Aion-Fs
6 results

 view release on metacpan or  search on metacpan

lib/Aion/Fs.pm  view on Meta::CPAN 

package Aion::Fs;

use common::sense;

our $VERSION = "0.2.4";

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 = (

lib/Aion/Fs.pm  view on Meta::CPAN 

		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};
	}

lib/Aion/Fs.pm  view on Meta::CPAN 


=back

In the example below, the file "replace.ex" is read by the C<:utf8> layer and written by the C<:raw> layer in the C<replace> function:

	local $_ = "replace.ex";
	lay "abc";
	replace { $b = ":utf8"; y/a/¡/ } [$_, ":raw"];
	cat  # => ¡bc

=head3 See also

=over

=item * L<File::Edit> – C<< File::Edit-E<gt>new($file)-E<gt>replace('x', 'y')-E<gt>save >>.

=item * L<File::Edit::Portable> – C<< File::Edit::Portable-E<gt>new-E<gt>splice(file =E<gt> $file, line =E<gt> 10, contens =E<gt> ["line1", "line2"]) >>.

=item * L<File::Replace> – C<< ($infh,$outfh,$repl) = replace3($file); while (E<lt>$infhE<gt>) { print $outfh "X: $_" } $repl-E<gt>finish >>.

=item * L<File::Replace::Inplace>.

=back

=head2 mkpath (;$path)

Like B<mkdir -p>, but considers the last part of the path (after the last slash) to be a filename and does not create it as a directory. Without a parameter, uses C<$_>.

=over

=item * If C<$path> is not specified, use C<$_>.

=item * If C<$path> is an array reference, then the path is used as the first element and rights as the second element.

=item * Default permissions are C<0755>.

=item * Returns C<$path>.

=back

	local $_ = ["A", 0755];
	mkpath   # => A
	
	eval { mkpath "/A/" }; $@   # ~> mkpath /A: Permission denied
	
	mkpath "A///./file";
	-d "A"  # -> 1

=head3 See also

=over

=item * L<File::Path> – C<mkpath("dir1/dir2")>.

=item * L<File::Path::Tiny> – C<File::Path::Tiny::mk($path)>. Does not throw exceptions.

=back

=head2 mtime (;$path)

Modification time of C<$path> in unixtime with fractional part (from C<Time::HiRes::stat>). Without a parameter, uses C<$_>.

Throws an exception if the file does not exist or does not have permission:

	local $_ = "nofile";
	eval { mtime }; $@  # ~> mtime nofile: No such file or directory
	
	mtime ["/"]   # ~> ^\d+(\.\d+)?$

=head3 See also

=over

=item * C<-M> – C<-M "file.txt">, C<-M _> in days from the current time.

=item * L<stat> – C<(stat "file.txt")[9]> in seconds (unixtime).

=item * L<Time::HiRes> – C<(Time::HiRes::stat "file.txt")[9]> in seconds with fractional part.

=item * L<Mojo::File> – C<< path($file)-E<gt>stat-E<gt>mtime >>.

=back

=head2 sta (;$path)

Returns statistics about the file. Without a parameter, uses C<$_>.

To be used with other file functions, it can receive a reference to an array from which it takes the first element as the file path.

Throws an exception if the file does not exist or does not have permission:

	local $_ = "nofile";
	eval { sta }; $@  # ~> sta nofile: No such file or directory
	
	sta(["/"])->{ino} # ~> ^\d+$
	sta(".")->{atime} # ~> ^\d+(\.\d+)?$

=head3 See also

=over

=item * L<Fcntl> – contains constants for mode recognition.

=item * L<BSD::stat> - optionally returns atime, ctime and mtime in nanoseconds, user flags and file generation number. Has an OOP interface.

=item * L<File::chmod> – C<chmod("o=,g-w","file1","file2")>, C<@newmodes = getchmod("+x","file1","file2")>.

=item * L<File::stat> – provides an OOP interface to stat.

=item * L<File::Stat::Bits> - similar to L<Fcntl>.

