#!/usr/bin/perl # pjcs - 2024-07-12 - revised version use utf8; use v5.26; use warnings; use HTML::Entities; use Encode 'decode_utf8'; use URI::Escape; # in content script our ($analysis, $array1, $array2, $base, %data, $date, $examples, $f9_can_execute, $heading, $hilit, $id, $name, $next, $one, $onex, $output, $prev, $PRODUCTION, $root, $task, $task_no, $try_eval, $try_it, $two, $twox, $week); my (@t, $today10, $timestamp, $log); # standard start pwc_start(); # more or main if ($data{more}) { show_more() } else { show_main() } # ----- sub show_main { my ($date2, $db, $e, $err, $next_link, $prev_link, $script, $status, $styles, $task1, $task2, $f91, $f92); # get week and task_no ($week, $task_no, $status, $prev, $next) = get_week_data(); # get content if ($status) { require qq[$root/content/content_${week}_$task_no.pl] } else { $err = qq[No content file for week $week task $task_no] } # get highlit source script if (open HILIT, '; close HILIT; $/ = qq[\n]; $hilit =~ m|(.*?)|s; $styles = qq[]; $styles =~ s|span .*?\}||s; $hilit =~ m|.*(.*?).*|s; $script = qq[
\n\n$1\n
\n]; } else { $script = qq[No highlit source file for week $week task $task_no]; $styles = ''; } # heading $date =~ m|(\d+)\s+(\w+)\s+(\d+)|; # 1 January 2024 $date2 = sprintf('%d %s %d', $1, substr($2, 0, 3), $3); # page heading page_begin({title => 'The Weekly Challenge', description => 'The Weekly Challenge', styles => $styles, heading => $heading, line1 => qq[Weekly challenge $week — $date], line2 => qq[Week $week: $date2]}); # for $e (sort keys %data) { say qq[
$e: $data{$e} ] }; if ($err) { say $err; page_end(); exit; } # skip to try_it say qq[] if $data{submit}; # prev & next prev_and_next(); # tabs $task1 = -e qq[$root/content/content_${week}_1.pl] ? 'Task 1' : ''; $task2 = -e qq[$root/content/content_${week}_2.pl] ? 'Task 2' : ''; tabs("$task1|$task2|More", "/challenge/$week/1|/challenge/$week/2|/challenge?more=index", $task_no - 1, 1, 0); # non-existent task unless ($status) { say qq[

Sorry, I did not submit a solution for this task.]; page_end(); exit; } # left column - task name $task =~ s|!!!(.*?)!!!|

$1
|sg; $task =~ s|!!(.*?)!!|$1|sg; say qq[

Task \— $name

$task]; # examples if ($examples) { $examples =~ s|\n(Example\s*\d+)|\n\n$1|g unless $examples =~ m||; $examples =~ s|[\n\s]+Example|\nExample|gs; $examples =~ s|\n*$|\n\n|s; $examples =~ s|^(\s*)Input([\d\s]*?):|$1Input$2:|gm; $examples =~ s|^(\s*)Out?put([\d\s]*?):|$1Output$2:|gm; say qq[

Examples

$examples
]; } # analysis $analysis =~ s|!!!(.*?)!!!|
$1
|sg; $analysis =~ s|!!(.*?)!!|$1|sg; say qq[

Analysis

$analysis]; # try_it if ($try_it) { @t = localtime(); $timestamp = sprintf('%04d-%02d-%02d %02d:%02d:%02d', $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0]); # 2020-12-25 09:35:20 say qq[

Try it 

$try_it]; if ($data{submit} and defined($try_eval)) { unless ($week == 165) { $try_eval =~ s|^\n+|\n|s; $try_eval =~ s|\n+$|\n|s; $try_eval =~ s|^Input([\d\s]*?):|Input$1:|gm; $try_eval =~ s|^Output([\d\s]*?):|Output$1:|gm; } else { # special case for SVG challenges unless ($try_eval =~ m|^invalid|) { $try_eval = `cat /var/www/pwc/public_html/tmp/temp_165_2_$id.txt`; $try_eval .= qq[]; } } say qq[
Your results:
\n$try_eval
] if $try_eval; # record usage if ($PRODUCTION) { $two = $two ? qq[ p2=($two)] : ''; $log = uri_escape(qq[$timestamp ch=$week:$task_no url=$ENV{REMOTE_ADDR} p1=($one)$two]); `curl -s http://campbellsmiths.f9.co.uk:8083/perl/log_tryit.pl?z=$log`; } } } say qq[

\n]; # right column - script say qq[

Script

