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   38932 use Filter::Util::Call;
  77         64007  
  77         27287  
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   338 my ($class) = @_;
14 80         324 ($file,$offset) = (caller)[1,2]; # for error reporting
15 80         358 $offset++;
16            
17             ## Parse class name into a regexp suitable for filtration
18 80         271 my $terminator = terminator_regexp($class);
19              
20             filter_add(
21             sub {
22 159     159   4141 my ($status, $off, $end);
23 159         365 my $count = 0;
24 159         342 my $data = "";
25 159         1324 while ($status = filter_read()) {
26 94414 50       150382 return $status if $status < 0;
27            
28 94414 50 33     310421 if (defined($terminator) && m/$terminator/) {
29 0         0 $off=1;
30 0         0 last;
31             }
32 94414 100       165161 if (m/^\s*(__END__|__DATA__)\s*$/) {
33 1         5 $end=$1; $off = 1;
  1         3  
34 1         2 last;
35             }
36 94413         132431 $data .= $_;
37 94413         110961 $count++;
38 94413         203541 $_ = "";
39             }
40 159         3810 $_ = $data;
41 159 50       1210 $_ = findslice $_ unless $status < 0; # the actual filter
42 159 100       728 $_ .= "no $class;\n" if $off;
43 159 100       488 $_ .= "$end\n" if $end;
44 159         17488 return $count;
45             }
46 80         585 );
47             }
48              
49             sub unimport {
50 1     1   1898 filter_del();
51             }
52              
53             1;