=item * L<File::stat::Extra> – extends L<File::stat> methods to obtain information about the mode, and also reloads B<-X>, B<< <=> >>, B<cmp> and B<~~> operators and is stringified.

=item * L<File::Stat::Ls> – returns the mode in the format of the ls utility.

=item * L<File::Stat::Moose> – OOP interface for Moose.

=item * L<File::Stat::OO> – provides an OOP interface to stat. Can return atime, ctime and mtime at once in C<DateTime>.

=item * L<File::Stat::Trigger> – monitors changes in file attributes.

=item * L<Linux::stat> – parses /proc/stat and returns additional information. However, it does not work on other OSes.

=item * L<Stat::lsMode> – returns the mode in the ls utility format.

=item * L<VMS::Stat> - returns VMS ACLs.

=back

=head2 path (;$path)

Splits a file path into its components or assembles it from its components.

=over

=item * If it receives a reference to an array, it treats its first element as a path.

lib/Aion/Fs.pm  view on Meta::CPAN 

	        dir    => "::::mix:",
	        folder => ":::mix",
	        file   => "report.doc",
	        name   => "report",
	        ext    => "doc",
	    };
	
	    path $path->{path} # --> $path
	    path $path         # => $path->{path}
	
	    path 'report' # --> {path => 'report', file => 'report', name => 'report'}
	
	    path {volume => "x", file => "f"} # => x:f
	    path {folder => "x"} # => x:
	}
	
	{
	    local $^O = "vmesa";
	
	    my $path = {
	        path   => ' USERID   FILE EXT   VOLUME ',
	        userid => "USERID",
	        file   => "FILE EXT",
	        name   => "FILE",
	        ext    => "EXT",
	        volume => "VOLUME",
	    };
	
	    path $path->{path} # --> $path
	
	    path {volume => "x", file => "f"} # -> ' f  x'
	}
	

=head3 See also

=over

=item * https://en.wikipedia.org/wiki/Path_(computing)

=back

Modules for determining the OS, and therefore determining what file paths are in the OS:

=over

=item * C<$^O> – superglobal variable with the name of the current OS.

=item * L<Devel::CheckOS>, L<Perl::OSType> – define the OS.

=item * L<Devel::AssertOS> – prohibits the use of the module outside the specified OS.

=item * L<System::Info> – information about the OS, its version, distribution, CPU and host.

=back

Parts of file paths are distinguished:

=over

=item * L<File::Spec> – C<< ($volume, $directories, $file) = File::Spec-E<gt>splitpath($path) >>. Only supports unix, win32, os/2, vms, cygwin and amigaos.

=item * L<File::Spec::Functions> - C<($volume, $directories, $file) = splitpath($path)>.

=item * L<File::Spec::Mac> - included in L<File::Spec>, but not defined by it, so it has to be used separately. For mac os version 9.

=item * L<File::Basename> – C<($name, $path, $suffix) = fileparse($fullname, @suffixlist)>.

=item * L<Path::Class::File> – C<< file('foo', 'bar.txt')-E<gt>is_absolute >>.

=item * L<Path::Extended::File> – C<< Path::Extended::File-E<gt>new($file)-E<gt>basename >>.

=item * L<Mojo::File> – C<< path($file)-E<gt>extname >>.

=item * L<Path::Util> - C<$filename = basename($dir)>.

=item * L<Parse::Path> – C<< Parse::Path-E<gt>new(path =E<gt> 'gophers[0].food.count', style =E<gt> 'DZIL')-E<gt>push("chunk") >>. Works with paths as arrays (C<push>, C<pop>, C<shift>, C<splice>). It also overloads comparison operators. It has sty...

=back

=head2 transpath ($path?, $from, $to)

Converts a path from one OS format to another.

If C<$path> is not specified, C<$_> is used.

For a list of supported operating systems, see the examples of the C<path> subroutine just above or like this: C<keys %Aion::Fs::FS>.

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<[^/]>



( run in 1.700 second using v1.01-cache-2.11-cpan-df04353d9ac )