#!/usr/local/bin/perl -- -*-perl-*-
# create a PICS rating header from a form created from the ratings file
# copyright 1996 Andrew Daviel, Vancouver Webpaegs
# you may freely use this script

print "Content-type: text/html\n\n";
print "<Head><Title>Vancouver Webpages PICS generator</Title></Head>";
print "<Body><H1>PICS generator</H1>\n";
$method = $ENV{'REQUEST_METHOD'} ;

$query = $ENV{'QUERY_STRING'} ;
$len = $ENV{'CONTENT_LENGTH'};
if (($method eq 'POST' && $len>0) || ($method eq 'GET' && $query =~ /=/)) {
  # Get the input
  if ($method eq 'POST' && $len>0) {
    read(STDIN, $buffer, $len) ;
  } else {
    $buffer = $query ;
  }
  # Split the name-value pairs
  @pairs = split(/&/, $buffer);
  foreach $pair (@pairs)
  {
    ($name, $value) = split(/=/, $pair);
    # print "$name $value<br>\n";

    # Un-Webify plus signs and %-encoding
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $FORM{$name} = $value ;
  }
}
$_ = $FORM{'URL'} ;
if ($_) {
  $err += !m%^http://%i ;
  $sfx += /\.\w+$/ ;
  $sl += m%://.+/.+$% ;
  if ($err) {
    print "ERROR - you must include a transport (\"http://\") in the URL.<p>\n";
  }
  $scope = $FORM{'SCOPE'} ;
  if ($scope eq "Site" &&  $sl ){
     print "ERROR - you specified a scope of <b>Site</b> but a URL for a file or directory.<p>\n";
  }
  if ($scope eq "Directory" && !$sl) {
     print "ERROR - you specified a scope of <b>Directory</b> but a URL for a site.<p>\n";
  }
  if ($scope eq "File" && !$sl) {
     print "ERROR - you specified a scope of <b>File</b> but a URL for a site.<p>\n";
  }
  if ($scope eq "File" && !$sfx){
     print "WARNING - you specified a scope of <b>File</b> but a URL with no suffix.<p>\n";
  }
  $url = $_ ;
}
$version = $FORM{'VERSION'} ;
$service = $FORM{'SERVICE'} ;
$system = $FORM{'SYSTEM'} ;
$icon = $FORM{'ICON'} ;
$name = $FORM{'NAME'} ;
$desc = $FORM{'DESC'} ;
$by = $FORM{'BY'} ;
if (!$version || !$service || !$system) {
  print "ERROR - a version, service URL and system URL must be supplied.<p>\n";
}
$err = 0 ;
$_ = $service ;  $err += ( !m%^http://%i && !m%^ftp://%i ) ;
$_ = $system ;  $err += ( !m%^http://%i && !m%^ftp://%i ) ;
if ($err) {
  print "ERROR - the service URL or system URL is incomplete.<p>\n";
}
$date = `/bin/date +%Y.%m.%dT%H:%M` ; chop($date) ;
$hr = `/bin/date +%k` ; $uhr = `/bin/date -u +%k` ;
$tz = $hr - $uhr ;
$tz = sprintf("%2.2d00",$tz) ;
if ($url) {
  if ($scope eq "File") {
    print " You may include the following META tag in your HTML document 
<a href=\"$url\">$url</a> " ;
  } elsif($scope eq "Site") {
    print " You may include the following META tag in your HTML homepage on server
<a href=\"$url\">$url</a> " ;
  } else {
    print " You may include the following META tag in your HTML documents in directory
<a href=\"$url\">$url</a> " ;
  }
} else {
  print " You may include the following META tag in your HTML documents ";
}

print "(cut to buffer or
save as TEXT). The META data should appear in the HTML document head
(between the &lt;HEAD&gt; and &lt;/HEAD&gt; tags):
<PRE>
&lt;META http-equiv=&quot;PICS-Label&quot; content='(PICS-$version
&quot;$service&quot; l ";
if ($scope ne "File") {
  print "gen true " ;
} else {
  print "gen false " ;
}
if ($name) { print "comment &quot;$name&quot; " ; }
if ($by)  { print "by &quot;$by&quot; " ; }
print "\n";
if ($date)  { print "on &quot;$date$tz&quot; "; }
if ($url) { print "for &quot;$url&quot;\n " ; }
print "r (" ;
while (($name,$value) = each (%FORM)) {
  $_ = $name ;
  if (!tr/a-z/a-z/) { next ; }
  print "$value ";
}
print "))'>\n</PRE>\n";
if ($url) {
  print "<p><b>Note:</b> you may only include this META tag in documents using
the specified URL and scope.\n";
}

print "<p>
You may include the following one-line header in HTTP headers on HTML documents,
image files, etc. (using e.g. Apache <b>.meta</b> files, as-is documents or CGI scripts):
<PRE>
PICS-Label: (PICS-$version &quot;$service&quot; l ";
if ($scope ne "File") {
  print "gen true " ;
} else {
  print "gen false " ;
}
if ($name) { print "comment &quot;$name&quot; " ; }
if ($by)  { print "by &quot;$by&quot; " ; }
if ($date)  { print "on &quot;$date$tz&quot; "} ;
if ($url) { print "for &quot;$url&quot; " ; }
print "r (" ;
while (($name,$value) = each (%FORM)) {
  $_ = $name ;
  if (!tr/a-z/a-z/) { next ; }
  print "$value ";
}
print "))\n";

print "</body></html>\n";  
