#!/bin/perl
# Link checker for relative links.
#  find . -name javadoc -prune -or \
#         -name \_\* -prune -or \
#         -name \*html -print  | xargs linkcheck

# Slurp whole files
undef $/ ;
# Comments

while(defined($file=shift @ARGV))
{
    ( $dir = $file ) =~ s![^/]*$!! ;
    $dir =~ s!/$!! ;

    open(FILE, $file) || die "Can't open '$file': $!\n";
    $_ = <FILE> ;
    s/<!--.*?-->//g ; 

    @a = /<a[^>]*href="([^"]*)"[^>]*>/gis ; #"
    map(&checkIt, @a) ;

    @a = /<img\s+[^>]*src="([^"]*)"[^>]*>/gis ; #"
    map(&checkIt, @a) ;
}




sub checkIt
{
    my $original = $_ ;
    # Absolute URI?
    # http:, ftp:, mailto:
    return if ( m!^[^/]*:! ) ;
    # if same file fragment
    return if ( m!^#! ) ; 

    # Remove fragid
    ( $link = $_ ) =~ s/\#[^\#]*$// ;
    $link = $dir.'/'.$link if ( $dir ne '' && ($link !~ m!^/! ) ) ;
    $link =~ s/%20/ /g ;

    print "Missing ($file): $original", "\n" if ( ! -e $link ) ;

}