File Coverage

blib/lib/Devel/Todo/Find.pm
Criterion Covered Total %
statement 58 63 92.0
branch 13 16 81.2
condition 1 2 50.0
subroutine 9 11 81.8
pod 6 6 100.0
total 87 98 88.7


line stmt bran cond sub pod time code
1              
2             # $Id: Find.pm,v 1.14 2014-10-15 11:04:49 Martin Exp $
3              
4             package Devel::Todo::Find;
5              
6             =head1 NAME
7              
8             Devel::Todo::Find - Search source code files for TODO comments
9              
10             =head1 SYNOPSIS
11              
12             use Devel::Todo::Find;
13             my $o = new Devel::Todo::Find;
14             my @a = $o->todos;
15              
16             =head1 DESCRIPTION
17              
18             This class helps you search your file system recursively,
19             looking for files containing what looks like a Perl comment
20             expressing a TODO item.
21             This is an example of the format it looks for:
22              
23             # TODO: this is an example
24              
25             You can tell it where to look (using the add_dirs method)
26             and
27             you can tell it folders to ignore (using the ignore_dirs method).
28             By default, it looks in the current working directory,
29             and
30             by default, it skips
31             folders in a Perl module development environment that a module author
32             typically wants to skip (such as CVS and blib),
33             as well as Emacs backup files (that end with tilde),
34             CM hidden folders (.git and .subversion), and
35             tar files (.tar).
36             Then you can get the list of TODO items by calling the todos method.
37              
38             =head1 FUNCTIONS
39              
40             =cut
41              
42 1     1   32213 use Data::Dumper;
  1         2  
  1         54  
43 1     1   6 use File::Find;
  1         2  
  1         843  
