#!/usr/bin/perl -wT
#
# This file is MPL/GPL dual-licensed under the following terms:
# 
# The contents of this file are subject to the Mozilla Public License
# Version 1.1 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
# the License for the specific language governing rights and
# limitations under the License.
#
# The Original Code is the registration script on libpr0n.com.
# The Initial Developer of the Original Code is Ian Hickson.
#
# Alternatively, the contents of this file may be used under the terms
# of the GNU General Public License Version 2 or later (the "GPL"), in
# which case the provisions of the GPL are applicable instead of those
# above. If you wish to allow use of your version of this file only
# under the terms of the GPL and not to allow others to use your
# version of this file under the MPL, indicate your decision by
# deleting the provisions above and replace them with the notice and
# other provisions required by the GPL. If you do not delete the
# provisions above, a recipient may use your version of this file
# under either the MPL or the GPL.

use strict; # be anal about stuff
use diagnostics; # enable fuller diagnostics of warnings
use CGI; # oh yeah, this is a CGI script
use LWP::UserAgent; # which reads web pages

my $query = CGI->new();
my $spec = $query->param('s');
my $search = $query->param('q');

my $specs = {
    'css21' => {
        'index' => 'http://www.w3.org/TR/CSS21/indexlist.html',
        'base' => 'http://www.w3.org/TR/CSS21/',
        'regexp' => '<li class="tocline0">\'?@@\'?.*?<a href="([^"]+)" class="index-def">',
        'preprocessor' => \&HTML,
    },
    'css2' => {
        'index' => 'http://www.w3.org/TR/REC-CSS2/indexlist.html',
        'base' => 'http://www.w3.org/TR/REC-CSS2/',
        'regexp' => '<li class="tocline0">\'?@@\'?.*?<a href="([^"]+)" class="index-def">',
        'preprocessor' => \&HTML,
    },
    'html401-elements' => {
        'index' => 'http://www.w3.org/TR/html401/index/elements.html',
        'base' => 'http://www.w3.org/TR/html401/',
        'regexp' => '<td title="Name"><a href="\.\./([^"]+)">@@</a></td>',
        'preprocessor' => \&HTML,
    },
    'html401-attributes' => {
        'index' => 'http://www.w3.org/TR/html401/index/attributes.html',
        'base' => 'http://www.w3.org/TR/html401/',
        'regexp' => '<td title="Name"><a href="\.\./([^"]+)">'."\n".'?@@</a></td>',
        'preprocessor' => \&HTML,
    },
};

# pick a spec
$spec = $specs->{$spec} if $spec;

if (not $spec or not $search) {
    print <<EOF;
Content-Type: text/plain

You need to give the spec (s=) and query (q=) parameters.
Allowed specs:
EOF
    foreach (keys %$specs) {
        print "   $_\n";
    }
    exit;
}

# set it up
$search = quotemeta(&{$spec->{'preprocessor'}}($search));
$spec->{'regexp'} =~ s/@@/$search/gos;

# get the index page
my $page = &fetch($spec->{'index'});

# look for the data (not optimised since it's a dynamic regexp)
if ($page =~ m/$spec->{'regexp'}/s) {
    # create the target URI
    print <<EOF;
Location: $spec->{'base'}$1
Content-Type: text/plain

See $spec->{'base'}$1
EOF
} else {
    # failed
    print <<EOF;
Content-Type: text/plain

No luck, sorry.
EOF
}

sub fetch {
    my($uri) = @_;
    my $ua = LWP::UserAgent->new();
    $ua->protocols_allowed(['http', 'https']);
    my $request = HTTP::Request->new(GET => $uri);
    return $ua->request($request)->content;
}

sub HTML {
    # if we're going to search an HTML doc with quotes not escaped
    for (@_) {
        s/&/&amp;/gos;
        s/</&lt;/gos;
        s/>/&gt;/gos;
    }
    return $_[0];
}