view release on metacpan or  search on metacpan

Prima/sys/FS.pm  view on Meta::CPAN

	return @pats;
}

sub lstat { Prima::Utils::stat($_[0], 1) }

sub __x(&$) {
	my @p = Prima::Utils::stat($_[1]);
	return undef unless scalar @p;
	$_[0]->(@p);
}

sub __f($$) {
	no strict 'refs';
	my @p = Prima::Utils::stat($_[1]);
	return undef unless scalar @p;
	return undef unless ${'Fcntl::'}{$_[0]};
	my $c = Fcntl->can($_[0])->();
	return (($c & $p[2]) == $c) ? 1 : 0;
}

sub _l ($) {
	no strict 'refs';
	my @p = Prima::Utils::stat($_[1], 1);
	return undef unless scalar @p;
	return undef unless ${'Fcntl::'}{S_IFLNK};
	my $c = Fcntl->can('S_IFLNK')->();
	return (($c & $p[2]) == $c) ? 1 : 0;
}

sub _r ($) { access($_[0], 4, 1) >= 0 }
sub _w ($) { access($_[0], 2, 1) >= 0 }
sub _x ($) { access($_[0], 1, 1) >= 0 }
sub _o ($) { __x sub { $> == $_[4] }, $_[0] }
sub _R ($) { access($_[0], 4, 0) >= 0 }
sub _W ($) { access($_[0], 2, 0) >= 0 }
sub _X ($) { access($_[0], 1, 0) >= 0 }
sub _O ($) { __x sub { $< == $_[4] }, $_[0] }
sub _e ($) { __x sub { 1 }, $_[0] }
sub _z ($) { __x sub { 0  == $_[7] }, $_[0] }
sub _s ($) { __x sub { $_[7] }, $_[0] }
sub _f ($) { __f S_IFREG  => $_[0] }
sub _d ($) { __f S_IFDIR  => $_[0] }
sub _p ($) { __f S_IFFIFO => $_[0] }
sub _S ($) { __f S_IFSOCK => $_[0] }
sub _b ($) { __f S_IFBLK  => $_[0] }
sub _c ($) { __f S_IFCHR  => $_[0] }
sub _t ($) { -t $_[0] }
sub _u ($) { __f S_ISUID  => $_[0] }
sub _g ($) { __f S_ISGID  => $_[0] }
sub _k ($) { __f S_ISVTX  => $_[0] }
sub _A ($) { __x sub { ( time - $_[8]  ) / 86400 }, $_[0] }
sub _M ($) { __x sub { ( time - $_[9]  ) / 86400 }, $_[0] }
sub _C ($) { __x sub { ( time - $_[10] ) / 86400 }, $_[0] }

# adapted from Cwd.pm
sub abs_path
{
	unless ( $^O =~ /win32|cygwin/i ) {
		require Cwd;
		my $p = $_[0];
		my $was_utf8 = Encode::is_utf8($p);
		$p = Cwd::abs_path($p);
		$p = Encode::decode('utf-8', $p) if $was_utf8;
		return $p;
	}

	my $cwd = Prima::Utils::getcwd();
	defined $cwd or return undef;

	my $path = @_ ? shift : '.';
	unless (_e $path) {
		require Errno;
		$! = Errno::ENOENT();
		return undef;
	}

	unless (_d $path) {
		# Make sure we can be invoked on plain files, not just directories.
		require File::Spec;
		my ($vol, $dir, $file) = File::Spec->splitpath($path);
		return File::Spec->catfile($cwd, $path) unless length $dir;

		return $dir eq File::Spec->rootdir
			? File::Spec->catpath($vol, $dir, $file)
			: abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
	}

	return undef unless Prima::Utils::chdir($path);
	my $realpath = Prima::Utils::getcwd();
	if (! ((_d $cwd) && (Prima::Utils::chdir($cwd)))) {
		croak("Cannot chdir back to $cwd: $!");
	}

	return $realpath;
}

1;

=pod

=head1 NAME

Prima::sys::FS - unicode-aware core file functions

=head1 DESCRIPTION

Since perl win32 unicode support for files is unexistent, Prima has its own
parallel set of functions mimicking native functions, ie open, chdir etc. This
means that files with names that cannot be converted to ANSI (ie
user-preferred) codepage are not visible in perl, but the functions below
mitigate that problem.

This module exports the unicode-aware functions from C<Prima::Utils> to override
the core functions. Read more in L<Prima::Utils/"Unicode-aware file system functions">.

=head2 SYNOPSIS

  use Prima::sys::FS;

  my $fn = "\x{dead}\x{beef};
  if ( _f $fn ) {
     open F, ">", $fn or die $!;
     close F;