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