44              
45             our
46             $VERSION = 1.204;
47              
48             =head2 Constructor
49              
50             =head3 new
51              
52             Creates a new object and returns it. Takes no arguments.
53              
54             =cut
55              
56             sub new
57             {
58 1     1 1 11 my $class = shift;
59 1         2 my %hash;
60 1         3 $hash{_dirs_} = [];
61 1         2 $hash{_ignore_} = [];
62 1         2 my $self = bless \%hash, $class;
63 1         4 return $self;
64             } # new
65              
66             =head2 Methods
67              
68             =over
69              
70             =item add_dirs
71              
72             Takes any number of arguments, either files or folders that will be
73             searched during the todos() process.
74              
75             If you do not call this method to add any items,
76             only the Cwd will be processed by default.
77             (But, see ignore_dirs() below.)
78              
79             =cut
80              
81             sub add_dirs
82             {
83 1     1 1 396 my $self = shift;
84 1         2 push @{$self->{_dirs_}}, @_;
  1         5  
85             } # add_dirs
86              
87              
88             =item add_files
89              
90             This is just a synonym for add_dirs() just above.
91              
92             =cut
93              
94             sub add_files
95             {
96 0     0 1 0 shift->add_dirs(@_);
97             } # add_files
98              
99              
100             =item ignore_dirs
101              
102             Takes any number of arguments, each argument is used as a regex such
103             that any file or folder matching any of the regexen will NOT be
104             searched during the todos() process.
105              
106             If you do not call this method to ignore any items,
107             by default the following items will be ignored:
108              
109             qr{~\Z}i
110             qr{blib}
111             qr{CVS}i
112             qr{\A\.git\Z}i,
113             qr{\Ainc/}
114             qr{\.subversion}i,
115             qr{\.tar\Z}i,
116             qr{\.yaml\Z}i
117              
118             =cut
119              
120             sub ignore_dirs
121             {
122 2     2 1 727 my $self = shift;
123 2         4 push @{$self->{_ignore_}}, @_;
  2         7  
124             } # ignore_dirs
125              
126              
127             =item ignore_files
128              
129             This is a synonym for ignore_dirs() just above.
130              
131             =cut
132              
133             sub ignore_files
134             {
135 0     0 1 0 shift->ignore_dirs(@_);
136             } # ignore_files
137              
138              
139             =item todos
140              
141             In scalar mode, returns a human-readable string of all TODO items found.
142             In array mode, returns a list of Emacs-readable strings of TODO items.
143             Apologies if my concept of "human-readable" is different from yours.
144              
145             =cut
146              
147             sub todos
148             {
149 5     5 1 1001 my $self = shift;
150 5         12 $self->_gather_todos;
151 5         33 my $sRet = q{};
152 5         7 my @as;
153 5         6 while (my ($sFname, $ra) = each %{$self->{_todo_}})
  24         84  
154             {
155 19         27 foreach my $rh (@$ra)
156             {
157             $sRet .= sprintf(qq{file=%s, line=%d, %s: %s\n},
158 34         109 $rh->{file}, $rh->{line}, $rh->{type}, $rh->{what});
159 34         159 push @as, sprintf(qq{%s:%d:%s\n}, $rh->{file}, $rh->{line}, $rh->{what});
160             } # foreach
161             } # while
162 5 100       32 return wantarray ? @as : $sRet;
163             } # todos
164              
165             # Private method which does the "heavy-lifting" of file-finding:
166              
167             sub _gather_todos
168             {
169 5     5   9 my $self = shift;
170             # Clear 'em out and start over:
171 5         46 delete $self->{_todo_};
172 5         5 my @asItem = @{$self->{_dirs_}};
  5         13  
173 5         7 my @aIgnore = @{$self->{_ignore_}};
  5         12  
174             # By default, (if user doesn't tell us otherwise), we will process
175             # Cwd (and recursively all subdirectories):
176 5 100       14 if (! @asItem)
177             {
178 2         3 push @asItem, q{.};
179             } # if
180             # By default, (if user doesn't tell us otherwise), we will ignore
181             # items that a Perl module-author would want to ignore:
182 5 100       11 if (! @aIgnore)
183             {
184 3         33 @aIgnore =(
185             qr{blib},
186             qr{CVS}i,
187             qr{\Ainc/},
188             qr{\.yaml\Z}i,
189             qr{\A\.git\Z}i,
190             qr{\.subversion}i,
191             qr{\.tar\Z}i,
192             qr{~\Z}i,
193             );
194             } # if
195             # print STDERR qq{ DDD in _gather_todos, asItem is }, Dumper(\@asItem);
196             find({
197             no_chdir => 1,
198 99     99   250 wanted => sub { $self->_wanted(\@aIgnore) },
199 5         324 }, @asItem);
200             } # todos
201              
202              
203             # Private method which is the "wanted" callback of File::Find
204              
205             sub _wanted
206             {
207 99     99   126 my $self = shift;
208 99   50     212 my $raIgnore = shift || [];
209 99         122 my $sFname = $File::Find::name;
210 99         161 foreach my $qr (@$raIgnore)
211             {
212             # print STDERR " DDD compare =$sFname= to ignore pattern =$qr=\n";
213 685 100       2328 if ($sFname =~ m/$qr/)
214             {
215 10         14 $File::Find::prune = 1;
216 10         127 return;
217             } # if
218             } # foreach
219             # print STDERR qq{ DDD in _wanted, F::F::name is $sFname\n};
220 89 50       991 if (! -s $sFname)
221             {
222             # warn qq{ III $sFname is not -s};
223 0         0 return;
224             } # if
225 89 50       1861 if (! open FFF, q{<}, $sFname)
226             {
227 0         0 warn qq{ EEE cannot open $sFname for read: $!};
228 0         0 return;
229             } # if
230 89         128 my $iLine = 1;
231 89         690 while (my $sLine = )
232             {
233 7267         7641 chomp $sLine;
234             # print STDERR qq{ DDD sLine $iLine is $sLine\n};
235 7267 100       13879 if ($sLine =~ m/#\s*(TODO):?\s*(.+?)$/)
236             {
237 34         178 my %h = (
238             file => $sFname,
239             line => $iLine,
240             type => $1,
241             what => $2,
242             );
243 34         43 push @{$self->{_todo_}->{$sFname}}, \%h;
  34         110  
244             } # if
245 7267         17384 $iLine++;
246             } # while
247 89 50       2963 close FFF or warn;
248             } # _wanted
249              
250             1;
251              
252             __END__