/usr/share/perl5/SHARYANTO/File/Util.pm is in libsharyanto-file-util-perl 0.56-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | package SHARYANTO::File::Util;
use 5.010001;
use strict;
use warnings;
use Cwd ();
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(file_exists l_abs_path dir_empty);
our $VERSION = '0.56'; # VERSION
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;
my @d = grep {$_ ne '.' && $_ ne '..'} readdir($dh);
my $res = !@d;
#$log->tracef("dir_is_empty(%s)? %d", $dir, $res);
$res;
}
1;
# ABSTRACT: File-related utilities
__END__
=pod
=encoding utf-8
=head1 NAME
SHARYANTO::File::Util - File-related utilities
=head1 VERSION
version 0.56
=head1 SYNOPSIS
use SHARYANTO::File::Util qw(file_exists l_abs_path dir_empty);
print "file exists" if file_exists("/path/to/file/or/dir");
print "absolute path = ", l_abs_path("foo");
print "dir exists and is empty" if dir_empty("/path/to/dir");
=head1 DESCRIPTION
=head1 FUNCTIONS
None are exported by default, but they are exportable.
=head2 file_exists($path) => BOOL
This routine is just like the B<-e> test, except that it assume symlinks with
non-existent target as existing. If C<sym> is a symlink to a non-existing
target:
-e "sym" # false, Perl performs stat() which follows symlink
but:
-l "sym" # true, Perl performs lstat()
-e _ # false
This function performs the following test:
!(-l "sym") && (-e _) || (-l _)
=head2 l_abs_path($path) => STR
Just like Cwd::abs_path(), except that it will not follow symlink if $path is
symlink (but it will follow symlinks for the parent paths).
Example:
use Cwd qw(getcwd abs_path);
say getcwd(); # /home/steven
# s is a symlink to /tmp/foo
say abs_path("s"); # /tmp/foo
say l_abs_path("s"); # /home/steven/s
# s2 is a symlink to /tmp
say abs_path("s2/foo"); # /tmp/foo
say l_abs_path("s2/foo"); # /tmp/foo
Mnemonic: l_abs_path -> abs_path is analogous to lstat -> stat.
Note: currently uses hardcoded C</> as path separator.
=head2 dir_empty($dir) => BOOL
Will return true if C<$dir> exists and is empty.
None are exported by default, but they are exportable.
=head1 FAQ
=head2 Where is file_empty()?
For checking if some path exists, is a regular file, and is empty (content is
zero-length), you can simply use the C<-z> filetest operator.
=head1 AUTHOR
Steven Haryanto <stevenharyanto@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Steven Haryanto.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|