File Coverage

lib/Devel/PerlySense/Class.pm
Criterion Covered Total %
statement 145 156 92.9
branch 10 22 45.4
condition 5 7 71.4
subroutine 33 36 91.6
pod 14 15 93.3
total 207 236 87.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Devel::PerlySense::Class - A Perl Class
4              
5             =head1 SYNOPSIS
6              
7              
8              
9             =head1 DESCRIPTION
10              
11             A Perl Class is a Perl Package with an OO interface.
12              
13             =cut
14              
15              
16              
17              
18              
19 63     63   206 use strict;
  63         85  
  63         1745  
20 63     63   252 use warnings;
  63         78  
  63         1229  
21 63     63   210 use utf8;
  63         115  
  63         250  
22              
23             package Devel::PerlySense::Class;
24              
25              
26              
27              
28              
29 63     63   5297 use Spiffy -Base;
  63         77  
  63         263  
30 63     63   110771 use Carp;
  63     63   87  
  63     63   1421  
  63         218  
  63         69  
  63         1212  
  63         215  
  63         79  
  63         3291  
31 63     63   270 use Data::Dumper;
  63         80  
  63         2242  
32 63     63   276 use File::Basename;
  63         115  
  63         3655  
33 63     63   252 use Path::Class qw/dir file/;
  63         82  
  63         2723  
34 63     63   478 use List::MoreUtils qw/ uniq /;
  63         81  
  63         2362  
35              
36 63     63   242 use Devel::PerlySense;
  63         73  
  63         363  
37 63     63   11930 use Devel::PerlySense::Util;
  63         77  
  63         3265  
38 63     63   246 use Devel::PerlySense::Util::Log;
  63         76  
  63         2278  
39 63     63   14025 use Devel::PerlySense::Document;
  63         108  
  63         489  
40 63     63   19926 use Devel::PerlySense::Document::Api;
  63         99  
  63         689  
41 63     63   25223 use Devel::PerlySense::Document::Meta;
  63         111  
  63         349  
42 63     63   15707 use Devel::PerlySense::Document::Location;
  63         81  
  63         428  
43              
44 63     63   20162 use Devel::TimeThis;
  63         80  
  63         112283  
