line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright (C) 2005 Joshua Hoblitt |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# $Id: Tidy.pm,v 1.27 2009/02/17 21:49:37 jhoblitt Exp $ |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Pod::Tidy; |
6
|
|
|
|
|
|
|
|
7
|
9
|
|
|
9
|
|
844521
|
use strict; |
|
9
|
|
|
|
|
22
|
|
|
9
|
|
|
|
|
571
|
|
8
|
9
|
|
|
9
|
|
56
|
use warnings FATAL => qw( all ); |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
521
|
|
9
|
|
|
|
|
|
|
|
10
|
9
|
|
|
9
|
|
50
|
use vars qw( $VERSION $columns ); |
|
9
|
|
|
|
|
21
|
|
|
9
|
|
|
|
|
925
|
|
11
|
|
|
|
|
|
|
$VERSION = '0.10'; |
12
|
|
|
|
|
|
|
|
13
|
9
|
|
|
9
|
|
50
|
use Fcntl ':flock'; |
|
9
|
|
|
|
|
16
|
|
|
9
|
|
|
|
|
1907
|
|
14
|
9
|
|
|
9
|
|
57
|
use File::Basename qw( basename dirname ); |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
1288
|
|
15
|
9
|
|
|
9
|
|
51
|
use File::Spec; |
|
9
|
|
|
|
|
20
|
|
|
9
|
|
|
|
|
309
|
|
16
|
9
|
|
|
9
|
|
15693
|
use IO::String; |
|
9
|
|
|
|
|
41800
|
|
|
9
|
|
|
|
|
412
|
|
17
|
9
|
|
|
9
|
|
11432
|
use File::Copy qw( cp ); |
|
9
|
|
|
|
|
54713
|
|
|
9
|
|
|
|
|
1421
|
|
18
|
9
|
|
|
9
|
|
86
|
use Pod::Find qw( contains_pod ); |
|
9
|
|
|
|
|
21
|
|
|
9
|
|
|
|
|
579
|
|
19
|
9
|
|
|
9
|
|
16810
|
use Pod::Simple; |
|
9
|
|
|
|
|
606472
|
|
|
9
|
|
|
|
|
822
|
|
20
|
9
|
|
|
9
|
|
16473
|
use Pod::Wrap::Pretty; |
|
9
|
|
|
|
|
40
|
|
|
9
|
|
|
|
|
775
|
|
21
|
9
|
|
|
9
|
|
145
|
use Text::Wrap qw($columns); |
|
9
|
|
|
|
|
19
|
|
|
9
|
|
|
|
|
2160
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# Text::Wrap's default is 76, we are using 80 to maintain compatability with |
24
|
|
|
|
|
|
|
# Pod::Tidy <= 0.09 |
25
|
|
|
|
|
|
|
$columns = 80; |
26
|
|
|
|
|
|
|
|
27
|
9
|
|
|
9
|
|
123
|
use vars qw( $BACKUP_POSTFIX); |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
16161
|
|
28
|
|
|
|
|
|
|
# used by backup_file |
29
|
|
|
|
|
|
|
$BACKUP_POSTFIX = "~"; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub tidy_files |
32
|
|
|
|
|
|
|
{ |
33
|
7
|
|
|
7
|
1
|
20726
|
my %p = @_; |
34
|
|
|
|
|
|
|
|
35
|
7
|
50
|
|
|
|
32
|
$columns = $p{columns} if $p{columns}; |
36
|
|
|
|
|
|
|
|
37
|
7
|
|
|
|
|
48
|
my $queue = build_pod_queue( |
38
|
|
|
|
|
|
|
files => $p{files}, |
39
|
|
|
|
|
|
|
ignore => $p{ignore}, |
40
|
|
|
|
|
|
|
recursive => $p{recursive}, |
41
|
|
|
|
|
|
|
verbose => $p{verbose}, |
42
|
|
|
|
|
|
|
); |
43
|
|
|
|
|
|
|
|
44
|
7
|
100
|
|
|
|
43
|
return undef unless $queue; |
45
|
|
|
|
|
|
|
|
46
|
4
|
|
|
|
|
27
|
return process_pod_queue( |
47
|
|
|
|
|
|
|
inplace => $p{inplace}, |
48
|
|
|
|
|
|
|
nobackup => $p{nobackup}, |
49
|
|
|
|
|
|
|
queue => $queue, |
50
|
|
|
|
|
|
|
); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub tidy_filehandle |
54
|
|
|
|
|
|
|
{ |
55
|
2
|
|
|
2
|
1
|
9852
|
my $input = shift; |
56
|
|
|
|
|
|
|
|
57
|
2
|
100
|
|
|
|
16
|
return undef unless $input; |
58
|
|
|
|
|
|
|
|
59
|
1
|
|
|
|
|
46
|
my $wrapper = Pod::Wrap::Pretty->new; |
60
|
1
|
|
|
|
|
18
|
$wrapper->parse_from_filehandle($input); |
61
|
|
|
|
|
|
|
|
62
|
1
|
|
|
|
|
104
|
return 1; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub process_pod_queue |
66
|
|
|
|
|
|
|
{ |
67
|
10
|
|
|
10
|
1
|
18057
|
my %p = @_; |
68
|
|
|
|
|
|
|
|
69
|
10
|
|
|
|
|
27
|
my $verbose = $p{verbose}; |
70
|
10
|
|
|
|
|
20
|
my $inplace = $p{inplace}; |
71
|
10
|
|
|
|
|
23
|
my $queue = $p{queue}; |
72
|
10
|
|
|
|
|
21
|
my $nobackup = $p{nobackup}; |
73
|
|
|
|
|
|
|
|
74
|
10
|
100
|
|
|
|
77
|
return undef unless defined $queue; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# count the number of files processed |
77
|
8
|
|
|
|
|
15
|
my $processed = 0; |
78
|
8
|
|
|
|
|
192
|
my $wrapper = Pod::Wrap::Pretty->new; |
79
|
|
|
|
|
|
|
|
80
|
8
|
|
|
|
|
18
|
foreach my $filename (@{ $queue }) { |
|
8
|
|
|
|
|
22
|
|
81
|
|
|
|
|
|
|
# all files in queue should have already been checked to be readable |
82
|
7
|
50
|
0
|
|
|
375
|
open(my $src, '+<', $filename) or warn "can't open file: $!" && next; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# wait for an exclusive lock in case we want to modify the file |
85
|
7
|
|
|
|
|
64
|
flock($src, LOCK_EX); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# slurp the file into memory to avoid making a tmp file |
88
|
7
|
|
|
|
|
13
|
my $doc = do { local $/; <$src> }; |
|
7
|
|
|
|
|
31
|
|
|
7
|
|
|
|
|
229
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# wrap the doc with a file handle |
91
|
7
|
|
|
|
|
73
|
my $input = IO::String->new($doc); |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# modify in place? |
94
|
7
|
100
|
|
|
|
353
|
if ($inplace) { |
95
|
2
|
|
|
|
|
13
|
my $output = IO::String->new; |
96
|
2
|
|
|
|
|
308
|
$wrapper->parse_from_filehandle($input, $output); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# leave the mtime alone if we didn't change anything |
99
|
2
|
50
|
|
|
|
107
|
next if ${$input->string_ref} eq ${$output->string_ref}; |
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
13
|
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# backup existing file |
102
|
2
|
100
|
|
|
|
17
|
unless ($nobackup) { |
103
|
1
|
|
|
|
|
5
|
backup_file($filename); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# overwrite the original file |
107
|
2
|
|
|
|
|
894
|
truncate($src, 0); |
108
|
2
|
|
|
|
|
16
|
seek($src, 0, 0); |
109
|
2
|
|
|
|
|
3
|
print $src ${$output->string_ref}; |
|
2
|
|
|
|
|
11
|
|
110
|
|
|
|
|
|
|
} else { |
111
|
|
|
|
|
|
|
# send the output to STDOUT |
112
|
5
|
|
|
|
|
374
|
$wrapper->parse_from_filehandle($input); |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# count of files actually processed |
116
|
|
|
|
|
|
|
# note that this number will be different for 'inplace' as unmodified |
117
|
|
|
|
|
|
|
# files will not be counted |
118
|
7
|
|
|
|
|
552
|
$processed++; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
8
|
|
|
|
|
72
|
return $processed; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub build_pod_queue |
125
|
|
|
|
|
|
|
{ |
126
|
24
|
|
|
24
|
1
|
20067
|
my %p = @_; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# deref once |
129
|
24
|
|
|
|
|
53
|
my $verbose = $p{verbose}; |
130
|
24
|
|
|
|
|
49
|
my $recursive = $p{recursive}; |
131
|
24
|
|
|
|
|
43
|
my $ignore = $p{ignore}; |
132
|
|
|
|
|
|
|
|
133
|
24
|
|
|
|
|
30
|
my @queue; |
134
|
24
|
|
|
|
|
31
|
PERITEM: foreach my $item (@{ $p{files} }) { |
|
24
|
|
|
|
|
66
|
|
135
|
|
|
|
|
|
|
# FIXME do we need to add symlink handling options? |
136
|
33
|
|
|
|
|
193
|
$item = File::Spec->canonpath($item); |
137
|
|
|
|
|
|
|
|
138
|
33
|
|
|
|
|
54
|
foreach my $pattern (@{ $ignore }) { |
|
33
|
|
|
|
|
66
|
|
139
|
|
|
|
|
|
|
# try the absolute path, then the relative path, then the 'base' |
140
|
|
|
|
|
|
|
# path |
141
|
26
|
50
|
66
|
|
|
497
|
if ( |
|
|
|
66
|
|
|
|
|
142
|
|
|
|
|
|
|
(File::Spec->rel2abs($item) =~ $pattern) |
143
|
|
|
|
|
|
|
or ($item =~ $pattern) |
144
|
|
|
|
|
|
|
or (base($item) =~ $pattern) |
145
|
|
|
|
|
|
|
) { |
146
|
6
|
50
|
|
|
|
18
|
warn "$0: omitting file \`$item\': matches ignore pattern: " |
147
|
|
|
|
|
|
|
. "$pattern\n" if $verbose; |
148
|
6
|
|
|
|
|
22
|
next PERITEM; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# is it a file? |
153
|
27
|
100
|
|
|
|
611
|
if (-f $item) { |
154
|
|
|
|
|
|
|
# only check if we can read the file, we don't need to be able to |
155
|
|
|
|
|
|
|
# write to it unless we're doing an inplace edit |
156
|
16
|
50
|
|
|
|
311
|
unless (-r $item) { |
157
|
0
|
|
|
|
|
0
|
warn "$0: omitting file \`$item\': permission denied\n"; |
158
|
0
|
|
|
|
|
0
|
next; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
16
|
50
|
|
|
|
1619
|
unless (contains_pod($item, 0)) { |
162
|
0
|
0
|
|
|
|
0
|
warn "$0: omitting file \`$item\': does not contain Pod\n" |
163
|
|
|
|
|
|
|
if $verbose; |
164
|
0
|
|
|
|
|
0
|
next; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
16
|
100
|
|
|
|
49
|
unless (valid_pod_syntax($item, $verbose)) { |
168
|
8
|
50
|
|
|
|
130
|
warn "$0: omitting file \`$item\': bad Pod syntax\n" |
169
|
|
|
|
|
|
|
if $verbose; |
170
|
8
|
|
|
|
|
22
|
next; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
8
|
|
|
|
|
124
|
push @queue, $item; |
174
|
|
|
|
|
|
|
|
175
|
8
|
|
|
|
|
18
|
next; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# is it a dir? |
179
|
11
|
50
|
|
|
|
211
|
if (-d $item) { |
180
|
11
|
50
|
33
|
|
|
438
|
unless (-r $item and -x $item) { |
181
|
0
|
|
|
|
|
0
|
warn "$0: omitting file \`$item\': permission denied\n"; |
182
|
0
|
|
|
|
|
0
|
next; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# is recursion allowed? |
186
|
11
|
100
|
|
|
|
31
|
if ($recursive) { |
187
|
|
|
|
|
|
|
# It may be better to use File::Find or Pod::Find here. |
188
|
|
|
|
|
|
|
# Initialiy I was using Pod::Find but I wanted explict control |
189
|
|
|
|
|
|
|
# over warnings. |
190
|
9
|
50
|
0
|
|
|
433
|
opendir(my $dir, $item) or warn "can't open dir: $!" && next; |
191
|
9
|
|
|
|
|
354
|
my @files = grep !/^\.{1,2}$/, readdir($dir); |
192
|
9
|
|
|
|
|
26
|
@files = map { "$item/$_" } @files; |
|
20
|
|
|
|
|
63
|
|
193
|
9
|
|
|
|
|
63
|
my $pod_list = build_pod_queue( |
194
|
|
|
|
|
|
|
files => \@files, |
195
|
|
|
|
|
|
|
verbose => $verbose, |
196
|
|
|
|
|
|
|
recursive => $recursive, |
197
|
|
|
|
|
|
|
ignore => $ignore, |
198
|
|
|
|
|
|
|
); |
199
|
9
|
100
|
|
|
|
70
|
push(@queue, @{ $pod_list }) if $pod_list; |
|
6
|
|
|
|
|
152
|
|
200
|
|
|
|
|
|
|
} else { |
201
|
|
|
|
|
|
|
# ignoring $item, recursion not enabled |
202
|
2
|
50
|
|
|
|
11
|
warn "$0: omitting direcotry \`$item\': recursion is not enabled\n" |
203
|
|
|
|
|
|
|
if $verbose; |
204
|
|
|
|
|
|
|
} |
205
|
11
|
|
|
|
|
38
|
next; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# it must be bogus |
209
|
0
|
0
|
|
|
|
0
|
warn "$0: \`$item\': no such file or directory\n" if $verbose; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
24
|
100
|
|
|
|
133
|
return scalar @queue ? \@queue : undef; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub valid_pod_syntax |
216
|
|
|
|
|
|
|
{ |
217
|
20
|
|
|
20
|
1
|
4271
|
my ($filename, $verbose) = @_; |
218
|
|
|
|
|
|
|
|
219
|
20
|
100
|
100
|
|
|
556
|
return undef unless defined $filename and -e $filename; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# method for checking syntax stolen from Test::Pod |
222
|
18
|
|
|
|
|
312
|
my $parser = Pod::Simple->new; |
223
|
|
|
|
|
|
|
|
224
|
18
|
50
|
|
|
|
642
|
$parser->complain_stderr(1) if $verbose; |
225
|
18
|
|
|
|
|
82
|
$parser->parse_file($filename); |
226
|
|
|
|
|
|
|
|
227
|
18
|
100
|
|
|
|
33864
|
return $parser->any_errata_seen ? undef : 1; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub backup_file |
231
|
|
|
|
|
|
|
{ |
232
|
4
|
|
|
4
|
1
|
3717
|
my $filename = shift; |
233
|
|
|
|
|
|
|
|
234
|
4
|
100
|
100
|
|
|
109
|
return undef unless defined $filename and -e $filename; |
235
|
2
|
|
|
|
|
17
|
return cp($filename, $filename . $BACKUP_POSTFIX); |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub base |
239
|
|
|
|
|
|
|
{ |
240
|
20
|
|
|
20
|
1
|
33
|
my $path = shift; |
241
|
|
|
|
|
|
|
|
242
|
20
|
50
|
|
|
|
692
|
if (my $base = basename($path)) { |
243
|
20
|
|
|
|
|
135
|
return $base; |
244
|
|
|
|
|
|
|
} else { |
245
|
0
|
|
|
|
|
|
return basename(dirname($path)); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
1; |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
__END__ |