#!/usr/bin/perl -w use strict; use HTTP::Date qw(time2iso); require "db.pl"; use vars qw($dbh); if (@ARGV == 1 && $ARGV[0] =~ /^\d+$/) { my $id = shift; my $sth = $dbh->query("select scheme, host, port, abs_path, uri.last_visit, status_code, message, last_mod, etag, entity, content_type from server, uri where server.id = uri.server and uri.id = $id") or die $dbh->errmsg; unless ($sth->numrows) { die "None found $id\n"; } my($scheme,$host,$port,$abs_path,$last_visit,$code,$mess, $last_mod,$etag,$eid,$ctid) = $sth->fetchrow; print "URL: ", make_url($scheme, $host, $port, $abs_path), "\n"; print "Last-Visit: ", time2iso($last_visit), "\n" if $last_visit; print "Status: $code $mess\n" if $code; if ($ctid) { $sth = $dbh->query("select name from media_types where id=$ctid") or die $dbh->errmsg; my($name) = $sth->fetchrow; my $ct = $name ? $name : "#$ctid"; print "Content-Type: $ct\n"; } print "Last-Modified: ", time2iso($last_mod), "\n" if $last_mod; print "ETag: $etag\n" if $etag; my @r; if ($eid) { print "Entity-ID: $eid\n"; @r= $dbh->query("select id from uri where entity=$eid and id<>$id order by id")->fetchcol(0); print "Same-Entity-As: @r\n" if @r; } @r= $dbh->query("select dest from links where src = $id order by dest")->fetchcol(0); print "References: @r\n" if @r; @r = $dbh->query("select src from links where dest = $id order by src")->fetchcol(0); print "Referenced-By: @r\n" if @r; exit; } my $extra = join(" ", @ARGV); substr($extra,0,0) = " AND " if $extra; my $sql = "SELECT uri.id, scheme, host, port, abs_path, status_code FROM server, uri WHERE server.id = uri.server$extra"; print STDERR "$sql\n"; my $sth = $dbh->query($sql) or die $dbh->errmsg; while (my($id, $scheme,$host,$port,$abs_path,$code) = $sth->fetchrow) { $code = "---" unless $code; my $url = make_url($scheme,$host,$port,$abs_path); print "$code $url #$id\n"; } sub make_url { my($scheme,$host,$port,$abs_path) = @_; if ($port) { if ($scheme eq "http" && $port == 80) { $port = ""; } else { $port = ":$port"; } } else { $port = ""; } "$scheme://$host$port$abs_path"; }