Aion-Fs
view release on metacpan or search on metacpan
lib/Aion/Fs.pm view on Meta::CPAN
use Exporter qw/import/;
use Scalar::Util qw//;
use List::Util qw//;
use Time::HiRes qw//;
use Aion::Fs::Cat;
use Aion::Fs::Lay;
use Aion::Fs::Find;
use Symbol qw//;
our @EXPORT = our @EXPORT_OK = grep {
ref \$Aion::Fs::{$_} eq "GLOB" && *{$Aion::Fs::{$_}}{CODE} && !/^(?:_|(NaN|import)\z)/
} keys %Aion::Fs::;
# СпиÑок ÐС Ñ ÑазлиÑаÑÑимÑÑ ÑинÑакÑиÑом ÑайловÑÑ
пÑÑей (должен бÑÑÑ Ð² нижнем ÑегиÑÑÑе)
use constant {
UNIX => 'unix',
AMIGAOS => 'amigaos',
CYGWIN => 'cygwin',
MSYS => 'msys',
MSYS2 => 'msys2',
MSWIN32 => 'mswin32',
DOS => 'dos',
OS2 => 'os2',
SYMBIAN => 'symbian',
VMS => 'vms',
VOS => 'vos',
RISCOS => 'riscos',
MACOS => 'macos',
VMESA => 'vmesa',
};
sub _fs();
sub _match($$) {
my ($match, $fs) = @_;
my @res; my @remove;
my $trans = $fs->{before_split} // sub {$_[0]};
for my $key (@$match) {
next unless exists $_->{$key};
push @remove, $key unless defined $_->{$key};
my $regexp = ($key eq "path"? $fs->{regexp}: $fs->{group}{$key});
my $val = $trans->($_->{$key});
push @res, $val =~ $regexp
? %+
: die "`$key` is in the wrong format `$val`. Has been used regexp: $regexp";
}
my %res = @res;
delete @res{keys %{$fs->{remove}->{$_}}} for @remove;
return %res, %$_;
}
sub _join(@) {
my ($match, @format) = @_;
my $fs = _fs;
my $trans = $fs->{before_split} // sub {$_[0]};
my %f = _match $match, $fs;
join "", List::Util::pairmap {
my @keys = ref $a? @$a: $a;
my $is = List::Util::first {defined $f{$_}} @keys;
defined $is? do {
my ($if, $format) = ref $b? @$b: (undef, $b);
my @val = map $trans->($f{$_}), @keys;
defined $if && $val[0] eq $if? $if:
$format !~ /%s/? $format:
sprintf($format, @val)
}: ()
} @format
}
# СинÑакÑиÑÑ ÑайловÑÑ
пÑÑей в ÑазнÑÑ
ÐС
my %FS;
my @FS = (
{
name => UNIX,
symdir => '/',
symext => '.',
regexp => qr!^
(
(?<dir> / ) | (?<dir> .* ) /
)?
(?<file>
(?<name> \.? [^/.]* )
( \. (?<ext> [^/]* ) )?
)
\z!xsn,
join => sub {
_join [qw/path file/],
dir => ["/", "%s/"],
name => "%s",
ext => ".%s",
},
},
{
name => AMIGAOS,
symdir => '/',
symext => '.',
regexp => qr!^
(?<dir>
( (?<volume> [^/:]+) : )?
(?<folder> .* ) /
)?
(?<file>
(?<name> \.? [^/.]* )
( \. (?<ext> [^/]* ) )?
)
\z!xsn,
join => sub {
_join [qw/path dir file/],
volume => "%s:",
folder => "%s/",
name => "%s",
ext => ".%s",
},
},
{
name => CYGWIN,
symdir => '/',
symext => '.',
regexp => qr!^
(?<dir>
( /cygdrive/ (?<volume> [^/]+ ) /? )?
( (?<folder> .* ) / )?
lib/Aion/Fs.pm view on Meta::CPAN
(?<file>
(?<name> [^./]*? )
( / (?<ext> [^.]* ) )?
)
\z!xsn,
join => sub {
_join [qw/path dir volume file/],
fstype => "%s",
option => "#%s",
[qw/fstype option/] => ":",
disk => ":%s.",
folder => "%s.",
name => "%s",
ext => "/%s",
},
},
{
name => MACOS,
symdir => ':',
symext => '.',
regexp => qr!^
(?<dir>
( (?<volume> [^:]* ) : )?
( (?<folder> .* ) : )?
)
(?<file>
(?<name> [^.:]*? )
( \. (?<ext> [^:]* ) )?
)
\z!xsn,
join => sub {
_join [qw/path dir file/],
volume => "%s:",
folder => "%s:",
name => "%s",
ext => ".%s",
},
},
{
name => VMESA,
symdir => '/',
symext => '.',
regexp => qr!^
\s* (?<userid> \S+ )
\s+ (?<file>
(?<name> \S+ )
\s+ (?<ext> \S+ )
)
\s+ (?<volume> \S+ )
\s*
\z!xsn,
join => sub {
_join [qw/path/],
[qw/userid file ext volume/] => "%s %s %s %s",
},
},
);
# ÐниÑиализаÑÐ¸Ñ Ð¿Ð¾ имени
%FS = map {
$_->{symdirquote} = quotemeta $_->{symdir};
$_->{symextquote} = quotemeta $_->{symext};
my @S;
while($_->{regexp} =~ m{
\\ .
| (?<open> \( ( \?<(?<group> \w+ )> )? )
| (?<close> \) )
}gx) {
if($+{open}) {
my $group = $+{group};
if ($group && @S) {
my $curgroup;
for(my $i = $#S; $i>=0; --$i) { $curgroup = $S[$i][1], last if defined $S[$i][1] }
$_->{remove}{$curgroup}{$group}++ if defined $curgroup;
}
push @S, [length($`) + length $&, $group];
}
elsif($+{close}) {
my ($pos, $group, $g2) = @{pop @S};
$S[$#S][2] //= $group if $_->{group}{$group} && @S;
$group //= $g2;
$_->{group}{$group} = do {
my $x = substr $_->{regexp}, $pos, length($`) - $pos;
qr/()^$x\z/xsn
} if defined $group;
}
}
my $x = $_;
ref $_->{name}? (map { ($_ => $x) } @{$_->{name}}): ($_->{name} => $_)
} @FS;
sub _fs() { $FS{lc $^O} // $FS{unix} }
# ÐÑ Ð½Ð°Ñ
одимÑÑ Ð² ÐС ÑемейÑÑва UNIX
sub isUNIX() { _fs->{name} eq "unix" }
# Ð Ð°Ð·Ð±Ð¸Ð²Ð°ÐµÑ Ð´Ð¸ÑекÑоÑÐ¸Ñ Ð½Ð° ÑоÑÑавлÑÑÑие
sub splitdir(;$) {
my ($dir) = @_ == 0? $_: @_;
($dir) = @$dir if ref $dir;
my $fs = _fs;
$dir = $fs->{before_split}->($dir) if exists $fs->{before_split};
split $fs->{symdirquote}, $dir, -1
}
# ÐбÑединÑÐµÑ Ð´Ð¸ÑекÑоÑÐ¸Ñ Ð¸Ð· ÑоÑÑавлÑÑÑиÑ
sub joindir(@) {
join _fs->{symdir}, @_
}
# Ð Ð°Ð·Ð±Ð¸Ð²Ð°ÐµÑ ÑаÑÑиÑение (Ñип Ñайла) на ÑоÑÑавлÑÑÑие
sub splitext(;$) {
my ($ext) = @_ == 0? $_: @_;
($ext) = @$ext if ref $ext;
split _fs->{symextquote}, $ext, -1
}
# ÐбÑединÑÐµÑ ÑаÑÑиÑение (Ñип Ñайла) из ÑоÑÑавлÑÑÑиÑ
sub joinext(@) {
join _fs->{symext}, @_
}
# ÐÑделÑÐµÑ Ð² пÑÑи ÑоÑÑавлÑÑÑие, а еÑли полÑÑÐ°ÐµÑ Ñ
еÑ, Ñо обÑединÑÐµÑ ÐµÐ³Ð¾ в пÑÑÑ
sub path(;$) {
my ($path) = @_ == 0? $_: @_;
my $fs = _fs;
if(ref $path eq "HASH") {
local $_ = $path;
return $fs->{join}->();
}
($path) = @$path if ref $path;
$path = $fs->{before_split}->($path) if exists $fs->{before_split};
+{
$path =~ $fs->{regexp}? (map { $_ ne "ext" && $+{$_} eq ""? (): ($_ => $+{$_}) } keys %+): (error => 1),
path => $path,
}
}
# ÐеÑÐµÐ²Ð¾Ð´Ð¸Ñ Ð¿ÑÑÑ Ð¸Ð· ÑоÑмаÑа одной ÐС в дÑÑгÑÑ
sub transpath ($$;$) {
my ($path, $from, $to) = @_ == 2? ($_, @_): @_;
my (@dir, @folder, @ext);
{ local $^O = $from;
$path = path $path;
@dir = splitdir $path->{dir} if exists $path->{dir} && !exists $path->{folder};
@folder = splitdir $path->{folder} if exists $path->{folder};
@ext = splitext $path->{ext} if exists $path->{ext};
}
delete $path->{path};
delete $path->{dir} if exists $path->{folder};
delete $path->{file};
{ local $^O = $to;
@dir = @folder, @folder = () if !_fs->{group}{folder};
$path->{dir} = joindir @dir if scalar @dir;
$path->{folder} = joindir @folder if scalar @folder;
$path->{ext} = joinext @ext if scalar @ext;
path $path;
}
}
# как mkdir -p
use constant FILE_EXISTS => 17;
use config DIR_DEFAULT_PERMISSION => 0755;
sub mkpath (;$) {
my ($path) = @_ == 0? $_: @_;
my $permission;
($path, $permission) = @$path if ref $path;
$permission = DIR_DEFAULT_PERMISSION unless Scalar::Util::looks_like_number $permission;
local $!;
if(isUNIX) {
while($path =~ m!/!g) {
mkdir $`, $permission
or ($! != FILE_EXISTS? die "mkpath $`: $!": ())
if $` ne '';
}
}
else {
my $part = path $path;
return $path unless exists $part->{folder};
my @dirs = splitdir $part->{folder};
# ÐÑли волÑм или пеÑвÑй dirs пÑÑÑ - знаÑÐ¸Ñ Ð¿ÑÑÑ Ð¾ÑноÑиÑелÑнÑй
my $cat = $part->{volume};
for(my $i=0; $i<@dirs; $i++) {
lib/Aion/Fs.pm view on Meta::CPAN
($file, $layer) = @$file if ref $file;
open my $f, ">$layer", $file or die "lay $file: $!";
local $\;
print $f $s;
close $f;
$file
}
# СÑиÑаÑÑ Ñайл, еÑли он еÑÑ Ð½Ðµ бÑл ÑÑиÑан
our %FILE_INC;
sub catonce (;$) {
my ($file) = @_ == 0? $_: @_;
die "catonce not use ref path!" if ref $file;
return undef if exists $FILE_INC{$file};
$FILE_INC{$file} = 1;
cat $file
}
use constant {
DEV_NO => 0, # ÐÐ¾Ð¼ÐµÑ ÑÑÑÑойÑÑва
INO_NO => 1, # ÐÐ¾Ð¼ÐµÑ inode
MODE_NO => 2, # Режим Ñайла (пÑава доÑÑÑпа)
NLINK_NO => 3, # ÐолиÑеÑÑво жеÑÑкиÑ
ÑÑÑлок
UID_NO => 4, # ÐденÑиÑикаÑÐ¾Ñ Ð¿Ð¾Ð»ÑзоваÑелÑ-владелÑÑа
GID_NO => 5, # ÐденÑиÑикаÑÐ¾Ñ Ð³ÑÑппÑ-владелÑÑа
RDEV_NO => 6, # ÐÐ¾Ð¼ÐµÑ ÑÑÑÑойÑÑва (еÑли ÑÑо ÑпеÑиалÑнÑй Ñайл)
SIZE_NO => 7, # Ð Ð°Ð·Ð¼ÐµÑ Ñайла в байÑаÑ
ATIME_NO => 8, # ÐÑÐµÐ¼Ñ Ð¿Ð¾Ñледнего доÑÑÑпа
MTIME_NO => 9, # ÐÑÐµÐ¼Ñ Ð¿Ð¾Ñледнего изменениÑ
CTIME_NO => 10, # ÐÑÐµÐ¼Ñ Ð¿Ð¾Ñледнего Ð¸Ð·Ð¼ÐµÐ½ÐµÐ½Ð¸Ñ inode
BLKSIZE_NO => 11, # Ð Ð°Ð·Ð¼ÐµÑ Ð±Ð»Ð¾ÐºÐ° ввода-вÑвода
BLOCKS_NO => 12, # ÐолиÑеÑÑво вÑделеннÑÑ
блоков
};
# ÐеÑнÑÑÑ Ð²ÑÐµÐ¼Ñ Ð¼Ð¾Ð´Ð¸ÑикаÑии Ñайла
sub mtime(;$) {
my ($file) = @_ == 0? $_: @_;
($file) = @$file if ref $file;
(Time::HiRes::stat $file)[MTIME_NO] // die "mtime $file: $!"
}
# ÐнÑоÑмаÑÐ¸Ñ Ð¾ Ñайле в виде Ñ
еÑа
sub sta(;$) {
my ($path) = @_ == 0? $_: @_;
($path) = @$path if ref $path;
my %sta = (path => $path);
@sta{qw/dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks/} = Time::HiRes::stat $path or die "sta $path: $!";
# @sta{qw/
# user_can_exec user_can_read user_can_write
# group_can_exec group_can_read group_can_write
# other_can_exec other_can_read other_can_write
# /} = (
#
# );
\%sta
}
# ФайловÑе ÑилÑÑÑÑ
sub _filters(@) {
map {
if(ref $_ eq "CODE") {$_}
elsif(ref $_ eq "Regexp") { my $re = $_; sub { $_ =~ $re } }
elsif(/^-([a-z]+)$/) {
eval join "", "sub { ", (join " && ", map "-$_()", split //, $1), " }"
}
else { my $re = wildcard(); sub { $_ =~ $re } }
} @_
}
# ÐайÑи ÑайлÑ
sub find(;@) {
my $files = @_? shift: $_;
$files = [$files] unless ref $files;
my @noenters; my $errorenter = sub {};
my $ex = @_ && ref($_[$#_]) eq 'Aion::Fs::Find'
? pop
: undef;
if($ex) {
bless $ex, 'Aion::Fs';
if(Scalar::Util::reftype $ex eq 'CODE') {
$errorenter = $ex;
} else {
$errorenter = bless pop @$ex, undef if Scalar::Util::reftype($ex->[$#$ex]) eq "CODE";
push @noenters, _filters @$ex;
}
}
my @filters = _filters @_;
my $iter = Aion::Fs::Find->new(
noenters => \@noenters,
errorenter => $errorenter,
filters => \@filters,
files => $files,
);
defined(wantarray)
? (wantarray? @$iter: $iter)
: do { while(defined $iter->next) {} };
}
# Ðе вÑ
одиÑÑ Ð² подкаÑалоги
sub noenter(@) {
bless [@_], "Aion::Fs::Find"
}
# ÐÑзÑваеÑÑÑ Ð´Ð»Ñ Ð²ÑеÑ
оÑибок ввода-вÑвода
sub errorenter(&) {
bless shift, "Aion::Fs::Find"
}
# ÐÑÑÐ°Ð½Ð°Ð²Ð»Ð¸Ð²Ð°ÐµÑ find бÑдÑÑи вÑзван Ñ Ð¾Ð´Ð½Ð¾Ð³Ð¾ из его ÑилÑÑÑов, errorenter или noenter
sub find_stop() {
die bless \(my $stop = 1), "Aion::Fs::Find"
}
# ÐÑÐ¾Ð¸Ð·Ð²Ð¾Ð´Ð¸Ñ Ð·Ð°Ð¼ÐµÐ½Ñ Ð²Ð¾ вÑеÑ
ÑказаннÑÑ
ÑайлаÑ
. ÐозвÑаÑÐ°ÐµÑ ÑÐ°Ð¹Ð»Ñ Ð² коÑоÑÑÑ
замен не бÑло
sub replace(&@) {
my $fn = shift;
my @noreplace; local $_; my $pkg = caller;
my $aref = "$pkg\::a"; my $bref = "$pkg\::b";
lib/Aion/Fs.pm view on Meta::CPAN
| (?<comma> , )
| .
}{
exists $+{file}? "[^/]*?":
exists $+{path}? ".*?":
exists $+{anyn}? "[^/]":
exists $+{any}? ".":
exists $+{w1}? "(":
exists $+{w2}? ")":
exists $+{comma}? "|":
quotemeta $&
}gxe;
qr/^$wildcard$/ns
}
# ÐÑкÑÑÐ²Ð°ÐµÑ Ñайл на Ñказанной ÑÑÑоке в ÑедакÑоÑе
use config EDITOR => "vscodium %p:%l";
sub goto_editor($$) {
my ($path, $line) = @_;
my $p = EDITOR;
$p =~ s!%p!$path!;
$p =~ s!%l!$line!;
my $status = system $p;
die "$path:$line --> $status" if $status;
return;
}
# Ðз пакеÑа в ÑайловÑй пÑÑÑ
sub from_pkg(;$) {
my ($pkg) = @_ == 0? $_: @_;
$pkg =~ s!::!/!g;
"$pkg.pm"
}
# Ðз Ñайлового пÑÑи в пакеÑ
sub to_pkg(;$) {
my ($path) = @_ == 0? $_: @_;
$path =~ s!\.\w+$!!;
$path =~ s!/!::!g;
$path
}
# Ðз пакеÑа в ÑайловÑй пÑÑÑ Ð¸Ð· @INC, Ð¿Ð°ÐºÐµÑ Ð½Ðµ подгÑÑжаеÑÑÑ
sub from_inc(;$) {
my ($pkg) = @_ == 0? $_: @_;
$pkg = from_pkg $pkg;
for my $dir (@INC) {
my $path = "$dir/$pkg";
return $path if -f $path;
}
return;
}
# Ðз Ñайлового пÑÑи в @INC в пакеÑ
sub to_inc(;$) {
my ($path) = @_ == 0? $_: @_;
my $inc = join "|", map quotemeta, @INC;
return to_pkg $' if $path =~ m!^(?:$inc)/!;
return;
}
# ÐодклÑÑÐ°ÐµÑ Ð¼Ð¾Ð´ÑлÑ, еÑли он еÑÑ Ð½Ðµ подклÑÑÑн, и возвÑаÑÐ°ÐµÑ ÐµÐ³Ð¾
sub include(;$) {
my ($pkg) = @_ == 0? $_: @_;
return $pkg if $pkg->can("new") || $pkg->can("has");
my $path = from_pkg $pkg;
return $pkg if exists $INC{$path};
require $path;
$pkg
}
1;
__END__
=encoding utf-8
=head1 NAME
Aion::Fs - utilities for the file system: reading, writing, searching, replacing files, etc.
=head1 VERSION
0.2.3
=head1 SYNOPSIS
use Aion::Fs;
lay mkpath "hello/world.txt", "hi!";
lay mkpath "hello/moon.txt", "noreplace";
lay mkpath "hello/big/world.txt", "hellow!";
lay mkpath "hello/small/world.txt", "noenter";
mtime "hello"; # ~> ^\d+(\.\d+)?$
[map cat, grep -f, find ["hello/big", "hello/small"]]; # --> [qw/ hellow! noenter /]
my @noreplaced = replace { s/h/$a $b H/ }
find "hello", "-f", "*.txt", qr/\.txt$/, sub { /\.txt$/ },
noenter "*small*",
errorenter { warn "find $_: $!" };
\@noreplaced; # --> ["hello/moon.txt"]
cat "hello/world.txt"; # => hello/world.txt :utf8 Hi!
cat "hello/moon.txt"; # => noreplace
cat "hello/big/world.txt"; # => hello/big/world.txt :utf8 Hellow!
cat "hello/small/world.txt"; # => noenter
[find "hello", "*.txt"]; # --> [qw! hello/moon.txt hello/world.txt hello/big/world.txt hello/small/world.txt !]
my @dirs;
my $iter = find "hello", "-d";
while(<$iter>) {
push @dirs, $_;
}
\@dirs; # --> [qw! hello hello/big hello/small !]
erase reverse find "hello";
-e "hello"; # -> undef
=head1 DESCRIPTION
This module makes it easier to use the file system.
Modules C<File::Path>, C<File::Slurper> and
C<File::Find> is burdened with various features that are rarely used, but require time to become familiar with and thereby increase the barrier to entry.
C<Aion::Fs> uses the KISS programming principle - the simpler the better!
The C<IO::All> supermodule is not a competitor to C<Aion::Fs>, because uses an OOP approach, and C<Aion::Fs> is FP.
=over
=item * OOP â object-oriented programming.
=item * FP â functional programming.
=back
=head1 SUBROUTINES/METHODS
=head2 cat ($file)
Reads the file. If no parameter is specified, use C<$_>.
cat "/etc/passwd" # ~> root
C<cat> reads with layer C<:utf8>. But you can specify another layer like this:
lay "unicode.txt", "â¯";
length cat "unicode.txt" # -> 1
lib/Aion/Fs.pm view on Meta::CPAN
=item * L<IO::All> â C<< io('file.txt') E<lt> $contents >>.
=item * L<IO::Util> â C<slurp \$contents, 'file.txt'>.
=item * L<File::Util> â C<< File::Util-E<gt>new-E<gt>write_file(file =E<gt> 'file.txt', content =E<gt> $contents, bitmask =E<gt> 0644) >>.
=item * L<Mojo::File> â C<< path($file)-E<gt>spew($chars, 'UTF-8') >>.
=back
=head2 find (;$path, @filters)
Recursively traverses and returns paths from the specified path or paths if C<$path> is an array reference. Without parameters, uses C<$_> as C<$path>.
Filters can be:
=over
=item * By subroutine - the path to the current file is passed to C<$_>, and the subroutine must return true or false, as understood by Perl.
=item * Regexp â tests each path with a regular expression.
=item * String in the form "-Xxx", where C<Xxx> is one or more characters. Similar to Perl operators for testing files. Example: C<-fr> checks the path with file testers LLL<https://perldoc.perl.org/functions/-X>.
=item * The remaining lines are turned by the C<wildcard> function (see below) into a regular expression to test each path.
=back
Paths that fail the C<@filters> check are not returned.
If the -X filter is not a perl file function, an exception is thrown:
eval { find "example", "-h" }; $@ # ~> Undefined subroutine &Aion::Fs::h called
In this example, C<find> cannot enter the subdirectory and passes an error to the C<errorenter> function (see below) with the C<$_> and C<$!> variables set (to the directory path and the OS error message).
B<Attention!> If C<errorenter> is not specified, then all errors are B<ignored>!
mkpath ["example/", 0];
[find "example"] # --> ["example"]
[find "example", noenter "-d"] # --> ["example"]
eval { find "example", errorenter { die "find $_: $!" } }; $@ # ~> find example: Permission denied
mkpath for qw!ex/1/11 ex/1/12 ex/2/21 ex/2/22!;
my $count = 0;
find "ex", sub { find_stop if ++$count == 3; 1};
$count # -> 3
=head3 See also
=over
=item * L<AudioFile::Find> â searches for audio files in the specified directory. Allows you to filter them by attributes: title, artist, genre, album and track.
=item * L<Directory::Iterator> â C<< $it = Directory::Iterator-E<gt>new($dir, %opts); push @paths, $_ while E<lt>$itE<gt> >>.
=item * L<IO::All> â C<< @paths = map { "$_" } grep { -f $_ && $_-E<gt>size E<gt> 10*1024 } io(".")-E<gt>all(0) >>.
=item * L<IO::All::Rule> â C<< $next = IO::All::Rule-E<gt>new-E<gt>file-E<gt>size("E<gt>10k")-E<gt>iter($dir1, $dir2); push @paths, "$f" while $f = $next-E<gt>() >>.
=item * L<File::Find> â C<find( sub { push @paths, $File::Find::name if /\.png/ }, $dir )>.
=item * L<File::Find::utf8> â like L<File::Find>, only file paths are in I<utf8>.
=item * L<File::Find::Age> â sorts files by modification time (inherits L<File::Find::Rule>): C<< File::Find::Age-E<gt>in($dir1, $dir2) >>.
=item * L<File::Find::Declare> â C<< @paths = File::Find::Declare-E<gt>new({ size =E<gt> 'E<gt>10K', perms =E<gt> 'wr-wr-wr-', modified =E<gt> 'E<lt>2010-01-30', recurse =E<gt> 1, dirs =E<gt> [$dir1] })-E<gt>find >>.
=item * L<File::Find::Iterator> â has an OOP interface with an iterator and the C<imap> and C<igrep> functions.
=item * L<File::Find::Match> â calls a handler for each matching filter. Similar to C<switch>.
=item * L<File::Find::Node> â traverses the file hierarchy in parallel by several processes: C<< tie @paths, IPC::Shareable, { key =E<gt> "GLUE STRING", create =E<gt> 1 }; File::Find::Node-E<gt>new(".")-E<gt>process(sub { my $f = shift; $f-E<gt>for...
=item * L<File::Find::Fast> â C<@paths = @{ find($dir) }>.
=item * L<File::Find::Object> â has an OOP interface with an iterator.
=item * L<File::Find::Parallel> â can compare two directories and return their union, intersection and quantitative intersection.
=item * L<File::Find::Random> â selects a file or directory at random from the file hierarchy.
=item * L<File::Find::Rex> â C<< @paths = File::Find::Rex-E<gt>new(recursive =E<gt> 1, ignore_hidden =E<gt> 1)-E<gt>query($dir, qr/^b/i) >>.
=item * L<File::Find::Rule> â C<< @files = File::Find::Rule-E<gt>any( File::Find::Rule-E<gt>file-E<gt>name('*.mp3', '*.ogg')-E<gt>size('E<gt>2M'), File::Find::Rule-E<gt>empty )-E<gt>in($dir1, $dir2); >>. Has an iterator, procedural interface and ex...
=item * L<File::Find::Wanted> â C<@paths = find_wanted( sub { -f && /\.png/ }, $dir )>.
=item * L<File::Hotfolder> â C<< watch( $dir, callback =E<gt> sub { push @paths, shift } )-E<gt>loop >>. Powered by C<AnyEvent>. Customizable. There is parallelization into several processes.
=item * L<File::Mirror> â also forms a parallel path for copying files: C<recursive { my ($src, $dst) = @_; push @paths, $src } '/path/A', '/path/B'>.
=item * L<File::Set> â C<< $fs = File::Set-E<gt>new; $fs-E<gt>add($dir); @paths = map { $_-E<gt>[0] } $fs-E<gt>get_path_list >>.
=item * L<File::Wildcard> â C<< $fw = File::Wildcard-E<gt>new(exclude =E<gt> qr/.svn/, case_insensitive =E<gt> 1, sort =E<gt> 1, path =E<gt> "src///*.cpp", match =E<gt> qr(^src/(.*?)\.cpp$), derive =E<gt> ['src/$1.o','src/$1.hpp']); push @paths, $f...
=item * L<File::Wildcard::Find> â C<findbegin($dir); push @paths, $f while $f = findnext()> or C<findbegin($dir); @paths = findall()>.
=item * L<File::Util> â C<< File::Util-E<gt>new-E<gt>list_dir($dir, qw/ --pattern=\.txt$ --files-only --recurse /) >>.
=item * L<Mojo::File> â C<< say for path($path)-E<gt>list_tree({hidden =E<gt> 1, dir =E<gt> 1})-E<gt>each >>.
=item * L<Path::Find> â C<@paths = path_find( $dir, "*.png" )>. For complex queries, use I<matchable>: C<< my $sub = matchable( sub { my( $entry, $directory, $fullname, $depth ) = @_; $depth E<lt>= 3 } >>.
=item * L<Path::Extended::Dir> â C<< @paths = Path::Extended::Dir-E<gt>new($dir)-E<gt>find('*.txt') >>.
=item * L<Path::Iterator::Rule> â C<< $i = Path::Iterator::Rule-E<gt>new-E<gt>file; @paths = $i-E<gt>clone-E<gt>size("E<gt>10k")-E<gt>all(@dirs); $i-E<gt>size("E<lt>10k")... >>.
=item * L<Path::Class::Each> â C<< dir($dir)-E<gt>each(sub { push @paths, "$_" }) >>.
=item * L<Path::Class::Iterator> â C<< $i = Path::Class::Iterator-E<gt>new(root =E<gt> $dir, depth =E<gt> 2); until ($i-E<gt>done) { push @paths, $i-E<gt>next-E<gt>stringify } >>.
=item * L<Path::Class::Rule> â C<< @paths = Path::Class::Rule-E<gt>new-E<gt>file-E<gt>size("E<gt>10k")-E<gt>all($dir) >>.
=back
=head2 noenter (@filters)
Tells C<find> not to enter directories matching the filters behind it.
=head2 errorenter (&block)
Calls C<&block> for every error that occurs when a directory cannot be entered.
=head2 find_stop ()
Stops C<find> being called in one of its filters, C<errorenter> or C<noenter>.
my $count = 0;
find "ex", sub { find_stop if ++$count == 3; 1};
$count # -> 3
=head2 erase (@paths)
Removes files and empty directories. Returns C<@paths>. If there is an I/O error, it throws an exception.
eval { erase "/" }; $@ # ~> erase dir /: Device or resource busy
eval { erase "/dev/null" }; $@ # ~> erase file /dev/null: Permission denied
=head3 See also
=over
=item * C<unlink> + C<rmdir>.
=item * L<File::Path> â C<remove_tree("dir")>.
=item * L<File::Path::Tiny> â C<File::Path::Tiny::rm($path)>. Does not throw exceptions.
=item * L<Mojo::File> â C<< path($file)-E<gt>remove >>.
=back
lib/Aion/Fs.pm view on Meta::CPAN
OS names are case insensitive.
local $_ = ">x>y>z.doc.zip";
transpath "vos", "unix" # \> /x/y/z.doc.zip
transpath "vos", "VMS" # \> [.x.y]z.doc.zip
transpath $_, "vos", "RiscOS" # \> .x.y.z/doc/zip
=head2 splitdir (;$dir)
Splits a directory into components. The directory should first be obtained from C<< path-E<gt>{dir} >>.
local $^O = "unix";
[ splitdir "/x/" ] # --> ["", "x", ""]
=head2 joindir (;$dirparts)
Combines a directory from its components. The resulting directory should then be included in C<< path +{dir =E<gt> $dir} >>.
local $^O = "unix";
joindir qw/x y z/ # => x/y/z
path +{ dir => joindir qw/x y z/ } # => x/y/z/
=head2 splitext (;$ext)
Breaks the extension into its components. The extension should first be obtained from C<< path-E<gt>{ext} >>.
local $^O = "unix";
[ splitext ".x." ] # --> ["", "x", ""]
=head2 joinext (;$extparts)
Combines an extension from its components. The resulting extension should then be included in C<< path +{ext =E<gt> $ext} >>.
local $^O = "unix";
joinext qw/x y z/ # => x.y.z
path +{ ext => joinext qw/x y z/ } # => .x.y.z
=head2 include (;$pkg)
Connects C<$pkg> (if it has not already been connected via C<use> or C<require>) and returns it. Without a parameter, uses C<$_>.
lib/A.pm file:
package A;
sub new { bless {@_}, shift }
1;
lib/N.pm file:
package N;
sub ex { 123 }
1;
use lib "lib";
include("A")->new # ~> A=HASH\(0x\w+\)
[map include, qw/A N/] # --> [qw/A N/]
{ local $_="N"; include->ex } # -> 123
=head2 catonce (;$file)
Reads the file for the first time. Any subsequent attempt to read this file returns C<undef>. Used to insert js and css modules into the resulting file. Without a parameter, uses C<$_>.
=over
=item * C<$file> can contain arrays of two elements. The first is considered as a path, and the second as a layer. The default layer is C<:utf8>.
=item * If C<$file> is not specified, use C<$_>.
=back
local $_ = "catonce.txt";
lay "result";
catonce # -> "result"
catonce # -> undef
eval { catonce[] }; $@ # ~> catonce not use ref path!
=head2 wildcard (;$wildcard)
Converts a file mask to a regular expression. Without a parameter, uses C<$_>.
=over
=item * C<**> - C<[^/]*>
=item * C<*> - C<.*>
=item * C<?> - C<.>
=item * C<??> - C<[^/]>
=item * C<{> - C<(>
=item * C<}> - C<)>
=item * C<,> - C<|>
=item * Other characters are escaped using C<quotemeta>.
=back
wildcard "*.{pm,pl}" # \> (?^usn:^.*?\.(pm|pl)$)
wildcard "?_??_**" # \> (?^usn:^._[^/]_[^/]*?$)
Used in filters of the C<find> function.
=head3 See also
=over
=item * L<File::Wildcard>.
=item * L<String::Wildcard::Bash>.
=item * L<Text::Glob> â C<glob_to_regex("*.{pm,pl}")>.
=back
=head2 goto_editor ($path, $line)
Opens the file in the editor from .config at the specified line. Defaults to C<vscodium %p:%l>.
.config.pm file:
package config;
config_module 'Aion::Fs' => {
EDITOR => 'echo %p:%l > ed.txt',
};
1;
goto_editor "mypath", 10;
cat "ed.txt" # => mypath:10\n
eval { goto_editor "`", 1 }; $@ # ~> `:1 --> 512
=head2 from_pkg (;$pkg)
Transfers the packet to the FS path. Without a parameter, uses C<$_>.
from_pkg "Aion::Fs" # => Aion/Fs.pm
[map from_pkg, "Aion::Fs", "A::B::C"] # --> ["Aion/Fs.pm", "A/B/C.pm"]
=head2 to_pkg (;$path)
Translates the path from the FS to the package. Without a parameter, uses C<$_>.
to_pkg "Aion/Fs.pm" # => Aion::Fs
[map to_pkg, "Aion/Fs.md", "A/B/C.md"] # --> ["Aion::Fs", "A::B::C"]
=head2 from_inc (;$pkg)
Translates the packet to the FS path in C<@INC>. The package file must exist in one of the C<@INC> paths. Without a parameter, uses C<$_>.
from_inc "Aion::Fs" # -> $INC{'Aion/Fs.pm'}
[map from_inc, "A::B::C", "Aion::Fs"] # --> [$INC{'Aion/Fs.pm'}]
from_inc "A::B::C" # -> undef
=head2 to_inc (;$path)
Translates the path from FS to C<@INC> into a package. Without a parameter, uses C<$_>.
to_inc $INC{'Aion/Fs.pm'} # => Aion::Fs
[map to_inc,"A/B/C.pm", $INC{'Aion/Fs.pm'}] # --> ["Aion::Fs"]
to_inc 'Aion/Fs.pm' # -> undef
=head2 ilay (;$path)
Creates a file descriptor. It knows how to close as soon as the last link to it disappears.
It also has a C<path> method, which returns the path to the file.
my $test_file = "test_ilay_complete.txt";
my $f = ilay $test_file;
print $f "Line 1\n";
print $f "Line 2\n";
my $std = select $f; $| = 1; select $std;
-s $f # -> 14
$f->path # => test_ilay_complete.txt
fileno($f) > 0 # -> 1
undef $f;
cat $test_file # => Line 1\nLine 2\n
local $_ = [$test_file, ':raw'];
my $f = ilay;
my $str = "string";
my $num = 42;
my $end = "END";
*FD = *$f{IO};
format FD =
@<<<<<<<< @||||| @>>>>>
$str, $num, $end
.
write FD;
$str = 'int';
write FD;
undef *FD;
undef $f;
my $table = << 'TABLE';
string 42 END
int 42 END
TABLE
cat $test_file # -> $table
=head3 See also
=over
=item * LLL<https://perldoc.perl.org/IO::Handle>.
( run in 2.063 seconds using v1.01-cache-2.11-cpan-0d23b851a93 )