45              
46              
47              
48              
49              
50             =head1 PROPERTIES
51              
52             =head2 oPerlySense
53              
54             Devel::PerlySense object.
55              
56             Default: set during new()
57              
58             =cut
59             field "oPerlySense" => undef;
60              
61              
62              
63              
64              
65             =head2 name
66              
67             The Class name (i.e. the package name)
68              
69             Default: ""
70              
71             =cut
72             field "name" => "";
73              
74              
75              
76              
77              
78             =head2 raDocument
79              
80             Array ref with PerlySense::Document objects that define this class.
81              
82             Default: []
83              
84             =cut
85             field "raDocument" => [];
86              
87              
88              
89              
90              
91             =head2 rhClassBase
92              
93             Hash ref with (keys: base class names; values: base class
94             PerlySense::Class objects).
95              
96             Default: {}
97              
98             =cut
99             ###TODO: Make this lazy, populate on first request, so we don't have
100             ###to go all the way up all the time! There are enough objects in
101             ###memory as it is (this makes all subclasses eagerly find all ther
102             ###base classes...)
103             field "rhClassBase" => {};
104              
105              
106              
107              
108              
109             =head1 API METHODS
110              
111             =head2 new(oPerlySense, name, raDocument, rhClassSeen => {})
112              
113             Create new PerlySense::Class object. Give it $name and associate it
114             with $oPerlySense.
115              
116             $rhClassSeen is used to keep track of seen base classes in case we
117             encounter circular deps.
118              
119             =cut
120 28     28 1 65 sub new {
121 28         143 my ($oPerlySense, $name, $raDocument) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "name", "raDocument"], @_);
122 27         109 my $rhClassSeen = {@_}->{rhClassSeen};
123              
124 27         134 $self = bless {}, $self; #Create the object. It looks weird because of Spiffy
125 27         739 $self->oPerlySense($oPerlySense);
126 27         851 $self->name($name);
127 27         1064 $self->raDocument($raDocument);
128              
129 27   100     365 $rhClassSeen ||= { $name => $self };
130 27         106 $self->findBaseClasses(rhClassSeen => $rhClassSeen);
131              
132 27         71 return($self);
133             }
134              
135              
136              
137              
138              
139             =head2 newFromFileAt(oPerlySense => $oPerlySense, file => $file, row => $row, col => $col)
140              
141             Create new PerlySense::Class object given the class found at $row,
142             $col in $file.
143              
144             If there was no package started yet at $row, $col, but there is one
145             later in the file, use the first one instead (this is when you're at
146             the top of the file and the package statement didn't happen yet).
147              
148             Return new object, or undef if no class was found, or die if the file
149             doesn't exist.
150              
151             =cut
152 8     8 1 16 sub newFromFileAt {
153 8         45 my ($oPerlySense, $file, $row, $col) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "file", "row", "col"], @_);
154              
155 8         43 my $oDocument = $oPerlySense->oDocumentParseFile($file);
156 7         31 my $package = $oDocument->packageAt(row => $row);
157              
158 7 100       202 if($package eq "main") {
159 2 50       9 $package = ($oDocument->aNamePackage)[0] or return undef;
160             }
161              
162 7         121 my $class = Devel::PerlySense::Class->new(
163             oPerlySense => $oPerlySense,
164             name => $package,
165             raDocument => [ $oDocument ],
166             );
167              
168 7         51 return($class);
169             }
170              
171              
172              
173              
174              
175             =head2 newFromName(oPerlySense, name, dirOrigin, rhClassSeen)
176              
177             Create new PerlySense::Class object given the class $name.
178              
179             Look for the module file starting at $dirOrigin.
180              
181             Return new object, or undef if no class was found with that $name.
182              
183             =cut
184 15     15 1 1259 sub newFromName {
185 15         65 my ($oPerlySense, $name, $dirOrigin, $rhClassSeen) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "name", "dirOrigin", "rhClassSeen"], @_);
186              
187 15 50       76 my $oDocument = $oPerlySense->oDocumentFindModule(
188             nameModule => $name,
189             dirOrigin => $dirOrigin,
190             ) or return undef;
191              
192 15         170 my $class = Devel::PerlySense::Class->new(
193             rhClassSeen => $rhClassSeen,
194             oPerlySense => $oPerlySense,
195             name => $name,
196             raDocument => [ $oDocument ],
197             );
198              
199 15         80 return($class);
200             }
201              
202              
203              
204              
205              
206             =head2 findBaseClasses(rhClassSeen)
207              
208             Find the base classes of this class and set (replace) rBaseClass with
209             newly created Class objects.
210              
211             Reuse any class names and objects in $rhClassSeen (keys: class names;
212             values: Class objects), i.e. don't follow them upwards, they have
213             already been taken care of.
214              
215             =cut
216 27     27 1 32 sub findBaseClasses {
217 27         82 my ($rhClassSeen) = Devel::PerlySense::Util::aNamedArg(["rhClassSeen"], @_);
218              
219 27         63 my $rhClassBase = {};
220              
221 27         642 debug("Checking class (" . $self->name . ") for inheritance\n");
222              
223             ###TODO: protect against infinite inheritance loops
224 27         41 for my $oDocument (@{$self->raDocument}) {
  27         784  
225 26         213 for my $classNameBase ($oDocument->aNameBase) {
226 18         427 debug(" Base for (" . $self->name . ") is ($classNameBase)\n");
227 18 50 66     433 my $classBase =
228             $rhClassSeen->{$classNameBase} ||
229             ref($self)->newFromName(
230             oPerlySense => $self->oPerlySense,
231             rhClassSeen => $rhClassSeen,
232             name => $classNameBase,
233             dirOrigin => dirname($oDocument->file),
234             ) or debug("WARN: Could not find parent ($classNameBase)\n"), next; #Don't stop if we can't find the base class. Maybe warn?
235              
236 18         48 $rhClassSeen->{$classNameBase} = $classBase;
237              
238 18         84 $rhClassBase->{$classNameBase} = $classBase;
239             }
240             }
241              
242 27         652 $self->rhClassBase($rhClassBase);
243              
244 27         173 return 1;
245             }
246              
247              
248              
249              
250              
251             =head2 rhClassSub()
252              
253             Find the sub classes of this class and return a hash ref with (keys:
254             Class names; values: Class objects).
255              
256             Look for subclasses in the directory of this Class, and below.
257              
258             (In the future, look in all of the current project.)
259              
260             (this is a horribly inefficient way of finding subclasses. When there
261             is Project with metadata, use that instead of looking everywhere).
262              
263             =cut
264 1     1 1 2 sub rhClassSub {
265              
266 1 50       26 my $oDocument = $self->raDocument->[0] or return {};
267 1         29 my $fileClass = $oDocument->file;
268 1         62 my $dirClass = dir( dirname($fileClass) )->absolute;
269              
270 1         396 my $nameClass = $self->name;
271             my @aDocumentCandidate =
272             $self->oPerlySense->aDocumentGrepInDir(
273             dir => $dirClass,
274 17     17   23 rsGrepFile => sub { shift ne $fileClass },
275 17     17   70 rsGrepDocument => sub { shift->hasBaseClass($nameClass) },
276 1 50       27 ) or return {};
277              
278             ###TODO: can any of this be pushed down into the document/meta
279             ###class?
280 1         7 my $rhPackageDocument = {};
281 1         2 for my $oDocumentCandidate (@aDocumentCandidate) {
282 4         10 for my $package ($oDocumentCandidate->aNamePackage) {
283 4   50     117 $rhPackageDocument->{$package} ||= [];
284 4         3 push(@{$rhPackageDocument->{$package}}, $oDocumentCandidate);
  4         13  
285             }
286             }
287              
288 4         6 my $rhClassSub = {
289             map {
290 1         5 my $namePackage = $_;
291              
292 4         100 $_ => ref($self)->new(
293             oPerlySense => $self->oPerlySense,
294             name => $namePackage,
295             raDocument => $rhPackageDocument->{$namePackage},
296             );
297             }
298             keys %$rhPackageDocument
299             };
300              
301 1         17 return $rhClassSub;
302             }
303              
304              
305              
306              
307              
308             =head2 rhDirNameClassInNeighbourhood()
309              
310             Find the classes in the neighbourhood of this class and return a hash
311             ref with (keys: up, current, down; values: array refs with (Package names).
312              
313             =cut
314 12     12 0 21 sub raClassInDirs {
315 12         19 my ($raDir) = @_;
316              
317 12         13 my @aNameClass;
318 12         27 for my $dir (@$raDir) {
319 12         36 push(@aNameClass, $self->aNameClassInDir(dir => $dir));
320             }
321              
322 12         210 return [ sort( uniq(@aNameClass) ) ];
323             }
324 4     4 1 8 sub rhDirNameClassInNeighbourhood {
325              
326 4         145 my $dir = dir(dirname( $self->raDocument->[0]->file ));
327 4         656 my $raDir = [ $dir ];
328 4         19 my $raDirUp = [ $dir->parent ];
329              
330 4         682 my $nameClassLast = (split(/::/, $self->name))[-1];
331 4         43 my $raDirDown = [ dir($dir, $nameClassLast) ];
332              
333             return({
334 4         190 up => $self->raClassInDirs($raDirUp),
335             current => $self->raClassInDirs($raDir),
336             down => $self->raClassInDirs($raDirDown),
337             });
338             }
339              
340              
341              
342              
343              
344             =head2 aNameClassInDir(dir => $dir)
345              
346             Find the classes names in the .pm files in $dir and return a list of
347             Class names.
348              
349             =cut
350 13     13 1 17 sub aNameClassInDir {
351 13         87 my ($dir) = Devel::PerlySense::Util::aNamedArg(["dir"], @_);
352              
353 50         258908 my @aNameClass =
354             map {
355 13         241 my $oDocument = Devel::PerlySense::Document->new(
356             oPerlySense => $self->oPerlySense,
357             );
358 50 50       186 $oDocument->parse(file => $_) ? $oDocument->aNamePackage : ();
359             }
360             glob("$dir/*.pm");
361              
362 13         116806 return sort( uniq( @aNameClass ) );
363             }
364              
365              
366              
367              
368              
369             =head2 aNameModuleUse()
370              
371             Return array with the names of the "use MODULE" modules in the Class.
372              
373             =cut
374 3     3 1 6 sub aNameModuleUse {
375 3         6 return sort( uniq( map { $_->aNameModuleUse } @{$self->raDocument} ) );
  3         34  
  3         75  
376             }
377              
378              
379              
380              
381              
382             =head2 aBookmarkMatchResult()
383              
384             Return array of Bookmark::MatchResult objects that matches the current
385             source.
386              
387             =cut
388 3     3 1 4 sub aBookmarkMatchResult {
389 3         124 my $file = $self->raDocument->[0]->file;
390 3         180 return $self->oPerlySense->oBookmarkConfig->aMatchResult(file => $file);
391             }
392              
393              
394              
395              
396              
397             =head2 dirModule()
398              
399             Return the base dir for this class, i.e. the dir in which the main .pm
400             file is in.
401              
402             =cut
403 0     0 1 0 sub dirModule {
404 0         0 my $file = $self->raDocument->[0]->file;
405 0         0 return file($file)->absolute->dir . "";
406             }
407              
408              
409              
410              
411              
412             =head2 oLocationMethodDoc(method => $method)
413              
414             Find the docs for the $method name and return a Location object
415             similar to PerlySense->oLocationMethodDocFromDocument, or undef if no
416             doc could be found.
417              
418             Die on errors.
419              
420             =cut
421 3     3 1 5 sub oLocationMethodDoc {
422 3         11 my ($method) = Devel::PerlySense::Util::aNamedArg(["method"], @_);
423 3 50       81 my $oDocument = $self->raDocument->[0] or return undef;
424 3         88 return $self->oPerlySense->oLocationMethodDocFromDocument($oDocument, $method);
425             }
426              
427              
428              
429              
430              
431             =head2 oLocationMethodGoTo(method => $method)
432              
433             Find the declaration for the $method name and return a Location object
434             similar to PerlySense->oLocationSubDefinitionFromDocument, or undef if no
435             declaration could be found.
436              
437             Die on errors.
438              
439             =cut
440 2     2 1 2 sub oLocationMethodGoTo {
441 2         9 my ($method) = Devel::PerlySense::Util::aNamedArg(["method"], @_);
442 2 50       55 my $oDocument = $self->raDocument->[0] or return undef;
443 2         58 return $self->oPerlySense->oLocationMethodDefinitionFromDocument(
444             nameClass => $self->name,
445             nameMethod => $method,
446             oDocument => $oDocument,
447             );
448             }
449              
450              
451              
452              
453              
454             =head2 oLocationSubAt(row => $row, col => $col)
455              
456             Return a Devel::PerlySense::Document::Location object with the
457             location of the sub definition at $row/$col, or undef if it row/col
458             isn't inside a sub definition.
459              
460             Die on errors.
461              
462             =cut
463 0     0 1   sub oLocationSubAt {
464 0           my ($row, $col) = Devel::PerlySense::Util::aNamedArg(["row", "col"], @_);
465 0 0         my $oDocument = $self->raDocument->[0] or return undef;
466 0           return $oDocument->oLocationSubAt(row => $row, col => $col);
467             }
468              
469              
470              
471              
472              
473             =head2 oLocationSub(name => $name)
474              
475             Return a Devel::PerlySense::Document::Location object with the
476             location of the sub declaration called $name, or undef if it wasn't
477             found.
478              
479             Die on errors.
480              
481             =cut
482 0     0 1   sub oLocationSub {
483 0           my ($name) = Devel::PerlySense::Util::aNamedArg(["name"], @_);
484 0 0         my $oDocument = $self->raDocument->[0] or return undef;
485 0           return $oDocument->oLocationSub(name => $name, package => $self->name);
486             }
487              
488              
489              
490              
491              
492             1;
493              
494              
495              
496              
497              
498             __END__
499              
500             =encoding utf8
501              
502             =head1 AUTHOR
503              
504             Johan Lindström, C<< <johanl[ÄT]DarSerMan.com> >>
505              
506             =head1 BUGS
507              
508             Please report any bugs or feature requests to
509             C<bug-devel-perlysense@rt.cpan.org>, or through the web interface at
510             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-PerlySense>.
511             I will be notified, and then you'll automatically be notified of progress on
512             your bug as I make changes.
513              
514             =head1 ACKNOWLEDGEMENTS
515              
516             =head1 COPYRIGHT & LICENSE
517              
518             Copyright 2005 Johan Lindström, All Rights Reserved.
519              
520             This program is free software; you can redistribute it and/or modify it
521             under the same terms as Perl itself.
522              
523             =cut