File Coverage

blib/lib/Class/Inspector.pm
Criterion Covered Total %
statement 154 178 86.5
branch 71 92 77.2
condition 2 7 28.6
subroutine 21 24 87.5
pod 10 12 83.3
total 258 313 82.4


line stmt bran cond sub pod time code
1             package Class::Inspector;
2              
3             =pod
4            
5             =head1 NAME
6            
7             Class::Inspector - Get information about a class and its structure
8            
9             =head1 SYNOPSIS
10            
11             use Class::Inspector;
12            
13             # Is a class installed and/or loaded
14             Class::Inspector->installed( 'Foo::Class' );
15             Class::Inspector->loaded( 'Foo::Class' );
16            
17             # Filename related information
18             Class::Inspector->filename( 'Foo::Class' );
19             Class::Inspector->resolved_filename( 'Foo::Class' );
20            
21             # Get subroutine related information
22             Class::Inspector->functions( 'Foo::Class' );
23             Class::Inspector->function_refs( 'Foo::Class' );
24             Class::Inspector->function_exists( 'Foo::Class', 'bar' );
25             Class::Inspector->methods( 'Foo::Class', 'full', 'public' );
26            
27             # Find all loaded subclasses or something
28             Class::Inspector->subclasses( 'Foo::Class' );
29            
30             =head1 DESCRIPTION
31            
32             Class::Inspector allows you to get information about a loaded class. Most or
33             all of this information can be found in other ways, but they arn't always
34             very friendly, and usually involve a relatively high level of Perl wizardry,
35             or strange and unusual looking code. Class::Inspector attempts to provide
36             an easier, more friendly interface to this information.
37            
38             =head1 METHODS
39            
40             =cut
41              
42 2     2   59 use 5.005;
  2         29  
  2         20  
43             # We don't want to use strict refs, since we do a lot of things in here
44             # that arn't strict refs friendly.
45 2     2   31 use strict qw{vars subs};
  2         20  
  2         84  
46 2     2   68 use File::Spec ();
  2         19  
  2         20  
47              
48             # Globals
49 2     2   28 use vars qw{$VERSION $RE_IDENT $RE_CLASS $UNIX};
  2         18  
  2         31  
