ACIL FM

Nama	Ukuran	Aksi
data	-	Open
fakelib	-	Open
lib	-	Open
00-report-prereqs.dd	4.52 MB	View DL Edit
00-report-prereqs.t	5.88 MB	View DL Edit
basename.t	880 B	View DL Edit
basic.t	9.06 MB	View DL Edit
children.t	1.24 MB	View DL Edit
chmod.t	1020 B	View DL Edit
digest.t	1.25 MB	View DL Edit
exception.t	1.26 MB	View DL Edit
exports.t	674 B	View DL Edit
filesystem.t	13.82 MB	View DL Edit
has_same_bytes.t	2.04 MB	View DL Edit
input_output.t	18.31 MB	View DL Edit
input_output_no_PU_UU.t	579 B	View DL Edit
input_output_no_UU.t	566 B	View DL Edit
locking.t	1.37 MB	View DL Edit
mkdir.t	1008 B	View DL Edit
mkpath.t	947 B	View DL Edit
mutable_tree_while_iterating.t	1.43 MB	View DL Edit
normalize.t	898 B	View DL Edit
overloading.t	534 B	View DL Edit
parent.t	3.06 MB	View DL Edit
README	214 B	View DL Edit
recurse.t	3.89 MB	View DL Edit
rel-abs.t	7.88 MB	View DL Edit
sig_die.t	533 B	View DL Edit
size.t	4.76 MB	View DL Edit
subsumes.t	3.16 MB	View DL Edit
symlinks.t	1.51 MB	View DL Edit
temp.t	4.99 MB	View DL Edit
visit.t	447 B	View DL Edit
zz-atomic.t	922 B	View DL Edit
zzz-spec.t	6.62 MB	View DL Edit

Edit file: /home/.cpan/build/Path-Tiny-0.146-0/t/filesystem.t

use 5.008001;
use strict;
use warnings;
use Test::More 0.96;
use File::Temp qw(tmpnam tempdir);
use File::Spec;
use Cwd;

use lib 't/lib';
use TestUtils qw/exception has_symlinks/;

use Path::Tiny;

# Tests adapted from Path::Class t/basic.t

my $file = path( scalar tmpnam() );
ok $file, "Got a filename via tmpnam()";

{
    my $fh = $file->openw;
    ok $fh, "Opened $file for writing";

ok print( $fh "Foo\n" ), "Printed to $file";
}

ok -e $file, "$file should exist";
ok $file->is_file, "it's a file!";

if ( -e "/dev/null" ) {
    ok( path("/dev/null")->is_file, "/dev/null is_file, too" );
}

my ( $volume, $dirname, $basename ) =
  map { s{\\}{/}; $_ } File::Spec->splitpath($file);
is( $file->volume,   $volume,   "volume correct" );
is( $file->volume,   $volume,   "volume cached " );  # for coverage
is( $file->dirname,  $dirname,  "dirname correct" );
is( $file->basename, $basename, "basename correct" );

{
    my $fh = $file->openr;
    is scalar <$fh>, "Foo\n", "Read contents of $file correctly";
}

note "stat";
{
    my $stat = $file->stat;
    ok $stat;
    cmp_ok $stat->mtime, '>', time() - 20; # Modified within last 20 seconds

$stat = $file->parent->stat;
    ok $stat;
}

note "stat/lstat with no file";
{
    my $file = "i/do/not/exist";
    ok exception { path($file)->stat };
    ok exception { path($file)->lstat };
}

1 while unlink $file;
ok not -e $file;

my $dir = path( tempdir( TMPDIR => 1, CLEANUP => 1 ) );
ok $dir;
ok -d $dir;
ok $dir->is_dir, "It's a directory!";

$file = $dir->child('foo.x');
$file->touch;
ok -e $file;
my $epoch = time - 10;
utime $epoch, $epoch, $file;
$file->touch;
ok( $file->stat->mtime > $epoch, "touch sets utime as current time" );
$file->touch($epoch);
ok( $file->stat->mtime == $epoch, "touch sets utime as 10 secs before" );

{
    my @files = $dir->children;
    is scalar @files, 1 or diag explain \@files;
    ok scalar grep { /foo\.x/ } @files;
}

ok $dir->remove_tree, "Removed $dir";
ok !-e $dir, "$dir no longer exists";
ok !$dir->remove_tree, "Removing non-existent dir returns false";

my $tmpdir = Path::Tiny->tempdir;

