File Coverage

blib/script/find

Criterion	Covered	Total	%
statement	72	83	86.7
branch	20	44	45.4
condition	3	6	50.0
subroutine	13	13	100.0
pod			n/a
total	108	146	73.9

#!/usr/local/bin/perl

=begin metadata

Name: find
Description: search directory tree for files matching a pattern
Author: Greg Snow, [e-mail]
Author: Tom Christiansen, [e-mail]
Author: Larry Wall, [e-mail]
License: perl

=end metadata

=cut


# find - actually a pass through front end for find2perl

use strict;

use Config qw(%Config);
use File::Basename;
use File::Spec::Functions;
use File::Temp qw/ tempfile /;
use FindBin;

sub find_find2perl {
	return $ENV{FIND2PERL} if defined $ENV{FIND2PERL};
	my @candidates =
		grep { -e }
		map { catfile( $_, 'find2perl' ) }
			dirname($Config{perlpath}),
			split( /$Config{path_sep}/, $ENV{PATH} )
			;

	push @candidates, catfile( $ENV{PERL_LOCAL_LIB_ROOT}, 'bin', 'find2perl' )
		if defined $ENV{PERL_LOCAL_LIB_ROOT};

	return defined $candidates[0] ? $candidates[0] : ();
	}

my $find2perl  = find_find2perl();
die("This program needs the App::find2perl module.\n") unless -e $find2perl;

# Temp files to capture find2perl output and error.
my ($out_fh, $out_file) = tempfile();
my ($err_fh, $err_file) = tempfile();

END {
    unlink $out_file;
    unlink $err_file;
}

# Save STDOUT and STDERR.  Redirect to temp files.

open SAVE_OUT, '>&', STDOUT or die "Can't save STDOUT: $!";
die unless defined fileno SAVE_OUT;

open STDOUT, '>&', $out_fh or die "Can't dup STDOUT to $out_file: $!";
$|++, select $_ for select STDOUT;

open SAVE_ERR, '>&', STDERR or die "Can't save STDERR: $!";
die unless defined fileno SAVE_ERR;

open STDERR, '>&', $err_fh or die "Can't dup STDERR to $err_file: $!";
$|++, select $_ for select STDERR;

# Run find2perl to convert find command to Perl script.

system $^X, $find2perl, @ARGV;

# Check for errors.

my $child_error = $?;
my $acm_min_error;

open STDERR, '>&', SAVE_ERR or die "Can't restore STDERR: $!";

seek $err_fh, 0, 0 or die "Can't rewind $err_file: $!";

my $error = do { local $/; <$err_fh> };

close $err_fh;

if ($error) {
    if ($error =~ /^Unrecognized switch: -[acm]min\s*$/) {
        # Tried to use -amin, -cmin or -mmin, which find2perl doesn't
        # support.
        $acm_min_error++;

        # So change to -atime, -ctime or -mtime, and append an
        # identifier to its argument (fortunately, find2perl does not
        # validate the argument).
        for my $i (0..$#ARGV) {
            $ARGV[$i + 1] .= '-ppt-minutes'
                if $ARGV[$i] =~ s/^(-[acm])min$/${1}time/;
        }

        system $find2perl, @ARGV;
        $child_error = $?;
    } else {
        warn $error;
    }
}

die "Can't run $find2perl (wait status == $child_error)" if $child_error;

die "Empty program" unless -s $out_fh && -s $out_file;

# Get "find" Perl script from output.

seek $out_fh, 0, 0 or die "Can't rewind $out_file: $!";

my $program = do { local $/; <$out_fh> };

close $out_fh;

open STDOUT, '>&', SAVE_OUT or die "Can't restore STDOUT: $!";

# Convert fake -atime, -ctime and -mtime conditionals, such as:
#
#    (int(-C _) > 60-ppt-minutes) &&
#    (int(-M _) < 15-ppt-minutes)
#
# To -amin, -cmin and -mmin conditionals, such as:
#
#    (int(1440 * -C _) > 60) &&
#    (int(1440 * -M _) < 15)
#
if ($acm_min_error) {
    my $minutes_per_day = 24 * 60;
    $program =~ s/(\bint\()(-[AMC] .*)-ppt-minutes/$1$minutes_per_day * $2/g;
}

# Run "find" Perl script.

eval qq{
    no strict;
    local \$^W = 0;
    $program;
};

die "Can't compile and execute $find2perl: $@\n" if $@;

exit 0;

__END__