view release on metacpan or  search on metacpan

lib/App/finddo.pm  view on Meta::CPAN

            schema => 'bool*',
        },
        # XXX add arg: doc/ebook, backup, compressed, archive

        # XXX add arg: recursive (-r)
        # XXX add arg: max_depth
        # XXX add arg: (mtime, ctime) (min, max)
        # XXX add arg: size (min, max)
    },
    args_rels => {
        'choose_one&' => [
            [qw/sort newest oldest smallest largest/],
            [qw/files dirs/],
            [qw/media audio video image/],
        ],
    },
    result_naked => 1,
    links => [
        {url=>'prog:find', summary => 'Unix command'},
    ],
};
sub finddo {
    my %args = @_;

    my $max_result = $args{max_result};
    if ($args{newest} || $args{oldest} || $args{largest} || $args{smallest}) {
        $max_result = 1 unless defined $max_result;
    }
    $max_result = -1 unless defined $max_result;

    my $re_ext;
    my $ext_cond;
    if (defined $args{media}) {
        $ext_cond = $args{media};
        $re_ext = _get_ext_re_from_mime_types_file(qr!^(?:audio|video|image)/!);
    } elsif (defined $args{audio}) {
        $ext_cond = $args{audio};
        $re_ext = _get_ext_re_from_mime_types_file(qr!^(?:audio)/!);
    } elsif (defined $args{video}) {
        $ext_cond = $args{video};
        $re_ext = _get_ext_re_from_mime_types_file(qr!^(?:video)/!);
    } elsif (defined $args{image}) {
        $ext_cond = $args{image};
        $re_ext = _get_ext_re_from_mime_types_file(qr!^(?:image)/!);
    }

    my @res;
  FIND:
    {
        opendir my $dh, "." or do {
            warn "finddo: Can't opendir: $!\n";
            last FIND;
        };
        my @entries = readdir $dh;
        closedir $dh;

      ENTRY:
        for my $entry (@entries) {
            next if $entry eq '.' || $entry eq '..';
            my @lst = lstat $entry;
            my @st  = $lst[2] & S_IFLNK ? stat($entry) : @lst;

            if (defined $args{exists}) {
                next ENTRY if $args{exists} xor @st;
            }
            if (defined $args{files}) {
                next ENTRY unless @st;
                next ENTRY if $st[2] & S_IFREG xor $args{files};
            }
            if (defined $args{dirs}) {
                next ENTRY unless @st;
                next ENTRY if $st[2] & S_IFDIR xor $args{dirs};
            }
            if ($re_ext) {
                my $match = $entry =~ $re_ext;
                $match = !$match unless $ext_cond;
                next ENTRY unless $match;
            }
            push @res, {name=>$entry, stat=>\@st};
        }

      SORT:
        {
            my $sort = $args{sort};
            if    ($sort)           { }
            elsif ($args{newest})   { $sort = "-mtime" }
            elsif ($args{oldest})   { $sort =  "mtime" }
            elsif ($args{largest})  { $sort = "-size"  }
            elsif ($args{smallest}) { $sort =  "size"  }
            last unless $sort;

            my $sortsub;
            if    ($sort eq   'name') { $sortsub = sub { $a->{name} cmp $b->{name} } }
            elsif ($sort eq  '-name') { $sortsub = sub { $b->{name} cmp $a->{name} } }
            elsif ($sort eq  'mtime') { $sortsub = sub { ($a->{stat}[9]||0) <=> ($b->{stat}[9]||0) } }
            elsif ($sort eq '-mtime') { $sortsub = sub { ($b->{stat}[9]||0) <=> ($a->{stat}[9]||0) } }
            elsif ($sort eq   'size') { $sortsub = sub { ($a->{stat}[7]||0) <=> ($b->{stat}[7]||0) } }
            elsif ($sort eq  '-size') { $sortsub = sub { ($b->{stat}[7]||0) <=> ($a->{stat}[7]||0) } }

            @res = sort $sortsub @res;
        }

        @res = map {$_->{name}} @res;

      LIMIT:
        {
            last unless $max_result >= 0;
            if (@res > $max_result) {
                splice @res, $max_result;
            }
        }

    }

    if ($args{command} && @{$args{command}}) {
        if (@res) {
            system {$args{command}[0]} @{$args{command}}, @res;
            exit $?;
        } else {
            warn "finddo: No matching files\n";
            exit 1;