{
    $dir = path( $tmpdir, 'foo', 'bar' );
    $dir->parent->remove_tree if -e $dir->parent;

ok $dir->mkdir, "Created $dir";
    ok -d $dir, "$dir is a directory";

$dir = $dir->parent;
    ok $dir->remove_tree( { safe => 1 } ); # check that we pass through args
    ok !-e $dir;
}

{
    $dir = path( $tmpdir, 'foo' );
    ok $dir->mkdir;
    ok $dir->child('dir')->mkdir;
    ok -d $dir->child('dir');

ok $dir->child('file.x')->touch;
    ok $dir->child('0')->touch;
    ok $dir->child('foo/bar/baz.txt')->touchpath;

subtest 'iterator' => sub {
        my @contents;
        my $iter = $dir->iterator;
        while ( my $file = $iter->() ) {
            push @contents, $file;
        }
        is scalar @contents, 4
          or diag explain \@contents;
        is( $iter->(), undef, "exhausted iterator is undef" );

my $joined = join ' ', sort map $_->basename, grep { -f $_ } @contents;
        is $joined, '0 file.x'
          or diag explain \@contents;

my ($subdir) = grep { $_ eq $dir->child('dir') } @contents;
        ok $subdir;
        is -d $subdir, 1;

my ($file) = grep { $_ eq $dir->child('file.x') } @contents;
        ok $file;
        is -d $file, '';
    };

subtest 'visit' => sub {
        my @contents;
        $dir->visit( sub { push @contents, $_[0] } );
        is scalar @contents, 4
          or diag explain \@contents;

my $joined = join ' ', sort map $_->basename, grep { -f $_ } @contents;
        is $joined, '0 file.x'
          or diag explain \@contents;

my ($subdir) = grep { $_ eq $dir->child('dir') } @contents;
        ok $subdir;
        is -d $subdir, 1;

my ($file) = grep { $_ eq $dir->child('file.x') } @contents;
        ok $file;
        is -d $file, '';
    };

ok $dir->remove_tree;
    ok !-e $dir;

# Try again with directory called '0', in curdir
    my $orig = Path::Tiny->cwd;

ok $dir->mkdir;
    ok chdir($dir);
    my $dir2 = path(".");
    ok $dir2->child('0')->mkdir;
    ok -d $dir2->child('0');

subtest 'iterator' => sub {
        my @contents;
        my $iter = $dir2->iterator;
        while ( my $file = $iter->() ) {
            push @contents, $file;
        }
        ok grep { $_ eq '0' } @contents;
    };
    subtest 'visit' => sub {
        my @contents;
        $dir2->visit( sub { push @contents, $_[0] } );
        ok grep { $_ eq '0' } @contents;
    };

ok chdir($orig);
    ok $dir->remove_tree;
    ok !-e $dir;
}

{
    my $file = path( $tmpdir, 'slurp' );
    ok $file;

my $fh = $file->openw or die "Can't create $file: $!";
    print $fh "Line1\nLine2\n";
    close $fh;
    ok -e $file;

my $content = $file->slurp;
    is $content, "Line1\nLine2\n";

my @content = $file->lines;
    is_deeply \@content, [ "Line1\n", "Line2\n" ];

@content = $file->lines( { chomp => 1 } );
    is_deeply \@content, [ "Line1", "Line2" ];

ok( $file->remove, "removing file" );
    ok !-e $file, "file is gone";
    ok !$file->remove, "removing file again returns false";

my $subdir = $tmpdir->child('subdir');
    ok $subdir->mkdir;
    ok exception { $subdir->remove }, "calling 'remove' on a directory throws";
    ok rmdir $subdir;

my $orig = Path::Tiny->cwd;
    ok chdir $tmpdir;
    my $zero_file = path '0';
    ok $zero_file->openw;
    ok $zero_file->remove, "removing file called '0'";
    ok chdir $orig;
}

