in reply to regex question - dynamically address captures

The following may be what you want. Note the @captures = map... line in particular.

use warnings;
use strict;
use Data::Dump::Streamer;

my %patterns = (
    pattern1 => {
        'regex'     => qr'^/section/([\d]{1,8})/?$',
        'function'  => 'do__section',
        'id_fields' => ['section_id']
    },
    pattern2 => {
        'regex'     => qr'^/para/([\d]{1,8})/?$',
        'function'  => 'do__para',
        'id_fields' => ['para_id']
    }
);

my @lines = ('/section/123', '/para/256');

for my $line (@lines) {
  for my $key (keys %patterns) {
    next if $line !~ /$patterns{$key}->{regex}/;

    my @captures = map {substr $line, $-[$_], $+[$_] - $-[$_] + 1} 1..
+$#-;
    my %args;

    @args{@{$patterns{$key}->{'id_fields'}}} = @captures;
    print "Dump for $key:\n";
    Dump (\%args);
  }
}

[download]

Prints:

Dump for pattern1:
$HASH1 = { section_id => 123 };
Dump for pattern2:
$HASH1 = { para_id => 256 };

[download]
DWIM is Perl's answer to Gödel

Replies are listed 'Best First'.
Re^2: regex question - dynamically address captures
by ikegami (Patriarch) on Feb 21, 2006 at 23:15 UTC

    Nice, but you should replace 

    next if $line !~ /$patterns{$key}->{regex}/;
my @captures = map {substr $line, $-[$_], $+[$_] - $-[$_] + 1} 1..$#-;

    [download]

    with the much simpler 

    my @captures = $line =~ /$patterns{$key}->{regex}/
  or next;

    [download]
[reply]
[d/l]
[select]

      Argh. I had the equivelent of that first off, but I'd used 1 for the section and para numbers so @captures contained a single element with the value 1 and I convinced myself that it was the match count.

      Candidate for OT: most egregious programming error, ever maybe? :)

      DWIM is Perl's answer to Gödel
[reply]
        Well, it will place 1 (success flag) in @captures when there are no captures in the regexp, but that shouldn't matter since there shouldn't be any id_fields when there are no captures.
[reply]
[d/l]
[select]
      a_ AWESOME. thank you both.

      b_ the +1 on the substr should be cut.
[reply]
        On further investigation, it appears GrandFather's solution, as corrected by nmerriweather, is correct. ikegami's solution passes a 1 into @captures in the case of a successful match with no captures requested. This doesn't DWIM, and it proved to be a deal-breaker in my real-world task. 

        my $line = q{Convention_9841_12345678901234.txt};
my @captures;

print "\nIncorrect\n\n";

print_captures( incorrect( qr/Convention_(\d{4})_(\d{14})\.txt$/, $lin
+e ) );

print_captures( incorrect( qr/Convention_(\d{4})_\d{14}\.txt$/, $line 
+) );

print_captures( incorrect( qr/Convention_\d{4}_\d{14}\.txt$/, $line ) 
+);

print_captures( incorrect( qr/Convention_((\d{4})_(\d{14}))\.txt$/, $l
+ine ) );

print_captures( incorrect( qr/^(.*Convention_(\d{4})_(\d{14})\.txt)$/,
+ $line ) );
print "\nCorrect\n\n";
print_captures( get_captures( qr/Convention_(\d{4})_(\d{14})\.txt$/, $
+line ) );

print_captures( get_captures( qr/Convention_(\d{4})_\d{14}\.txt$/, $li
+ne ) );

print_captures( get_captures( qr/Convention_\d{4}_\d{14}\.txt$/, $line
+ ) );

print_captures( get_captures( qr/Convention_((\d{4})_(\d{14}))\.txt$/,
+ $line ) );

print_captures( get_captures( qr/^(.*Convention_(\d{4})_(\d{14})\.txt)
+$/, $line ) );

sub incorrect {
    my ($pattern, $line) = @_;
    my @captures;
    (@captures) = $line =~ m/$pattern/ or return;
    return @captures;
}

sub get_captures {
    my ($pattern, $line) = @_;
    $line =~ m/$pattern/ or return;
    return map {substr $line, $-[$_], $+[$_] - $-[$_]} (1 .. $#-);
}

sub print_captures {
    my @captures = @_;
    @captures ? print "captures:  @captures\n" : print "no captures\n"
+;
}

        [download]

        Jim Keenan
[reply]
[d/l]
[select]
      Your response and Grandfather's have solved an important problem for me on my day job. Thank you, fellow monks!

      Jim Keenan
[reply]

In Section Seekers of Perl Wisdom