view release on metacpan or  search on metacpan

lib/File/RDir.pm  view on Meta::CPAN

package File::RDir;
$File::RDir::VERSION = '0.02';
use strict;
use warnings;

use Carp qw(croak);

require Exporter;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(read_rdir) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();

sub new {
    my $pkg = shift;
    my ($root, $opt) = @_;
    $root =~ s{\\}'/'xmsg;

    my @PList;

    if (ref($opt) eq 'HASH' and defined($opt->{'prune'})) {
        for (split m{;}xms, $opt->{'prune'}) {
            my ($item, $mod) = m{\A ([^:]*) : ([A-Z]*)\z}xmsi ? ($1, $2) : ($_, '');

            my $rstring = '';

            for my $frag (split m{([\*\?])}xms, $item) {
                if ($frag eq '*') {
                    $rstring .= '.*?';
                }
                elsif ($frag eq '?') {
                    $rstring .= '.';
                }
                else {
                    $rstring .= quotemeta($frag);
                }
            }

            push @PList, $mod =~ m{i}xmsi ? qr{\A $rstring \z}xmsi : qr{\A $rstring \z}xms;
        }
    }

    opendir my $hdl, $root or croak "Can't opendir '$root' because $!";

    my $self = { 'root' => $root, 'ndir' => '', 'dlist' => [], 'hdl' => $hdl, 'pl' => \@PList };

    bless $self, $pkg;
}

sub match {
    my $self = shift;
    return unless $self->{'hdl'};

    my $ele;
    my $full_dir = $self->{'root'}.$self->{'ndir'};

    LOOP1: {
        $ele = readdir $self->{'hdl'};

        unless (defined $ele) {
            closedir $self->{'hdl'};
            $self->{'hdl'} = undef;

            my $ndir = shift @{$self->{'dlist'}};
            last LOOP1 unless defined $ndir;

            $self->{'ndir'} = $ndir;

            $full_dir = $self->{'root'}.$self->{'ndir'};
            opendir $self->{'hdl'}, $full_dir or croak "Can't opendir '$full_dir' because $!";
            redo LOOP1;
        }

        my $full_ele = $full_dir.'/'.$ele;

        if (-d $full_ele) {
            redo LOOP1 if $ele eq '.' or $ele eq '..';

            for my $p (@{$self->{'pl'}}) {
                redo LOOP1 if $ele =~ $p;
            }

            push @{$self->{'dlist'}}, $self->{'ndir'}.'/'.$ele;
            redo LOOP1;
        }
    }