{
    my $file = path( $tmpdir, 'slurp' );
    ok $file;

my $fh = $file->openw(':raw') or die "Can't create $file: $!";
    print $fh "Line1\r\nLine2\r\n\302\261\r\n";
    close $fh;
    ok -e $file;

my $content = $file->slurp( { binmode => ':raw' } );
    is $content, "Line1\r\nLine2\r\n\302\261\r\n", "slurp raw";

my $line3 = "\302\261\n";
    utf8::decode($line3);

$content = $file->slurp( { binmode => ':crlf:utf8' } );
    is $content, "Line1\nLine2\n" . $line3, "slurp+crlf+utf8";

my @content = $file->lines( { binmode => ':crlf:utf8' } );
    is_deeply \@content, [ "Line1\n", "Line2\n", $line3 ], "lines+crlf+utf8";

chop($line3);
    @content = $file->lines( { chomp => 1, binmode => ':crlf:utf8' } );
    is_deeply \@content, [ "Line1", "Line2", $line3 ], "lines+chomp+crlf+utf8";

$file->remove;
    ok not -e $file;
}

{
    my $file = path( $tmpdir, 'spew' );
    $file->remove() if $file->exists;
    $file->spew( { binmode => ':raw' }, "Line1\r\n" );
    $file->append( { binmode => ':raw' }, "Line2" );

my $content = $file->slurp( { binmode => ':raw' } );

is( $content, "Line1\r\nLine2" );
}

{
    # Make sure we can make an absolute/relative roundtrip
    my $cwd = path(".");
    is $cwd, $cwd->absolute->relative,
      "from $cwd to " . $cwd->absolute . " to " . $cwd->absolute->relative;
}

{
    # realpath should resolve ..
    my $lib  = path("t/../lib");
    my $real = $lib->realpath;
    unlike $real, qr/\.\./, "updir gone from realpath";
    my $abs_lib = $lib->absolute;
    my $abs_t   = path("t")->absolute;
    my $case    = $abs_t->child("../lib");
    is( $case->realpath, $lib->realpath, "realpath on absolute" );

# non-existent directory in realpath should throw error
    eval { path("lkajdfak/djslakdj")->realpath };
    like(
        $@,
        qr/Error resolving realpath/,
        "caught error from realpath on non-existent dir"
    );

# but non-existent basename in realpath should throw error
    eval { path("./djslakdj")->realpath };
    is( $@, '', "no error from realpath on non-existent last component" );
}

subtest "move()" => sub {
    subtest "dest is a file (and does not exist)" => sub {
        my $file = $tmpdir->child("mv-foo.txt");
        $file->spew("Hello World\n");

my $moveto = $tmpdir->child("mv-bar.txt");
        ok !-e $moveto, "destination does not exist before";
        my $result = $file->move("$moveto");

is "$result" => "$moveto", "returned the right file";
        is $moveto->slurp, "Hello World\n", "target exists and matches orig";
        ok !$file->exists, "orig no longer exists";
    };

subtest "dest is a dir" => sub {
        my $file = $tmpdir->child("mv-dir.txt");
        $file->spew("Hello World\n");

my $anothertmpdir = Path::Tiny->tempdir;
        my $result        = $file->move($anothertmpdir);

is "$result" => "$anothertmpdir/mv-dir.txt", "returned the right file";
        is $result->slurp, "Hello World\n", "target exists and matches orig";
        ok !$file->exists, "orig no longer exists";
    };

subtest "dest file already exists" => sub {
        my $file = $tmpdir->child("mv-non.txt");
        $file->spew("Hello World\n");

my $anothertmpdir = Path::Tiny->tempdir;
        my $dest = $anothertmpdir->child( "move-it.there");
        $dest->spew( "Original Content\n" );

ok -f $dest, "destination file exists";

my $result;
        {
            local ( $!, $@ );
            $result        = $file->move("$dest");
            is $@, undef, q[$@ - no errors leaked on success];
            is $!, "", q[$! - no errors leaked on success];
        }

is "$result" => $dest, "returned the right file";
        is $result->slurp, "Hello World\n", "target exists and matches orig";

ok !$file->exists, "orig no longer exists";
    };

subtest "dest parent dir does not exist" => sub {
        my $file = $tmpdir->child("mv-noparent.txt");
        $file->spew("Hello World\n");

my $anothertmpdir = Path::Tiny->tempdir;
        my $result = eval { $file->move("$anothertmpdir/rutroh/yo.txt") };

ok !$result, "does not return true";
        like "$@", qr/move/, "throws error";
        ok $file->exists, "orig still exists";
    }
};

