Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re: Need help with regex

by BastardOperator (Monk)
on Sep 22, 2000 at 18:34 UTC ( [id://33636]=note: print w/replies, xml ) Need Help??


in reply to Need help with regex

Update: I went with tilly's suggestion to use unpack, however I'm not sure that I did this efficiently. I first did an unpack into 2 columns, then broke it up from there, unpacking each column. This actually runs slower than my regex version, but it is a little nicer on the eyes. Suggestions are very welcome!
#!/usr/bin/env perl use strict; use Text::Soundex; my $PHONE_LIST = "$ENV{HOME}/phone_list"; my %seen; my $cntr; if(@ARGV == 0 || $ARGV[0] eq '-?' || $ARGV[0] eq '-h') { print "\nUsage: $0 <last name> ...\n\n"; exit 1; } open(PL, "$PHONE_LIST") || die "Can't open $PHONE_LIST: $!"; while(<PL>) { foreach my $name (@ARGV) { my $code = soundex($name); my @name_list; undef @name_list; my ($column_one, $column_two) = unpack("a40a40", $_); if($code eq soundex(split(/,/, $column_one))) { @name_list = unpack("a18a5a7", $column_one); } elsif($code eq soundex(split(/,/, $column_two))) { @name_list = unpack("a18a5a7", $column_two); } if(defined(@name_list)) { $seen{$name}++; if(++$cntr == 1) { printf("\n %-24s %-9s %-5s\n ", "Last, First M", "Ext", "Rm#"); print "=" x 40, "\n"; } printf("%-25s %-8d %-5s\n", @name_list); } } } foreach my $name (@ARGV) { if(! exists($seen{$name})) { print "\nNot found: $name"; } } print "\n"; close(PL);

Replies are listed 'Best First'.
RE: Re: Need help with regex
by tye (Sage) on Sep 23, 2000 at 00:10 UTC

    I think the above code has one problem in that it won't report two matches on the same line. You might prefer:

    for my $column ( unpack("a40a40", $_) ) { if( $code eq soundex( (split(/,/, $column))[0] ) ) { @name_list = unpack("a18a5a7", $column); $seen{$name}++; if(++$cntr == 1) { printf("\n %-24s %-9s %-5s\n ", "Last, First M", "Ext", "Rm#"); print "=" x 40, "\n"; } printf("%-25s %-8d %-5s\n", @name_list); } }

    Note also that defined @name_list is not a good idea. It might work in this specific example with your version of perl, but using defined on aggregate types (arrays and hashes) is documented as not a good idea. If you don't use my code above, change the if(defined(@name_list)) to if(0 < @name_list) or just if(@named_list)

            - tye (but my friends call me "Tye")

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://33636]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (6)
As of 2024-04-19 13:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found