50             BEGIN {
51 2     2   30 $VERSION = '1.16';
52              
53             # Predefine some regexs
54 2         171 $RE_IDENT = qr/\A[^\W\d]\w*\z/s;
55 2         22 $RE_CLASS = qr/\A[^\W\d]\w*(?:(?:'|::)[^\W\d]\w*)*\z/s;
56              
57             # Are we on something Unix-like?
58 2         26 $UNIX = !! ( $File::Spec::ISA[0] eq 'File::Spec::Unix' );
59             }
60              
61              
62              
63              
64              
65             #####################################################################
66             # Basic Methods
67              
68             =pod
69            
70             =head2 installed $class
71            
72             The C<installed> static method tries to determine if a class is installed
73             on the machine, or at least available to Perl. It does this by wrapping
74             around C<resolved_filename>.
75            
76             Returns true if installed/available, false if the class is not installed,
77             or C<undef> if the class name is invalid.
78            
79             =cut
80              
81             sub installed {
82 2     2 1 19 my $class = shift;
83 2   66     24 !! ($class->loaded_filename($_[0]) or $class->resolved_filename($_[0]));
84             }
85              
86             =pod
87            
88             =head2 loaded $class
89            
90             The C<loaded> static method tries to determine if a class is loaded by
91             looking for symbol table entries.
92            
93             This method it uses to determine this will work even if the class does not
94             have its own file, but is contained inside a single file with multiple
95             classes in it. Even in the case of some sort of run-time loading class
96             being used, these typically leave some trace in the symbol table, so an
97             L<Autoload> or L<Class::Autouse>-based class should correctly appear
98             loaded.
99            
100             Returns true if the class is loaded, false if not, or C<undef> if the
101             class name is invalid.
102            
103             =cut
104              
105             sub loaded {
106 28     28 1 271 my $class = shift;
107 28 50       312 my $name = $class->_class(shift) or return undef;
108 28         301 $class->_loaded($name);
109             }
110              
111             sub _loaded {
112 688     688   7673 my ($class, $name) = @_;
113              
114             # Handle by far the two most common cases
115             # This is very fast and handles 99% of cases.
116 688 100       7205 return 1 if defined ${"${name}::VERSION"};
  688         9447  
117 430 100       3716 return 1 if defined @{"${name}::ISA"};
  430         5769  
118              
119             # Are there any symbol table entries other than other namespaces
120 288         2454 foreach ( keys %{"${name}::"} ) {
  288         7107  
121 467 100       7591 next if substr($_, -2, 2) eq '::';
122 311 100       2757 return 1 if defined &{"${name}::$_"};
  311         4191  
123             }
124              
125             # No functions, and it doesn't have a version, and isn't anything.
126             # As an absolute last resort, check for an entry in %INC
127 208         4121 my $filename = $class->_inc_filename($name);
128 208 50       2186 return 1 if defined $INC{$filename};
129              
130 208         2509 '';
131             }
132              
133             =pod
134            
135             =head2 filename $class
136            
137             For a given class, returns the base filename for the class. This will NOT
138             be a fully resolved filename, just the part of the filename BELOW the
139             C<@INC> entry.
140            
141             print Class->filename( 'Foo::Bar' );
142             > Foo/Bar.pm
143            
144             This filename will be returned with the right seperator for the local
145             platform, and should work on all platforms.
146            
147             Returns the filename on success or C<undef> if the class name is invalid.
148            
149             =cut
150              
151             sub filename {
152 1     1 1 11 my $class = shift;
153 1 50       13 my $name = $class->_class(shift) or return undef;
154 1         29 File::Spec->catfile( split /(?:'|::)/, $name ) . '.pm';
155             }
156              
157             =pod
158            
159             =head2 resolved_filename $class, @try_first
160            
161             For a given class, the C<resolved_filename> static method returns the fully
162             resolved filename for a class. That is, the file that the class would be
163             loaded from.
164            
165             This is not nescesarily the file that the class WAS loaded from, as the
166             value returned is determined each time it runs, and the C<@INC> include
167             path may change.
168            
169             To get the actual file for a loaded class, see the C<loaded_filename>
170             method.
171            
172             Returns the filename for the class, or C<undef> if the class name is
173             invalid.
174            
175             =cut
176              
177             sub resolved_filename {
178 2     2 1 20 my $class = shift;
179 2 50       23 my $filename = $class->_inc_filename(shift) or return undef;
180 2         21 my @try_first = @_;
181              
182             # Look through the @INC path to find the file
183 2         22 foreach ( @try_first, @INC ) {
184 23         233 my $full = "$_/$filename";
185 23 100       564 next unless -e $full;
186 1 50       21 return $UNIX ? $full : $class->_inc_to_local($full);
187             }
188              
189             # File not found
190 1         20 '';
191             }
192              
193             =pod
194            
195             =head2 loaded_filename $class
196            
197             For a given loaded class, the C<loaded_filename> static method determines
198             (via the C<%INC> hash) the name of the file that it was originally loaded
199             from.
200            
201             Returns a resolved file path, or false if the class did not have it's own
202             file.
203            
204             =cut
205              
206             sub loaded_filename {
207 3     3 1 36 my $class = shift;
208 3         32 my $filename = $class->_inc_filename(shift);
209 3 50       58 $UNIX ? $INC{$filename} : $class->_inc_to_local($INC{$filename});
210             }
211              
212              
213              
214              
215              
216             #####################################################################
217             # Sub Related Methods
218              
219             =pod
220            
221             =head2 functions $class
222            
223             For a loaded class, the C<functions> static method returns a list of the
224             names of all the functions in the classes immediate namespace.
225            
226             Note that this is not the METHODS of the class, just the functions.
227            
228             Returns a reference to an array of the function names on success, or C<undef>
229             if the class name is invalid or the class is not loaded.
230            
231             =cut
232              
233             sub functions {
234 3     3 1 44 my $class = shift;
235 3 50       33 my $name = $class->_class(shift) or return undef;
236 3 100       33 return undef unless $class->loaded( $name );
237              
238             # Get all the CODE symbol table entries
239 17         329 my @functions = sort grep { /$RE_IDENT/o }
  26         344  
240 26         198 grep { defined &{"${name}::$_"} }
  1         26  
241 1         10 keys %{"${name}::"};
242 1         21 \@functions;
243             }
244              
245             =pod
246            
247             =head2 function_refs $class
248            
249             For a loaded class, the C<function_refs> static method returns references to
250             all the functions in the classes immediate namespace.
251            
252             Note that this is not the METHODS of the class, just the functions.
253            
254             Returns a reference to an array of C<CODE> refs of the functions on
255             success, or C<undef> if the class is not loaded.
256            
257             =cut
258              
259             sub function_refs {
260 1     1 1 12 my $class = shift;
261 1 50       12 my $name = $class->_class(shift) or return undef;
262 1 50       12 return undef unless $class->loaded( $name );
263              
264             # Get all the CODE symbol table entries, but return
265             # the actual CODE refs this time.
266 17         203 my @functions = map { \&{"${name}::$_"} }
  17         1276  
  17         195  
267 26         295 sort grep { /$RE_IDENT/o }
268 26         201 grep { defined &{"${name}::$_"} }
  1         29  
269 1         11 keys %{"${name}::"};
270 1         31 \@functions;
271             }
272              
273             =pod
274            
275             =head2 function_exists $class, $function
276            
277             Given a class and function name the C<function_exists> static method will
278             check to see if the function exists in the class.
279            
280             Note that this is as a function, not as a method. To see if a method
281             exists for a class, use the C<can> method for any class or object.
282            
283             Returns true if the function exists, false if not, or C<undef> if the
284             class or function name are invalid, or the class is not loaded.
285            
286             =cut
287              
288             sub function_exists {
289 4     4 1 39 my $class = shift;
290 4 50       44 my $name = $class->_class( shift ) or return undef;
291 4 100       47 my $function = shift or return undef;
292              
293             # Only works if the class is loaded
294 3 100       31 return undef unless $class->loaded( $name );
295              
296             # Does the GLOB exist and its CODE part exist
297 2         17 defined &{"${name}::$function"};
  2         36  
298             }
299              
300             =pod
301            
302             =head2 methods $class, @options
303            
304             For a given class name, the C<methods> static method will returns ALL
305             the methods available to that class. This includes all methods available
306             from every class up the class' C<@ISA> tree.
307            
308             Returns a reference to an array of the names of all the available methods
309             on success, or C<undef> if the class name is invalid or the class is not
310             loaded.
311            
312             A number of options are available to the C<methods> method that will alter
313             the results returned. These should be listed after the class name, in any
314             order.
315            
316             # Only get public methods
317             my $method = Class::Inspector->methods( 'My::Class', 'public' );
318            
319             =over 4
320            
321             =item public
322            
323             The C<public> option will return only 'public' methods, as defined by the Perl
324             convention of prepending an underscore to any 'private' methods. The C<public>
325             option will effectively remove any methods that start with an underscore.
326            
327             =item private
328            
329             The C<private> options will return only 'private' methods, as defined by the
330             Perl convention of prepending an underscore to an private methods. The
331             C<private> option will effectively remove an method that do not start with an
332             underscore.
333            
334             B<Note: The C<public> and C<private> options are mutually exclusive>
335            
336             =item full
337            
338             C<methods> normally returns just the method name. Supplying the C<full> option
339             will cause the methods to be returned as the full names. That is, instead of
340             returning C<[ 'method1', 'method2', 'method3' ]>, you would instead get
341             C<[ 'Class::method1', 'AnotherClass::method2', 'Class::method3' ]>.
342            
343             =item expanded
344            
345             The C<expanded> option will cause a lot more information about method to be
346             returned. Instead of just the method name, you will instead get an array
347             reference containing the method name as a single combined name, ala C<full>,
348             the seperate class and method, and a CODE ref to the actual function ( if
349             available ). Please note that the function reference is not guarenteed to
350             be available. C<Class::Inspector> is intended at some later time, work
351             with modules that have some some of common run-time loader in place ( e.g
352             C<Autoloader> or C<Class::Autouse> for example.
353            
354             The response from C<methods( 'Class', 'expanded' )> would look something like
355             the following.
356            
357             [
358             [ 'Class::method1', 'Class', 'method1', \&Class::method1 ],
359             [ 'Another::method2', 'Another', 'method2', \&Another::method2 ],
360             [ 'Foo::bar', 'Foo', 'bar', \&Foo::bar ],
361             ]
362            
363             =back
364            
365             =cut
366              
367             sub methods {
368 22     22 1 391 my $class = shift;
369 22 50       231 my $name = $class->_class( shift ) or return undef;
370 22         202 my @arguments = map { lc $_ } @_;
  20         250  
371              
372             # Process the arguments to determine the options
373 22         199 my %options = ();
374 22         271 foreach ( @arguments ) {
375 20 100       862 if ( $_ eq 'public' ) {
    100          
    100          
    50          
376             # Only get public methods
377 6 100       69 return undef if $options{private};
378 5         53 $options{public} = 1;
379              
380             } elsif ( $_ eq 'private' ) {
381             # Only get private methods
382 4 100       52 return undef if $options{public};
383 3         32 $options{private} = 1;
384              
385             } elsif ( $_ eq 'full' ) {
386             # Return the full method name
387 4 100       51 return undef if $options{expanded};
388 3         34 $options{full} = 1;
389              
390             } elsif ( $_ eq 'expanded' ) {
391             # Returns class, method and function ref
392 6 100       101 return undef if $options{full};
393 5         83 $options{expanded} = 1;
394              
395             } else {
396             # Unknown or unsupported options
397 0         0 return undef;
398             }
399