File Coverage

blib/lib/File/MoreUtil.pm

Criterion	Covered	Total	%
statement	246	248	99.1
branch	184	216	85.1
condition	114	124	91.9
subroutine	34	34	100.0
pod	29	29	100.0
total	607	651	93.2

## no critic: Subroutines::ProhibitExplicitReturnUndef
package File::MoreUtil;

use 5.010001;
use strict;
use warnings;

use Cwd ();
use Exporter 'import';

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-11-02'; # DATE
our $DIST = 'File-MoreUtil'; # DIST
our $VERSION = '0.628'; # VERSION

our @EXPORT_OK = qw(
                       file_exists
                       l_abs_path
                       dir_empty
                       dir_not_empty
                       dir_has_entries
                       dir_has_files
                       dir_has_dot_files
                       dir_has_non_dot_files
                       dir_has_subdirs
                       dir_has_non_subdirs
                       dir_has_dot_subdirs
                       dir_has_non_dot_subdirs
                       dir_only_has_files
                       dir_only_has_dot_files
                       dir_only_has_non_dot_files
                       dir_only_has_subdirs
                       dir_only_has_dot_subdirs
                       dir_only_has_non_dot_subdirs

                       get_dir_entries
                       get_dir_dot_entries
                       get_dir_subdirs
                       get_dir_non_subdirs
                       get_dir_dot_subdirs
                       get_dir_non_dot_subdirs
                       get_dir_files
                       get_dir_dot_files
                       get_dir_non_dot_files
                       get_dir_only_file
                       get_dir_only_subdir
               );

our %SPEC;

sub file_exists {
    my $path = shift;

    !(-l $path) && (-e _) || (-l _);
}

sub l_abs_path {
    my $path = shift;
    return Cwd::abs_path($path) unless (-l $path);

    $path =~ s!/\z!!;
    my ($parent, $leaf);
    if ($path =~ m!(.+)/(.+)!s) {
        $parent = Cwd::abs_path($1);
        return undef unless defined($path);
        $leaf   = $2;
    } else {
        $parent = Cwd::getcwd();
        $leaf   = $path;
    }
    "$parent/$leaf";
}

sub dir_empty {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return 0;
    }
    1;
}

sub dir_not_empty {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return 1;
    }
    0;
}

sub dir_has_entries { goto \&dir_not_empty }

sub dir_has_files {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        next unless -f "$dir/$e";
        return 1;
    }
    0;
}

sub dir_only_has_files {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    my $has_files;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return 0 unless -f "$dir/$e";
        $has_files++;
    }
    $has_files ? 1:0;
}

sub dir_has_dot_files {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        next unless $e =~ /\A\./;
        next unless -f "$dir/$e";
        return 1;
    }
    0;
}

sub dir_only_has_dot_files {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    my $has_dot_files;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return 0 unless $e =~ /\A\./;
        return 0 unless -f "$dir/$e";
        $has_dot_files++;
    }
    $has_dot_files ? 1:0;
}

sub dir_has_non_dot_files {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        next if $e =~ /\A\./;
        next unless -f "$dir/$e";
        return 1;
    }
    0;
}

sub dir_only_has_non_dot_files {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    my $has_nondot_files;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return 0 if $e =~ /\A\./;
        return 0 unless -f "$dir/$e";
        $has_nondot_files++;
    }
    $has_nondot_files ? 1:0;
}

sub dir_has_subdirs {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        next if -l "$dir/$e";
        next unless -d _;
        return 1;
    }
    0;
}

sub dir_only_has_subdirs {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    my $has_subdirs;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return 0 unless -d "$dir/$e";
        $has_subdirs++;
    }
    $has_subdirs ? 1:0;
}

sub dir_has_non_subdirs {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return 1 if -l "$dir/$e";
        return 1 if !(-d _);
    }
    0;
}

sub dir_has_dot_subdirs {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        next unless $e =~ /\A\./;
        next if -l "$dir/$e";
        next unless -d _;
        return 1;
    }
    0;
}

sub dir_only_has_dot_subdirs {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    my $has_dot_subdirs;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return 0 unless $e =~ /\A\./;
        return 0 unless -d "$dir/$e";
        $has_dot_subdirs++;
    }
    $has_dot_subdirs ? 1:0;
}

sub dir_has_non_dot_subdirs {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        next if $e =~ /\A\./;
        next if -l "$dir/$e";
        next unless -d _;
        return 1;
    }
    0;
}

sub dir_only_has_non_dot_subdirs {
    my ($dir) = @_;
    return undef unless (-d $dir);
    return undef unless opendir my($dh), $dir;
    my $has_nondot_subdirs;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return 0 if $e =~ /\A\./;
        return 0 unless -d "$dir/$e";
        $has_nondot_subdirs++;
    }
    $has_nondot_subdirs ? 1:0;
}

sub get_dir_entries {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my @res = grep { $_ ne '.' && $_ ne '..' } readdir $dh;
    closedir $dh; # we're so nice
    @res;
}

sub get_dir_dot_entries {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my @res = grep { $_ ne '.' && $_ ne '..' && /\A\./ } readdir $dh;
    closedir $dh; # we're so nice
    @res;
}

sub get_dir_files {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my @res = grep { $_ ne '.' && $_ ne '..' && (-f "$dir/$_")} readdir $dh;
    closedir $dh; # we're so nice
    @res;
}

sub get_dir_dot_files {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my @res = grep { $_ ne '.' && $_ ne '..' && /\A\./ && (-f "$dir/$_")} readdir $dh;
    closedir $dh; # we're so nice
    @res;
}

sub get_dir_non_dot_files {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my @res = grep { $_ ne '.' && $_ ne '..' && !/\A\./ && (-f "$dir/$_")} readdir $dh;
    closedir $dh; # we're so nice
    @res;
}

sub get_dir_subdirs {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my @res = grep { $_ ne '.' && $_ ne '..' && !(-l "$dir/$_") && (-d _) } readdir $dh;
    closedir $dh; # we're so nice
    @res;
}

sub get_dir_non_subdirs {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my @res = grep { $_ ne '.' && $_ ne '..' && ((-l "$dir/$_") || !(-d _)) } readdir $dh;
    closedir $dh; # we're so nice
    @res;
}

sub get_dir_dot_subdirs {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my @res = grep { $_ ne '.' && $_ ne '..' && /\A\./ && !(-l "$dir/$_") && (-d _) } readdir $dh;
    closedir $dh; # we're so nice
    @res;
}

sub get_dir_non_dot_subdirs {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my @res = grep { $_ ne '.' && $_ ne '..' && !/\A\./ && !(-l "$dir/$_") && (-d _) } readdir $dh;
    closedir $dh; # we're so nice
    @res;
}

sub get_dir_only_file {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my $res;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return unless -f "$dir/$e";
        return if defined $res;
        $res = $e;
    }
    return unless defined $res;
    $res;
}

sub get_dir_only_subdir {
    my ($dir) = @_;
    $dir //= ".";
    opendir my($dh), $dir or die "Can't opendir $dir: $!";
    my $res;
    while (defined(my $e = readdir $dh)) {
        next if $e eq '.' || $e eq '..';
        return unless -d "$dir/$e";
        return if defined $res;
        $res = $e;
    }
    return unless defined $res;
    $res;
}

1;
# ABSTRACT: File-related utilities

__END__