package Zen;

use strict;

our $Engine;


sub import
{
	my ($class, $projectName) = @_;
	my $cpkg = caller;
	$Engine = (bless {}, $class)->init($projectName)
		if $projectName;
	return;
}

sub engine
{
	my $this = ref($_[0]) ? $_[0] : $Engine;
	$this or die 'engine is not initialized';
}

sub init
{
	my ($this, $projectName) = @_;

	$this->{ProjectName} = $projectName;

	# identifying loader and base locations

	($this->{LoaderDir} = $INC{"Zen.pm"}) =~ s!Zen\.pm$!!;
	die "a full path to Zen module should be defined through -I or 'use lib'"
		unless $this->{LoaderDir};
	($this->{BaseDir} = $this->{LoaderDir}) =~ s|[\w\-]+/$||;

	# read project configuration

	my %cfg;
	{
		my $fh;
		my $fn = "$this->{LoaderDir}/config.$this->{ProjectName}";
		open $fh, $fn or die "failed to open project config [$fn]: $!";
		for (<$fh>)
		{
			$cfg{$1} = $2 if /^(\w+)\s*(.*)[\r\n]*$/;
		}
		close $fh;
	}

	# set up kits

	my @kits = split /\s+/, $cfg{Kits};
	
	$this->{Kits} = [@kits]; # copy array!
	$this->{DefKits} = [@kits]; # copy array!

	# set up other parameters

	for (qw/
		CompileTo
		CompileOnTheFly
		
		ConfigDBC
		ConfigMailer
		
		EmailOnDie
		EnableErrLog
		
		Language
	/)
	{
		die "parameter $_ missing in the project config [$projectName]"
			unless exists $cfg{$_};
		$this->{$_} = $cfg{$_};
	}
	$this->{CompileTo} .= '/'
		if $this->{CompileTo} && $this->{CompileTo} !~ m|/^|;
	
	$ENV{SERVER_NAME} ||= $cfg{ServerName};
	$ENV{HTTP_HOST} ||= $cfg{HttpHost};
	$ENV{DOCUMENT_ROOT} ||= $cfg{DocumentRoot};
	$ENV{SCRIPT_NAME} ||= $cfg{ScriptName};
	$ENV{SCRIPT_FILENAME} ||= $cfg{ScriptFilename};

	# set up paths to perl modules

	for my $kit (reverse @kits)
	{
		if ($kit =~ /\.par$/)
		{
			require PAR;
			PAR->import;
			unshift @INC, "$this->{BaseDir}$kit";
		}
		else
		{
			unshift @INC, "$this->{BaseDir}$kit";
			unshift @INC, "$this->{BaseDir}$this->{CompileTo}$kit"
				if $this->{CompileTo};
		}
	}

	$this->{DefINC} = [@INC]; # copy array!

	
	# set up warn and die handling

	if ($this->{EnableErrLog})
	{
		$SIG{__WARN__} = sub
		{
			my $msg = shift;
			my $log_fh = $this->{LogFH} ||= do
			{
				my $d = $this->getSitebox . 'logs';
				-d $d or mkdir($d, 0777) or die "failed to create dir [$d]: $!";
				my $fn = "$d/$this->{ProjectName}.errlog";
				my $fh;
				open $fh, ">>$fn" or die "failed to open [$fn]: $!";
				my $oldfs = select $fh; $| = 1; select $oldfs;
				$fh;
			};
			print $log_fh sprintf("W [%s] %s", scalar(localtime time), $msg);
		};
	}

	$SIG{__DIE__} = sub
	{
		my $msg = shift;

		exit(1)
			if $msg =~ /ModPerl\:\:Util\:\:exit/;

		$msg =~ s/\s+at \S+ line \S+$//;
		$msg .= "\n";

		my $i = 0;
		while (my @trace = caller($i++))
		{
			$msg .= sprintf("\t%s:%s %s\n", (index($trace[1], $this->{BaseDir}) == 0 ? substr($trace[1], length($this->{BaseDir})) : $trace[1]), @trace[2,3]);
		}
		
		warn($msg);

		# send out email 

		if ($this->{EmailOnDie})
		{
			my $mail_cmd = "/usr/sbin/sendmail -t";
			my $mail;
			my $env = join("\n", map { "$_: $ENV{$_}" } sort keys %ENV);
			open $mail, "|$mail_cmd" or print STDERR "failed to send mail on die: $!\n";
			print $mail <<END;
To: $this->{EmailOnDie}
Subject: Script Error!

$msg

$env
END
			close $mail;
		}

		# display bluescreen
		
		$this->{Request}->bluescreen('fatal', "<pre>$msg</pre>")
			if $this->{Request};

		exit(1);
	};

	$this;
}

