#!/usr/bin/perl -wT
use strict;
$|++;


BEGIN {
    require '/usr/home/little/data/values.dat';
}
    
my %CONF;
eval {
 populateHash(\%CONF,'/usr/home/little/conf/cfg');
};
if ($@) {
    print "Content-Type: text/html\n\n";
    print "<h1>Couldn't initialize!</h1>";
    print "$@";
    exit 0;
}

use CGI qw/:standard /;
$CGI::DISABLE_UPLOADS = 1;
$CGI::POST_MAX = 0;
# alternatively use CGI::Safe :-)

# never on Live-Server
use CGI::Carp qw(fatalsToBrowser);
use Storable qw(store retrieve);
use LWP::Simple;

## END: LOAD MODULES ##


my $ENDUNG = ".html";

my %pages = (
'head'    => $CONF{'TEMPLATES_DIR'}.'header/header.shtml',
'foot'    => $CONF{'TEMPLATES_DIR'}.'footer/footer.shtml',
'error'   => $CONF{'TEMPLATES_DIR'}.'error.txt',
'default' => $CONF{'TEMPLATES_DIR'}.'index'.$ENDUNG,
'id'      => '',
'keywords'=> ''
);

            
my %myVars = (
'autor'   => 'minka',
'counter' => \&counter,
'zufall' => \&random,
'userlist' => \&userlist
);
## END: CONFIG ##

my $zu ='default';

if (!param('keywords')) {
    if (param('id')) {
        if (param('id') =~ m/(\.(\.)?\/)|(\\)/) {
            $zu = 'error';
        } else {    
            $pages{'id'} = $CONF{'TEMPLATES_DIR'}.param('id').$ENDUNG;
            $zu = (-e $pages{'id'})? 'id' : 'error';
        }
    }
}

## Ausgabe ##
print header;

foreach my $tmp ('head',$zu,'foot') {
    my $line = ${slurpFile($pages{$tmp},'string')};
    # are names requested in the file?
    if ($line =~ m/\$(\w+)/g) {
        # if so, load hash %myVars from a file
        populateHash(\%myVars,$CONF{'DATEN_DIR'}.'variablen.txt');
        # now try to replace the name with its value 
        $line =~ s/\$(\w+)/${getValue(\%myVars,\$1);}/sgex;
    }
    print $line;
}
 
# END #
 
## SUBROUTINES ##

#####
## getValue(\%hash,\$string);
## input: - hashref (required) to the Hash to be looked up
##        - stringref (required) which shall be found as key in the ha
+sh
## ouptut: - value if a value for the given keywas found 
##         - otherwise an empty string (false value) if it failed
#####
 
sub getValue {
    # gimme a ref to a hash
    my $tmp = $_[0] || die "Ungenügende oder falsche Parameter: Refere
+nz des zu durchsuchenden Hashes muß übergeben werden!";
    # gimme a name to look up
    my $var = ${$_[1]} || die "Ungenügende Parameter: Der Schlüssel fü
+r den Rückgabewert muß als Referenz übergeben werden!";
    # I won't say anything unless I have something to tell
    my $result = '';
    # does the provided hash have such key?
    if (exists %{$tmp}->{$var}) {
        # is the value for that key not a ref?
        if (!ref(%{$tmp}->{$var})){
            # the answer will be the value 
            $result = %{$tmp}->{$var};
        # but if the value is a ref, is it a coderef?
        }elsif (ref(%{$tmp}->{$var}) eq 'CODE' )  {
            # well, lets execute it
            $result = &{%{$tmp}->{$var}};
        }
    # here starts the nightmare
    # so the provide hash had no key with such name
    } else {
        # I FEAR THIS
        no strict "refs";
        # uhm, but it exists in our namespace ? in our scope? 
        if (defined $$var){
            # if so, then take the value of the skalar 
            $result = $$var;
        } else {        
        warn "undefined Variable $var requested!";
        }
    }
    return \$result;
}

sub populateHash {
    my $tmp = $_[0] || die "Missing parameter: Referenz des zu füllend
+en Hashes muß übergeben werden!";
    my $file = $_[1] || die "Eine Datei zum Einlesen der Werte in den 
+Hash wird benötigt!";
    die "Wrong call!Der erste übergebene Parameter muß eine Referenz a
+uf einen Hash sein!" unless (ref($tmp));
    die "Der erste übergebene Parameter muß eine Referenz auf einen Ha
+sh sein!" unless (ref($tmp) eq "HASH") ;

    foreach (@{slurpFile($file,'array','#')}) {
        chomp;
            next if !/\S/;
            my($var, $val) = $_ =~ /^\s*(\S+)\s+(.+)$/;
            $val =~ s/\s*$//;
            next unless $var && $val;
        %{$tmp}->{$var} = $val;
    }
    return;
}
 
sub slurpFile {
        my $file = shift || die "Missing parameter: Path/filename !";
        my $mode = shift || '';
        my $ignore = shift || '';
        $mode = ( grep { $_ eq $mode} ('string','array'))? $mode: 'arr
+ay';
        my $content;
        die "Couldn't find file $file , request in line:".(caller)[2].
+'!' unless (-e $file);
        open (HANDLE,"<".$file) || die "Couldn't open file $file to re
+ad from: $!";
        if ($mode eq 'array') {
            while (<HANDLE>) {
                next if ($ignore && (/$ignore/));
                chomp;
                push @{$content}, $_ ;
            }
    } elsif ($mode eq 'string') {
            local $/ = undef;
            ${$content} = <HANDLE>;
        }
        close (HANDLE);
        return $content;
}
# was not my idea
sub random {
    my $zahl;
    foreach (1..9) {
        $zahl .= int(rand(9));
    }
    return $zahl;
}
# I wonder what happens upon server crash, probably sets back to zero
# wanna test? crash the server *grin*
sub counter {
        my $tmp;
        $tmp = retrieve($CONF{'TEMP_DIR'}.'counter') if (-e $CONF{'TEM
+P_DIR'}.'counter');
    ${$tmp}++;
        store($tmp, $CONF{'TEMP_DIR'}.'counter') or die "Kann nicht in
+ $CONF{'TEMP_DIR'}counter speichern!\n";
        return ${$tmp};
};

#quick n dirty
sub userlist {
    # uncomment if proper URL provided
    # my $url = "http://bla/liste.txt";
    # my $inhalt = get($url);
    # comment out if proper URL provided
    my $inhalt = ${slurpFile($CONF{'DATEN_DIR'}.'users','string')};
    my $liste;
    my $bgcolor = ${getValue(\%myVars,\'bgcolor');};
    if ($inhalt) {
        $liste = join('', 
        map {'<tr><td bgcolor="'.$bgcolor.'">'.$_->[0].'</td><td>'.$_-
+>[1].'</td></tr>'."\n" }
        map {[/\((.*?)\)/sg]}
        split(/\r?\n/, $inhalt));
    }
    $liste = '<tr><td colspan="2">List is empty</td></tr>' unless $lis
+te;
    return $liste;
};

1;
[download]

Edit: chipmunk 2002-02-12