Generating Regular Expressions

[cjf-II]

I recently started working on a CGI program that acted as a gateway between a few Python clients and a large number of XML files on a server. When I started writing the parameter checking code I found myself writing virtually the same code for each subroutine. Having a single separate sub that was flexible enough to check all parameters would keep the code far simpler, shorter, and more maintainable.

What I quickly threw together was a sub that takes a list of acceptable symbols and two numbers indicating whether or not alpha and numeric characters are allowed in the given parameter. It then generates a very simple regex based on the input.

This seems like it would be a fairly common task (there's even a brief mention of it in Programming Perl 3rd ed.) but a quick search here didn't turn up much other than generating regexes? which wasn't quite what I was looking for. Does anyone routinely generate regexes, and if so what types of tasks have you found generating them most useful for. Also, are there any other examples and/or modules available that I should take a look at? Thanks.

Here's the code (any suggestions are greatly appreciated):

use diagnostics;
use strict;
use warnings;

my @randomParameters = ('Abc.123', '../../', 'a@b.c', '789');
my @allowedSymbols   = ('.', '@');
my (@goodParams, @badParams);

checkParam($_, 1, 1, @allowedSymbols) for (@randomParameters);

print $_, " is good\n" for @goodParams;
print $_, " is bad\n"  for @badParams;

sub checkParam {
    my $param   = shift;
    my $alpha   = shift; # if true allow alpha
    my $numeric = shift; # if true allow numeric
    my @symbols = @_;    # allow all symbols in @_

    my $regex = "";

    $regex .= '([a-zA-Z' if $alpha;
    $regex .= '0-9'      if $numeric;

    for my $symbol (@symbols) {
        $regex .= $symbol;
    }
    $regex .= ']*)';

    my $pattern = qr/^${regex}$/;

    if ($param =~ /$pattern/) {
        push(@goodParams, $param);
    } else {
        push(@badParams, $param);
    }


}

[Abigail-II]

I often generate regexes on the fly. Have a look at the regex that matches URLs at http://www.foad.org/~abigail/Perl/url3.regex, which was generated by the program found at http://www.foad.org/~abigail/Perl/url3.pl. And then there's the Regexp::Common module as found on CPAN. Many of its regexes are generated.

Abigail

[DamnDirtyApe]

Not bad, but there's a couple things I'd do slightly different, in the interest of scalability. Also, assigning to arrays outside the sub from inside the sub couples your routine too tightly to this particular program. Here's my version:

use diagnostics;
use strict;
use warnings;

use Data::Dumper ;

my @randomParameters = ('Abc.123', '../../', 'a@b.c', '789');
my @allowedSymbols   = ('.', '@');
my (@goodParams, @badParams);

my @results = checkParam( \@randomParameters,
                          ALPHA   => 1,
                          NUMERIC => 1,
                          SYMBOLS => \@allowedSymbols ) ;

print Dumper \@results ;

sub checkParam
{
    my ( $param_list, %options ) = @_ ;

    my %chartypes = (
        'ALPHA'   => '[:alpha:]',
        'NUMERIC' => '[:digit:]'
    ) ;

    my $regex = '[' ;

    ## include the character classes.
    $regex .= join '' => map  { $chartypes{$_} }
                         grep { $options{$_}   } keys %chartypes ;

    ## include the symbols.
    $regex .= join '' => @{$options{'SYMBOLS'}} ;
    $regex .= ']+' ;

    my $pattern = qr/^$regex$/;

    my @results = ([], []) ;

    for ( @$param_list )
    {
        if ( $_ =~ /$pattern/ )
        {
            push @{$results[0]}, $_ ;
        }
        else
        {
            push @{$results[1]}, $_ ;
        }
    }
    return @results ;
}


_______________
DamnDirtyApe

Those who know that they are profound strive for clarity. Those who
would like to seem profound to the crowd strive for obscurity.
            --Friedrich Nietzsche