view release on metacpan or  search on metacpan

t/filesystem/path.t  view on Meta::CPAN

#============================================================= -*-perl-*-
#
# t/filesystem/path.t
#
# Test the Badger::Filesystem::Path module
#
# Written by Andy Wardley <abw@wardley.org>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#========================================================================

use lib qw( ./lib ../lib ../../lib );
use strict;
use warnings;
use File::Spec;
use Badger::Filesystem ':types';
use Badger::Filesystem::Path;
use Badger::Test 
    tests => 48,
    debug => 'Badger::Filesystem::Path',
    args  => \@ARGV;

our $PATH  = 'Badger::Filesystem::Path';
our $FS    =  $PATH->filesystem;
our $CWD   = $FS->cwd;
my ($path, $sub);

# ugly hack to grok file separator on local filesystem
my $PATHSEP  = File::Spec->catdir(('badger') x 2);
$PATHSEP =~ s/badger//g;

# convert unix-like paths into local equivalent
sub lp($) {
    my $path = shift;
    $path =~ s|/|$PATHSEP|g;
    $path;
}

$path = $PATH->new('foo');
ok( $path, 'created a new file: foo' );
ok( $path->is_relative, 'foo is relative' );
ok( ! $path->is_absolute, 'foo is not absolute' );
is( $path->absolute, $FS->join_dir($CWD, 'foo'), 'foo absolute is ' . $path->absolute );

if (1) { # && $FS->rootdir eq '/' && $FS->separator eq '/') {
    $path = $PATH->new('/foo');
    ok( $path, 'created a new file: /foo' );
    ok( ! $path->is_relative, '/foo is not relative' );
    ok( $path->is_absolute, '/foo is absolute' );
    is( $path->absolute, lp '/foo', '/foo is already absolute' );
    
    #-----------------------------------------------------------------------
    # test construction
    #-----------------------------------------------------------------------
    
    $path = $PATH->new('/foo/bar/baz');
    is( $path->relative('bam'), lp '/foo/bar/baz/bam', '/foo/bar/baz + bam' );
    is( $path->relative('/bam'), lp '/bam', '/foo/bar/baz + /bam' );
    is( $path->relative('../../wam'), lp '/foo/wam', '/foo/bar/baz + ../../wam' );
}
else {
    skip_some(7, 'Non-standard file separators')
}

#-----------------------------------------------------------------------
# base()
#-----------------------------------------------------------------------

is( Path('/foo/bar')->base, lp '/foo/bar', 'path base' );
is( Directory('/foo/bar')->base, lp '/foo/bar', 'dir base' );
is( File('/foo/bar')->base, lp '/foo', 'file base' );


#-----------------------------------------------------------------------
# parent()
#-----------------------------------------------------------------------

# absolute
is( Path('/foo/bar')->parent, lp '/foo', 'absolute path parent' );
is( Directory('/foo/bar/baz')->parent, lp '/foo/bar', 'absolute dir parent' );
is( File('/foo/bar/baz/bam')->parent, lp '/foo/bar/baz', 'absolute file parent' );
is( Path('/foo/bar/baz/bam')->parent, lp '/foo/bar/baz', 'absolute path parent' );
is( Path('/foo/bar/baz/bam')->parent(0), lp '/foo/bar/baz', 'absolute path parent zero' );
is( Path('/foo/bar/baz/bam')->parent(1), lp '/foo/bar', 'absolute path parent one' );
is( Path('/foo/bar/baz/bam')->parent(2), lp '/foo', 'absolute path parent two' );
is( Path('/foo/bar/baz/bam')->parent(3), lp '/', 'absolute path parent three' );
is( Path('/foo/bar/baz/bam')->parent(4), lp '/', 'absolute path parent four' );
is( Path('/foo/bar/baz/bam')->parent(5), lp '/', 'absolute path parent five' );

# relative
my $cwd = $FS->dir;
is( Path('foo/bar')->parent, 'foo', 'relative path parent' );
is( Path('foo/bar/')->parent, 'foo', 'relative path trailing slash parent' );