$script]; # output $output =~ s|^Input([\d\s]*?):|Input$1:|gm; $output =~ s|^Output([\d\s]*?):|Output$1:|gm; say qq[

Output

$output]; say qq[

]; page_end(); } sub show_more { my ($FILE, $date, $line, $result, $task1, $task2, $f91, $f92, $week, $this_week, %found, $sub1, $sub2, $x, $priv, $ln1, $ln2, $tloc); # get latest week open $FILE, '; close $FILE; $line =~ m|¦(\d\d\d)¦|; $this_week = $1; $priv = -e './check_all'; # page heading page_begin({title => 'The Weekly Challenge', description => 'The Weekly Challenge', styles => '', heading => qq[The Weekly Challenge
Week $this_week], line1 => 'More information'}); # tabs $task1 = -e qq[$root/content/content_${this_week}_1.pl] ? 'Task 1' : ''; $task2 = -e qq[$root/content/content_${this_week}_2.pl] ? 'Task 2' : ''; tabs("$task1|$task2|More", "/challenge/$this_week/1|/challenge/$this_week/2|/challenge?more=1", 2, 1, 0); # top stuff say qq[

Perl

]; say qq[
]; $data{more} = 'index' unless $data{more} =~ m|^[a-z]|; if ($data{more} eq 'index') { # display $data{find} = '' unless $data{find}; say qq[

Peter's solutions

]; # search entries if ($data{find}) { $data{find} =~ s|'||g; $result = `grep -l -i '$data{find}' $root/content/*.pl`; while ($result =~ m|(\d\d\d)_(\d)|g) { $found{$1}{$2} = 1; } } # show results or all say qq[

]; open $FILE, ') { ($date, $week, $task1, $task2, $x, $x, $sub1, $sub2, $f91, $f92, $ln1, $ln2) = split('¦', $line); $sub1 = $sub2 = 'Y' if $week == $this_week; $task1 .= ' *' if ($task1 and $sub1 ne 'Y'); $task2 .= ' *' if ($task2 and $sub2 ne 'Y'); $task1 .= ' →' if ($task1 and $f91 ne 'Y' and $priv); $task2 .= ' →' if ($task2 and $f92 ne 'Y' and $priv); if ($data{find}) { next unless defined $found{$week}; $task1 = "$task1" if $found{$week}{1}; $task2 = "$task2" if $found{$week}{2}; } $date =~ m|\d\d(\d\d).(\d+).(\d+)|; $date = qq[$3.$2.$1]; say qq[]; if ($week == 233) { say qq[]; } $tloc += $ln1 + $ln2; } say qq[
 Date Task 1 Task 2 Week
 $date

$task1 [$ln1]

