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