hi all,
here is the code for the main loop of ack. study it deeply if you want
but in general notice how much code there is for such a tight loop. one
simple rule about perl code is the less code the faster it runs (there
are some fun exceptions to that rule). if i have the time i will do a
quick review of this code and some of its insanity. one obvious point is
that it has been built up feature by feature with no consideration to
how that affects the code and logic. and nothing was optimized with many
unneeded string copies and a poor design for the context buffer and
printing. i will definitely post up my design before tuesday so you can
ruminate (regurgitate? :) over it.
and post to the list if you are interested in helping or if you just
want to hang out. there will be fun and clowns and balloons for
everyone! i assume there will be free pizza and stuff as usual. is bob
clancy the pizza boy again this time? if so, rsvp to him so we get the
right amount of mass quantities.
thanx,
uri
=head2 search( $fh, $could_be_binary, $filename, $regex, \%opt )
Main search method
=cut
{
my $filename;
my $regex;
my $display_filename;
my $keep_context;
my $last_output_line; # number of the last line that has been output
my $any_output; # has there been any output for the current file yet
my $context_overall_output_count; # has there been any output at all
sub search {
my $fh = shift;
my $could_be_binary = shift;
$filename = shift;
$regex = shift;
my $opt = shift;
my $v = $opt->{v};
my $passthru = $opt->{passthru};
my $max = $opt->{m};
my $nmatches = 0;
$display_filename = undef;
# for --line processing
my $has_lines = 0;
my @lines;
if ( defined $opt->{lines} ) {
$has_lines = 1;
@lines = ( @{$opt->{lines}}, -1 );
undef $regex; # Don't match when printing matching line
}
# for context processing
$last_output_line = -1;
$any_output = 0;
my $before_context = $opt->{before_context};
my $after_context = $opt->{after_context};
$keep_context = ($before_context || $after_context) && !$passthru;
my @before;
my $before_starts_at_line;
my $after = 0; # number of lines still to print after a match
while (<$fh>) {
# XXX Optimize away the case when there are no more @lines to find.
if ( $has_lines
? $. != $lines[0]
: $v ? /$regex/o : !/$regex/o ) {
if ( $passthru ) {
print;
next;
}
if ( $keep_context ) {
if ( $after ) {
print_match_or_context( $opt, 0, $., $_ );
$after--;
}
elsif ( $before_context ) {
if ( @before ) {
if ( @before >= $before_context ) {
shift @before;
++$before_starts_at_line;
}
}
else {
$before_starts_at_line = $.;
}
push @before, $_;
}
last if $max && ( $nmatches >= $max ) && !$after;
}
next;
} # not a match
++$nmatches;
shift @lines if $has_lines;
if ( $could_be_binary ) {
if ( -B $filename ) {
print "Binary file $filename matches\n";
last;
}
$could_be_binary = 0;
}
if ( $keep_context ) {
if ( @before ) {
print_match_or_context( $opt, 0, $before_starts_at_line,
@before );
@before = ();
undef $before_starts_at_line;
}
if ( $max && $nmatches > $max ) {
--$after;
}
else {
$after = $after_context;
}
}
print_match_or_context( $opt, 1, $., $_ );
last if $max && ( $nmatches >= $max ) && !$after;
} # while
if ( $nmatches && $opt->{show_filename} && $opt->{group} ) {
print "\n";
}
return $nmatches;
} # search()
=head2 print_match_or_context( $opt, $is_match, $starting_line_no, @lines )
Prints out a matching line or a line of context around a match.
=cut
sub print_match_or_context {
my $opt = shift; # opts array
my $is_match = shift; # is there a match on the line?
my $line_no = shift;
my $color = $opt->{color};
my $group = $opt->{group};
my $show_filename = $opt->{show_filename};
if ( $show_filename ) {
if ( not defined $display_filename ) {
$display_filename =
$color
? Term::ANSIColor::colored( $filename,
$ENV{ACK_COLOR_FILENAME} )
: $filename;
if ( $group && !$any_output ) {
print $display_filename, "\n";
}
}
}
my $sep = $is_match ? ':' : '-';
my $output_func = $opt->{output};
for ( @_ ) {
if ( $keep_context && !$output_func ) {
if ( ( $last_output_line != $line_no - 1 ) &&
( $any_output || ( !$group && $context_overall_output_count++ >
0 ) ) ) {
print "--\n";
}
# to ensure separators between different files when --nogroup
$last_output_line = $line_no;
}
if ( $show_filename ) {
print $display_filename, $sep if not $group;
print $line_no, $sep;
}
if ( $output_func ) {
while ( /$regex/go ) {
print $output_func->(), "\n";
}
}
else {
if ( $color && $is_match && $regex ) {
if (
s/($regex)/Term::ANSIColor::colored($1,$ENV{ACK_COLOR_MATCH})/eg ) {
s/\n$/\e[0m\e[K\n/; # Before \n, reset the color and
clear to end of line
}
}
print;
}
$any_output = 1;
++$line_no;
}
return;
} # print_match_or_context()
} # scope around search() and print_match_or_context()
--
Uri Guttman ------ [EMAIL PROTECTED] -------- http://www.sysarch.com --
----- Perl Code Review , Architecture, Development, Training, Support ------
--------- Free Perl Training --- http://perlhunter.com/college.html ---------
--------- Gourmet Hot Cocoa Mix ---- http://bestfriendscocoa.com ---------
_______________________________________________
Boston-pm mailing list
[email protected]
http://mail.pm.org/mailman/listinfo/boston-pm