$task2 [$ln2]

  $week
 28.08.23 No challenge was set for this week
]; close $FILE; say qq[]; say qq[] if $priv; say qq[
*solved after the closing date
[nn]lines of code for task
$tloctotal lines of code
→try-it uses web service on Joppa
]; say qq[

]; } else { # text page open $FILE, '<:utf8:', qq[$root/more/$data{more}.htm]; undef $/; $result = <$FILE>; close $FILE; $result =~ s||$base|egs; say qq[$result]; } page_end(); } sub get_week_data { my ($FILE, $line, @vals, $task_no, $week, $prev, $next); # week and task_no $week = defined $data{week} ? $data{week} : 0; $task_no = defined($data{task_no}) ? $data{task_no} : 1; # get prev and next open $FILE, ') { @vals = split(/¦/, $line); # default to latest week $week = $vals[1] unless $week; if ($week == $vals[1]) { $task_no = 2 unless $task_no; $prev = $vals[4] + 0; $next = $vals[5] + 0; last; } } close $FILE; # return week, task, status return ($week, $task_no, -e qq[$root/content/content_${week}_$task_no.pl], $prev, $next); } sub page_begin { # standard page header # print page header my $k; my %params = %{$_[0]}; for $k (qw[styles heading line1 line2]) { $params{$k} = '' unless $params{$k}; } say qq[Content-type: text/html; charset=UTF-8 The Weekly Challenge $params{styles}
Camel
Peter
Peter Campbell Smith

$params{heading}

$params{line1}

$params{line2}

]; } sub page_end { # footing say qq[

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain

]; } sub pwc_start { my ($DEBUG, $HOSTNAME, $hostname, @t); use Encode; # various encode/decode functions use POSIX qw(tzset); # sets to UK time rather than where the server is use open qw(:utf8); # opens all text files in UTF-8 mode use Time::Local; $ENV{TZ} = 'Europe/London'; tzset; # environment $DEBUG = 0; # hostname on Linux $hostname = `hostname`; $hostname =~ s|[\r\n]+$||g; $HOSTNAME = $hostname; $PRODUCTION = $ENV{HTTP_HOST} !~ m|joppa|; # file system root and website base if ($PRODUCTION) { $root = `pwd`; $root =~ s|pwc(.*)|pwc|s; $base = '/pwc'; } else { $root = '/var/www/pwc/public_html'; $base = ''; } # make STDOUT and STDIN utf8 binmode(STDOUT, ':utf8'); binmode(STDIN, ':utf8'); # get paramter data %data = get_data(); } sub get_data { # () my ($item, $j, $param, $query, $save, $value, %params, %result, @list); # returns get and post parameters as hash, so $result{key} -> value use Encode; use URI::Escape; %params = (); for $j (1 .. 2) { if ($j == 1) { # parameters in URI (ie method = get) $query = $ENV{QUERY_STRING} . '&'; } else { # parameters in form (ie method = post) last unless $ENV{REQUEST_METHOD} eq 'POST'; $save = $/; undef $/; $params{post_body} = ; $query .= $params{post_body}; $query =~ s|\+| |g; $/ = $save; } if ($query) { @list = split /&/, $query; # must split before unescaping in case there's a '=' escaped foreach $item (@list) { ($param, $value) = split(/=/, $item, 2); if ($param) { $param = uri_unescape($param); $value = uri_unescape($value); utf8::decode($param); utf8::decode($value); $params{$param} = $value if $param; } } } } return %params; } sub tabs { # captions, screens, selected, can_switch, can_select my ($c, $can_select, $can_switch, $i, $num_tabs, $selected, $t, $w_spc, $w_tab, @captions, @screens); # captions = pipe-separated list of tab captions - eg one|two|three # screens = pipe-separated links for the captions - eg one.pl?param=1|two.pl?param=1|two.pl?param=3 # selected = 0-based index of selected tab - eg 0 is the first one # can_switch = true if the unselected tabs can be activated, false if not # can_select = true if the tab caption is still a link when the tab is selected (default is false) @captions = split /\|/, $_[0]; @screens = split /\|/, $_[1]; $selected = $_[2]; $can_switch = $_[3]; $can_select = $_[4]; $num_tabs = scalar @captions; $w_tab = qq[calc(90% / $num_tabs - 2px)]; $w_spc = qq[calc(5% - ${num_tabs}px)]; print qq[

\n]; # loop over tabs for $i (0 .. $num_tabs - 1) { if ($i == $selected and not $can_select) { # selected and unclickable $c = 'tab_sel'; $t = $captions[$i]; } elsif ($i == $selected) { # selected and clickable $c = 'tab_sel'; $t = qq[$captions[$i]]; } elsif ($can_switch) { # unselected and clickable $c = 'tab_unsel'; $t = qq[$captions[$i]]; } else { # unselected and disabled $c = 'tab_dis'; $t = $captions[$i]; } print qq[
$t
\n]; } print qq[
\n]; } sub prev_and_next { my $prev2 = $prev ? qq[  ← Week $prev] : ''; say qq[
]; say qq[]; say qq[

Current week →

] if $next; say qq[] if $next; say qq[
]; } sub encode_string { my $string = shift; return '' unless $string; $string =~ s|'|'|gs; $string =~ s|"|"|gs; return $string; } sub limit_lines { my ($text, $max_length, $indent, $folded, $line, @chars, $j, $k, $ch); # breaks lines after $max_length chars # indents all but first line $text = $_[0]; $max_length = $_[1]; $indent = $_[2]; $folded = ''; # loop over lines W: while ($text =~ m|(.*?)\n|g) { $line = $1; $line =~ s|"|"|g; # split line into multiple lines @chars = split(//, $line); while (1) { # remaining line shorter than max if ($#chars <= $max_length) { $folded .= join('', @chars) . qq[\n]; next W; } # seek comma for ($j = $max_length; $j >= -1; $j --) { last if ($j == -1 or $chars[$j] eq ','); } # or blank if ($j == -1) { for ($j = $max_length; $j >= -1; $j --) { last if ($j == -1 or $chars[$j] eq ' '); } } # no comma found - output rest of line if ($j == -1) { $folded .= join('', @chars) . qq[\n]; next W; } # output chars up to comma $folded .= shift @chars for 0 .. $j; $folded .= qq[\n]; # add indent and repeat shift @chars while $chars[0] eq ' '; unshift @chars, ' ' for 1 .. $indent; } } return $folded; }