This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Actually, only changes to regexec.c from #30081 needed to be reverted.
[perl5.git] / ext / re / lib / re / Tie / Hash / NamedCapture.pm
CommitLineData
44a2ac75
YO
1package re::Tie::Hash::NamedCapture;
2use strict;
3use warnings;
4our $VERSION = "0.01";
66e6b4c5 5no re 'debug';
44a2ac75
YO
6use re qw(is_regexp
7 regname
8 regnames
9 regnames_count
10 regnames_iterinit
11 regnames_iternext);
12
13sub TIEHASH {
14 my $classname = shift;
15 my $hash = {@_};
16
17 if ($hash->{re} && !is_regexp($hash->{re})) {
18 die "'re' parameter to ",__PACKAGE__,"->TIEHASH must be a qr//"
19 }
20
21 return bless $hash, $classname;
22}
23
24sub FETCH {
25 return regname($_[1],$_[0]->{re},$_[0]->{all});
26}
27
28sub STORE {
29 require Carp;
30 Carp::croak("STORE forbidden: Hashes tied to ",__PACKAGE__," are read/only.");
31}
32
33sub FIRSTKEY {
34 regnames_iterinit($_[0]->{re});
35 return $_[0]->NEXTKEY;
36}
37
38sub NEXTKEY {
39 return regnames_iternext($_[0]->{re},$_[0]->{all});
40}
41
42sub EXISTS {
43 return defined regname( $_[1], $_[0]->{re},$_[0]->{all});
44}
45
46sub DELETE {
47 require Carp;
48 Carp::croak("DELETE forbidden: Hashes tied to ",__PACKAGE__," are read/only");
49}
50
51sub CLEAR {
52 require Carp;
53 Carp::croak("CLEAR forbidden: Hashes tied to ",__PACKAGE__," are read/only");
54}
55
56sub SCALAR {
57 return scalar regnames($_[0]->{re},$_[0]->{all});
58}
59
601;
61
62__END__
63
64=head1 NAME
65
66re::Tie::Hash::NamedCapture - Perl module to support named regex capture buffers
67
68=head1 SYNOPSIS
69
70 tie my %hash,"re::Tie::Hash::NamedCapture";
71 # %hash now behaves like %-
72
73 tie my %hash,"re::Tie::Hash::NamedCapture",re => $qr, all=> 1,
74 # %hash now access buffers from regex in $qr like %+
75
76=head1 DESCRIPTION
77
78Implements the behaviour required for C<%+> and C<%-> but can be used
79independently.
80
81When the C<re> parameter is provided, and the value is the result of
82a C<qr//> expression then the hash is bound to that particular regexp
83and will return the results of its last successful match. If the
84parameter is omitted then the hash behaves just as C<$1> does by
85referencing the last successful match.
86
87When the C<all> parameter is provided then the result of a fetch
88is an array ref containing the contents of each buffer whose name
89was the same as the key used for the access. If the buffer wasn't
90involved in the match then an undef will be stored. When the all
91parameter is omitted or not a true value then the return will be
92a the content of the left most defined buffer with the given name.
93If there is no buffer with the desired name defined then C<undef>
94is returned.
95
96
97For instance:
98
99 my $qr = qr/(?<foo>bar)/;
100 if ( 'bar' =~ /$qr/ ) {
101 tie my %hash,"re::Tie::Hash::NamedCapture",re => $qr, all => 1;
102 if ('bar'=~/bar/) {
103 # last successful match is now different
104 print $hash{foo}; # prints foo
105 }
106 }
107
108=head1 SEE ALSO
109
110L<re>, L<perlmodlib/Pragmatic Modules>.
111
112=cut