bin/fixhtml

   1 #! /usr/bin/perl -- # -*- perl -*-
   2 eval 'exec /bin/perl -S $0 "$*"'
   3     if undef;
   4 #
   5 # FixHTML v1.02 2001/01/07
   6 #
   7 # Copyright (C) 1994, 1995, 1996 by Victor Parada (vparada@inf.utfsm.cl)
   8 # Copyright (C) 1997, ..., 2001 by Jan Kratochvil <short@ucw.cz>
   9 #
  10 # Fix broken paths in downloaded HTML trees.
  11 #
  12 # Syntax: fixhtml path host;
  13 #
  14 # Please read this "License Agreement and Lack of Warranty":
  15 # - The author of this program is Jan Kratochvil <short@k332.feld.cvut.cz>.
  16 # - This program is "Freeware", not "Public Domain".
  17 # - This program must be distributed for free, and cannot be included in
  18 #   commercial packages without prior written permisson from the autor.
  19 # - This program cannot be distributed if modified in any way.
  20 # - This program can be used by anyone if the copyright and this notice
  21 #   remains intact in every file.
  22 # - If you modify this program, please e-mail patches to the the author.
  23 # - This is a Beta version of the program. You have been warned!
  24 # - This program is provided ``AS IS'', without any warranty.
  25 # - This program can cause huge file transfers and all the related effects.
  26 # - This program can fill data disks without notice.
  27 # - Neither the author nor UTFSM are responsible for the use of this program.
  28 # - Bug reports, comments, questions and suggestions are welcome!  But
  29 #   please check first that you have the latest version!
  30 # - The latest version of this program is available at:
  31 #   <URL:--->
  32 #
  33 # If you use this program, please send e-mail to the author.
  34 # He will try to notify you of any updates made to it.
  35 #
  36
  37 # Setup perl defaults
  38 #
  39 $fixhtml=$0;
  40 $0=~s![^/]*/!!g;
  41 $|=1;
  42 $[=0;
  43
  44 # Configurable defaults
  45 #
  46 $tmpfile="W$$.tmp";     # temp.
  47 $port=80;
  48
  49 dump QUICKSTART if $ARGV[0] eq "--dump";
  50 QUICKSTART:
  51
  52 # Process options in command line
  53 #
  54 while ($_=$ARGV[0],/^-/) {
  55     shift;
  56     /h|\?/ && ($help=1, next);
  57     die "$0: Invalid option $_\n";
  58 }
  59
  60 exit &about if $help;
  61
  62 $path=shift || die "Path not specified\n";
  63 $host=shift || die "Host not specified\n";
  64
  65 chdir $path || die "Cannot find specified path $path!\n";
  66
  67 open(FEED,"find -type f|") or die "No files found";
  68
  69 FLSKIP: while (<FEED>) {
  70  s/\n//g;
  71  $curfile=$_;
  72  print "$curfile - ";
  73  open(I,$curfile) or die "Cannot open $curfile!\n";
  74  IDENT: while (<I>) {
  75         last IDENT if (m/[^ \t\r\n]/);
  76         }
  77  $line=$_;
  78  if ($line!~/^[ -~\r]*$/ || $line!~/\<\s*[!\w]+/i) { #.*\>
  79   close(I);
  80   print "not HTML\n";
  81   next FLSKIP;
  82   }
  83  print "fixing ... ";
  84  seek I,0,SEEK_SET;
  85  open(F,">".$tmpfile) or die "Cannot create $tmpfile!\n";
  86  $line="";
  87  $pth=$curfile;
  88  $pth=~s/^.\///;
  89  $pth=~s![^/]*$!!;
  90  while (<I>) {
  91   $line.=$_;
  92   while ($line=~/\<([^\<\>]*)([\<\>])(.*)$/s) {
  93 #print "TAG=$1\n";
  94    $line=($2 eq "<"?"<":"").$3;
  95    $endoftag=$2;
  96    print F $`."<";
  97    $fulltag=$1; if ($fulltag=~/^!/)
  98      { print F $fulltag; }
  99    else {
 100      $fulltag=$1; $origtag=$fulltag;
 101      $fulltag=~tr/\n\t\r/   /;
 102      ($tag,%args)=&split_tag($fulltag);
 103      for (sort keys %args) {
 104      $x=$y=$z=$args{$_};
 105      if (defined($za=rindex($z,"/")))
 106        { $zb=substr($z,0,$za+1); $zc=substr($z,$za+1); }
 107      else { $zb=""; $zc=$z }
 108      ($zc,$zd)=$zc=~m!^([^\?\#]*)(.*)$!;
 109      ($h,$n,$p,$f,$e)=(($y=~/^\w+:/)?
 110        &split_url($x):("localhost",$port,$zb,$zc,$zd));
 111 #print "par=\"$x\", h=\"$h\", n=\"$n\", p=\"$p\", f=\"$f\", e=\"$e\",
 112 #       host=\"$host\", port=\"$port\"\n";
 113      $minone||=($e=~s/\?/%3F/g);
 114      if (($h eq "localhost" || $h eq $host) && $n eq $port) {
 115       @new=split('/',$pth);
 116       @nwa=split('/',$p);
 117       splice(@nwa,0,1) if (@nwa[0] eq "");
 118       splice(@new,0,1) if (@new[0] eq "");
 119       @nwb=@new;
 120       if (substr($p,0,1) eq "/") {
 121        @new=();
 122        }
 123       foreach $dir (@nwa) {
 124         if ($dir eq "..")
 125           { pop(@new); }
 126         elsif ($dir ne "." && $dir ne "")
 127           { push(@new,$dir); }
 128         }
 129       while (defined(@new[0]) && @new[0] eq @nwb[0]) {
 130         splice(@new,0,1);
 131         splice(@nwb,0,1);
 132         }
 133       $newone=join('/',(map("..",@nwb),@new,$f)).$e;
 134       if ($newone ne $args{$_}) {
 135         $args{$_}=$newone;
 136         $minone=1;
 137         }
 138        }
 139       }
 140 #print "minone=".$minone."\n";
 141      if ($minone) {
 142        print F $tag;
 143        for (sort keys %args)
 144          { print F " ".$_.($args{$_} eq ""?"":"=\"$args{$_}\""); }
 145        }
 146      else {
 147        print F $origtag
 148        }
 149     }
 150    print F ">" if ($endoftag eq ">");
 151    }
 152   }
 153  print F $line;
 154  print F "\n" if ($line!~/\n$/);
 155  close(I);
 156  close(F);
 157  rename($tmpfile,$curfile) || die "Cannot rename $tmpfile to $curfile ($!)!\n";
 158 #&set_date($file,$update);
 159  print "done\n";
 160  }
 161 close(FEED);
 162 exit;
 163
 164 sub split_tag {
 165     local($fulltag)=@_;
 166     local($tagname,$etc,$var,$quote,$arg,$value,@tagargs);
 167     undef $etc;
 168     ($tagname,$etc)=$fulltag=~/\s*(\S+)\s*(.*)$/;
 169     while ($etc!~/^\s*$/) {
 170         ($arg,$var,$value,$etc)=$etc=~/\s*([^=\s]+)\s*(=)?\s*(\S+)?(.*)$/;
 171         ($value,$etc)=((undef),$value.$etc) unless $var=~/^=$/;
 172         ($quote)=$value=~/^([\"\'])/;
 173         if ($quote) {
 174             if ($value!~/.$quote$/) {
 175                 ($_,$etc)=$etc=~/^([^$quote]*)$quote?(.*)$/;
 176                 $value.=$_.$quote;
 177             }
 178             $value=~s/$quote\s*(.*)\s*$quote$/$1/;
 179             $value=~s/\s*$//;
 180         }
 181         $arg="\U$arg\E";
 182         push(@tagargs,$arg,$value);
 183     }
 184     $tagname="\U$tagname\E";
 185     ($tagname,@tagargs);
 186 }
 187
 188 sub split_url {
 189     local($url)=@_;
 190     local($host,$port,$path,$file,$extra,$v);
 191     ($url,$extra)=$url=~m!^([^\?\#]*)(.*)$!;
 192     $v=$url=~m!^http:(//([^:/]*)(:(\d*))?)?((/([^/]+/)*)?([^/]*))?$!;
 193     return () unless $v;
 194     ($host,$port,$path,$file)=(($2?$2:"localhost"),($4?$4:80),$6,$8);
 195     ($host,$port,$path,$file,$extra);
 196 }
 197
 198 sub about {
 199     print <<EOH;
 200
 201 FixHTML v1.02 2001/01/07 (C) 2001 by Jan Kratochvil <short\@ucw.cz>
 202
 203 Fix broken paths in downloaded HTML trees.
 204
 205 Usage:  $0 path host
 206
 207 EOH
 208     undef;
 209 }
 210
 211 __END__