File Coverage

blib/lib/Filesys/POSIX/Path.pm

Criterion	Covered	Total	%
statement	68	71	95.7
branch	34	36	94.4
condition	12	12	100.0
subroutine	16	17	94.1
pod	11	12	91.6
total	141	148	95.2

# Copyright (c) 2014, cPanel, Inc.
# All rights reserved.
# http://cpanel.net/
#
# This is free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.  See the LICENSE file for further details.

package Filesys::POSIX::Path;

use strict;
use warnings;

use Filesys::POSIX::Error qw(throw);

=head1 NAME

Filesys::POSIX::Path - Pathname manipulation utility class

=head1 SYNOPSIS

    use Filesys::POSIX::Path;

    my $path = Filesys::POSIX::Path->new('/foo/bar/baz');

    printf("%s\n", $path->basename); # outputs 'baz'
    printf("%s\n", $path->dirname);  # outputs '/foo/bar'

    # outputs '/foo/bar/../baz'
    printf("%s\n", $path->full('/foo/./././bar/../baz'));

=head1 DESCRIPTION

This module provides an object-oriented approach to path cleanup and
introspection.

=head1 CREATING AN OBJECT

=over

=item Cnew($path)>

Creates a new path object.

The path is split on the forward slash (/) character into tokens; empty and
redundant tokens are discarded.  Enough context is kept to help the methods
implemented in this module determine the nature of the path; if it is relative
to root, prefixed with './', or relative to the "current working directory".
An C reference blessed into this package's namespace is returned upon
success.  An EINVAL is thrown if the path provided is empty.

=back

=cut

sub new {
    my ( $class, $path ) = @_;
    my @components = split( /\//, $path );
    my @ret;

    if ( @components && _non_empty( $components[0] ) ) {
        push @ret, $components[0];
    }

    if ( @components > 1 ) {
        push @ret, grep { _non_empty($_) && $_ ne '.' } @components[ 1 .. $#components ];
    }

    throw &Errno::EINVAL unless @components || _non_empty($path);

    my @hier = _non_empty( $components[0] ) ? @ret : ( '', @ret );

    if ( @hier == 1 && !_non_empty( $hier[0] ) ) {
        @hier = ('/');
    }

    return bless \@hier, $class;
}

sub _proxy {
    my ( $context, @args ) = @_;

    unless ( ref $context eq __PACKAGE__ ) {
        return $context->new(@args);
    }

    return $context;
}

sub _non_empty {
    my ($string) = @_;

    return 0 unless defined $string;
    return 0 if $string eq '';

    return 1;
}

=head1 PATH INTROSPECTION

=over

=item C<$path-Ecomponents>

Return a list of the components parsed at object construction time.

=cut

sub components {
    my $self = _proxy(@_);

    return @$self;
}

=item C<$path-Efull>

Returns a string representation of the full path.  This is the same as:

    join('/', @$path);

=cut

sub full {
    my $self = _proxy(@_);
    my @hier = @$self;

    return join( '/', @$self );
}

=item C<$path-Edirname>

Returns a string representation of all of the leading path elements, of course
save for the final path element.

=cut

sub dirname {
    my $self = _proxy(@_);
    my @hier = @$self;

    if ( @hier > 1 ) {
        my @parts = @hier[ 0 .. $#hier - 1 ];

        if ( @parts == 1 && !_non_empty( $parts[0] ) ) {
            return '/';
        }

        return join( '/', @parts );
    }

    return $hier[0] eq '/' ? '/' : '.';
}

=item C<$path-Ebasename>

=item C<$path-Ebasename($ext)>

Returns the final path component.  If called with an extension, then the method
will return the path component with the extension chopped off, if found.

=cut

sub basename {
    my ( $self, $ext ) = ( _proxy( @_[ 0 .. 1 ] ), $_[2] );
    my @hier = @$self;

    my $name = $hier[$#hier];
    $name =~ s/$ext$// if _non_empty($ext);

    return $name;
}

=item C<$path-Eshift>

Useful for iterating over the components of the path object.  Shifts the
internal start-of-array pointer by one, and returns the previous first value.

=cut

sub shift {
    my ($self) = @_;
    return shift @$self;
}

=item C<$path-Epush(@parts)>

Push new components onto the current path object.  Each part will be tokenized
on the forward slash (/) character, and useless items will be discarded.

=cut

sub push {
    my ( $self, @parts ) = @_;

    return push @$self, grep { $_ && $_ ne '.' } map { split /\// } @parts;
}

=item C<$path-Econcat($pathname)>

A new C object is created based on $pathname, and the
current path object's non-empty components are pushed onto that new instance.
The new path object is returned.

=cut

sub concat {
    my ( $self, $path ) = @_;
    $path = __PACKAGE__->new($path) unless ref $path eq __PACKAGE__;

    $path->push( grep { $_ && $_ ne '.' } $self->components );
    return $path;
}

=item C<$path-Econcat($pathname)>

A new C object is created based on C<$pathname>, and the
new path object's non-empty components are pushed onto the current path object.
The current C<$path> reference is then returned.

=cut

sub append {
    my ( $self, $path ) = @_;
    $path = __PACKAGE__->new($path) unless ref $path eq __PACKAGE__;

    $self->push( grep { $_ ne '.' } $path->components );
    return $self;
}

=item C<$path-Epop>

Pops the final path component off of the path object list, and returns that
value.

=cut

sub pop {
    my ($self) = @_;
    return pop @$self;
}

=item C<$path-Ecount>

Returns the number of components in the current path object.

=cut

sub count {
    my ($self) = @_;
    return scalar @$self;
}

=item C<$path-Eis_absolute>

Returns true if the current path object represents an absolute path.

=cut

sub is_absolute {
    my ($self) = @_;

    return 1 unless _non_empty( $self->[0] );
    return 0;
}

=back

=cut

1;

__END__