#
#
#  Copyright (C) 2006-2010 Andrew Speer <andrew@webdyne.org>.
#  All rights reserved.
#
#  This file is part of WebDyne.
#
#  WebDyne is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#
package WebDyne::Constant;


#  Pragma
#
use strict qw(vars);
use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT_OK @EXPORT %Constant);
no warnings qw(uninitialized);
local $^W=0;


#  External modules
#
use WebDyne::Base;
use File::Spec;
require Opcode;


#  Version information
#
$VERSION='1.020';


#  Get mod_perl version. Clear $@ after evals
#
eval { require mod_perl2 if ($ENV{'MOD_PERL_API_VERSION'}==2) } ||
eval { require Apache2   if  $ENV{'MOD_PERL'}=~/1.99/ } ||
eval { require mod_perl  if  $ENV{'MOD_PERL'} };
eval { undef } if $@;
my $Mod_perl_version=$mod_perl::VERSION || $mod_perl2::VERSION || $ENV{MOD_PERL_API_VERSION};
my $MP2 = ($Mod_perl_version > 1.99) ? 1 : 0;


#  Hash of constants
#
%Constant = (


    #  Array structure index abstraction. Do not change or bad
    #  things will happen.
    #
    WEBDYNE_NODE_NAME_IX			=>	0,
    WEBDYNE_NODE_ATTR_IX			=>	1,
    WEBDYNE_NODE_CHLD_IX			=>	2,
    WEBDYNE_NODE_SBST_IX			=>	3,
    WEBDYNE_NODE_LINE_IX			=>	4,
    WEBDYNE_NODE_LINE_TAG_END_IX		=>	5,
    WEBDYNE_NODE_SRCE_IX			=>	6,


    #  Container structure
    #
    WEBDYNE_CONTAINER_META_IX			=> 	0,
    WEBDYNE_CONTAINER_DATA_IX			=> 	1,
    

    #  Where compiled scripts are stored. Scripts are stored in
    #  here with a the inode of the source file as the cache
    #  file name.
    #
    WEBDYNE_CACHE_DN				=>	&cache_dn,


    #  Empty cache files at startup ? Default is yes (psp files wil be
    #  recompiled again after a server restart)
    #
    WEBDYNE_STARTUP_CACHE_FLUSH			=>	1,


    #  How often to check cache for excess entries, clean to
    #  low_water if > high_water entries, based on last used
    #  time or frequency.
    #
    #  clean_method 0				= clean based on last used time (oldest
    #  get cleaned)
    #
    #  clean_method 1				= clean based on frequency of use (least
    #  used get cleaned)
    #
    WEBDYNE_CACHE_CHECK_FREQ			=>	256,
    WEBDYNE_CACHE_HIGH_WATER			=>	64,
    WEBDYNE_CACHE_LOW_WATER			=>	32,
    WEBDYNE_CACHE_CLEAN_METHOD			=>	1,


    #  Type of eval code to run - use Safe module, or direct. Direct
    #  is default, but may allow subversion of code
    #
    #  1					= Safe # Not tested much - don't assume it is really safe !
    #  0					= Direct (UnSafe)
    #
    WEBDYNE_EVAL_SAFE				=>	0,


    #  Prefix eval code with strict pragma. Can be undef'd to remove
    #  this behaviour, or altered to suit local taste
    #
    WEBDYNE_EVAL_USE_STRICT			=>	'use strict qw(vars);',


    #  Global opcode set, only these opcodes can be used if using a
    #  safe eval type. Uncomment the full_opset line if you want to
    #  be able to use all perl opcodes. Ignored if using direct eval
    #
    #WEBDYNE_EVAL_SAFE_OPCODE_AR		=>	[&Opcode::full_opset()],
    #WEBDYNE_EVAL_SAFE_OPCODE_AR			=>	[&Opcode::opset(':default')],
    WEBDYNE_EVAL_SAFE_OPCODE_AR			=>	[':default'],
    
    
    #  Use strict var checking, eg will check that a when ${varname} param
    #  exists with a HTML page that the calling perl code (a) supplies a
    #  "varname" hash parm, and (b) that param is not undef
    #
    WEBDYNE_STRICT_VARS				=>	1,
    WEBDYNE_STRICT_DEFINED_VARS			=>	0,


    #  When a perl method loaded by a user calls another method within
    #  that just-loaded package (eg sub foo { shift()->bar() }), the
    #  WebDyne AUTOLOAD method gets called to work out where "bar" is,
    #  as it is not in the WebDyne ISA stack.
    #
    #  By default, this gets done every time the routine is called,
    #  which can add up when done many times. By setting the var below
    #  to 1, the AUTOLOAD method will pollute the WebDyne class with
    #  a code ref to the method in question, saving a run through
    #  AUTOLOAD if it is ever called again. The downside - it is
    #  forever, and if your module has a method of the same name as
    #  one in the WebDyne class, it will clobber the WebDyne one, probably
    #  bringing the whole lot crashing down around your ears.
    #
    #  The upside. A speedup of about 10% on modules that use AUTOLOAD
    #  heavily
    #
    WEBDYNE_AUTOLOAD_POLLUTE			=>	0,


    #  Dump flag. Set to 1 if you want the <dump> tag to display the
    #  current CGI status
    #
    WEBDYNE_DUMP_FLAG				=>	0,


    #  DTD to use when generating HTML
    #
    WEBDYNE_DTD					=>
	'<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" '.
	'"http://www.w3.org/TR/html4/loose.dtd">',
	
	
    #  Content-type for text/html. Combined with charset to produce Content-type header
    #
    WEBDYNE_CONTENT_TYPE_HTML			=>	'text/html',


    #  Content-type for text/plain. As above
    #
    WEBDYNE_CONTENT_TYPE_PLAIN			=>	'text/plain',


    #  Encoding
    #
    WEBDYNE_CHARSET				=>	'ISO-8859-1',
    
    
    #  Include a Content-Type meta tag ?
    #
    WEBDYNE_CONTENT_TYPE_HTML_META		=>	0,


    #  Default <html> tag paramaters, eg { lang	=>'en-US' }
    #
    WEBDYNE_HTML_PARAM				=>	undef,


    #  Ignore ignorable whitespace in compile. Play around with these settings if
    #  you don't like the formatting of the compiled HTML. See HTML::TreeBuilder
    #  man page for details here
    #
    WEBDYNE_COMPILE_IGNORE_WHITESPACE		=>	1,
    WEBDYNE_COMPILE_NO_SPACE_COMPACTING		=>	0,


    #  Store and render comments ?
    #
    WEBDYNE_STORE_COMMENTS			=>	0,


    #  Send no-cache headers ?
    #
    WEBDYNE_NO_CACHE				=>	1,


    #  Render blocks outside of perl code
    #
    #WEBDYNE_DELAYED_BLOCK_RENDER		=>	1,


    #  Are warnings fatal ?
    #
    WEBDYNE_WARNINGS_FATAL			=>	0,


    #  CGI disable uploads default, max post size default
    #
    WEBDYNE_CGI_DISABLE_UPLOADS		        =>	1,
    WEBDYNE_CGI_POST_MAX			=>	(512 * 1024), #512Kb
    
    
    #  Expand CGI parameters found in CGI values, e.g. button with submit=1&name=2 will get those
    #  CGI params set.
    #
    WEBDYNE_CGI_PARAM_EXPAND			=>	1,
    
    
    #  Disable CGI autoescape of form fields ?
    #
    WEBDYNE_CGI_AUTOESCAPE                      =>      0,


    #  Error handling. Use text errors rather than HTML ?
    #
    WEBDYNE_ERROR_TEXT				=>	0,
    

    #  Show errors ? Extended shows additional information with granularity as per following
    #  section.
    #
    WEBDYNE_ERROR_SHOW			        =>	1,
    WEBDYNE_ERROR_SHOW_EXTENDED			=>	0,


    #  Show error, source file context, number of lines pre and post. Only applicable
    #  for extended + HTML error output.
    #
    WEBDYNE_ERROR_SOURCE_CONTEXT_SHOW		=>	1,
    WEBDYNE_ERROR_SOURCE_CONTEXT_LINES_PRE	=>	4,
    WEBDYNE_ERROR_SOURCE_CONTEXT_LINES_POST	=>	4,
    #  Max length of source line to show in ouput. 0 for unlimited.
    WEBDYNE_ERROR_SOURCE_CONTEXT_LINE_FRAGMENT_MAX=>	80,
    #  Show filename (including full filesystem path)
    WEBDYNE_ERROR_SOURCE_FILENAME_SHOW		=>	1,
    #  Show backtrace, show full or brief backtrace
    WEBDYNE_ERROR_BACKTRACE_SHOW		=>	1,
    WEBDYNE_ERROR_BACKTRACE_SHORT		=>	0,
    #  Show eval trace. Uses SOURCE_CONTEXT_LINES to determine number of lines to show
    WEBDYNE_ERROR_EVAL_CONTEXT_SHOW		=>	1,
    #  CGI Params
    WEBDYNE_ERROR_CGI_PARAM_SHOW		=>	1,
    #  URI and version
    WEBDYNE_ERROR_URI_SHOW			=>	1,
    WEBDYNE_ERROR_VERSION_SHOW			=>	1,
    
    
    #  Internal indexes for error eval handler array
    #
    WEBDYNE_ERROR_EVAL_TEXT_IX			=>	0,
    WEBDYNE_ERROR_EVAL_EMBEDDED_IX		=>	1,
    WEBDYNE_ERROR_EVAL_LINE_NO_IX		=>	2,
    
    
    #  Alternate error message if WEBDYNE_ERROR_SHOW disabled
    #
    WEBDYNE_ERROR_SHOW_ALTERNATE		=>
        'error display disabled - enable WEBDYNE_ERROR_SHOW to show errors, or review web server error log.',
    

    #  Mod_perl level. Do not change unless you know what you are
    #  doing.
    #
    MP2						=>	$MP2,
    MOD_PERL					=>	$Mod_perl_version


);


