view release on metacpan or  search on metacpan

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

#============================================================= -*-perl-*-
#
# t/filesystem/directory.t
#
# Test the Badger::Filesystem::Directory 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::Directory;
use Badger::Filesystem::Virtual;
use Badger::Test 
    tests => 59,
    debug => 'Badger::Filesystem::Directory',
    args  => \@ARGV;

our $DIR   = 'Badger::Filesystem::Directory';
our $FS    = 'Badger::Filesystem';
our $TDIR  = -d 't' ? $FS->join_dir(qw(t filesystem)) : $FS->directory;

# 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;
}

my $dir = $DIR->new('example');

ok( $dir, 'created a new directory' );
is( $dir->name, 'example', 'got example name' );
ok( ! $dir->volume, 'got (no) file volume' );
ok( ! $dir->dir, 'got (no) file directory' );
#print "dir: ", $dir->dir, "\n";

is( $DIR->new(name => 'example')->name,
    'example', 'got dir using name param' );

is ( $DIR->new(path => 'example')->name,
    'example', 'got dir using path param' );

is( $DIR->new({ name => 'example' })->name,
    'example', 'got dir using name param hash' );

is ( $DIR->new({ path => 'example' })->name,
    'example', 'got dir using path param hash' );


$dir = $DIR->new('/foo/bar/baz');
is( $dir, lp '/foo/bar/baz', 'foo/bar/baz path');
is( $dir->dir, lp '/foo/bar/', 'foo/bar dir');
is( $dir->name, 'baz', 'baz file' );
is( $dir->canonical, lp '/foo/bar/baz/', 'baz slashed' );

$dir = $DIR->new('/foo/bar/baz/');
is( $dir, lp '/foo/bar/baz', 'foo/bar/baz path with trailing slash');
is( $dir->dir, lp '/foo/bar/', 'foo/bar dir with trailing slash');
is( $dir->name, 'baz', 'baz file with trailing slash' );

#-----------------------------------------------------------------------
# test the up() method (alias for parent())
#-----------------------------------------------------------------------

$dir = $DIR->new('/path/to/file/number/one');
is( $dir, lp '/path/to/file/number/one', 'full path' );
is( $dir->up, lp '/path/to/file/number', 'path up one' );
is( $dir->up->up, lp '/path/to/file', 'path up two' );
is( $dir->up(1), lp '/path/to/file', 'path up, skip one' );
is( $dir->up(2), lp '/path/to', 'path up, skip two' );
is( $dir->up(3), lp '/path', 'path up, skip three' );
is( $dir->up(4), lp '/', 'path up, skip four' );
is( $dir->up(42), lp '/', 'path up, skip fourty two' );

is( $dir->directory('two'), lp '/path/to/file/number/one/two', 
    'relative path down' );
is( $dir->directory('../three'), lp '/path/to/file/number/three', 
    'relative path up' );
is( $dir->directory('../../four'), lp '/path/to/file/four', 
    'relative path up up' );
is( $dir->directory('/five'), lp '/five', 
    'absolute path on relative path' );