fig12_12.pl

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

#!/usr/bin/perl
# Figure 12.12: fig12_12.pl
# Analyzes the Apache error log file.

use warnings;
use strict;
use English;

# System settings - change to make output appear correctly
$FORMAT_LINES_PER_PAGE = 25;
$FORMAT_FORMFEED = '';
my $error='C:\Program Files\Apache Group\Apache\logs\error.log';

# The format and format top are ERROR_LOG_TOP
# Number of lines left is set to the amount of lines in a page
# Page number is set to 1
( $~, $^, $-, $% ) = ( 'ERROR_LOG_TOP', 'ERROR_LOG_TOP', $=, 1 );
write();

# Change format to ERROR_LOG
$~ = 'ERROR_LOG';
my @total = ('','');

open( FILE, $error ) or die( "Cannot open: $!" );

# Loop that prints each entry and gathers information
while ( <FILE> ) {
   next if ( $_ eq "\n" );         # skip blank lines
   
   my @entry = parseErrorEntry( $_ );

   # if message has same date, time and client number
   if ( ( $total[ 0 ] eq $entry[ 0 ] ) 
        && ( $total[ 1 ] eq $entry[ 1 ] ) ) {
      # add new information to the error message
      $total[2] .= ( ' 'x58 ).$entry[ 2 ];  
   }
   # if we have a new message to print
   elsif ( defined( $total[ 2 ] ) ) {

      # paginate analyzes the error message, putting the 
      # information into different pages as necessary
      my @pages = paginate( $total[ 2 ], 44, $- - 1, $= - 4 );

      foreach my $page ( @pages[ 0 .. $#pages - 1 ] ) {
         # assign the message to total[2]
         $total[ 2 ] = $page;
         # print the error message, date and client
         write();
         # prompt the user at the end of the page
         prompt();
      }

      $total[ 2 ] = $pages[ $#pages ];       
      write();
  
      if ( $- < 4 ) {
         print( "\n" x ( $- - 1 ) );
         prompt();
         $- = 0;
      }
      else {
         print( "\n" );
         $---;
      }
      @total = @entry;
   }
   # otherwise get a new message to print
   else {
      @total = @entry;
   }
}

my @pages = paginate( $total[ 2 ], 44, $- - 1, $= - 4 );

foreach my $page ( @pages[ 0 .. $#pages - 1 ] ) {
   $total[ 2 ] = $page;
   write();
   prompt();
}

$total[ 2 ] = $pages[ $#pages ];       
write();

print( "\n" x ( $- - 2 ) );

sub parseErrorEntry 
{
   my $entry = shift;

   # this line of the regex captures the time and day
   if ( $entry =~ /^\[(\w{3}\s\w{3}\s\d\d?\s[\d:]+\s\d\d\d\d)\]
   # this line captures the IP address and error message
                  \s\[error\]\s\[client\s([\d.]+)\]\s(.*)\n$/x ) {

      # return the time and day, client and message
      return ( $1, $2, $3 );
   }

   warn "Not a normal error log entry.\n$entry\n";
   return undef;
}

sub prompt 
{
   print( "--- Press Enter to Continue ---" );
   <STDIN>;
   $FORMAT_LINES_LEFT--;
}

sub paginate 
{
   my ( $string, $length, $firstPage, $perPage ) = @_ ;
   my ( $lineStart, $pageStart, $lines, $page ) = ( 0, 0, 0, 1 );
   my @pages = ();
   my $totalLines = ( $firstPage > 0 )? $firstPage : $perPage;

   # counts how many lines gone through so far
   while ( defined( $lineStart ) ) {
    
      if ( $lines >= $totalLines ) {
         my $next = '';
         $next .= "(page $page of message)" . ' ' x $length 
                                              if ( $page > 1 );
         $next .= substr($string,$pageStart,$lineStart-$pageStart);
         push( @pages, $next );
         $totalLines = $perPage;
         $lines = 1;
         $pageStart = $lineStart;
         $page++;
      }
      
      $lineStart = getNextLine( $string, $lineStart, $length );
      $lines++;
   } 
   my $next = '';

   # in case a message has run onto another page
   $next .= "(page $page of message)" . ' ' x $length 
            if ( $page > 1 );
   $next .= substr( $string, $pageStart );
   push( @pages, $next );
   return @pages;
}

# determines where lines will break
# returns the index of the beginning of the next line
sub getNextLine {
   my ( $string, $start, $length ) = @_;
   
   # ignoring whitespace at the front of a line
   $start++ while ( ( $start < length( $string ) ) 
           && ( substr( $string, $start, 1 ) =~ /^[\s\n]$/ ) );         
   return undef if ( length( $string ) < $start + $length );

   if ( substr( $string, $start + $length, 1 ) =~ /^[\n\s]$/ ) {
      return ( $start + $length + 1 );
   }

   $length--;
   
   while ( $length > 0 ) {

      if ( substr( $string, $start + $length, 1 ) =~ /^[\n\-\s]$/ ) {
         return ( $start + $length + 1 );
      }

      $length--;
   }
   return ( $start + $_[2] );
}

format ERROR_LOG_TOP =
error.log                                               Page @<<<
                                                              $%
Time and Client      Error Message
---------------      --------------------------------------------
.

format ERROR_LOG =
@<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~
$total[0],           $total[2]
@<<<<<<<<<<<<<<      ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~
$total[1],           $total[2]
~~                   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                     $total[2]
.


###########################################################################
#  (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.                     #
###########################################################################