sub local_constant_load {

    my ($class, $constant_hr)=@_;
    debug("class $class, constant_hr %s", Dumper($constant_hr));
    my $local_constant_cn=local_constant_cn();
    debug("local_constant_cn $local_constant_cn");
    my $local_hr=(-f $local_constant_cn) && (do($local_constant_cn) ||
	warn "unable to read local constant file, $!");
    debug("local_hr $local_hr");
    if (my $hr=$local_hr->{$class}) {
	debug("found class $class hr %s", Dumper($hr));
	while(my($key,$val)=each %{$hr}) {
	    $constant_hr->{$key}=$val;
	}
    }


    #  Set via environment vars first
    #
    foreach my $key (keys %{$constant_hr}) {
	if (my $val=$ENV{$key}) {
	    debug("using environment value $val for key: $key");
	    $constant_hr->{$key}=$val;
	}
    }


    #  Then command line
    #
    #GetOptions($constant_hr, map { "$_=s" } keys %{$constant_hr});


    #  Load up Apache config - only if running under mod_perl
    #
    if ($Mod_perl_version) {


	#  Ignore die's for the moment so don't get caught by error handler
	#
	debug("detected mod_perl version $Mod_perl_version - loading Apache directives");
	local $SIG{'__DIE__'}=undef;
	my $server_or;
	eval {
	    #  Modern mod_perl 2
	    require Apache2::ServerUtil;
	    require APR::Table;
	    $server_or = Apache2::ServerUtil->server();
	};
	$@ && eval {
	    #  Interim mod_perl 1.99x
	    require Apache::ServerUtil;
	    require APR::Table;
	    $server_or = Apache::ServerUtil->server();
	};
	$@ && eval {
	    #  mod_perl 1x ?
	    require Apache::Table;
	    $server_or = Apache->server();
	};

	#  Clear any eval errors, set via dir_config now (overrides env)
	#
	$@ && do { eval { undef }; errclr() };
	debug("loaded server_or: $server_or");
	if ($server_or) {
	    my $table_or=$server_or->dir_config();
	    while(my($key,$val)=each %{$table_or}) {
		debug("installing value $val for Apache directive: $key");
		$constant_hr->{$key}=$val if exists $constant_hr->{$key};
	    }
	}
    }
    
    
    #  Is charset defined ? If so combine into content-type header
    #
    if (my $charset=$constant_hr->{'WEBDYNE_CHARSET'}) {
        $constant_hr->{'WEBDYNE_CONTENT_TYPE_HTML'}=sprintf("%s; charset=$charset", $constant_hr->{'WEBDYNE_CONTENT_TYPE_HTML'})
            unless $constant_hr->{'WEBDYNE_CONTENT_TYPE_HTML'}=~/charset=/;
        $constant_hr->{'WEBDYNE_CONTENT_TYPE_PLAIN'}=sprintf("%s; charset=$charset", $constant_hr->{'WEBDYNE_CONTENT_TYPE_PLAIN'})
            unless $constant_hr->{'WEBDYNE_CONTENT_TYPE_PLAIN'}=~/charset=/;
    }
            


    #  Done - return constant hash ref
    #
    $constant_hr;

}


