#!/usr/bin/perl -w
#
# link
#
# Generate an HTML page linking to a URI or filename.
#
# -- Ed Avis, epa98@doc.ic.ac.uk, 2000-06-18
#
use strict;
use URI;
use LWP::UserAgent;
use HTTP::Request;
use Date::Manip;
die "usage: $0 [URI or filename...]" if not @ARGV;
# Maintainer's name and SMTP address.
my $MAINTAINER_NAME = 'Edward Avis';
my $MAINTAINER_ADDR = 'epa98@doc.ic.ac.uk';
# Maximum amount of content to receive in bytes (we're only looking
# for the title, and that should be somewhere near the beginning)
#
my $MAX_SIZE = 1000000;
# Set the timestamp.
my $TIMESTAMP = UnixDate(ParseDate('now'), '%C');
print <Links
END
;
my $ua = new LWP::UserAgent;
$ua->max_size($MAX_SIZE);
$ua->env_proxy();
foreach (@ARGV) {
my $title = gettitle($_);
$title = $_ if not defined $title;
print <$title
END
;
}
print <$MAINTAINER_NAME
$TIMESTAMP
END
;
# gettitle()
#
# Attempt to get the title from the document pointed to by a URI;
# return undef if failed.
#
sub gettitle($_) {
die 'usage: gettitle(filename or URI)' if @_ != 1;
my $fu = shift;
my $u;
# Make the argument into a URI, if it isn't already
my $uri = new URI($fu);
if (not defined $uri->scheme()) {
$uri->scheme('file');
$u = $uri->as_string();
}
else {
# Already a URI
$u = $fu;
}
my $resp = $ua->request(new HTTP::Request(GET => $u));
if ($resp->is_success()) {
my $title = $resp->title();
if (defined $title and $title !~ /^\s*$/) {
return $title;
}
else {
# Document contains no title
return undef;
}
}
else {
warn "failed to get $u";
return undef;
}
}