File Coverage

blib/lib/Text/Query/SolveAdvancedString.pm
Criterion Covered Total %
statement 13 24 54.1
branch 1 8 12.5
condition 2 12 16.6
subroutine 5 6 83.3
pod 2 3 66.6
total 23 53 43.4


line stmt bran cond sub pod time code
1             #
2             # Copyright (C) 1999 Eric Bohlman, Loic Dachary
3             #
4             # This program is free software; you can redistribute it and/or modify it
5             # under the terms of the GNU General Public License as published by the
6             # Free Software Foundation; either version 2, or (at your option) any
7             # later version. You may also use, redistribute and/or modify it
8             # under the terms of the Artistic License supplied with your Perl
9             # distribution
10             #
11             # This program is distributed in the hope that it will be useful,
12             # but WITHOUT ANY WARRANTY; without even the implied warranty of
13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14             # GNU General Public License for more details.
15             #
16             # You should have received a copy of the GNU General Public License
17             # along with this program; if not, write to the Free Software
18             # Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19              
20             package Text::Query::SolveAdvancedString;
21              
22 1     1   6 use strict;
  1         2  
  1         53  
23              
24 1     1   6 use Text::Query::Solve;
  1         3  
  1         33  
25              
26 1     1   4 use vars qw(@ISA);
  1         2  
  1         395  
27              
28             @ISA = qw(Text::Query::Solve);
29              
30 1     1 0 3 sub initialize {
31             }
32              
33             sub match {
34 13     13 1 19 my($self) = shift;
35 13         23 my($expr) = shift;
36              
37 13 50 33     534 return $expr->(shift || $_) if(@_ <= 1 && ref($_[0]) ne 'ARRAY');
      33        
38              
39 0 0 0       my($pa) = (@_ == 1 && ref($_[0]) eq 'ARRAY') ? shift : \@_;
40              
41 0           my(@ra);
42 0 0         if(ref($pa->[0]) eq 'ARRAY') {
43 0           @ra = grep { $expr->($_[0]) } @$pa;
  0            
44             } else {
45 0           @ra = grep { $expr->($_) } @$pa;
  0            
46             }
47 0 0         return wantarray ? @ra : \@ra;
48             }
49              
50             sub matchscalar {
51 0     0 1   my($self) = shift;
52 0           my($expr) = shift;
53              
54 0   0       return $expr->(shift || $_);
55             }
56              
57             1;
58              
59             __END__