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 file_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     if (# strip out the w3c img callback; replace with alt text
  24         $fc =~ s{<img\s+src="http://www.w3c.org/Icons/[^"]+"[^>]*?alt="([^"]+)"[^>]*>}{$1}img
  25         or
  26         # if it doesn't have alt text, just replace it with Valid HTML
  27         $fc =~ s{<img\s+src="http://www.w3c.org/Icons/[^"]+"[^>]*>}{Valid HTML}img ) {
  28         $fh = IO::File->new($_,'w') or
  29             die "Unable to open $_ for writing: $!";
  30         print {$fh} $fc;
  31         close($fh);
  32     }
  33 }