sub local_constant_cn {


    #  Where local constants reside
    #
    my $local_constant_fn='webdyne.pm';
    my $local_constant_cn;
    if ($^O=~/MSWin[32|64]/) {
	my $dn=$ENV{'WEBDYNE_HOME'} || $ENV{'WEBDYNE'} || $ENV{'WINDIR'};
	$local_constant_cn=
	    File::Spec->catfile($dn, $local_constant_fn)
	}
    else {
	$local_constant_cn=File::Spec->catfile(
	    File::Spec->rootdir(), 'etc', $local_constant_fn)
    }
    return $local_constant_cn;

}


sub cache_dn {


    #  Where the cache directory should be located
    #
    my $cache_dn;
    if ($ENV{'PAR_TEMP'}) {
	$cache_dn=$ENV{'PAR_TEMP'}
    }


    #  Used to set like this - now leave the installer to
    #  find and set an appropriate location
    #
    #else {
	#require File::Temp;
	#$cache_dn=&File::Temp::tempdir( CLEANUP=> 1 );
    #}
    #elsif ($prefix) {
    #  $cache_dn=File::Spec->catdir($prefix, 'cache');
    #}
    #elsif ($^O=~/MSWin[32|64]/) {
    #  $cache_dn=File::Spec->catdir($ENV{'SYSTEMROOT'}, qw(TEMP webdyne))
    #}
    #else {
    #  $cache_dn=File::Spec->catdir(
    #    File::Spec->rootdir(), qw(var cache webdyne));
    #}
    return $cache_dn

}


sub hashref {

    my $class=shift();
    return \%{"${class}::Constant"};

}


#  Export constants to namespace, place in export tags
#
require Exporter;
@ISA=qw(Exporter);
&local_constant_load(__PACKAGE__,\%Constant);
foreach (keys %Constant) { ${$_}=$Constant{$_} }
@EXPORT=map { '$'.$_ } keys %Constant;
@EXPORT_OK=@EXPORT;
%EXPORT_TAGS=(all => [@EXPORT_OK]);
$_=\%Constant;
