#============================================================= -*-perl-*-
#
# t/filesystem/visitor
#
# Test the Badger::Filesystem::Visitor 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 'FS';
use Badger::Test
tests => 25,
debug => 'Badger::Filesystem::Visitor',
args => \@ARGV;
our $here = -d 't' ? FS->dir(qw(t filesystem)) : FS->dir;
our $tdir = $here->dir('testfiles')->must_exist;
our $vdir = $tdir->dir('visitor')->must_exist;
my ($visitor, @files);
#-----------------------------------------------------------------------
# basic tests
#-----------------------------------------------------------------------
$visitor = $tdir->visit(
recurse => 1,
dirs => 0,
files => 'foo'
);
ok( $visitor, 'got visitor' );
is( ref $visitor, 'Badger::Filesystem::Visitor', 'isa visitor object' );
@files = $visitor->collect;
is( scalar @files, 3, 'got 3 foo files' );
@files = $tdir->visit(
recurse => 1,
dirs => 0,
files => ['foo', 'bar'],
)->collect;
is( scalar @files, 5, 'got 5 foo and bar files' );
@files = $tdir->visit(
dirs => 0,
files => qr/foo|bar/,
in_dirs => 1,
not_in_dirs => '.svn',
)->collect;
is( scalar @files, 5, 'got 5 foo or bar files via regex' );
#-----------------------------------------------------------------------
# wildcards
#-----------------------------------------------------------------------
# all html files
@files = $vdir->visit(
dirs => 0,
files => '*.html',
in_dirs => 1,
not_in_dirs => '.svn',
)->collect;
print STDERR "HTML files: \n", join("\n ", @files), "\n" if $DEBUG;
is( scalar @files, 2, 'got 2 HTML files' );
is( join(' ', sort map { $_->name } @files),
'goodbye.html hello.html',
'got all HTML files' );
# all goodbye files with a 3 character extension
@files = $vdir->visit(
dirs => 0,
files => 'goodbye.???',
in_dirs => 1,
not_in_dirs => '.svn',
)->collect;
print STDERR "goodbye files: \n", join("\n ", @files), "\n" if $DEBUG;
is( scalar @files, 2, 'got 2 goodbye files' );
is( join(' ', sort map { $_->name } @files),
'goodbye.bak goodbye.txt',
'got all goodbye files' );
# same again using wilder wildcard (checks that '.' is not wild)
@files = $vdir->visit(
dirs => 0,
files => '*.???',
in_dirs => 1,
not_in_dirs => ['.svn', 'tm?'],
)->collect;
print STDERR "wild files: \n", join("\n ", @files), "\n" if $DEBUG;
is( scalar @files, 3, 'got 3 wild files' );
is( join(' ', sort map { $_->name } @files),
'goodbye.bak goodbye.txt hello.txt',
'got all wild files' );
# same again with tighter wildcard
@files = $vdir->visit(
dirs => 0,
files => 'g*.???',
in_dirs => 1,
not_in_dirs => ['.svn', 'tm?'],
)->collect;
print STDERR "wild goodbye files: \n", join("\n ", @files), "\n" if $DEBUG;
is( scalar @files, 2, 'got 2 wild goodbye files' );
is( join(' ', sort map { $_->name } @files),
'goodbye.bak goodbye.txt',
'got all wild goodbye files' );
#-----------------------------------------------------------------------
# subroutine filters
#-----------------------------------------------------------------------
# small files
@files = $vdir->visit(
dirs => 0,
files => sub { shift->size < 100 },
in_dirs => 1,
not_in_dirs => '.svn',
)->collect;
print STDERR "small files: \n", join("\n ", @files), "\n" if $DEBUG;
is( scalar @files, 6, 'got 6 small files' );
is( join(' ', sort map { $_->name } @files),
'README goodbye.bak hello.txt mushroom small snake',
'got all small files' );
# medium files
@files = $vdir->visit(
dirs => 0,
files => sub { my $size = shift->size; $size >= 100 && $size < 420 },
in_dirs => 1,
not_in_dirs => '.svn',
)->collect;
print STDERR "medium files: \n", join("\n ", @files), "\n" if $DEBUG;
is( scalar @files, 3, 'got 3 medium files' );
is( join(' ', sort map { $_->name } @files),
'badger goodbye.txt medium',
'got all small files' );
# large files
@files = $vdir->visit(
dirs => 0,
files => sub { shift->size > 420 },
in_dirs => 1,
not_in_dirs => ['.svn', 'tmp'],
)->collect;
print STDERR "large files: \n", join("\n ", @files), "\n" if $DEBUG;
is( scalar @files, 3, 'got 3 large files' );
is( join(' ', sort map { $_->name } @files),
'goodbye.html hello.html large',
'got all large files' );
# directories containing a README file
@files = $vdir->visit(
dirs => sub { shift->file('README')->exists },
files => 0,
in_dirs => 1,
not_in_dirs => '.svn',
)->collect;
print STDERR "dirs with README files: \n", join("\n ", @files), "\n" if $DEBUG;
is( scalar @files, 1, 'got 1 dir with README' );
is( join(' ', sort map { $_->name } @files),
'tmp',
'got all dirs with README files in' );
#-----------------------------------------------------------------------
# all-in-one test with default arguments
#-----------------------------------------------------------------------
@files = grep { $_ !~ /svn/ } $vdir->collect;
print STDERR "default files: \n", join("\n ", @files), "\n" if $DEBUG;
is( scalar @files, 6, 'got default files' );
is( join(' ', sort map { $_->name } @files),
'large medium one small tmp two',
'got all default files' );
#-----------------------------------------------------------------------
# visitor callbacks
#-----------------------------------------------------------------------
my $n = 0;
@files = $vdir->visit(
accept_file => sub { $n++ }
);
is( $n, 3, 'visited three files via a callback' );
#-----------------------------------------------------------------------
# subclass
#-----------------------------------------------------------------------
package My::Test::Visitor;
use base 'Badger::Filesystem::Visitor';
our $FILES = qr/^good/;
our $DIRS = 0;
our $IN_DIRS = 1;
our $NOT_IN_DIRS = ['.svn', 'tmp'];
package main;
@files = $vdir->collect( My::Test::Visitor->new );
print STDERR "subclass files: \n", join("\n ", @files), "\n" if $DEBUG;
is( join(' ', sort map { $_->name } @files),
'goodbye.bak goodbye.html goodbye.txt',
'got all subclass files' );