altmaker.pl

PERL语言资料 可以用于PERL程序设计

#!/usr/bin/perl
# Fig. 23.2: altMaker.pl
# Program inserts ALT attributes into HTML <IMG> tags

use warnings;
use strict;
use CGI qw( :standard *center :cgi-lib escapeHTML );

package HTML::Parser::ImgFinder;
require HTML::Parser;
our @ISA = "HTML::Parser";

sub start
{
   my ( undef, $tag, $attributes, undef, undef ) = @_;

   if ( $tag eq 'img' ) {
      my $alt  = $$attributes{ 'alt' };
      my $name = $$attributes{ 'src' };

      unless ( $main::images{ $name } ) {
         print( "<img src = \"../$name\"><br/><br/>\n" );
         print( "<input type = \"text\" size = \"40\"" );
         print( "name = \"$name\" value = \"$alt\">" );
         print( "<br/><br/><hr/>\n" );
      }

      $main::images{ $name } = 1;
   }
}

package HTML::Parser::AltMaker;
require HTML::Parser;
our @ISA = "HTML::Parser";

sub start
{
   my ( undef, $tag, $attributes, $order, $original ) = @_;

   if ( $tag eq 'img' ) {
      my $key = $$attributes{ 'src' };

      unless ( exists $$attributes{ 'alt' } ) {
         push @$order, 'alt';
      }

      $$attributes{ 'alt' } = $main::images{ $key } || "";

      $original = "<img";
      foreach $key ( @$order ) {
         $original .= " $key = \"$$attributes{ $key }\"";
      }

      $original .= ">"; 
   }

   print main::FILE $original;
}

sub end 
{
    my $tag = $_[ 1 ];
    print main::FILE "</$tag>";
}

sub text 
{
   my $text = $_[ 1 ];
   print main::FILE $text;
}

package main;
our %images = ();

unless ( param ) {
   print( header, start_html( "Enter file name" ), 
      h2( "Enter file name:" ), start_form, 
      filefield( -name => "file" ), br, br,
      submit( -name => "submit", -value => "Submit file" ), 
      end_form, end_html );

}
elsif ( param( "submit" ) eq "Submit file" ) {
   my $file = param( "file" );
   my $parser = new HTML::Parser::ImgFinder;

   print( header, start_html( "Images found" ), start_center,
      h2( "Enter ALT descriptions for the images below." ),
      i( "File is $file" ), start_form );

   $parser->parse_file( $file );

   print( br, hidden( -name => "file" ),
      submit( -name => "submit", -value => "Submit ALT tags" ), 
      submit( -name => "submit", -value => "Do another page" ),
      end_form, end_html );

} 
else {
   my $file = param( "file" );
   my $parser = new HTML::Parser::AltMaker;

   %images = Vars;
   foreach ( keys %images ) {
      $images{ $_ } = escapeHTML( $images{ $_ } );
   }

   ( my $newfile = $file ) =~ s/\./_tmp./; 

   open( FILE, "> $newfile" ) or die( "Could not open: $!" );
   $parser->parse_file( $file );
   close( FILE );

   unlink( $file ) or die ( "Could not delete: $!" );
   rename( $newfile, $file ) or die ( "Could not rename: $!" );

   if ( param( "submit" ) eq "Do another page" ) {
      print( redirect( "altMaker.pl" ) );
   }
   else {
      my $base = $ENV{ "DOCUMENT_ROOT" };

      $file =~ s#\\#/#g;
      $file =~ s#^$base##i;
      print( redirect( "..$file" ) );
   }
} 


###########################################################################
#  (C) Copyright 2001 by Deitel & Associates, Inc. and Prentice Hall.     #
#  All Rights Reserved.                                                   #
#                                                                         #
#  DISCLAIMER: The authors and publisher of this book have used their     #
#  best efforts in preparing the book. These efforts include the          #
#  development, research, and testing of the theories and programs        #
#  to determine their effectiveness. The authors and publisher make       #
#  no warranty of any kind, expressed or implied, with regard to these    #
#  programs or to the documentation contained in these books. The authors #
#  and publisher shall not be liable in any event for incidental or       #
#  consequential damages in connection with, or arising out of, the       #
#  furnishing, performance, or use of these programs.                     #
###########################################################################