File Coverage

blib/lib/Path/Find.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	22	26	84.6
condition	3	3	100.0
subroutine	15	15	100.0
pod	2	2	100.0
total	99	103	96.1

package Path::Find;

# $Id: Find.pm 2590 2024-02-23 17:36:47Z fil $

use 5.00405;
use strict;
use vars qw($VERSION @ISA);
@ISA = qw();

$VERSION = '0.04';

use Carp;
use File::Spec;
use IO::Dir;
use Scalar::Util qw( blessed );
use Text::Glob qw( glob_to_regex );

use Exporter qw( import );
our @EXPORT = qw( path_find );
our @EXPORT_OK = qw( path_find matchable );

sub path_find
{
    my( $dir, $dirglob, $fileglob ) = @_;
    if( 2==@_ ) {
        $fileglob = $dirglob;
        $dirglob = "*";
    }

    __path_find( $dir, matchable( $dirglob ), matchable( $fileglob ), 0 );
}

sub __path_find
{
    my( $dir, $dirmatch, $filematch, $depth ) = @_;

    my @ret;

    my $dh = IO::Dir->new( $dir );
    $dh or return;
    my $entry;
    while( defined( $entry = $dh->read ) ) {
        next if $entry eq '.' or $entry eq '..';
        my $full = File::Spec->catfile( $dir, $entry );
        if( -d $full ) {
            push @ret, __path_find( $full, $dirmatch, $filematch, $depth+1 ) if $dirmatch->( $entry, $dir, $full, $depth );
        }
        elsif( $filematch->( $entry, $dir, $full, $depth ) ) {
            push @ret, $full;
        }
    }
    return @ret;
}

# Turn a glob into a coderef
sub matchable
{
    my( $glob ) = @_;
    $glob = '*' unless defined $glob;
    return $glob if 'CODE' eq ref $glob;
    return sub { $_[0] =~ $glob } if 'Regexp' eq ref $glob;
    if( blessed $glob ) {
        confess ref( $glob ), " object doesn't have method 'match'" unless $glob->can( 'match' );
        return sub { $glob->match( @_ ) };
    }
    confess "Can't convert $glob into a matchable" if ref $glob;
    $glob = '*' unless defined $glob;
    my $re = glob_to_regex( $glob );
    # warn "glob=$glob re=$re";
    return sub { $_[0] =~ $re };
}

1;

__END__