1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
#!/usr/bin/perl -w
# Copyright 2009, 2010, 2012, 2014 Kevin Ryde
# This file is part of Perl-Critic-Pulp.
#
# Perl-Critic-Pulp is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# Perl-Critic-Pulp is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
# Look for __END__ without a pod =cut before it
#
# /usr/share/perl/5.14/ExtUtils/MM_BeOS.pm
# /usr/share/perl/5.14.2/IPC/Cmd.pm
use 5.005;
use strict;
use warnings;
use Perl6::Slurp;
use FindBin;
use lib::abs '.';
use MyLocatePerl;
use MyStuff;
# uncomment this to run the ### lines
use Smart::Comments;
my $verbose = 0;
{
my $filename = File::Spec->catfile ($FindBin::Bin, $FindBin::Script);
my $str = Perl6::Slurp::slurp($filename);
my_grep ($filename, $str);
}
{
my $filename = '/usr/share/perl/5.14/ExtUtils/MM_BeOS.pm';
my $str = Perl6::Slurp::slurp($filename);
my_grep ($filename, $str);
}
{
my $l = MyLocatePerl->new (exclude_t => 1,
under_directory => '/usr/share/perl5');
while (my ($filename, $str) = $l->next) {
my_grep ($filename, $str);
}
}
my $count_all = 0;
my $count_noend = 0;
my $count_cut = 0;
sub my_grep {
my ($filename, $str) = @_;
if ($verbose) { print "look at $filename\n"; }
$count_all++;
my $endpos = index($str, "\n__END__");
unless ($endpos >= 0) {
$count_noend++;
return;
}
my $cmdpos = rindex($str, "\n=", $endpos+1);
return unless $cmdpos >= 0;
$cmdpos++;
my $command = substr($str, $cmdpos, 4);
if ($command !~ '=[a-z]') {
# some "==" or "=>", not a pod directive
return;
}
if ($command eq '=cut') {
$count_cut++;
return;
}
my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $cmdpos);
print "$filename:$line:$col: __END__ within POD\n $command\n";
}
print "files $count_all\n";
print "no __END__ $count_noend\n";
exit 0;
=pod
__END__
|
