File Coverage

blib/lib/File/Find/Rex.pm

Criterion	Covered	Total	%
statement	78	106	73.5
branch	23	70	32.8
condition	10	24	41.6
subroutine	19	21	90.4
pod	8	9	88.8
total	138	230	60.0

# File: File/Find/Rex.pm
# Description:
# Revisions:  2018.01.21 - Roland Ayala - Created
#
# License: Artistic License 2.0
#
package File::Find::Rex;

use 5.006;
use strict;
use warnings;
our $VERSION = '1.02';

# import modules
use Carp;
use Cwd 'abs_path';
use File::Basename;
use File::Find;
use File::Spec 'canonpath';
use if $^O eq 'MSWin32', 'Win32::File';

sub new {
    my ( $class, $options, $callback ) = @_;
    if ( defined $options && ref $options ne 'HASH' ) {
        croak 'options expects hash reference';
    }
    if ( defined $callback && ref $callback ne 'CODE' ) {
        croak 'callback expects code reference';
    }

    my $self = {
        _options  => $options,
        _callback => $callback
    };
    bless $self, $class;
    return $self;
}

sub set_option {
    my ( $self, $key, $value ) = @_;
    if ( defined $key ) {
        $self->{_options}->{$key} = $value;
    }
    return;
}

sub is_ignore_dirs {
    my $self = shift;
    return
        defined $self->{_options}->{ignore_dirs}
      ? $self->{_options}->{ignore_dirs} > 0
          ? 1
          : 0
      : 0;
}

sub is_ignore_hidden {
    my $self = shift;
    return
        defined $self->{_options}->{ignore_hidden}
      ? $self->{_options}->{ignore_hidden} > 0
          ? 1
          : 0
      : 0;
}

sub is_ignore_symlink {
    my $self = shift;
    return
        defined $self->{_options}->{ignore_symlink}
      ? $self->{_options}->{ignore_symlink} > 0
          ? 1
          : 0
      : 0;
}

sub is_recursive {
    my $self = shift;
    return
        defined $self->{_options}->{recursive}
      ? $self->{_options}->{recursive} > 0
          ? 1
          : 0
      : 0;
}

sub get_last_modified_earliest {
    my $self = shift;
    my $val  = $self->{_options}->{last_modified_earliest};
    if ( defined $val ) {

        # ensure that value set is an integer value, because caller should
        # be setting option using epoch timevalue
        $val =~ m/^[\d]*$/gxs or $val = undef;
    }
    return $val;
}

sub get_last_modified_latest {
    my $self = shift;
    my $val  = $self->{_options}->{last_modified_latest};
    if ( defined $val ) {

        # ensure that value set is an integer value, because caller should
        # be setting option using epoch timevalue
        $val =~ m/^[\d]*$/gxs or $val = undef;
    }
    return $val;
}

sub query {
    my ( $self, $source, $regexp, $context ) = @_;
    defined $source or croak 'source path expected';
    if ( defined $regexp && ref $regexp ne 'Regexp' ) {
        croak 'regular expression expected';
    }

    # Initialize an empty array. If caller sets a callback then this empty
    # array is returned, else wanted callback will push any files found onto
    # the array.
    my @files = ();

    if ( -e $source ) {

        # Get the absolute path in case caller specifies relative path to source
        # directory so recursive behavior in find_files_wanted works correctly,
        # and for logging purposes.
        $source = abs_path($source);

        if ( -d $source )    # source is a directory
        {
            File::Find::find(
                _make_wanted(
                    \&_callback, $self, \@files, $source, $regexp, $context
                ),
                $source
            );
        }
        else                 # source is a file
        {
            _callback( $self, \@files, $source, $regexp, $context, 1 );
        }
    }
    else {
        warn 'No such file or directory' . "\n";
    }

    return @files;
}

sub _make_wanted {
    my @args   = @_;            # freeze the args
    my $wanted = shift @args;
    return sub { $wanted->(@args); };
}

sub _callback {
    my ( $self, $files, $source, $regexp, $context, $dummy ) = @_;
    my $file = defined $dummy ? $source : $File::Find::name;

    # if the file is a directory and caller has specified to ignore dirs in
    # results set then jump to end.
    unless ( -d $file && $self->is_ignore_dirs ) {
      NEXT: {
            my ( $fbase, $fdir, $ftype ) = fileparse( $file, '\.[^\.]*' );
            my $filename = $fbase . $ftype;

            # handle ignore_hidden option
            if ( $self->is_ignore_hidden ) {

                # method for determining if file is hidden depends on if windows
                # or not.
                my $is_visible;
                if ( $^O eq 'MSWin32' ) {
                    my $attr;
                    Win32::File::GetAttributes( $file, $attr );
                    $is_visible = !( $attr & Win32::File::HIDDEN() );
                }
                else {
                    $is_visible = ( $filename !~ /^[.]/gxs );
                }
                $is_visible or last NEXT;
            }

            # ignore if file is symbolic link and option set to ignore
            if ( $self->is_ignore_symlink ) {
              ! -l $file or last NEXT;
            }

            # handle regex pattern rule if set
            if ( defined $regexp && !-d $file ) {
                $filename =~ $regexp or last NEXT;
            }

            # handle last modified window rules if set
            my $oldest = $self->get_last_modified_earliest;
            my $newest = $self->get_last_modified_latest;
            if ( defined $oldest || defined $newest ) {

                # capture last modified timestamp from file
                my $timestamp = ( stat $file )[9];
                if ( defined $oldest ) { $timestamp >= $oldest or last NEXT; }
                if ( defined $newest ) { $timestamp <= $newest or last NEXT; }
            }

            my $cfile = File::Spec->canonpath($file);
            if ( defined $self->{_callback} ) {
                $self->{_callback}->( $cfile, $context );
            }
            else {
                push @{$files}, $cfile;
            }
        }
    }
    if ( -d $file && ( uc $file ) ne ( uc $source ) && !$self->is_recursive ) {
        $File::Find::prune = 1;
    }

    return;
}

1;    # End of File::Find::Rex

__END__