subtest "copy()" => sub {
    my $file = $tmpdir->child("foo.txt");
    $file->spew("Hello World\n");

my $copy;
    subtest "dest is a file" => sub {
        $copy = $tmpdir->child("bar.txt");
        my $result = $file->copy($copy);
        is "$result" => "$copy", "returned the right file";

is( $copy->slurp, "Hello World\n", "file copied" );
    };

subtest "dest is a dir" => sub {
        # new tempdir not to clobber the original foo.txt
        my $tmpdir = Path::Tiny->tempdir;
        my $result = $file->copy($tmpdir);

is "$result" => "$tmpdir/foo.txt", "returned the right file";

is $result->slurp, "Hello World\n", "file copied";
    };

subtest "try some different chmods" => sub {
        ok( $copy->chmod(0000),   "chmod(0000)" );
        ok( $copy->chmod("0400"), "chmod('0400')" );
        SKIP: {
            skip "No exception if run as root", 1 if $> == 0;
            skip "No exception writing to read-only file", 1
              unless
              exception { open my $fh, ">", "$copy" or die }; # probe if actually read-only
            my $error = exception { $file->copy($copy) };
            ok( $error, "copy throws error if permission denied" );
            like( $error, qr/\Q$file/, "error messages includes the source file name" );
            like( $error, qr/\Q$copy/, "error messages includes the destination file name" );
        }
        ok( $copy->chmod("u+w"), "chmod('u+w')" );
    };
};

{
    $tmpdir->child( "subdir", "touched.txt" )->touchpath->spew("Hello World\n");
    is(
        $tmpdir->child( "subdir", "touched.txt" )->slurp,
        "Hello World\n",
        "touch can chain"
    );
}

{
    # Only run if a 255 length filename is allowed. Test checks that the temp
    # file created doesn't exceed 255 characters.
    my $file = $tmpdir->child("A" x 255);
    if ( eval { $file->touch; 1 } ) {;
        ok( path($file)->spew("Hello"), "spew to long filename" );
    }
}

SKIP: {
    my $newtmp = Path::Tiny->tempdir;
    my $file   = $newtmp->child("foo.txt");
    my $link   = $newtmp->child("bar.txt");
    $file->spew("Hello World\n");
    skip "symlink unavailable", 1 unless has_symlinks();
    eval { symlink $file => $link };
    ok( $link->lstat->size, "lstat" );

is( $link->realpath, $file->realpath, "realpath resolves symlinks" );

ok $link->remove, 'remove symbolic link';
    ok $file->remove;

$file = $newtmp->child("foo.txt");
    $link = $newtmp->child("bar.txt");
    $file->spew("Hello World\n");
    ok symlink $file => $link;

ok $file->remove;
    ok $link->remove, 'remove broken symbolic link';

my $dir = $newtmp->child('foo');
    $link = $newtmp->child("bar");
    ok $dir->mkdir;
    ok -d $dir;
    $file = $dir->child("baz.txt");
    $file->spew("Hello World\n");
    ok symlink $dir => $link;

ok $link->remove_tree, 'remove_tree symbolic link';
    ok $dir->remove_tree;

$dir  = $newtmp->child('foo');
    $link = $newtmp->child("bar");
    ok $dir->mkdir;
    ok -d $dir;
    $file = $dir->child("baz.txt");
    $file->spew("Hello World\n");
    ok symlink $dir => $link;

ok $dir->remove_tree;
    ok $link->remove_tree, 'remove_tree broken symbolic link';

$file = $newtmp->child("foo.txt");
    $link = $newtmp->child("bar.txt");
    my $link2 = $newtmp->child("baz.txt");
    $file->spew("Hello World\n");
    ok symlink $file => $link;
    ok symlink $link => $link2;
    $link2->spew("Hello Perl\n");
    ok -l $link2, 'path is still symbolic link after spewing';
    is readlink($link2), $link, 'symbolic link is available after spewing';
    is readlink($link),  $file, 'symbolic link is available after spewing';
    is $file->slurp, "Hello Perl\n",
      'spewing follows the link and replace the destination instead';
}

# We don't have subsume so comment these out.  Keep in case we
# implement it later

##{
##  my $t = path( 't');
##  my $foo_bar = $t->child('foo','bar');
##  $foo_bar->remove; # Make sure it doesn't exist
##
##  ok  $t->subsumes($foo_bar), "t subsumes t/foo/bar";
##  ok !$t->contains($foo_bar), "t doesn't contain t/foo/bar";
##
##  $foo_bar->mkdir;
##  ok  $t->subsumes($foo_bar), "t still subsumes t/foo/bar";
##  ok  $t->contains($foo_bar), "t now contains t/foo/bar";
##
##  $t->child('foo')->remove;
##}

done_testing;

Batal