#!/bin/perl -w -T use strict; use CGI qw/:standard/; #undef $ENV{PATH}; print header, start_html( -title => "The Perl Geek Code... decoded", -bgcolor => "#FFFFFF"), h1( "The Perl Geek Code... decoded"), hr; open( DESC, "; close DESC; my $code= param( 'code'); my $version= param( 'version'); print p( strong ( "The Perl Geek Code - Version " . $version)); # remove block delimiters $code=~ s/^\s*-----BEGIN PERL CODE BLOCK-----\s*\n\s*Version: \d\.\d\s*\n//; $code=~ s/\s*------END PERL CODE BLOCK------\s*$//; while( $code=~ m{((\w+) # the item $2 ([*!? +-]+) # the level $3 (?:\>([*!? +-]+))? # optional >level $4 (?:\(([*! ?+-]+)\))? # optional (level) $5 (\@)? # optional @ $6 (\$)? ) # optional $ $7 }gx # before a word character or the end ) { my( $item_code, $item, $level)= ($1, $2, $3); my ($wannabe, $range)= ($4, $5); my ($varies, $paid)= ( $6, $7); print h3($desc{$item}."[$item_code]"); print "

"; if( $range) { print "My tendencies on this issue range from: " . '"' . $desc{$item.$level} . '" to "' . $desc{$item.$range} . '"'; } else { my $desc=$desc{$item.$level} || "unknown field $item$level"; print $desc; } if( $wannabe) { print ' but someday I\'d like to say: "' . $desc{$item.$wannabe} .'"'; } print ' but that varies...' if( $varies); print ' and I\'m getting paid for it' if( $paid); print '


'; } print p( {align => "center"}, a( {href=>"http://www.xmltwig.com/pgc/"},"The Perl Geek Code Home") ), end_html;