#!/usr/bin/perl # -*- perl -*- # C. Alex. North-Keys # Incept: 2007-06-07 21:58:37 CDT (Jun Thu) 1181271517 # render.cgi # accept a New York Times' .puz file for input and render it. # # requires the following in a relevant .htaccess file: # # AddOutputFilter INCLUDES .cgi # use strict; use CGI qw/:standard -private_tempfiles/; use IO::Handle; use IPC::Open2; my $ssi_wrapper_prefix = '/~erlkonig/'; # my $ssi_wrapper_prefix = ''; sub HtmlHeaderSSI # args: title { my $swp = $ssi_wrapper_prefix; my $html = ('' . "Content-type: text/html\n\n" . "\n" . "\n" . '' . "\n" . ''. "\n" . "\n" . '' . "\n" ); } sub HtmlTrailerSSI { my $swp = $ssi_wrapper_prefix; my $html = ('' . "\n" ."\n" ); } sub QueryTable { my ($query) = @_; my $html = ("\n" ."\n"); my @params = $query->param; my ($key); foreach my $key (sort @params) { my @data = $query->param($key); $html .= ('
Request Data
' . $key . "\n" ."

\n"); $html .= join("\n", @data); $html .= ("

\n" ."\n"); } $html .= "
\n"; return $html; } sub EnvironmentTable { my $html = ("\n" . "\n"); my ($key); foreach $key (sort keys(%ENV)) { my ($value) = $ENV{$key}; $html .= ('
Environment
' . $key . "\n" . "

\n" .$value ."

\n" ."\n"); } $html .= "
\n"; } sub Sanitize { my ($text) = @_; $text =~ y/-A-Za-z0-9.%_+//cd; # sanitization return $text; } sub SanitizePath # $pathname -- $relative-downward-only-path { my ($text) = @_; $text =~ y/-A-Za-z0-9.%_+\///cd; # sanitization - keep asterisks $text =~ s@^[\./]*/@/@; # toss all initial slashes and dots (to /) $text =~ s@/\.\./@@g; # toss all embedded /../ $text =~ s@/$@@; # toss trailing / return $text; } sub GetPuzzleData { my ($query) = @_; my $data = ''; my @fhs = $query->param("file_to_upload"); my $fh = $fhs[0]; my @infos = $query->uploadInfo($fh); foreach my $info (@infos) { my $type = $info->{'Content-Type'}; if(defined($type)) { while(<$fh>) { $data .= $_; } } } return $data; } sub SubdirAsUL # $directory -- $html-ul/li list { my($dir, $depthleft) = @_; my $html; if(opendir(DIR, $dir)) { my @entries = grep { /^[^.]/ ; } readdir(DIR); closedir(DIR); $html .= "\n"; } else { $html .= 'Target area inaccessible!autoflush(1); print(COMMANDS $data); close(COMMANDS); $output .= join('', ); close(RESULTS); waitpid($pid, 0); } } return ($output, $needs_html_wrapper); } sub Main { my $query = new CGI; my $puz = GetPuzzleData($query); my $format = $query->param("output_format"); my $answers = $query->param("show_answers") =~ m/^yes/i; my $key = $query->param("scramble_key"); if($key !~ /^\d\d\d\d$/) { $key = undef; } my ($rendered, $needs_html_wrapper) = RenderPuzzle($puz, $answers, $format, $key); if($needs_html_wrapper) { my $html = '' . &HtmlHeaderSSI() . ('' # . "puzdate: $puz\n" # . &QueryTable($query) . $rendered # . &EnvironmentTable() ) . &HtmlTrailerSSI(); print $html; } else { print $rendered; } exit 0; } &Main(); #-------------eof