File Coverage

blib/lib/PDLA/NiceSlice/FilterUtilCall.pm
Criterion Covered Total %
statement 27 29 93.1
branch 9 12 75.0
condition 1 3 33.3
subroutine 4 4 100.0
pod n/a
total 41 48 85.4


line stmt bran cond sub pod time code
1             # This original Filter::Util::Call-based
2             # PDLA::NiceSlice engine.
3             #
4 77     77   41409 use Filter::Util::Call;
  77         67669  
  77         29757  
5              
6             ##############################
7             # If you mess with the import filter, please also change the pdlpp importer
8             # just above this comment! They both do similar things, but one to an eval string
9             # and one to an import file.
10             # --CED 5-Nov-2007
11             #
12             sub import {
13 80     80   344 my ($class) = @_;
14 80         357 ($file,$offset) = (caller)[1,2]; # for error reporting
15 80         302 $offset++;
16            
17             ## Parse class name into a regexp suitable for filtration
18 80         295 my $terminator = terminator_regexp($class);
19              
20             filter_add(
21             sub {
22 159     159   4014 my ($status, $off, $end);
23 159         418 my $count = 0;
24 159         390 my $data = "";
25 159         1390 while ($status = filter_read()) {
26 94414 50       160415 return $status if $status < 0;
27            
28 94414 50 33     329722 if (defined($terminator) && m/$terminator/) {
29 0         0 $off=1;
30 0         0 last;
31             }
32 94414 100       175836 if (m/^\s*(__END__|__DATA__)\s*$/) {
33 1         6 $end=$1; $off = 1;
  1         4  
34 1         3 last;
35             }
36 94413         141471 $data .= $_;
37 94413         117122 $count++;
38 94413         219161 $_ = "";
39             }
40 159         3860 $_ = $data;
41 159 50       1333 $_ = findslice $_ unless $status < 0; # the actual filter
42 159 100       750 $_ .= "no $class;\n" if $off;
43 159 100       490 $_ .= "$end\n" if $end;
44 159         17047 return $count;
45             }
46 80         645 );
47             }
48              
49             sub unimport {
50 1     1   1777 filter_del();
51             }
52              
53             1;