#!/usr/bin/perl
use HTML::Parser;
use HTML::LinkExtor;
use URI::URL;
use LWP::UserAgent;

%z39port = ();
%z39url = ();

$locbase = "http://lcweb.loc.gov/cgi-bin/zgstart";
sub getlinks {
    my ($tag, %links) = @_;
    my $link, $url, $fhp, $dummy, $site, $port, $qf;
    return if $tag ne "a";
    for $link (values %links) {
	next if $link !~ /^$locbase/;
	$url = new URI::URL $link;
	%qf = $url->query_form;
	$fhp = $qf{"FORM_HOST_PORT"};
	($dummy, $site, $port) = split(",", $fhp);
	$z39port{$site} = $port;
	$z39url{$site} =  $link;
    }
}

@THOK::Z39crawl::ISA = qw(HTML::Parser);
# based on HTML::LinkExtor::new
sub THOK::Z39crawl::new
{
    my($class, $cb, $base) = @_;
    my $self = $class->HTML::Parser::new; # vs. SUPER?
    $self->{extractlink_cb} = $cb;
    $self->{extractlink_base} = $base;
    $self->{dbname} = undef;
    $self;
}

sub THOK::Z39crawl::start
{
    my($self, $tag, $attr) = @_;
    # matching <INPUT NAME="DBNAME" VALUE="COPAC" TYPE="HIDDEN">
    return unless $tag eq "input";
    return unless $attr->{"name"} eq "DBNAME";
    $self->{dbname} = $attr->{"value"};
}

sub THOK::Z39crawl::result
{
    my($self) = @_;
    $self->{dbname};
}

open(SUCCESS, "< gate-z39-output");
%z39success = ();
while(<SUCCESS>) {
    chomp;
    ($h,$other) = split(/:/, $_);
    $z39success{$h} = $h;
}

$ua = new LWP::UserAgent;
$ua->agent("THOK-Z39-crawl/0.1 " . $ua->agent);

$p = HTML::LinkExtor->new(\&getlinks);
$p->parse_file("gateway.html");

open(OUT, ">>gate-z39-output");
select((select(OUT), $| = 1)[0]);
open(FAIL, ">gate-z39-failed");
select((select(FAIL), $| = 1)[0]);
$| - 1;

for $site (keys z39url) {
    print STDERR "skipping $site\n" if $z39success{$site};
    next if $z39success{$site};
    print STDERR "doing $site\n";
    my $req = new HTTP::Request GET => $z39url{$site};
    my $res = $ua->request($req);
    if ($res->is_success) {
	my $p = THOK::Z39crawl->new;
	$p->parse($res->content);
	$p->eof;
	my $r = $p->result;
	print OUT "$site:$z39port{$site} $r\n" if defined $r;
	print "$site:$z39port{$site} $r\n" if defined $r;
	print "$site:$z39port{$site} NOT FOUND\n" unless defined $r;
	print FAIL "$site\n" unless defined $r;
    } else {
	print STDERR "Bad luck this time ($site)\n";
    }
}
