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 78     78   41175 use Filter::Util::Call;
  78         68580  
  78         28927  
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 81     81   356 my ($class) = @_;
14 81         340 ($file,$offset) = (caller)[1,2]; # for error reporting
15 81         307 $offset++;
16            
17             ## Parse class name into a regexp suitable for filtration
18 81         294 my $terminator = terminator_regexp($class);
19              
20             filter_add(
21             sub {
22 161     161   4098 my ($status, $off, $end);
23 161         396 my $count = 0;
24 161         385 my $data = "";
25 161         1479 while ($status = filter_read()) {
26 95639 50       157337 return $status if $status < 0;
27            
28 95639 50 33     321450 if (defined($terminator) && m/$terminator/) {
29 0         0 $off=1;
30 0         0 last;
31             }
32 95639 100       170186 if (m/^\s*(__END__|__DATA__)\s*$/) {
33 1         6 $end=$1; $off = 1;
  1         2  
34 1         4 last;
35             }
36 95638         137967 $data .= $_;
37 95638         114938 $count++;
38 95638         222836 $_ = "";
39             }
40 161         4026 $_ = $data;
41 161 50       1405 $_ = findslice $_ unless $status < 0; # the actual filter
42 161 100       763 $_ .= "no $class;\n" if $off;
43 161 100       519 $_ .= "$end\n" if $end;
44 161         18106 return $count;
45             }
46 81         663 );
47             }
48              
49             sub unimport {
50 1     1   1985 filter_del();
51             }
52              
53             1;