#
#  getters

sub getKits				{ @{ $_[0]->engine->{Kits} } }
sub getCompileTo		{ $_[0]->engine->{CompileTo} }
sub getCompileOnTheFly	{ $_[0]->engine->{CompileOnTheFly} }
sub getConfigDBC		{ $_[0]->engine->{ConfigDBC} }
sub getConfigMailer		{ $_[0]->engine->{ConfigMailer} }

#
# engine directories and kits

sub getBaseDir { $_[0]->engine->{BaseDir} }

sub getSitebox
{
	my $this = shift->engine;
	$this->{SiteboxDir} ||= do
	{
		my $d = "$this->{BaseDir}zen-sitebox/";
		-d $d or mkdir($d, 0777) or die "failed to create dir [$d]: $!";
		$d;
	};
}

sub unshiftKits
{
	my $this = shift->engine;
	my $newkit = shift;
	
	unshift @{ $this->{Kits} }, $newkit;

	unshift @INC, "$this->{BaseDir}$newkit";
	unshift @INC, "$this->{BaseDir}$this->{CompileTo}$newkit"
		if $this->{CompileTo};
	
	return;
}

sub setDefaultKits
{
	my $this = shift->engine;

	@{ $this->{Kits} } = @{ $this->{DefKits} }; # copy array!
	@INC = @{ $this->{DefINC} }; # copy array!

	return;
}

sub saveKits
{
	my $this = shift->engine;

	@{ $this->{SavedKits} ||= [] } = @{ $this->{Kits} }; # copy array!
	@{ $this->{SavedINC} ||= [] } = @INC; # copy array!

	return;
}

sub restoreKits
{
	my $this = shift->engine;

	@{ $this->{Kits} } = @{ $this->{SavedKits} }; # copy array!
	@INC = @{ $this->{SavedINC} }; # copy array!

	undef $this->{SavedKits};
	undef $this->{SavedINC};
	
	return;
}

#
# engine cache

sub getEngineCache
{
	my $this = shift;
	$this->{Cache} ||= {};
}

#
# engine files

sub engineFile
{
	my $this = shift->engine;
	my $file = shift;

	my $data;
	
	# then try to get the file directly
	
	for my $k (@{$this->{Kits}})
	{
		if ($k =~ /\.par$/i && $INC{'PAR.pm'})
		{
			$data = PAR::read_file($file);
			return $data
				if defined $data;
		}
		else
		{
			my $fullpath = $this->{BaseDir} . $k . '/' . $file;
			return $fullpath
				if -f $fullpath;
		}
	}

	return;
}

sub engineFileContent
{
	my $this = shift->engine;
	my $file = shift;

	my $fullpath = $this->engineFile($file)
		or return;

	my $fh;
	open $fh, $fullpath or die "failed to open engine file [$fullpath]: $!";
	binmode $fh;
	my $data;
	read $fh, $data, -s $fh;
	close $fh;

	return $data;
}

sub engineDir
{
	my $this = shift->engine;
	my ($type, $fore) = @_;
	my @kits = grep { -d $_ } map {"$this->{BaseDir}$_/$type"} @{$this->{Kits}};
	$fore ? $kits[1] : $kits[0];
}

#
# language

sub getLanguage { $_[0]->engine->{Language} }
sub setLanguage { $_[0]->engine->{Language} = $_[1] }

#
# CGI/FCGI request

sub hasRequest { $_[0]->engine->{Request} }
sub getRequest { $_[0]->engine->{Request} or die 'request undefined' }
sub setRequest { $_[0]->engine->{Request} = $_[1] }

1;
