File Coverage

blib/lib/PPIx/Regexp/Support.pm
Criterion Covered Total %
statement 29 32 90.6
branch 11 18 61.1
condition n/a
subroutine 9 9 100.0
pod 4 4 100.0
total 53 63 84.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             PPIx::Regexp::Support - Basis for the PPIx::Regexp support classes
4              
5             =head1 SYNOPSIS
6              
7             use PPIx::Regexp::Dumper;
8             PPIx::Regexp::Dumper->new( 'qr{foo}smx' )
9             ->print();
10              
11             =head1 INHERITANCE
12              
13             C is not descended from any other class.
14              
15             C is the parent of
16             L,
17             L and
18             L.
19              
20             =head1 DESCRIPTION
21              
22             This abstract class provides methods for the C support
23             classes.
24              
25             =head1 METHODS
26              
27             This class provides the following public methods. Methods not documented
28             here are private, and unsupported in the sense that the author reserves
29             the right to change or remove them without notice.
30              
31             =cut
32              
33             package PPIx::Regexp::Support;
34              
35 9     9   55 use strict;
  9         11  
  9         245  
36 9     9   28 use warnings;
  9         10  
  9         302  
37              
38 9     9   31 use PPIx::Regexp::Constant qw{ @CARP_NOT };
  9         12  
  9         755  
39 9     9   43 use PPIx::Regexp::Util qw{ __instance };
  9         11  
  9         3209  
40              
41             our $VERSION = '0.091_01';
42              
43             =head2 close_bracket
44              
45             This method takes as its argument a character. If this character is an
46             open bracket the corresponding close bracket is returned. Otherwise
47             C is returned. Only the ASCII bracket characters are considered
48             brackets: (), {}, [], and <>.
49              
50             =cut
51              
52             {
53             my %bracket = (
54             '(' => ')',
55             '{' => '}',
56             '<' => '>',
57             '[' => ']',
58             );
59              
60             sub close_bracket {
61 705     705 1 1253 my ( undef, $char ) = @_; # Invocant unused
62 705 50       1273 defined $char or return;
63 705 100       1556 __instance( $char, 'PPIx::Regexp::Element' )
64             and $char = $char->content();
65 705         2555 return $bracket{$char};
66             }
67              
68             }
69              
70             =head2 decode
71              
72             This method wraps the Encode::decode subroutine. If the object specifies
73             no encoding or encode_available() returns false, this method simply
74             returns its input string.
75              
76             =cut
77              
78             sub decode {
79 740     740 1 1403 my ( $self, $data ) = @_;
80 740 100       2493 defined $self->{encoding} or return $data;
81 1 50       3 encode_available() or return $data;
82 1         24 return Encode::decode( $self->{encoding}, $data );
83             }
84              
85             =head2 encode
86              
87             This method wraps the Encode::encode subroutine. If the object specifies
88             no encoding or encode_available() returns false, this method simply
89             returns its input string.
90              
91             =cut
92              
93             sub encode {
94 51     51 1 70 my ( $self, $data ) = @_;
95 51 50       139 defined $self->{encoding} or return $data;
96 0 0       0 encode_available() or return $data;
97 0         0 return Encode::encode( $self->{encoding}, $data );
98             }
99              
100             =head2 encode_available
101              
102             This method returns true if the Encode module is available, and false
103             otherwise. If it returns true, the Encode module has actually been
104             loaded.
105              
106             =cut
107              
108             {
109              
110             my $encode_available;
111              
112             sub encode_available {
113 1 50   1 1 4 defined $encode_available and return $encode_available;
114 1 50       2 return ( $encode_available = eval {
115 1         7 require Encode;
116 1         5 1;
117             } ? 1 : 0
118             );
119             }
120              
121             }
122              
123             # This method is to be used only by the PPIx-Regexp package. It returns
124             # the first of its arguments which is defined. It will go away when
125             # (or if!) these modules get 'use 5.010;' at the top.
126              
127             sub __defined_or {
128 742     742   2641 my ( undef, @args ) = @_; # Invocant unused
129 742         1343 foreach my $arg ( @args ) {
130 2226 100       13115 defined $arg and return $arg;
131             }
132 0           return;
133             }
134              
135             1;
136              
137             __END__