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