File Coverage

blib/lib/Poem.pm
Criterion Covered Total %
statement 25 42 59.5
branch 4 18 22.2
condition n/a
subroutine 6 7 85.7
pod 0 1 0.0
total 35 68 51.4


line stmt bran cond sub pod time code
1             #
2             # $Id: Poem.pm,v 0.1 2006/03/25 10:43:27 dankogai Exp dankogai $
3             #
4             package Poem;
5 1     1   55464 use 5.008001;
  1         4  
  1         69  
6 1     1   7 use strict;
  1         1  
  1         37  
7 1     1   6 use warnings;
  1         6  
  1         101  
8             our $VERSION = sprintf "%d.%02d", q$Revision: 0.1 $ =~ /(\d+)/g;
9              
10 1     1   27337 use Filter::Util::Call;
  1         10221  
  1         473  
11             my %opt = ();
12             sub import{
13 1     1   11 my $class = shift;
14 1         3 %opt = map { $_ => 1 } @_;
  0         0  
15 1         4 filter_add(\&read_poem);
16             }
17             sub unimport{
18 0     0   0 my $class = shift;
19 0         0 filter_del();
20 0         0 %opt = ();
21             }
22             sub read_poem{
23 1     1 0 14933 my $pkg = __PACKAGE__;
24 1         3 my ($status, $no_seen, @poem);
25 1         10 while ($status = filter_read()) {
26 6 50       41 if (/^\s*no\s+$pkg\s*;\s*?$/) {
27 0         0 $no_seen=1;
28 0         0 last;
29             }
30 6         11 push @poem, $_;
31 6         29 $_ = q();
32             }
33 1 50       8 if ($opt{-review}){
34             # eval does not work in filter. So we ask via pipe
35 0         0 print "# Your Poem:\n";
36 0         0 print @poem;
37 0 0       0 my $perlopt =
    0          
38             $opt{-deparse} ? "-MO=Deparse" :
39             $opt{-act} ? '-T' : '-Twc';
40 0         0 print "# Review by $^X $perlopt\n";
41 0 0       0 open my $perl, "| $^X $perlopt 2>&1" or die "$!";
42 0 0       0 $opt{-strict} and print $perl "use strict;\n";
43 0 0       0 $opt{-utf8} and print $perl "use utf8;\n";
44 0         0 print $perl @poem;
45 0         0 close $perl;
46             }else{
47 1 50       549 print @poem unless $opt{-quiet};
48             }
49 1 50       5 if ($no_seen){
50 0         0 $_ .= "no $pkg;\n";
51 0         0 return 1;
52             }else{
53 1         2683 return 0;
54             }
55             }
56              
57             # Preloaded methods go here.
58              
59             1;
60             __END__