File Coverage

lib/Devel/PerlySense/Bookmark/Definition.pm
Criterion Covered Total %
statement 61 61 100.0
branch 12 12 100.0
condition n/a
subroutine 13 13 100.0
pod 3 3 100.0
total 89 89 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Devel::PerlySense::Bookmark::Definition - A Bookmark definition
4              
5             =head1 DESCRIPTION
6              
7              
8             =cut
9              
10              
11              
12              
13              
14 63     63   220 use strict;
  63         90  
  63         1854  
15 63     63   233 use warnings;
  63         70  
  63         1378  
16 63     63   234 use utf8;
  63         69  
  63         267  
17              
18             package Devel::PerlySense::Bookmark::Definition;
19              
20              
21              
22              
23              
24 63     63   2393 use Spiffy -Base;
  63         86  
  63         282  
25 63     63   45910 use Carp;
  63     63   80  
  63     63   1586  
  63         216  
  63         604  
  63         1818  
  63         218  
  63         71  
  63         3113  
26 63     63   243 use Data::Dumper;
  63         84  
  63         2179  
27              
28 63     63   286 use Devel::PerlySense;
  63         92  
  63         322  
29 63     63   30002 use Devel::PerlySense::Bookmark::Match;
  63         107  
  63         505  
30              
31              
32              
33              
34              
35             =head1 PROPERTIES
36              
37             =head2 moniker
38              
39             The moniker of the Bookmark.
40              
41             Default: ""
42              
43             =cut
44             field "moniker" => "";
45              
46              
47              
48              
49              
50             =head2 raRexText
51              
52             Regexp texts to be evaled as qr definitions.
53              
54             Bookmarks are matched in this order.
55              
56             Default: []
57              
58             =cut
59             field "raRexText" => [];
60              
61              
62              
63              
64              
65             =head2 rhQrRex
66              
67             Hash ref with (keys: regexp texts; values: qr objects).
68              
69             Default: {}
70              
71             =cut
72             field "rhQrRex" => {};
73              
74              
75              
76              
77              
78             =head1 METHODS
79              
80             =head2 newFromConfig(moniker, rex)
81              
82             Create new PerlySense::Bookmark::Definition object. Give it $moniker and
83             parse the regex definitions in $ref (either a scalar or an array ref
84             with scalars).
85              
86             Die on errors, like if the rex definitions aren't valid Perl, or if
87             they don't result in a qr object.
88              
89             =cut
90 15     15 1 21 sub newFromConfig {
91 15         59 my ($moniker, $rex) = Devel::PerlySense::Util::aNamedArg(["moniker", "rex"], @_);
92              
93 15         81 $self = bless {}, $self; #Create the object. It looks weird because of Spiffy
94 15 100       387 $self->moniker($moniker)
95             or die("Bad Bookmark definition: No 'moniker' specified' in " . Dumper({@_}));
96              
97 14 100       153 my $raRex = ref $rex ? $rex : [ $rex ];
98              
99 14         23 for my $rex (@$raRex) {
100 18         36 push(@{$self->raRexText}, $rex);
  18         418  
101 18         120 my $qr = $self->parseRex($rex);
102 16         384 $self->rhQrRex->{$rex} = $qr;
103             }
104              
105 12         146 return($self);
106             }
107              
108              
109              
110              
111              
112             =head2 parseRex($rex)
113              
114             Perl eval the $rex string to create a qr// object and return it.
115              
116             Die on eval errors, or if the result isn't a qr.
117              
118             =cut
119 18     18 1 16 sub parseRex {
120 18         19 my ($rex) = @_;
121              
122 18         1777 my $qr = eval $rex; ## no critic
123 18 100       58 $@ and die("Perl syntax error encountered when parsing Bookmark regex ($rex):\n$@");
124 17 100       45 ref $qr eq "Regexp" or die("Bookmark regex definition ($rex) doesn't result in a regex (a qr// object)\n");
125 16         26 return $qr;
126             }
127              
128              
129              
130              
131              
132             =head2 aMatch(file, source)
133              
134             Return a Bookmark::Match object for each time this bookmark matches a
135             line in source.
136              
137             =cut
138 8     8 1 12 sub aMatch {
139 8         31 my ($file, $source) = Devel::PerlySense::Util::aNamedArg(["file", "source"], @_);
140              
141 8         44 my @aMatch;
142 8         10 my $row = 0;
143 8         674 for my $line (split(/\r?\n/, $source)) {
144 1158         707 $row++;
145              
146 1158         778 for my $rexText (@{$self->raRexText}) {
  1158         29667  
147 1319         38105 my $qr = $self->rhQrRex->{$rexText};
148              
149 1319 100       8602 if($line =~ $qr) {
150 14 100       42 my $text = defined($1) ? $1 : $line;
151            
152 14         64 push(
153             @aMatch,
154             Devel::PerlySense::Bookmark::Match->new(
155             oDefinition => $self,
156             file => $file,
157             line => $line,
158             text => $text,
159             row => $row,
160             ),
161             );
162 14         29 last;
163             }
164             }
165             }
166              
167 8         324 return(@aMatch);
168             }
169              
170              
171              
172              
173              
174             1;
175              
176              
177              
178              
179              
180             __END__
181              
182             =encoding utf8
183              
184             =head1 AUTHOR
185              
186             Johan Lindström, C<< <johanl[ÄT]DarSerMan.com> >>
187              
188             =head1 BUGS
189              
190             Please report any bugs or feature requests to
191             C<bug-devel-perlysense@rt.cpan.org>, or through the web interface at
192             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-PerlySense>.
193             I will be notified, and then you'll automatically be notified of progress on
194             your bug as I make changes.
195              
196             =head1 ACKNOWLEDGEMENTS
197              
198             =head1 COPYRIGHT & LICENSE
199              
200             Copyright 2005 Johan Lindström, All Rights Reserved.
201              
202             This program is free software; you can redistribute it and/or modify it
203             under the same terms as Perl itself.
204              
205             =cut