This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
7363491f94f11cf00114d63814358014c4663ab9
[perl5.git] / ext / re / lib / re / Tie / Hash / NamedCapture.pm
1 package re::Tie::Hash::NamedCapture;
2
3 use strict;
4 use warnings;
5
6 our $VERSION = "0.02";
7
8 no re 'debug';
9 use re qw(is_regexp
10           regname
11           regnames
12           regnames_count
13           regnames_iterinit
14           regnames_iternext);
15
16 sub TIEHASH {
17     my $classname = shift;
18     my $hash = {@_};
19
20     if ($hash->{re} && !is_regexp($hash->{re})) {
21         die "'re' parameter to ",__PACKAGE__,"->TIEHASH must be a qr//"
22     }
23
24     return bless $hash, $classname;
25 }
26
27 sub FETCH {
28     return regname($_[1],$_[0]->{re},$_[0]->{all});
29 }
30
31 sub STORE {
32     require Carp;
33     Carp::croak("STORE forbidden: hashes tied to ",__PACKAGE__," are read-only.");
34 }
35
36 sub FIRSTKEY {
37     regnames_iterinit($_[0]->{re});
38     return $_[0]->NEXTKEY;
39 }
40
41 sub NEXTKEY {
42     return regnames_iternext($_[0]->{re},$_[0]->{all});
43 }
44
45 sub EXISTS {
46     return defined regname( $_[1], $_[0]->{re},$_[0]->{all});
47 }
48
49 sub DELETE {
50     require Carp;
51     Carp::croak("DELETE forbidden: hashes tied to ",__PACKAGE__," are read-only");
52 }
53
54 sub CLEAR {
55     require Carp;
56     Carp::croak("CLEAR forbidden: hashes tied to ",__PACKAGE__," are read-only");
57 }
58
59 sub SCALAR {
60     return scalar regnames($_[0]->{re},$_[0]->{all});
61 }
62
63 1;
64
65 __END__
66
67 =head1 NAME
68
69 re::Tie::Hash::NamedCapture - Named regexp capture buffers
70
71 =head1 SYNOPSIS
72
73     tie my %hash, "re::Tie::Hash::NamedCapture";
74     # %hash now behaves like %+
75
76     tie my %hash, "re::Tie::Hash::NamedCapture", re => $qr, all => 1;
77     # %hash now access buffers from regexp in $qr like %-
78
79 =head1 DESCRIPTION
80
81 This module is used to implement the special hashes C<%+> and C<%->, but it
82 can be used independently.
83
84 When the C<re> parameter is set to a C<qr//> expression, then the tied
85 hash is bound to that particular regexp and will return the results of its
86 last successful match. If the parameter is omitted, then the hash behaves
87 just as C<$1> does by referencing the last successful match in the
88 currently active dynamic scope.
89
90 When the C<all> parameter is provided, then the tied hash elements will be
91 array refs listing the contents of each capture buffer whose name is the
92 same as the associated hash key. If none of these buffers were involved in
93 the match, the contents of that array ref will be as many C<undef> values
94 as there are capture buffers with that name. In other words, the tied hash
95 will behave as the C<%-> array.
96
97 When the C<all> parameter is omitted or false, then the tied hash elements
98 will be the contents of the leftmost defined buffer with the name of the
99 associated hash key. In other words, the tied hash will behave as the
100 C<%+> array.
101
102 The keys of C<%->-like hashes correspond to all buffer names found in the
103 regular expression; the keys of C<%+>-like hashes list only the names of
104 buffers that have captured (and that are thus associated to defined values).
105
106 For instance:
107
108     my $qr = qr/(?<foo>bar)/;
109     if ( 'bar' =~ $qr ) {
110         tie my %hash, "re::Tie::Hash::NamedCapture", re => $qr;
111         print $+{foo};    # prints "bar"
112         print $hash{foo}; # prints "bar" too
113         if ( 'bar' =~ /bar/ ) {
114             # last successful match is now different
115             print $+{foo};    # prints nothing (undef)
116             print $hash{foo}; # still prints "bar"
117         }
118     }
119
120 =head1 SEE ALSO
121
122 L<re>, L<perlmodlib/Pragmatic Modules>, L<perlvar/"%+">, L<perlvar/"%-">.
123
124 =cut