зеркало из https://github.com/mozilla/gecko-dev.git
Add 'express_fast' which is a much faster than 'express'. Uses Backwards.pm. This will probably replace 'express'.
This commit is contained in:
slamm%netscape.com
Родитель
e6dc193423
Коммит
649c654e40
|
|
@ -0,0 +1,216 @@
|
|||
# Backwards.pm
|
||||
|
||||
# Copyright (C) 1999 Uri Guttman. All rights reserved.
|
||||
# mail bugs, comments and feedback to uri@sysarch.com
|
||||
|
||||
|
||||
use strict ;
|
||||
|
||||
package Backwards ;
|
||||
|
||||
use Symbol ;
|
||||
use Fcntl ;
|
||||
use Carp ;
|
||||
use integer ;
|
||||
|
||||
#my $max_read_size = 3 ;
|
||||
|
||||
my $max_read_size = 1 << 13 ;
|
||||
|
||||
# support tied handles. the tied calls map directly to the object methods
|
||||
|
||||
*TIEHANDLE = \&new ;
|
||||
*READLINE = \&readline ;
|
||||
|
||||
# create a new Backwards object
|
||||
|
||||
sub new {
|
||||
|
||||
my( $class, $filename ) = @_ ;
|
||||
|
||||
my( $handle, $seek_pos, $read_size, $self ) ;
|
||||
|
||||
# get a new handle symbol and the real file handle
|
||||
|
||||
$handle = gensym() ;
|
||||
|
||||
# open the file for reading
|
||||
|
||||
unless( sysopen( $handle, $filename, O_RDONLY ) ) {
|
||||
carp "Can't open $filename $!" ;
|
||||
return ;
|
||||
}
|
||||
|
||||
# seek to the end of the file
|
||||
|
||||
seek( $handle, 0, 2 ) ;
|
||||
$seek_pos = tell( $handle ) ;
|
||||
|
||||
# get the size of the first block to read,
|
||||
# either a trailing partial one (the % size) or full sized one (max read size)
|
||||
|
||||
$read_size = $seek_pos % $max_read_size || $max_read_size ;
|
||||
|
||||
# create the hash for the object, bless and return it
|
||||
|
||||
$self = {
|
||||
'file_name' => $filename,
|
||||
'handle' => $handle,
|
||||
'read_size' => $read_size,
|
||||
'seek_pos' => $seek_pos,
|
||||
'lines' => [],
|
||||
} ;
|
||||
|
||||
return( bless( $self, $class ) ) ;
|
||||
}
|
||||
|
||||
sub readline {
|
||||
|
||||
my( $self, $line_ref ) = @_ ;
|
||||
|
||||
my( $handle, $lines_ref, $seek_pos, $read_cnt, $read_buf,
|
||||
$file_size, $read_size, $text ) ;
|
||||
|
||||
# get the buffer of lines
|
||||
|
||||
$lines_ref = $self->{'lines'} ;
|
||||
|
||||
while( 1 ) {
|
||||
|
||||
# see if there is more than 1 line in the buffer
|
||||
|
||||
if ( @{$lines_ref} > 1 ) {
|
||||
|
||||
# we have a complete line so return it
|
||||
|
||||
return( pop @{$lines_ref} ) ;
|
||||
}
|
||||
|
||||
# we don't have a complete, so have to read blocks until we do
|
||||
|
||||
$seek_pos = $self->{'seek_pos'} ;
|
||||
|
||||
# see if we are at the beginning of the file
|
||||
|
||||
if ( $seek_pos == 0 ) {
|
||||
|
||||
# the last read never made more lines, so return the last line in the buffer
|
||||
# if no lines left then undef will be returned
|
||||
|
||||
return( pop @{$lines_ref} ) ;
|
||||
}
|
||||
|
||||
#print "c size $read_size\n" ;
|
||||
|
||||
# we have to read more text so get the handle and the current read size
|
||||
|
||||
$handle = $self->{'handle'} ;
|
||||
$read_size = $self->{'read_size'} ;
|
||||
|
||||
# after the first read, always read the maximum size
|
||||
|
||||
$self->{'read_size'} = $max_read_size ;
|
||||
|
||||
# seek to the beginning of this block and save the new seek position
|
||||
|
||||
$seek_pos -= $read_size ;
|
||||
$self->{'seek_pos'} = $seek_pos ;
|
||||
seek( $handle, $seek_pos, 0 ) ;
|
||||
|
||||
#print "seek $seek_pos\n" ;
|
||||
|
||||
# read in the next (previous) block of text
|
||||
|
||||
$read_cnt = sysread( $handle, $read_buf, $read_size ) ;
|
||||
|
||||
#print "Read <$read_buf>\n" ;
|
||||
|
||||
# if ( $read_cnt != $read_size ) {
|
||||
# print "bad read cnt $read_cnt != size $read_size\n" ;
|
||||
# return( undef ) ;
|
||||
# }
|
||||
|
||||
# prepend the read buffer to the leftover (possibly partial) line
|
||||
|
||||
$text = $read_buf . ( pop @{$lines_ref} || '' ) ;
|
||||
|
||||
# split the buffer into a list of lines
|
||||
# this may want to be $/ but reading files backwards assumes plain text and
|
||||
# newline separators
|
||||
|
||||
@{$lines_ref} = $text =~ m[(^.*\n|^.+)]mg ;
|
||||
|
||||
#print "Lines \n=>", join( "<=\n=>", @{$lines_ref} ), "<=\n" ;
|
||||
}
|
||||
}
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Backwards.pm -- Read a file backwards by lines.
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Backwards ;
|
||||
|
||||
# Object interface
|
||||
|
||||
$bw = Backwards->new( 'log_file' ) ;
|
||||
|
||||
while( $log_line = $bw->readline ) {
|
||||
print $log_line ;
|
||||
}
|
||||
|
||||
# Tied Handle Interface
|
||||
|
||||
tie *BW, 'log_file' ;
|
||||
|
||||
while( <BW> ) {
|
||||
print ;
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
|
||||
This module reads a file backwards line by line. It is simple to use,
|
||||
memory efficient and fast. It supports both an object and a tied handle
|
||||
interface.
|
||||
|
||||
It is intended for processing log and other similar text files which
|
||||
typically have new entries appended. It uses newline as the separator
|
||||
and not $/ since it is only meant to be used for text.
|
||||
|
||||
It works by reading large (8kb) blocks of text from the end of the file,
|
||||
splits them on newlines and stores the other lines until the buffer runs
|
||||
out. Then it seeks to the previous block and splits it. When it reaches
|
||||
the beginning of the file, it stops reading more blocks. All boundary
|
||||
conditions are handled correctly. If there is a trailing partial line
|
||||
(no newline) it will be the first line returned. Lines larger than the
|
||||
read buffer size are ok.
|
||||
|
||||
=head2 Object Interface
|
||||
|
||||
|
||||
There are only 2 methods in Backwards' object interface, new and
|
||||
readline.
|
||||
|
||||
=head2 new
|
||||
|
||||
New takes just a filename for an argument and it either returns the
|
||||
object on a successful open on that file or undef.
|
||||
|
||||
=head2 readline
|
||||
|
||||
Readline takes no arguments and it returns the previous line in the file
|
||||
or undef when there are no more lines in the file.
|
||||
|
||||
|
||||
=head2 Tied Handle Interface
|
||||
|
||||
The only tied handle calls supported are TIEHANDLE and READLINE and they
|
||||
are typeglobbed to new and readline respectively. All other tied handle
|
||||
operations will generate an unknown method error. Do not seek, write or
|
||||
do any other operation other than <> on the handle.
|
||||
|
|
@ -71,8 +71,23 @@ if( $form{'tree'} eq '' ){
|
|||
exit;
|
||||
}
|
||||
else {
|
||||
if( $form{'timeit'} ) {
|
||||
use Benchmark;
|
||||
print "Timing the new express:<br>\n";
|
||||
$t0 = new Benchmark;
|
||||
&do_express_fast;
|
||||
$t1 = new Benchmark;
|
||||
print "express_fast took: ", timestr(timediff($t1,$t0)), "<br>\n";
|
||||
print "Now time the old express:<br>\n";
|
||||
&do_express_old;
|
||||
$t2 = new Benchmark;
|
||||
print "express took: ", timestr(timediff($t2,$t1)), "<br>\n";
|
||||
exit;
|
||||
}
|
||||
if( $form{'express'} ) {
|
||||
&do_express;
|
||||
&do_express_old;
|
||||
} elsif( $form{'express_fast'} ) {
|
||||
&do_express_fast;
|
||||
}
|
||||
else {
|
||||
&load_data;
|
||||
|
|
@ -354,7 +369,7 @@ sub display_build_table_row {
|
|||
}
|
||||
}
|
||||
else {
|
||||
print "<td> </td>\n";
|
||||
print "<td></td>\n";
|
||||
}
|
||||
$bn++;
|
||||
}
|
||||
|
|
@ -668,7 +683,7 @@ $script_str .= "</script>\n";
|
|||
}
|
||||
|
||||
|
||||
sub do_express {
|
||||
sub do_express_old {
|
||||
my($mailtime, $buildtime, $buildname, $errorparser, $buildstatus,
|
||||
$logfile);
|
||||
my $buildrec;
|
||||
|
|
@ -719,7 +734,64 @@ sub do_express {
|
|||
print "<font color=white>\n";
|
||||
}
|
||||
}
|
||||
print "$buildname";
|
||||
print "$buildname</td>";
|
||||
}
|
||||
print "</tr></table>\n";
|
||||
}
|
||||
|
||||
sub do_express_fast {
|
||||
my($mailtime, $buildtime, $buildname, $errorparser, $buildstatus,
|
||||
$logfile);
|
||||
my $buildrec;
|
||||
my %build;
|
||||
my %times;
|
||||
|
||||
{
|
||||
use Backwards;
|
||||
|
||||
my ($bw) = Backwards->new("$form{tree}/build.dat") or die;
|
||||
|
||||
$latest_time=0;
|
||||
while( $_ = $bw->readline ) {
|
||||
chop;
|
||||
($mailtime, $buildtime, $buildname, $errorparser, $buildstatus, $logfile) =
|
||||
split( /\|/ );
|
||||
if( $buildstatus eq 'success' or $buildstatus eq 'busted' ) {
|
||||
if ($latest_time == 0) {
|
||||
$latest_time = $buildtime;
|
||||
}
|
||||
# Ignore stuff more than 12 hours old
|
||||
last if $buildtime < $latest_time - 12*60*60;
|
||||
next if defined $build{$buildname};
|
||||
|
||||
$build{$buildname} = $buildstatus;
|
||||
$times{$buildname} = $buildtime;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@keys = sort keys %build;
|
||||
$keycount = @keys;
|
||||
$treename = $form{tree};
|
||||
$tm = &print_time(time);
|
||||
print "<table border=1 align=center><tr><th colspan=$keycount><a href=showbuilds.cgi?tree=$treename";
|
||||
print "&hours=$form{'hours'}" if $form{'hours'};
|
||||
print "&nocrap=1" if $form{'nocrap'};
|
||||
print ">$tree as of $tm</a></tr>"
|
||||
."<tr>\n";
|
||||
for $buildname (@keys ){
|
||||
if( $build{$buildname} eq 'success' ){
|
||||
print "<td bgcolor=00ff00>";
|
||||
}
|
||||
else {
|
||||
if ($form{'nocrap'}) {
|
||||
print "<td bgcolor=FF0000>";
|
||||
} else {
|
||||
print "<td bgcolor=000000 background=1afi003r.gif>";
|
||||
print "<font color=white>\n";
|
||||
}
|
||||
}
|
||||
print "$buildname</td>";
|
||||
}
|
||||
print "</tr></table>\n";
|
||||
}
|
||||
|
|
|
|||
Загрузка…
Ссылка в новой задаче