# # # Copyright (C) 2006-2010 Andrew Speer . # 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; use Data::Dumper; 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 tag to display the # current CGI status # WEBDYNE_DUMP_FLAG => 0, # DTD to use when generating HTML # WEBDYNE_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 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;