File Coverage

blib/lib/Path/Naive.pm

Criterion	Covered	Total	%
statement	47	47	100.0
branch	30	32	93.7
condition	26	30	86.6
subroutine	10	10	100.0
pod	7	7	100.0
total	120	126	95.2

package Path::Naive;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2020-02-07'; # DATE
our $DIST = 'Path-Naive'; # DIST
our $VERSION = '0.042'; # VERSION

use strict;
use warnings;

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
    abs_path
    concat_path
    concat_and_normalize_path
    normalize_path
    is_abs_path
    is_rel_path
    split_path
);

sub abs_path {
    my ($path, $base) = @_;

    die "Please specify path (first arg)" unless defined $path && length $path;
    die "Please specify base (second arg)" unless defined $base && length $base;
    die "base must be absolute" unless is_abs_path($base);
    concat_and_normalize_path($base, $path);
}

sub is_abs_path {
    my $path = shift;
    die "Please specify path" unless defined $path && length $path;
    $path =~ m!\A/! ? 1:0;
}

sub is_rel_path {
    my $path = shift;
    die "Please specify path" unless defined $path && length $path;
    $path =~ m!\A/! ? 0:1;
}

sub normalize_path {
    my $path = shift;
    my @elems0 = split_path($path);
    my $is_abs = $path =~ m!\A/!;
    my @elems;
    while (@elems0) {
        my $elem = shift @elems0;
        next if $elem eq '.' && (@elems || @elems0 || $is_abs);
        do { pop @elems; next } if $elem eq '..' &&
            (@elems>1 && $elems[-1] ne '..' ||
                 @elems==1 && $elems[-1] ne '..' && $elems[-1] ne '.' && @elems0 ||
                     $is_abs);
        push @elems, $elem;
    }
    ($is_abs ? "/" : "") . join("/", @elems);
}

sub split_path {
    my $path = shift;
    die "Please specify path" unless defined $path && length $path;
    grep {length} split qr!/+!, $path;
}

sub concat_path {
    die "Please specify at least two paths" unless @_ > 1;
    my $i = 0;
    my $res = $_[0];
    for (@_) {
        die "Please specify path (#$i)" unless defined && length;
        next unless $i++;
        if (m!\A/!) {
            $res = $_;
        } else {
            $res .= ($res =~ m!/\z! ? "" : "/") . $_;
        }
    }
    $res;
}

sub concat_and_normalize_path {
    normalize_path(concat_path(@_));
}

1;
# ABSTRACT: Yet another abstract, Unix-like path manipulation routines

__END__