view release on metacpan or  search on metacpan

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

#============================================================= -*-perl-*-
#
# t/filesystem/file.t
#
# Test the Badger::Filesystem::File 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 Badger::Timestamp 'TIMESTAMP';
use Badger::Filesystem 'FS File';
use Badger::Filesystem::File '@STAT_FIELDS';
use Badger::Filesystem::Directory;
use Badger::Test 
    tests => 60,
    debug => 'Badger::Filesystem::File Badger::Filesystem::Path Badger::Filesystem',
    args  => \@ARGV;

our $FILE  = 'Badger::Filesystem::File';
our $FS    = 'Badger::Filesystem';
our $cwd   = $FS->cwd;
our @tdir  = -d 't' ? qw( t filesystem ) : ($FS->curdir);
our $TDIR  = -d 't' ? FS->dir(qw(t filesystem)) : FS->directory;


#-----------------------------------------------------------------------
# basic file inspection
#-----------------------------------------------------------------------

my $file = $FILE->new('file.t');
ok( $file, 'created a new file' );
is( $file->name, 'file.t', 'got file name' );
ok( ! $file->volume, 'got (no) file volume' );
ok( ! $file->dir, 'got (no) file directory' );
ok( ! $file->is_absolute, 'file is not absolute' );

$file = $FILE->new([@tdir, 'file.t']);
ok( $file->exists, 'file exists' );

my @stat = (stat($file->path), -r _, -w _, -x _, -o _);
foreach my $m (@STAT_FIELDS) {
    is( $file->$m, $stat[0], "file $m is " . shift(@stat) );
}

my $expect = $FS->dir($cwd, @tdir, 'file.t');
is( $file->absolute, $expect, "absolute path is $expect" );

ok( $FILE->new(path => '/example/file.foo')->is_absolute, 'file is absolute' );
ok( $FILE->new(name => 'file.foo', directory => '/example')->is_absolute, 'directory file is absolute' );
ok( $FILE->new(name => 'file.foo', dir => '/example')->is_absolute, 'dir file is absolute' );

is( $FILE->new(name => 'file.t')->name,     'file.t', 'got file using name param' );
is( $FILE->new(path => 'file.t')->name,     'file.t', 'got file using path param' );
is( $FILE->new({ name => 'file.t' })->name, 'file.t', 'got file using name param hash' );
is( $FILE->new({ path => 'file.t' })->name, 'file.t', 'got file using path param hash' );


#-----------------------------------------------------------------------
# basename() - most of this is covered in t/filesystem/path.t
# The only additional thing we need to check is that we get only the 
# name of the file, not the whole path
#-----------------------------------------------------------------------

is( File('foo/bar.baz.html')->basename, 'bar.baz', 'multi-dotted basename' );


#-----------------------------------------------------------------------
# timestamps
#-----------------------------------------------------------------------

my $ts = $file->created;
is( ref($ts), TIMESTAMP, 'created_on() returned a Badger::Timestamp' );

$ts = $file->accessed;
is( ref($ts), TIMESTAMP, 'accessed_on() returned a Badger::Timestamp' );

$ts = $file->modified;
is( ref($ts), TIMESTAMP, 'modified_on() returned a Badger::Timestamp' );


#-----------------------------------------------------------------------
# create a file, delete it, touch it
#-----------------------------------------------------------------------

my $file3 = $TDIR->file('testfiles', 'newfile');
ok( $file3, 'got newfile' );
if ($file3->exists) {
    ok( $file3->delete, 'deleted file' );
}
else {
    pass('no existing file');
}
ok( ! $file3->exists, 'newfile does not exist' );
ok( $file3->create, 'created file' );
ok( $file3->exists, 'newfile now exists' );
ok( $file3->print("Hello World!\n"), 'printed to newfile' );
is( $file3->text, "Hello World!\n", 'read text from newfile' );
ok( $file3->touch, 'touched newfile' );