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