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__ |