File Coverage

lib/Class/Factory/Util.pm

Criterion	Covered	Total	%
statement	35	36	97.2
branch	6	8	75.0
condition			n/a
subroutine	7	8	87.5
pod	0	1	0.0
total	48	53	90.5

package Class::Factory::Util;

use strict;
use vars qw($VERSION);

use Carp qw(confess);

$VERSION = '1.7';

1;

sub import
{
    my $caller = caller(0);

    {
        no strict 'refs';
        *{"${caller}::subclasses"} = \&_subclasses;
    }
}

# deprecated
sub subclasses { _subclasses(@_) }

sub _subclasses
{
    my $base = shift;

    $base =~ s,::,/,g;

    my %dirs = map { $_ => 1 } @INC;

    my $dir = substr( $INC{"$base.pm"}, 0, (length $INC{"$base.pm"}) - 3 );

    $dirs{$dir} = 1;

    my @packages = map { _scandir( "$_/$base" ) } keys %dirs;

    # Make list of unique elements
    my %packages = map { $_ => 1 } @packages;

    return sort keys %packages;
}

sub _scandir
{
    my $dir = shift;

    return unless -d $dir;

    opendir DIR, $dir
	or confess ("Cannot open directory $dir: $!");

    my @packages =
        ( map { substr($_, 0, length($_) - 3) }
          grep { substr($_, -3) eq '.pm' && -f "$dir/$_" }
          readdir DIR
        );

    closedir DIR
	or confess("Cannot close directory $dir: $!" );

    return @packages;
}

__END__