nxhtml/nxhtml/html-chklnk/link_checker.pl

   1 #! perl
   2
   3 # Copyright 2006, 2007 Lennart Borgman, http://OurComments.org/. All
   4 # rights reserved.
   5 #
   6 # This file is free software; you can redistribute it and/or modify it
   7 # under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2, or (at your option)
   9 # any later version.
  10
  11 # This file is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  14 # General Public License for more details.
  15
  16 use strict;
  17 use warnings;
  18
  19 use IO::File;
  20 use File::Spec;
  21 use File::Find;
  22
  23 sub check_file($);
  24
  25 #############################
  26 ### Collecting info
  27 #############################
  28 my $m_site_dir;   # Site root directory (every file should be in this)
  29 my %m_CheckedFiles;
  30 my %m_FilesToCheck;
  31 my %m_MissedFiles;
  32 my $m_errors_found;
  33
  34 sub tell_bad_link($$$$$) {
  35         my $what = shift;
  36         my $file = shift;
  37         my $lnum = shift;
  38         my $link = shift;
  39         my $line = shift;
  40         $line =~ s/^\s+|\s+$//g;
  41         $m_CheckedFiles{$file}->{"ERR"}->{$lnum} = "$what\n    Link: \"$link\"\n";
  42         #$line";
  43 }
  44
  45 #############################
  46 ### Helpers
  47 #############################
  48 sub add_file_to_check($) {
  49     $m_FilesToCheck{File::Spec->canonpath(shift)} = 1;
  50 }
  51 # sub full_uq_file($) {
  52 #       my $file = shift;
  53 #       my $full_file = $file;
  54 #         if (! File::Spec->file_name_is_absolute($full_file)) {
  55 #             #$full_file = Win32::GetFullPathName($file);
  56 #             $full_file = File::Spec->rel2abs($full_file, $m_site_dir);
  57 #         }
  58 #         if (($^O eq "MSWin32") || ($^O eq "cygwin")) {
  59 #             $full_file =~ tr!A-Z!a-z!;
  60 #         }
  61 #         #print "ull_uq_file: full_file=$file\n";
  62 #       return $full_file;
  63 # }
  64
  65 #############################
  66 ### Checks
  67 #############################
  68 sub check_next_file() {
  69     if (scalar(keys %m_FilesToCheck) > 0) {
  70         my @FilesToCheck = sort keys %m_FilesToCheck;
  71         my $next_file = $FilesToCheck[0];
  72         delete $m_FilesToCheck{$next_file};
  73         check_file($next_file);
  74     }
  75 }
  76 sub not_a_local_file($) {
  77     my $url = shift;
  78     (
  79      $url =~ m!^javascript:!
  80      ||
  81      $url =~ m!^mailto:!
  82      ||
  83      $url =~ m!^[a-z]+://!
  84     );
  85 }
  86
  87 sub check_file($) {
  88         my $fname = shift;
  89         if (! File::Spec->file_name_is_absolute($fname)) {
  90             die "check_file: File is not abs: $fname";
  91         }
  92         my $only_name = (File::Spec->splitpath($fname))[2];
  93         print "Checking $fname ... ";
  94         sleep 0.5;
  95         $m_CheckedFiles{$fname} = {};
  96         my %links;
  97         my %anchs;
  98         my %lines;
  99         my $fh = new IO::File($fname);
 100         die "Can't read $fname: $!\n" unless defined $fh;
 101         my $whole;
 102         my $n;
 103         my $found_errors = 0;
 104         while (my $line = <$fh>) {
 105                 $n++;
 106                 chomp $line;
 107                 $whole = $line;
 108                 while ($whole =~ m!(?:\s|^)id="(.*?)"!g) {
 109                         $anchs{$1} = $n;
 110                         $lines{$n} = $line;
 111                 }
 112                 while ($whole =~ m!(?:\s|^)name="(.*?)"!g) {
 113                         $anchs{$1} = $n;
 114                         $lines{$n} = $line;
 115                 }
 116                 while ($whole =~ m!(?:\s|^)href="(.*?)"!g) {
 117                         my $l = $1;
 118                         next if not_a_local_file($l);
 119                         if ($l =~ m!^#!) {
 120                             $l = $only_name . $l;
 121                         }
 122                         $links{$l} = $n;
 123                         $lines{$n} = $line;
 124                 }
 125                 while ($whole =~ m!(?:\s|^)src="(.*?)"!g) {
 126                         my $l = $1; $l =~ tr!A-Z!a-z!;
 127                         $links{$l} = $n;
 128                         $lines{$n} = $line;
 129                 }
 130         }
 131         $fh->close();
 132         $m_CheckedFiles{$fname}->{ANC} = \%anchs;
 133         my ($fv, $fd, $ff) = File::Spec->splitpath($fname);
 134         my $fdir = File::Spec->catpath($fv, $fd, "");
 135         for my $link (sort keys %links) {
 136                 # Next line is for onclick lines
 137                 next if ($link eq "#");
 138                 my $lnum = $links{$link};
 139                 my $line = $lines{$lnum};
 140                 if ($link eq "") {
 141                         tell_bad_link("empty link", $fname, $lnum, $link, $line);
 142                         $found_errors = 1;
 143                         next;
 144                 }
 145                 if ($link =~ m!(.*)\?!) { $link = $1; }
 146                 my $anchor;
 147                 if ($link =~ m!(.*)#(.*)!) { $link = $1; $anchor = $2; }
 148                 if ($link eq "") {
 149                         if (!exists $anchs{$anchor}) {
 150                                 tell_bad_link("bad internal anchor ref ($anchor)", $fname, $lnum, $link, $line);
 151                                 $found_errors = 1;
 152                         }
 153                         next;
 154                 }
 155                 $link =~ m!([^\.]*)$!;
 156                 my $link_file_type = $1;
 157                 my $subfile = $link;
 158                 if (!File::Spec->file_name_is_absolute($subfile)) {
 159                     $subfile = File::Spec->catpath($fv, $fd, $link);
 160                 }
 161                 $subfile = File::Spec->canonpath($subfile);
 162                 die "Contained .." if $subfile =~ m/\.\./;
 163                 next if (exists $m_MissedFiles{$subfile});
 164                 if (! -r $subfile) {
 165                         tell_bad_link("Can't read linked file: $!", $fname, $lnum, $link, $line);
 166                         $found_errors = 1;
 167                         $m_MissedFiles{$subfile} = 1;
 168                         next;
 169                 }
 170                 next unless $link_file_type =~ m!^html?$!i;
 171                 if (defined $anchor) {
 172                         $m_CheckedFiles{$fname}->{EXTANC}->{$subfile} =
 173                                         { ANC=> $anchor, LINE=>$line, LNUM=>$lnum};
 174                 }
 175                 next if (exists $m_CheckedFiles{$subfile});
 176                 #check_file($subfile);
 177                 my $rel_root = File::Spec->abs2rel($subfile, $m_site_dir);
 178                 if (substr($rel_root, 0, 2) eq "..") {
 179                     tell_bad_link("Reference to file outside site", $fname, $lnum, $link, $line);
 180                     $found_errors = 1;
 181                 } else {
 182                     #$m_FilesToCheck{$subfile} = 1;
 183                     add_file_to_check($subfile);
 184                 }
 185         }
 186         if ($found_errors) {
 187             print "Errors found\n";
 188         } else {
 189             print "Ok\n";
 190         }
 191         sleep 0.5;
 192         check_next_file();
 193 } # check_file
 194
 195
 196 sub check_external_anchors() {
 197         for my $f (sort keys %m_CheckedFiles) {
 198                 my $fnode = $m_CheckedFiles{$f};
 199                 if (exists ${$fnode}{"EXTANC"}) {
 200                         my $extanc_hash = ${$fnode}{"EXTANC"};
 201                         for my $fx (keys %$extanc_hash) {
 202                                 next unless (exists $m_CheckedFiles{$fx});
 203                                 my $ea_hash = ${$extanc_hash}{$fx};
 204                                 my $ea = ${$ea_hash}{ANC};
 205                                 my $fxnode = $m_CheckedFiles{$fx};
 206                                 my $fx_anc_hash = ${$fxnode}{"ANC"};
 207                                 if (!exists ${$fx_anc_hash}{$ea}) {
 208                                         my $line = ${$ea_hash}{LINE};
 209                                         my $lnum = ${$ea_hash}{LNUM};
 210                                         tell_bad_link("Hash not found", $f, $lnum, "$fx#$ea", $line);
 211                                 }
 212                         }
 213                 }
 214         }
 215 } # check_external_anchors
 216
 217
 218
 219 #############################
 220 ### Reporting
 221 #############################
 222 sub report_errors() {
 223         for my $f (sort keys %m_CheckedFiles) {
 224                 my $fnode = $m_CheckedFiles{$f};
 225                 if (exists ${$fnode}{"ERR"}) {
 226                         if (!defined $m_errors_found) {
 227                                 $m_errors_found = 1;
 228                                 print "\n\n*********** Error details: **********\n";
 229                                 sleep 0.5;
 230                         }
 231                         #print "\n$f";
 232                         my $err_hash = ${$fnode}{"ERR"};
 233                         for my $e (sort keys %$err_hash) {
 234                             print "\n$f";
 235                             print " at line $e:\n    " . ${$err_hash}{$e} . "\n";
 236                             sleep 0.5;
 237                         }
 238                 }
 239         }
 240         if ($m_errors_found) {
 241                 die "\n*** There where errors ***\n";
 242         } else {
 243                 print "Everything that was checked is ok\n";
 244         }
 245 } # report_errors
 246
 247 #############################
 248 ### Help
 249 #############################
 250 sub usage() {
 251     die "Usage: $0 --site=SITE-DIR --start=START-FILE\n";
 252 }
 253
 254 #############################
 255 ### Parameters
 256 #############################
 257 #my $m_start_file; # File to start checking in
 258 sub get_params() {
 259     usage() unless $#ARGV > -1;
 260     for (my $i = 0; $i <= $#ARGV; $i++) {
 261         my ($k, $v) = ($ARGV[$i] =~ m!-?-?(.*?)=(.*)!);
 262         if ($k eq "site") {
 263             $m_site_dir = $v;
 264         } elsif( $k eq "start") {
 265             #$m_FilesToCheck{$v} = 1;
 266             add_file_to_check($v);
 267         } else {
 268             print STDERR "Unknown parameter: $ARGV[$i]\n";
 269             usage();
 270         }
 271     }
 272     foreach my $key (keys %m_FilesToCheck) {
 273         die "Can't find $key\n" unless -e $key;
 274     }
 275     if (! $m_site_dir) {
 276         print STDERR "No site directory given\n";
 277         usage();
 278     }
 279     die "Can't find $m_site_dir\n" unless -d $m_site_dir;
 280     if ((scalar keys %m_FilesToCheck) == 0) {
 281         my $add_files =
 282             sub {
 283                 return unless m/.html?$/i;
 284                 return if -d $_;
 285                 #$m_FilesToCheck{$File::Find::name} = 1;
 286                 add_file_to_check($File::Find::name);
 287             };
 288         File::Find::find($add_files, $m_site_dir);
 289     }
 290 }
 291
 292 sub check_canonpath() {
 293     my $testpath = "/test/../some.txt";
 294     if ($testpath eq File::Spec->canonpath($testpath)) {
 295         my $errmsg = <<_BADCANON_
 296
 297 ** Fatal Error:
 298
 299    File::Spec->canonpath does not clean up path.
 300
 301    If you are doing this from Emacs with html-chklnk-check-site-links
 302    it may be because you are using Cygwin as your shell.  You can cure
 303    this in the following ways:
 304
 305    1) Use w32shell.el - this will temporary switch to "cmd" as shell.
 306    2) Use the default shell on w32.
 307
 308 _BADCANON_
 309 ;
 310
 311         die $errmsg;
 312     }
 313 }
 314
 315 #############################
 316 ### Main
 317 #############################
 318
 319 check_canonpath();
 320
 321 $| = 1; # flush or blush!
 322
 323 print "\n";
 324 get_params();
 325
 326 check_next_file();
 327 check_external_anchors();
 328 report_errors();