package ExBase::Core;
#
# Copyright 2004 Bee Flag, Corp. All Rights Reserved.
# Masatoshi Mizuno <mizuno@beeflag.com>
#
# $Id: Core.pm,v 1.1 2005/07/26 19:44:44 Lushe Exp $
#
use strict;
use CGI;
use Jcode;
use FileHandle;
use HTML::Template::Ex;

our $VERSION = q$0.02$;
our $REVISION= q$Id: Core.pm,v 1.1 2005/07/26 19:44:44 Lushe Exp $;

sub REVISION { $REVISION }
sub eucConv  { defined($_[1]) ? Jcode->new($_[1])->euc: "" }
sub cgi { $_[0]->{cgi} }

sub run {
	my($class, $conf, $apr)= @_;
	my $cgi = $conf->{cgi}= CGI->new($apr);
	my $base= bless $conf, $class;
	my($path, $file);
	$conf->{___ApacheHandler} ? do {
		($path, $file)= $base->pathCuter($ENV{REQUEST_URI});
	 }: do {
		($path, $file)=
		 $cgi->param('path') ? $base->pathCuter($cgi->param('path')):
		 ($ENV{QUERY_STRING} && $ENV{QUERY_STRING}=~/^([^\&\;]+)/)
		 ? $base->pathCuter($1): ('/', $base->{indexName});
	 };
	$cgi->charset($conf->{charset});
	$file=~s{\.htm$} [.html];
	(-e "$base->{VRsite}$path$file" && -f _)
	 ? do { $base->execute($cgi, $path, $file) }
	 : do { print $cgi->header. q{<h1>404 File Not Found.</h1>} };
}
sub execute {
	my($base, $cgi, $path, $file)= @_;
	my $send= $base->{deflateOk} ? \&sendContent: \&sendContent;
	$base->{currentPage}= "$path$file";
	$base->{rewrite} ? do {
		$base->{baseRoot}  = $base->{siteRoot};
		$base->{currentUri}= $base->{currentPage};
	 }: do {
		$base->{baseRoot}  = "$base->{cgiPath}?$base->{siteRoot}";
		$base->{currentUri}= "$base->{cgiPath}?$base->{currentPage}";
	 };
	my $Vars= $cgi->Vars;
	while (my($name, $value)= each %$Vars) {
		$value=~tr/\t/ /;
		$value=~s{\r\n?} [\n]sg;
		$Vars->{$name}= $base->eucConv($value);
	}
	my @path= ("$base->{VRsite}$path", @{$base->{options}{path}});
	$base->{___tpOptions}=
	{ path=> \@path, filename => $file, associate=> [$cgi] };
	my $tmpl;
	eval{ $tmpl= HTML::Template::Ex->new($base, $base->{___tpOptions}) };
	$@ ? do {
		print $cgi->header, "Internal Server Error: $@";
	 }: do {
		$tmpl->param({
		 title=> $base->{title},
		 cgiPath => $base->{cgiPath},
		 baseRoot=> $base->{baseRoot},
		 siteRoot=> $base->{siteRoot},
		 currentUri=> $base->{currentUri},
		 currentPage=> $base->{currentPage},
		 scriptVersion=> sub { $base->scriptVersion },
		 supportURL=> 'http://exbase.luuu.net/',
		 });
		$send->($base, $cgi, $tmpl);
	 };
}
sub sendContent {
	print $_[1]->header, $_[2]->output;
}
sub sendDeflateContent {
}
sub fileOpen {
	my $base= shift;
	my $file= shift || return 0;
	FileHandle->new($file) || 0;
}
sub pathCuter {
	my $base= shift;
	my $path= shift || return ("/", $base->{indexName});
	my($dir, $file)=
	  $path=~m{^(/.*?)([^/]+)$} ? ($1, $2): ($path, $base->{indexName});
	(($dir || '/'), $file);
}
sub scriptVersion { $REVISION=~/v\s+([\.\d]+)/; __PACKAGE__." V$1" }

1;

