1package Class::Factory::Util; 2 3use strict; 4use vars qw($VERSION); 5 6use Carp qw(confess); 7 8$VERSION = '1.6'; 9 101; 11 12sub import 13{ 14 my $caller = caller(0); 15 16 { 17 no strict 'refs'; 18 *{"${caller}::subclasses"} = \&_subclasses; 19 } 20} 21 22# deprecated 23sub subclasses { _subclasses(@_) } 24 25sub _subclasses 26{ 27 my $base = shift; 28 29 $base =~ s,::,/,g; 30 31 my %dirs = map { $_ => 1 } @INC; 32 33 my $dir = substr( $INC{"$base.pm"}, 0, (length $INC{"$base.pm"}) - 3 ); 34 35 $dirs{$dir} = 1; 36 37 my @packages = map { _scandir( "$_/$base" ) } keys %dirs; 38 39 # Make list of unique elements 40 my %packages = map { $_ => 1 } @packages; 41 42 return sort keys %packages; 43} 44 45sub _scandir 46{ 47 my $dir = shift; 48 49 return unless -d $dir; 50 51 opendir DIR, $dir 52 or confess ("Cannot open directory $dir: $!"); 53 54 my @packages = 55 ( map { substr($_, 0, length($_) - 3) } 56 grep { substr($_, -3) eq '.pm' && -f "$dir/$_" } 57 readdir DIR 58 ); 59 60 closedir DIR 61 or confess("Cannot close directory $dir: $!" ); 62 63 return @packages; 64} 65 66__END__ 67 68=head1 NAME 69 70Class::Factory::Util - Provide utility methods for factory classes 71 72=head1 SYNOPSIS 73 74 package My::Class; 75 76 use Class::Factory::Util; 77 78 My::Class->subclasses; 79 80=head1 DESCRIPTION 81 82This module exports a method that is useful for factory classes. 83 84=head1 USAGE 85 86When this module is loaded, it creates a method in its caller named 87C<subclasses()>. This method returns a list of the available 88subclasses for the package. It does this by looking in C<@INC> as 89well as the directory containing the caller, and finding any modules 90in the immediate subdirectories of the calling module. 91 92So if you have the modules "Foo::Base", "Foo::Base::Bar", and 93"Foo::Base::Baz", then the return value of C<< Foo::Base->subclasses() 94>> would be "Bar" and "Baz". 95 96=head1 SUPPORT 97 98Please submit bugs to the CPAN RT system at 99http://rt.cpan.org/NoAuth/ReportBug.html?Queue=class-factory-util or 100via email at bug-class-factory-util@rt.cpan.org. 101 102=head1 AUTHOR 103 104Dave Rolsky, <autarch@urth.org>. 105 106Removed from Alzabo and packaged by Terrence Brannon, 107<tbone@cpan.org>. 108 109=head1 COPYRIGHT 110 111Copyright (c) 2003 David Rolsky. All rights reserved. This program 112is free software; you can redistribute it and/or modify it under the 113same terms as Perl itself. 114 115The full text of the license can be found in the LICENSE file included 116with this module. 117 118=cut 119