Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Getting a list of all possible pattern matches

by inoci (Scribe)
on Dec 13, 2007 at 18:57 UTC ( #656880=perlquestion: print w/replies, xml ) Need Help??
inoci has asked for the wisdom of the Perl Monks concerning the following question:

I want to be able to generate a list of all possible matches for a pattern. This will be for phone numbers configured in a sip gateway where the numbers are added into the config as patterns, not individual numbers. I need to generate a list of all the numbers that a given gateway is configured to handle. The ranges are defined in a very simple notation, with "." being a wildcard (matches 0-9), and brackets holding a set and/or range of numbers.

For instance, given something like :

1115551234 111555124. 111555125[0,3-7]

I want to end up with a list like this :

1115551234 1115551240 1115551241 1115551242 1115551243 1115551244 1115551245 1115551246 1115551247 1115551248 1115551249 1115551250 1115551253 1115551254 1115551255 1115551256 1115551257

I've gotten to the point where i can get a nice array that has each place and either a digit or an array ref for those that have multiple matches. I just can't figure out a way to output all of the possible matches. I'm hoping there is a module that I can't find that can translate a pattern into a series of all possible matches. I've tried List::Maker, which comes so close it hurts, but still isn't quite what i need and I haven't been able to shoehorn it into what I'm seeking. I can think of a couple of ways to brute force my will onto this problem, I'm just trying to find a more elegant solution. I'm out of good ideas, and running low on bad ones, so I'm hoping someone has some guidance.

Replies are listed 'Best First'.
Re: Getting a list of all possible pattern matches
by AK108 (Friar) on Dec 13, 2007 at 20:16 UTC
    Perl has a wonderful built-in function to expand wildcards: glob. The trick is to use the {} patterns. They don't require files to exist. So we just translate your patterns to the {} versions. The range operator (..) helps us a lot, as does evaluated regexes (/e flag).
    #!/usr/bin/perl use strict; use warnings; my @list = <DATA>; chomp @list; for my $pattern (@list) { # Handle the . wildcard $pattern =~ s/\./{0,1,2,3,4,5,6,7,8,9}/g; # Handle the ranges $pattern =~ s/\[([^\]]+?)\]/'{' . expand_brackets($1) . '}'/eg; # Uncomment this to see how the patterns look before being passed +to glob # print $pattern, "\n"; print "$_\n" for glob($pattern); } sub expand_brackets { my $pattern = shift; $pattern =~ s/\b(\d+)\-(\d+)\b/join ',', $1 .. $2/ge; return $pattern; } __DATA__ 1115551234 111555124. 111555125[0,3-7]
      neato. it works, but i don't know how or why. looks like i've got some reading to do...
Re: Getting a list of all possible pattern matches
by moritz (Cardinal) on Dec 13, 2007 at 19:00 UTC
    CPAN helps: Regexp::Genex.

    Update: It seems that a period . in your regex corresponds to \d in Perl, so you'd have to translate your patterns slightly before using Regexp::Genex.

      close, but Regexp::Genex appears to randomize the results for anything that has more than one possible match. this is apparently by design. so instead of getting a list of numbers, i get a different one each time.
Re: Getting a list of all possible pattern matches
by Cristoforo (Curate) on Dec 14, 2007 at 00:34 UTC
    A solution using 2 modules, Set::IntSpan and Set::CrossProduct.
    #!/usr/bin/perl use strict; use warnings; use Set::IntSpan; use Set::CrossProduct; while (<DATA>) { my @set; if (/^\d+$/) { print; } else { chomp; s/\./[0-9]/g; for my $part (split /(\[.+?])/) { if (-1 == index $part, '[') { push @set, [$part]; } else { my $set = Set::IntSpan->new( substr $part, 1,-1 ); push @set, [ $set->elements() ]; } } my $xp = Set::CrossProduct->new( \@set ); while( my @tuple = $xp->get ) { print @tuple, "\n"; } } } __DATA__ 1115551234 111555124. 111555125[0,3-7]

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://656880]
Approved by moritz
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (12)
As of 2017-07-20 20:38 GMT
Find Nodes?
    Voting Booth?
    I came, I saw, I ...

    Results (315 votes). Check out past polls.