Commit | Line | Data |
80305961 |
1 | package Tie::Hash::NamedCapture; |
3195cf34 |
2 | |
44a2ac75 |
3 | use strict; |
4 | use warnings; |
3195cf34 |
5 | |
28d8d7f4 |
6 | our $VERSION = "0.05"; |
44a2ac75 |
7 | |
8 | sub TIEHASH { |
9 | my $classname = shift; |
67261566 |
10 | my %opts = @_; |
44a2ac75 |
11 | |
28d8d7f4 |
12 | my $self = bless { all => $opts{all} }, $classname; |
67261566 |
13 | return $self; |
44a2ac75 |
14 | } |
15 | |
16 | sub FETCH { |
28d8d7f4 |
17 | return re::regname($_[1],$_[0]->{all}); |
44a2ac75 |
18 | } |
19 | |
20 | sub STORE { |
21 | require Carp; |
3195cf34 |
22 | Carp::croak("STORE forbidden: hashes tied to ",__PACKAGE__," are read-only."); |
44a2ac75 |
23 | } |
24 | |
25 | sub FIRSTKEY { |
28d8d7f4 |
26 | re::regnames_iterinit(); |
44a2ac75 |
27 | return $_[0]->NEXTKEY; |
28 | } |
29 | |
30 | sub NEXTKEY { |
28d8d7f4 |
31 | return re::regnames_iternext($_[0]->{all}); |
44a2ac75 |
32 | } |
33 | |
34 | sub EXISTS { |
28d8d7f4 |
35 | return defined re::regname( $_[1], $_[0]->{all}); |
44a2ac75 |
36 | } |
37 | |
38 | sub DELETE { |
39 | require Carp; |
3195cf34 |
40 | Carp::croak("DELETE forbidden: hashes tied to ",__PACKAGE__," are read-only"); |
44a2ac75 |
41 | } |
42 | |
43 | sub CLEAR { |
44 | require Carp; |
3195cf34 |
45 | Carp::croak("CLEAR forbidden: hashes tied to ",__PACKAGE__," are read-only"); |
44a2ac75 |
46 | } |
47 | |
48 | sub SCALAR { |
28d8d7f4 |
49 | return scalar re::regnames($_[0]->{all}); |
44a2ac75 |
50 | } |
51 | |
67261566 |
52 | tie %+, __PACKAGE__; |
53 | tie %-, __PACKAGE__, all => 1; |
54 | |
44a2ac75 |
55 | 1; |
56 | |
57 | __END__ |
58 | |
59 | =head1 NAME |
60 | |
80305961 |
61 | Tie::Hash::NamedCapture - Named regexp capture buffers |
44a2ac75 |
62 | |
63 | =head1 SYNOPSIS |
64 | |
80305961 |
65 | tie my %hash, "Tie::Hash::NamedCapture"; |
3195cf34 |
66 | # %hash now behaves like %+ |
44a2ac75 |
67 | |
28d8d7f4 |
68 | tie my %hash, "Tie::Hash::NamedCapture", all => 1; |
3195cf34 |
69 | # %hash now access buffers from regexp in $qr like %- |
44a2ac75 |
70 | |
71 | =head1 DESCRIPTION |
72 | |
3195cf34 |
73 | This module is used to implement the special hashes C<%+> and C<%->, but it |
28d8d7f4 |
74 | can be used to tie other variables as you choose. |
44a2ac75 |
75 | |
3195cf34 |
76 | When the C<all> parameter is provided, then the tied hash elements will be |
77 | array refs listing the contents of each capture buffer whose name is the |
78 | same as the associated hash key. If none of these buffers were involved in |
79 | the match, the contents of that array ref will be as many C<undef> values |
80 | as there are capture buffers with that name. In other words, the tied hash |
9f8c97d1 |
81 | will behave as C<%->. |
44a2ac75 |
82 | |
3195cf34 |
83 | When the C<all> parameter is omitted or false, then the tied hash elements |
84 | will be the contents of the leftmost defined buffer with the name of the |
9f8c97d1 |
85 | associated hash key. In other words, the tied hash will behave as |
86 | C<%+>. |
44a2ac75 |
87 | |
3195cf34 |
88 | The keys of C<%->-like hashes correspond to all buffer names found in the |
89 | regular expression; the keys of C<%+>-like hashes list only the names of |
90 | buffers that have captured (and that are thus associated to defined values). |
44a2ac75 |
91 | |
44a2ac75 |
92 | =head1 SEE ALSO |
93 | |
3195cf34 |
94 | L<re>, L<perlmodlib/Pragmatic Modules>, L<perlvar/"%+">, L<perlvar/"%-">. |
44a2ac75 |
95 | |
96 | =cut |