#! /usr/bin/perl
#
# linkabs.pl
#
# Converts relative links to absolute URL, and sends to stdout.
#
# by Kenneth J. Lanfear, lanfear@usgs.gov
# Version 1.1, 18DEC96
#
# Input:
#       $url      = Full URL of the file.
#       $filein   = input file name. If none specified, input
#                      will be from stdin
#
# Output:
#       The file, with relative URL's replaced by absolute URL's, 
#         is sent to standard output.
#
#=====================================================================

#Check the arguments
$url = $ARGV[0]; $filein = $ARGV[1]; 
unless ($url) {&usage}
unless ($filein) {$filein = '-'} #Standard input

#Read the input file into memory as a long string.
open (INFILE,"$filein") || die "Could not open input file $filein\n";
while (<INFILE>) {$text .= $_}
#Split the big string at the start of each html tag
@line = split('<',$text);

#Find each link "<a href=" and check it.
for ($i=0; $i<=$#line; $i++) {
  if ($i > 0) {$line[$i] = "<" . $line[$i]}
  next unless ($line[$i] =~ /<[ \s]*a[ \s]+href[ \s=]|<[ \s]*img[ \s]|<[ \s]*form[ \s]/i);
  if ($line[$i] =~ /([ \s]src[ \s]*=[ \s"]*)([^ \s][^"> \s]*)/i) {
    $link = $2; $before = $1;
  }
  elsif ($line[$i] =~ /([ \s]href[ \s]*=[ \s"]*)([^ \s][^"> \s]*)/i) {
    $link = $2; $before = $1;
  }
  elsif ($line[$i] =~ /([ \s]action[ \s]*=[ \s"]*)([^ \s][^"> \s]*)/i) {
    $link = $2; $before = $1;
  }
  else {next}
  $absolute_url = &absurl($url,$link);
  if ($absolute_url ne $link) {
    $line[$i] =~ s/$before$link/$before$absolute_url/;
  }
}

#All links changed.
$text = join("",@line);
print $text;
exit;

sub usage {
  print "Usage: linkabs.pl <filein> <url>\n";
  print "  where\n";
  print "    <url>        Full URL of the input file.\n";
  print "    <filein>     Input file name.\n";
  exit; #Kills the program
}

sub absurl {
  #Returns the absolute url of $url2 if $url2 is relative to $url1
  local ($url1,$url2) = @_;
  local ($dir);
  local ($protocol1,$server1,$dir1,$file1);
  local ($protocol2,$server2,$dir2,$file2);
  local ($urlstart);
  &breakurl($url2,$protocol2,$server2,$dir2,$file2);
  if ($server2) {return $url2} 
  &breakurl($url1,$protocol1,$server1,$dir1,$file1);
  $urlstart = "$protocol1://$server1/$dir1";
  $url2 =~ s/^\.\/|^\///; #Remove same-directory prefix.
  while ($url2 =~ /^\.\.\//) { #Walk up the directory tree
    $url2 =~ s/^\.\.\///; $urlstart =~ s/\/\w\/$//;
  }
  $url2 = $urlstart . $url2;
  return "$url2";
}

sub breakurl {
  #Breaks a full or a relative URL into protocol, server, directory, file
  local ($url) = $_[0];
  local ($protocol,$server,$dir,$file);
  if ($url =~ s/^(.*):\/\///) {
    $protocol = $1;
    if ($url =~ s/^([^\/]+)//) {$server = $1}
  }
  if ($url =~ s/([^\/]+)$//) {$file = $1}
  $url =~ s/^\///;
  $_[1]=$protocol; $_[2]=$server; $_[3]=$url; $_[4]=$file;
}