Aion-Fs
1 match

 view release on metacpan or  search on metacpan

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

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

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

			? %+
			: 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);

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

				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;

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

			};
			
			mkdir $cat, $permission or ($! != FILE_EXISTS? die "mkpath $cat: $!": ());
		}
	}
	
	$path
}

# Считывает файл
sub cat(;$) {
    my ($file) = @_ == 0? $_: @_;
	my $layer = ":utf8";
	($file, $layer) = @$file if ref $file;
	open my $f, "<$layer", $file or die "cat $file: $!";
	read $f, my $x, -s $f;
	close $f;
	$x
}

# записать файл

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

	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 $file = @_? shift: $_;
    $file = [$file] unless ref $file;

	my @noenters; my $errorenter = sub {};
	my $ex = @_ && ref($_[$#_]) =~ /^Aion::Fs::(noenter|errorenter)\z/ ? pop: undef;

	if($ex) {
		if($1 eq "errorenter") {
			$errorenter = $ex;
		} else {

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

	};
	
	if($@) {
		die if ref $@ ne "Aion::Fs::stop";
	}

	wantarray? @ret: $count
}

# Не входить в подкаталоги
sub noenter(@) {
	bless [@_], "Aion::Fs::noenter"
}

# Вызывается для всех ошибок ввода-вывода
sub errorenter(&) {
	bless shift, "Aion::Fs::errorenter"
}

# Останавливает find будучи вызван с одного из его фильтров, errorenter или noenter
sub find_stop() {
	die bless {}, "Aion::Fs::stop"
}

# Производит замену во всех указанных файлах. Возвращает файлы в которых замен не было
sub replace(&@) {
    my $fn = shift;
	my @noreplace; local $_; my $pkg = caller;
	my $aref = "${pkg}::a";	my $bref = "${pkg}::b";
    for $$aref (@_) {
		if(ref $$aref) { ($$aref, $$bref) = @$$aref } else { $$bref = ":utf8" }
        my $file = $_ = cat [$$aref, $$bref];
        $fn->();
		if($file ne $_) { lay [$$aref, $$bref], $_ } else { push @noreplace, $$aref if defined wantarray }
    }
	@noreplace
}

# Стирает все указанные файлы. Возвращает переданные файлы
sub erase(@) {
    -d? rmdir: unlink or die "erase ${\(-d? 'dir': 'file')} $_: $!" for @_;
	@_
}

# Переводит вилдкард в регулярку
sub wildcard(;$) {
	my ($wildcard) = @_;
	$wildcard = $_ if @_ == 0;
	$wildcard =~ s{
		(?<file> \*\*)
		| (?<path> \*)
		| (?<anyn> \?\? )
		| (?<any> \? )
		| (?<w1> \{ )
		| (?<w2> \} )
		| (?<comma> , )

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

		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
}

# Подключает модуль, если он ещё не подключён, и возвращает его
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;



( run in 0.236 second using v1.01-cache-2.11-cpan-cba739cd03b )