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
1 package re::Tie::Hash::NamedCapture;
2 use strict;
3 use warnings;
4 our $VERSION     = "0.01";
5 no re 'debug';
6 use re qw(is_regexp
7           regname
8           regnames
9           regnames_count
10           regnames_iterinit
11           regnames_iternext);
12
13 sub 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
24 sub FETCH {
25     return regname($_[1],$_[0]->{re},$_[0]->{all});
26 }
27
28 sub STORE {
29     require Carp;
30     Carp::croak("STORE forbidden: Hashes tied to ",__PACKAGE__," are read/only.");
31 }
32
33 sub FIRSTKEY {
34     regnames_iterinit($_[0]->{re});
35     return $_[0]->NEXTKEY;
36 }
37
38 sub NEXTKEY {
39     return regnames_iternext($_[0]->{re},$_[0]->{all});
40 }
41
42 sub EXISTS {
43     return defined regname( $_[1], $_[0]->{re},$_[0]->{all});
44 }
45
46 sub DELETE {
47     require Carp;
48     Carp::croak("DELETE forbidden: Hashes tied to ",__PACKAGE__," are read/only");
49 }
50
51 sub CLEAR {
52     require Carp;
53     Carp::croak("CLEAR forbidden: Hashes tied to ",__PACKAGE__," are read/only");
54 }
55
56 sub SCALAR {
57     return scalar regnames($_[0]->{re},$_[0]->{all});
58 }
59
60 1;
61
62 __END__
63
64 =head1 NAME
65
66 re::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
78 Implements the behaviour required for C<%+> and C<%-> but can be used
79 independently.
80
81 When the C<re> parameter is provided, and the value is the result of
82 a C<qr//> expression then the hash is bound to that particular regexp
83 and will return the results of its last successful match. If the
84 parameter is omitted then the hash behaves just as C<$1> does by
85 referencing the last successful match.
86
87 When the C<all> parameter is provided then the result of a fetch
88 is an array ref containing the contents of each buffer whose name
89 was the same as the key used for the access. If the buffer wasn't
90 involved in the match then an undef will be stored. When the all
91 parameter is omitted or not a true value then the return will be
92 a the content of the left most defined buffer with the given name.
93 If there is no buffer with the desired name defined then C<undef>
94 is returned.
95
96
97 For 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
110 L<re>, L<perlmodlib/Pragmatic Modules>.
111
112 =cut