debian/remove_w3c_callback

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use IO::File;
   7 use File::Find;
   8
   9 # <a href="http://validator.w3.org/check?uri=referer">
  10 # <img src="http://www.w3.org/Icons/valid-html401"
  11 #      alt="Valid HTML 4.01 Transitional"
  12 #      height="31" width="88"></a>
  13
  14 find(\&fix_if_file,@ARGV);
  15
  16 sub fix_if_file {
  17     return unless -f $_;
  18     my $fh = IO::File->new($_,'r') or
  19         die "Unable to open $_ for reading: $!";
  20     local $/;
  21     my $fc = <$fh>;
  22     close($fh);
  23     # strip out the w3c img callback; replace with alt text
  24     my $changed = $fc =~ s{<img\s+src="http://www.w3c?.org/Icons/[^"]+"[^>]*?alt="([^"]+)"[^>]*>}{$1}imsg;
  25     # if it doesn't have alt text, just replace it with Valid HTML
  26     $changed += $fc =~ s{<img\s+src="http://www.w3c?.org/Icons/[^"]+"[^>]*>}{Valid HTML}imsg;
  27
  28     if ($changed) {
  29         $fh = IO::File->new($_,'w') or
  30             die "Unable to open $_ for writing: $!";
  31         print {$fh} $fc;
  32         close($fh);
  33         print STDERR "$File::Find::name was changed\n";
  34     }
  35 }