view release on metacpan or  search on metacpan

lib/Path/Abstract/Underload.pm  view on Meta::CPAN

	my $path = join '/', @_;
    my $trailing = $path && substr($path, -1) eq '/';

	# From File::Spec::Unix::canonpath
	$path =~ s|/{2,}|/|g;				# xx////xx  -> xx/xx
	$path =~ s{(?:/\.)+(?:/|\z)}{/}g;		# xx/././xx -> xx/xx
	$path =~ s|^(?:\./)+||s unless $path eq "./";	# ./xx      -> xx
	$path =~ s|^/(?:\.\./)+|/|;			# /../../xx -> xx
	$path =~ s|^/\.\.$|/|;				# /..       -> /
	$path =~ s|/\z|| unless $path eq "/";		# xx/       -> xx
	$path .= '/' if $path ne "/" && $trailing;

	$path =~ s/^\/+// unless $leading;
	return $path;
}

sub set {
	my $self = shift;
	$$self = _canonize @_;
	return $self;
}

sub is_empty {
	my $self = shift;
	return $$self eq "";
}
for (qw(is_nil)) { no strict 'refs'; *$_ = \&is_empty }

sub is_root {
	my $self = shift;
	return $$self eq "/";
}

sub is_tree {
	my $self = shift;
	return substr($$self, 0, 1) eq "/";
}

sub is_branch {
	my $self = shift;
    Path::Abstract->_0_093_warn if $Path::Abstract::_0_093_warn;
#    return $$self && substr($$self, 0, 1) ne "/";
    return ! $$self || substr($$self, 0, 1) ne "/";
}

sub to_tree {
	my $self = shift;
	$$self = "/$$self" unless $self->is_tree;
	return $self;
}

sub to_branch {
	my $self = shift;
	$$self =~ s/^\///;
	return $self;
}

sub list {
	my $self = shift;
    Path::Abstract->_0_093_warn if $Path::Abstract::_0_093_warn;
    return grep { length $_ } split m/\//, $$self;
}
for (qw()) { no strict 'refs'; *$_ = \&list }

sub split {
    my $self = shift;
    Path::Abstract->_0_093_warn if $Path::Abstract::_0_093_warn;
    my @split = split m/(?<=.)\/(?=.)/, $$self;
    return @split;
}

sub first {
	my $self = shift;
    Path::Abstract->_0_093_warn if $Path::Abstract::_0_093_warn;
    return $self->at(0);
}

sub last {
	my $self = shift;
    Path::Abstract->_0_093_warn if $Path::Abstract::_0_093_warn;
    return $self->at(-1);
}

sub at {
    my $self = shift;
    return '' if $self->is_empty;
    my @path = split '/', $$self;
    return '' if 1 == @path && '' eq $path[0];
    my $index = shift;
    if (0 > $index) {
        $index += @path;
    }
    elsif (! defined $path[0] || ! length $path[0]) {
        $index += 1
    }
    return '' if $index >= @path;
    $index -= 1 if $index == @path - 1 && ! defined $path[$index] || ! length $path[$index];
    return '' unless defined $path[$index] && length $path[$index];
    return $path[$index];
}

sub beginning {
    my $self = shift;
    my ($beginning) = $$self =~ m{^(\/?[^/]*)};
    return $beginning;
}

sub ending {
    my $self = shift;
    my ($ending) = $$self =~ m{([^/]*\/?)$};
    return $ending;
}

sub get {
	my $self = shift;
	return $$self;
}
for (qw(path stringify)) { no strict 'refs'; *$_ = \&get }

sub push {
	my $self = shift;
	$$self = _canonize $$self, @_;
	return $self;
}
for (qw(down)) { no strict 'refs'; *$_ = \&push }

sub child {
	my $self = shift;