I'm searching large ASCII files for keywords. The keywords are part of section headings. These headings are in all caps on lines by themselves.
The files sometimes contain HTML tags. My logic handles this well enough, but combs through the HTML very slowly. I'm dealing with tens of thousands of files, so speed counts.
I thought I'd get around this by using HTML::TokeParser to remove any HTML before I searched each file. But now the script processes EVERY file slowly, taking a few seconds for each.
Any suggestions on how I might optimize the following code, or what I could be doing better?
-- Craig
# slurp file into variable { local $/; $wholefile = <IN>; }
Others have noted that if your files are large, the slurp technique can hurt you. If files are a known and constrained size, this is fine. However, see below.
# remove HTML tags from variable, leaving only text my $parser = HTML::TokeParser->new (\$wholefile); while (my $token = $parser->get_token) { next unless $token->[0] eq 'T'; $wholefile2 = $wholefile2 . $token->[1]; }
In your description of the problem, you stated that the keywords were by themselves on a line. If this is so, do you need to parse out the html? I'm going to assume not. If you sometimes have header tags at the beginning and end, you may consider matching the header tags in your regex. If you do need to parse out the html, (maybe to get other values?) should you insert whitespace between consecutive 'T' tokens?
foreach $keyword (@all_keywords)
{
This could slow you down. If you have N keywords, then you are making N passes on the data to find each keyword. If the file gets a little large, and not all your keywords are in it, you could be spending a lot of time looking for things that do not exist. I think it would be better to build one regex to match all the keywords and make one pass through the data.
my $re = qr
{
( # start of $1 variable
( # start of a group (\w+[A-Z])+ # one or more words in caps
The regex: (\w+[A-Z])+ matches any mixed case letters, numbers and underscores, of length 2 or more that ends in a capital letter. The trailing + is unnecessary, I think. Your comment indicates that you wanted one or more words in caps, which is what I'm going to assume you really wanted.
\s+ # one or more spaces
)* # zero or more groups
$keyword # the $keyword variable
\s+ # one or more spaces
AGREEMENT # the word "AGREEMENT"
) # end of $1 variable
}x;
You are also throwing away the regex you've built in each pass, which you must do since the regex changes each time. Compiling regexen is expensive. If you must, you should combine the one above with the one below so only one compile needs to happen. But I think we can find a better way...
my $wholeRE = qr{^\s*$re\s*$};
Good. You anchored the regex which makes the matcher happy.
if($wholefile2 =~ /$wholeRE/gm)
{
# proceed
}
I do not think the /g modifier is needed in this situation since each match is on a new regex.
}
Given your code and my assumptions, I came up with the following. <code> #!/usr/bin/perl -w use strict; use warnings; use File::Basename; my $myname = basename($0);
# my keywords my @keywords = qw(One Two Three Four Five Six Seven Eight Nine Ten);
# join keywords into a single regex. if they have special characters, # we need to quote them with \Q\E, but that's left as an exercise for # the reader. my $key_regex = join( '|', @keywords );
# We're looking for 0 or more uppercase words, followed by a keyword,
# followed by the word AGREEMENT alone on a line. There may be
# optional whitespace at the beginning and at the end of the line.
my $agreement_regex = qr
{
^\s* # optional leading whitespace
(([A-Z]+(\s+[A-Z]+)*)\s+)? # optional uppercase words $2
(${key_regex})\s+ # keyword $4
AGREEMENT # the word AGREEMENT
\s*$ # optional trailing whitespace
}x;# According to the original code, it appears that we only process # the first match of any keyword. We'll use a hash to keep track # of the keys that we've seen. And we'll save the words (if any) # as the value of the hash entry. my %keys_seen;
# For line-oriented data, I always try reading a line at a time first.
# The code is simpler, and it may be faster depending upon many
# factors: slurp speed, prefetch strategy, io/cpu scheduling policy,
# available ram, data cache size, etc. If performance needs dictate,
# you can try slurp mode, and put a while loop around the regex match
# with the /g modifier. I'll bet that with the other optimizations
# that this is fast enough.
while( my $line = <DATA> )
{
# agreement_regex is a constant, use /o modifier to compile once
next unless $line =~ m/$agreement_regex/o; my ($key, $words) = ($4, (defined( $2 ) ? $2 : "") );
if ( exists $keys_seen{$key} )
{
warn( "${myname}: duplicate key: ${key} (words=$words)\n" );
next;
}
$keys_seen{$key} = $words;
}# order the processing of the keys in this loop
foreach my $key ( @keywords )
{
# proceed
if ( exists $keys_seen{$key} )
{
my $words = $keys_seen{$key};
warn( "${myname}: ", sprintf( "%8s: %s\n", $key, $words ) );
}
}
__DATA__
# Next line is blank.One AGREEMENT ANOTHER One AGREEMENT ANOTHER Two AGREEMENT Not ANOTHER Two AGREEMENT YET ANOTHER Three AGREEMENT Not Quite a Four AGREEMENT Five AGREEMENT Failed # next line has trailing space too. Six AGREEMENT A B C D E F G H I J Seven AGREEMENT 1 2 3 Eight AGREEMENT NINE Nine AGREEMENT Ten AGREEMENT Nine AGREEMENT </code>
Which produces: <output> C:\WINDOWS\system32\cmd.exe /c perl tst_matchkw.pl tst_matchkw.pl: duplicate key: One (words=ANOTHER) tst_matchkw.pl: duplicate key: Nine (words=) tst_matchkw.pl: One: tst_matchkw.pl: Two: ANOTHER tst_matchkw.pl: Three: YET ANOTHER tst_matchkw.pl: Six: tst_matchkw.pl: Seven: A B C D E F G H I J tst_matchkw.pl: Nine: NINE tst_matchkw.pl: Ten: </output>
pax, rgr
--
use strict; use warnings; print unpack'u',join'',map{chr}grep{$_}split/(\d{2})/,
q(5750715383613433655970938458385382403733696070806458383767588653824396969610);
__END__
_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
