#!/usr/bin/perl -w # # The first line should be #!/usr/bin/perl/ -wT after testing # # how_old_3.pl -- Tiny CGI to calculate the year # Inits use strict; use Time::Piece; use Time::Seconds; my $first_time = 1; ######## # Main # ######## my $in = get_params(); return unless $in; my %in = parse_in($in); html_msg('Problems parsing input') unless %in; my $date = get_date($in{date}); html_msg($date) if $date; exit 0; ######## # Subs # ######## # Return the text to print in the HTML for sub get_date { my $date = shift; # Sanity check unless (defined $date) { html_msg('No date sent in'); return ""; } # Test date html_msg('Bad date format (YYYY-MM-DD)') unless $date =~ /^(\d{4})-([0,1]\d)-([0-3]\d)$/; my $in_date; eval { $in_date = Time::Piece->strptime($date, "%F") }; if ($@) { html_msg('Bad date format (YYYY-MM-DD)'); return ""; } if ($in_date->strftime("%F") ne $date) { html_msg('Bad date format (YYYY-MM-DD)'); return ""; } # How long ago? my $today = localtime; my $seconds = $today - $in_date; return sprintf("%d years ago", $seconds->years); } # Return an input string sub get_params { my $in; # Get and return input if request is GET or HEAD if ( ($ENV{'REQUEST_METHOD'} eq 'GET') or ($ENV{'REQUEST_METHOD'} eq 'HEAD') ) { return $ENV{'QUERY_STRING'}; } # Read content if POST method elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { if ($ENV{'CONTENT_TYPE'} =~ m{^application/x-www-form-urlencoded$}i) { length($ENV{'CONTENT_LENGTH'}) || html_msg('No Content-Length sent with the POST request'); read(STDIN, $in, $ENV{'CONTENT_LENGTH'}) || html_msg('Could not read POST content'); return $in; } else { html_msg("Unsupported Content-Type: $ENV{'CONTENT_TYPE'}"); exit 1; } } else { html_msg('Script was called with unsupported REQUEST_METHOD'); exit 2; } } # Parse name=value pairs sub parse_in { my %in; # Resolve and unencode name/value pairs into %in foreach (split(/[&;]/, $in)) { s/\+/ /g ; (my $name, my $value) = split('=', $_, 2) ; $name =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge; $value =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge; $in{$name} .= "\0" if defined $in{$name}; # concatenate multiple vars $in{$name} .= $value; } return %in ; } # Simple HTML form for errors and other messages sub html_msg { my $title = shift || 'Unknown Error'; return unless $first_time; print < $title

$title

EOF $first_time = 0; }