#!/usr/local/bin/perl use strict; use warnings; use CGI; use CGI::Carp qw (fatalsToBrowser); use Cwd; use Net::CIDR; use Data::Dumper; use Template; $| = 1; # set autoflush $/ = undef; # slurp mode my $q = CGI->new(); my $basedir = getcwd(); my $tt2_file = join('', @ENV{qw(DOCUMENT_ROOT PATH_INFO)}); (my $dir = $tt2_file) =~ s/[^\/]*$//; chdir($dir); open(TT2, $tt2_file) || die "Couldn't open file $tt2_file\n"; my $tt2_page=; close(TT2); $/ = "\n"; # anything in headers gets sent as $key: $value\n # specials is for controlling this script and controlling the # templates, as opposed to normal variables which are for # controlling what goes *into* templates my $ttvars = { cgi => { map { ($_, $q->param($_)) } $q->param() }, cookie => { map { ($_, $q->cookie($_)) } $q->cookie() }, env => { map { (lc($_), $ENV{$_}) } keys %ENV }, specials => {}, headers => {}, ((-f '_allfiles.tt2.data') ? do '_allfiles.tt2.data' : ()), ((-f "$tt2_file.data") ? do "$tt2_file.data" : ()) }; $ttvars->{headers}->{'Content-type'} ||= 'text/html'; $ttvars->{specials}->{cwd} ||= $dir; $ttvars->{specials}->{tt2file} ||= $tt2_file; # in order of priority this can be ... # set in a .data file; # set in a cookie; # divined from HTTP headers my %mobile_ips = ( '149.254.192.0/22' => 1, '127.0.0.0/8' => 1, ); foreach (keys %{$ttvars->{headers}}) { print "$_: ".$ttvars->{headers}->{$_}."\n"; } print "\n"; # create this sucka as late as possible so we can set $Template::Config::STASH # if we need to in a .data file my $tt2 = Template->new( INCLUDE_PATH => ".:$basedir", ABSOLUTE => 1, POST_CHOMP => 1, PRE_CHOMP => 1, FILTERS => { compressor => sub { my $t = shift; $t =~ s/\s+/ /g; $t } }, TRIM => 1, EVAL_PERL => 1 ); ( ($ttvars->{specials}->{NOTT2SURROUNDINGS} || $tt2->process('header.tt2', $ttvars, \&printer)) && $tt2->process($tt2_file, $ttvars, \&printer) && ($ttvars->{specials}->{NOTT2SURROUNDINGS} || $tt2->process('footer.tt2', $ttvars, \&printer)) # && print ''.Dumper($ttvars).'' # && print '' ) || # print "

ERROR

$tt2_page".Dumper($ttvars)."" print "

ERROR

Bad juju happened. Please let me know." ; sub printer { my $t = shift; $t =~ s!!!gi if(index($ENV{HTTP_USER_AGENT}, 'evilrobot') != 0); $t =~ s!!$ttvars->{insert_in_head}!i if($ttvars->{insert_in_head}); print $t; }