view release on metacpan or  search on metacpan

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

NATIVE:
	goto &CORE::open;
}

sub opendir(*$)
{
	if ( readonly($_[0])) {
		warn "Prima::sys::FS::opendir: cannot be use on filehandles, variables only\n";
		return;
	}
	$_[0] = open_dir( $_[1] );
	return defined $_[0];
}

sub readdir($)
{
	my $dh = shift;

	if ( wantarray ) {
		my @ret;
		while ( defined( my $f = read_dir($dh)) ) {
			push @ret, $f;
		}
		return @ret;
	} else {
		return read_dir($dh);
	}
}

sub glob
{
	my $pat = shift;
	my @pats;
	while ( 1 ) {
		$pat =~ m/\G"((?:[^"]|\\")*)(?<!\\)"/gcs and push @pats, $1 and next;
		$pat =~ m/\G'((?:[^']|\\')*)(?<!\\)'/gcs and push @pats, $1 and next;
		$pat =~ m/\G((?:\S|\\\s)+)/gcs and push @pats, $1 and next;
		$pat =~ m/\G\s+/gcs and next;
		$pat =~ m/\G$/gcs and last;
	}
	my @matches = @pats;
	@pats = ();
	my $win32 = $^O =~ /win32/i;
	MATCH: while ( my $q = shift @matches ) {
		if ( $q =~ m/^(.*)\{([^}]*)\}(.*)$/ ) {
			my ( $pre, $subpat, $post ) = ( $1, $2, $3 );
			push @matches, map { "$pre$_$post" } split /,/, $subpat;
		} elsif ( $q =~ m/^(.*)\[([^\]]*)\](.*)$/ ) {
			my ( $pre, $subpat, $post ) = ( $1, $2, $3 );
			push @matches, map { "$pre$_$post" } split //, $subpat;
		} elsif ( $q =~ m/^~(\w*)(.*)/ ) {
			my @pwent;
			unless ( length $1 ) {
				push @matches, ($ENV{HOME} // ($win32 ? $ENV{USERPROFILE} : undef) // '/' ) . $2;
			} elsif (!$win32 && (@pwent = getpwnam($1)) && defined($pwent[7])) {
				push @matches, $pwent[7] .  $2;
			}
		} elsif ( $q =~ m/(?<!\\)\*|\?/ ) {
			my @paths = ('');
			my $expanded;
			for my $subpath ( split m{(/)}, $q ) {
				if ( !$expanded && $subpath =~ m/(?<!\\)\*|\?/ ) {
					$subpath =~ s/(?<!\\)\*/.*/g;
					$subpath =~ s/(?<!\\)\?/./g;
					$subpath = qr/$subpath/;
					next MATCH unless Prima::sys::FS::opendir( my $dh, length($paths[0]) ? $paths[0] : '.' );
					my $opath = pop @paths;
					for my $e ( Prima::sys::FS::readdir $dh ) {
						next unless $e =~ /^$subpath$/;
						push @paths, $opath . $e;
					}
					Prima::Utils::closedir $dh;
					$expanded++;
				} else {
					$_ .= $subpath for @paths;
				}
			}
			push @matches, @paths;
		} elsif (_e($q)) {
			push @pats, $q;
		}
	}

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