File Coverage

blib/lib/Devel/PerlySense/Bookmark/MatchResult.pm
Criterion Covered Total %
statement 41 61 67.2
branch 2 10 20.0
condition n/a
subroutine 12 14 85.7
pod 3 3 100.0
total 58 88 65.9


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Devel::PerlySense::Bookmark::MatchResult - A Bookmark definition and its matches
4              
5             =head1 DESCRIPTION
6              
7             A Bookmark definition, and a list of matching Bookmark::Match objects
8              
9             =cut
10              
11              
12              
13              
14              
15 68     68   230 use strict;
  68         91  
  68         1747  
16 68     68   213 use warnings;
  68         83  
  68         1438  
17 68     68   209 use utf8;
  68         88  
  68         270  
18              
19             package Devel::PerlySense::Bookmark::MatchResult;
20             $Devel::PerlySense::Bookmark::MatchResult::VERSION = '0.0217';
21              
22              
23              
24              
25 68     68   2801 use Spiffy -Base;
  68         90  
  68         350  
26 68     68   40546 use Carp;
  68     68   84  
  68     68   989  
  68         178  
  68         90  
  68         1239  
  68         192  
  68         78  
  68         2906  
27 68     68   234 use Data::Dumper;
  68         101  
  68         2227  
28              
29 68     68   235 use Devel::PerlySense;
  68         92  
  68         384  
30 68     68   11939 use Devel::PerlySense::Bookmark::Match;
  68         81  
  68         257  
31 68     68   10427 use Devel::PerlySense::Bookmark::Definition;
  68         88  
  68         253  
32              
33              
34              
35              
36              
37             =head1 PROPERTIES
38              
39             =head2 oDefinition
40              
41             Bookmark::Definition object.
42              
43             =cut
44             field "oDefinition" => undef;
45              
46              
47              
48              
49              
50             =head2 raMatch
51              
52             Array ref with Bookmark::Match object.
53              
54             Default: []
55              
56             =cut
57             field "raMatch" => [];
58              
59              
60              
61              
62              
63             =head1 METHODS
64              
65             =head2 newFromMatch(oDefinition, file, source)
66              
67             Create new PerlySense::Bookmark::MatchResult object. Use $oDefinition
68             to match against the $source in $file.
69              
70             If no matches were found, don't create the MatchResult object. Instead
71             return undef (scalar context), or or an empty list (list context).
72              
73             Die on errors.
74              
75             =cut
76 6     6 1 12 sub newFromMatch {
77 6         21 my ($oDefinition, $file, $source) = Devel::PerlySense::Util::aNamedArg(["oDefinition", "file", "source"], @_);
78              
79 6         25 my @aMatch = $oDefinition->aMatch(
80             file => $file,
81             source => $source,
82             );
83              
84 6 100       21 @aMatch or return;
85              
86 4         11 $self = bless {}, $self; #Create the object. It looks weird because of Spiffy
87              
88 4         55 $self->oDefinition($oDefinition);
89 4         76 $self->raMatch(\@aMatch);
90              
91 4         33 return($self);
92             }
93              
94              
95              
96              
97              
98             =head2 parseRex($rex)
99              
100             Perl eval the $rex string to create a qr// object and return it.
101              
102             Die on eval errors, or if the result isn't a qr.
103              
104             =cut
105 0     0 1   sub parseRex {
106 0           my ($rex) = @_;
107              
108 0           my $qr = eval $rex; ## no critic
109 0 0         $@ and die("Perl syntax error encountered when parsing Bookmark regex ($rex):\n$@");
110 0 0         ref $qr eq "Regexp" or die("Bookmark regex definition ($rex) doesn't result in a regex (a qr// object)\n");
111 0           return $qr;
112             }
113              
114              
115              
116              
117              
118             =head2 aMatch(file, source)
119              
120             Return a Bookmark::Match object for each time this bookmark matches a
121             line in source.
122              
123             =cut
124 0     0 1   sub aMatch {
125 0           my ($file, $source) = Devel::PerlySense::Util::aNamedArg(["file", "source"], @_);
126              
127 0           my @aMatch;
128 0           my $indexLine = 0;
129 0           for my $line (split(/\n/, $source)) {
130 0           $indexLine++;
131              
132 0           for my $rexText (@{$self->raRexText}) {
  0            
133 0           my $qr = $self->rhQrRex->{$rexText};
134              
135 0 0         if($line =~ $qr) {
136 0 0         my $text = defined($1) ? $1 : $line;
137              
138 0           push(
139             @aMatch,
140             Devel::PerlySense::Bookmark::Match->new(
141             oMatchResult => $self,
142             file => $file,
143             line => $line,
144             text => $text,
145             row => $indexLine,
146             ),
147             );
148 0           last;
149             }
150             }
151             }
152              
153 0           return(@aMatch);
154             }
155              
156              
157              
158              
159              
160             1;
161              
162              
163              
164              
165              
166             __END__
167              
168             =encoding utf8
169              
170             =head1 AUTHOR
171              
172             Johan Lindstrom, C<< <johanl@cpan.org> >>
173              
174             =head1 BUGS
175              
176             Please report any bugs or feature requests to
177             C<bug-devel-perlysense@rt.cpan.org>, or through the web interface at
178             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-PerlySense>.
179             I will be notified, and then you'll automatically be notified of progress on
180             your bug as I make changes.
181              
182             =head1 ACKNOWLEDGEMENTS
183              
184             =head1 COPYRIGHT & LICENSE
185              
186             Copyright 2005 Johan Lindstrom, All Rights Reserved.
187              
188             This program is free software; you can redistribute it and/or modify it
189             under the same terms as Perl itself.
190              
191             =cut