view release on metacpan or  search on metacpan

lib/Test/Virtual/Filesystem.pm  view on Meta::CPAN

#######################################################################
#      $URL: svn+ssh://equilibrious@equilibrious.net/home/equilibrious/svnrepos/chrisdolan/Test-Virtual-Filesystem/lib/Test/Virtual/Filesystem.pm $
#     $Date: 2008-07-27 21:28:05 -0500 (Sun, 27 Jul 2008) $
#   $Author: equilibrious $
# $Revision: 785 $
########################################################################

package Test::Virtual::Filesystem;

use warnings;
use strict;
use 5.008;

use English qw(-no_match_vars);
use Carp qw(croak);
use File::Spec;
use List::MoreUtils qw(any);
use Attribute::Handlers;
use Config;
use POSIX qw(:errno_h strerror);
use Readonly;
use Test::More;
use base 'Test::Class';

our $VERSION = '0.13';

Readonly::Scalar my $TIME_LENIENCE => 2; # seconds of tolerance between CPU clock and disk mtime

# Currently this must not nest more than one level deep!
# (due to implementation of deep copy in new() and the static accessor/mutator constructor)
Readonly::Hash my %feature_defaults => (
      xattr => 0,
      time => {
         atime => 0,
         mtime => 1,
         ctime => 1,
      },
      permissions => 0,
      special => {
         fifo => 0,
      },
      symlink => 1,
      hardlink => {
         nlink => 1,
      },
      chown => 0,
);

# if true, the feature is disabled no matter what.  For example, most versions
# of Windows at this writing do not support symlinks at all, regardless of
# whether your virtual filesystem supports them
Readonly::Hash my %feature_disabled => (
   $Config{d_symlink} ? () : (symlink => 1),
   $Config{d_chown} ? () : (chown => 1),
   eval {require File::ExtAttr; 1;} ? () : (xattr => 1),
);

=pod

=for stopwords TODO CPAN MSWin32

=head1 NAME

Test::Virtual::Filesystem - Validate a filesystem

=head1 SYNOPSIS

    use Test::Virtual::Filesystem;
    Test::Virtual::Filesystem->new({mountdir => '/path/to/test'})->runtests;

or with more customization:

    use Test::Virtual::Filesystem;
    my $test = Test::Virtual::Filesystem->new({mountdir => '/path/to/test', compatible => '0.03'});
    $test->enable_test_xattr(1);
    $test->enable_test_chown(1);
    $test->enable_test_atime(1);
    $test->runtests;

See the file F<t/filesys.t> in this distribution or the file F<t/fusepdf.t> in
the L<Fuse::PDF> distribution for thorough examples.

WARNING: all of the files in the C<mountdir> will be deleted in the C<teardown>
method so BE CAREFUL that you specify the right folder!

=head1 LICENSE

Copyright 2008 Chris Dolan, I<cdolan@cpan.org>

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 DESCRIPTION

If you are creating a filesystem, say via L<Fuse> or L<Filesys::Virtual>, you
need a fairly mundane set of tests to try out lots of typical filesystem
operations.  This package attempts to accumulate a bunch of those tests into a
handy suite to make it easier for you to test your filesystem.

This suite is based on C<Test::Class>, a fantastic library for organizing
tests into bite-sized bundles.  The power of Test::Class lets you select a
subset of tests to run at author time.  For example, when I was working on the
extended attribute (aka C<xattr>) tests, I found myself typing this:

  env TEST_METHOD='xattr_.*' perl -Ilib t/filesys.t

which runs just the test methods that begin with C<xattr_>.

There are several methods that let you turn on or off a subset of the tests.
For example, if you do not intend that your filesystem will support symbolic
links, you can invoke C<$test->enable_test_symlink(0)> in your test program
just before you call C<$test->runtests>.

=head1 COMPATIBILITY POLICY

Every time I add a new test to this suite, I annotate it with a
version number.  If client code specifies an expected version number
(say, 1.10) and it's running against a newer version or this module
(say, 1.20) then any newer test will be marked as a TODO test.  That
way if the test fails, it won't regress published code that used to
work.

This policy will allow us to continue adding new filesystem tests
without worrying about breaking existing CPAN modules.

=head1 CAVEATS AND LIMITATIONS

This module needs a more complete suite of test cases.  In particular, tests
are needed for the following filesystem features:

    hardlinks
    nlink
    seek/rewinddir, tell/telldir
    read, sysread, syswrite
    overwrite (with open '+<')
    deep directories
    very full directories
    large files
    filenames with spaces
    non-ASCII filenames (maybe constructor should specify the encoding?)
    permissions
    special file types (fifos, sockets, character and block devices, etc)
    chown
    binmode, non-binmode
    eof
    fileno
    statfs (AKA `df` or `mount`)
    rename corner cases:
     * dest inside src
     * src or dest leaf is '.' or '..'
     * src or dest is FS root
     * dest leaf is symlink
    threading and re-entrancy
    file locking?
    async I/O??

Any help writing tests (or adapting tests from existing suites) will
be appreciated!

=head1 METHODS

This module is a subclass of L<Test::Class>.  All methods from that class are
available, particularly C<runtests()>.

=over

=item $pkg->new({mountdir =E<gt> $mountdir, ...})

Create a new test suite which will operate on files contained within the
specified mount directory.  WARNING: any and all files and folders in that
mount directory will be deleted!

The supported options are:

=over

=item C<mountdir>

This required property indicates where tests should run.

=item C<compatible>

Specify a Test::Virtual::Filesystem version number that is known to
work.  If the actual Test::Virtual::Filesystem version number is
greater, then any test cases added after the specified compatible
version are considered C<TODO> tests.  See L<Test::More> for details
about C<TODO> tests.

=back

=item $self->init()

Invoked just before then end of C<new()>.  This exists solely for
subclassing convenience.  This implementation does nothing.

=back

=head1 PROPERTIES

The following accessor/mutator methods exist to turn on/off various
features.  They all behave in usual Perl fashion: with no argument,
they return the current value.  With one argument, they set the
current value and return the newly set value.

=over

=item $self->enable_test_all()

As a getter, checks whether all of the other tests are enabled.

As a setter, turns on/off all the tests.

=item $self->enable_test_xattr()

Default false.

=item $self->enable_test_time()

Default true.  If set false, it also sets C<atime>, C<mtime> and C<ctime> false.

=item $self->enable_test_atime()

Default false.

=item $self->enable_test_mtime()

Default true.

=item $self->enable_test_ctime()

Default true.

=item $self->enable_test_permissions()

Default false.

=item $self->enable_test_special()

Default true.  If set false, it also sets C<fifo> false.

=item $self->enable_test_fifo()

Default false.  AKA named pipes.

=item $self->enable_test_symlink()

Default true, except for platforms that do not support symlinks (for example
MSWin32 and cygwin) as determined by C<$Config::Config{d_symlink}>.

=item $self->enable_test_hardlink()

AKA the C<link()> function.  Default true.  If set false, this also sets C<nlink> false.

=item $self->enable_test_nlink()

Count hard links.  Default true.

=item $self->enable_test_chown()

Default false.

=back

=head1 TEST CASES

=over

=cut

sub new {
   my ($pkg, $opts) = @_;
   my $self = $pkg->SUPER::new();
   $opts ||= {};
   for my $key (qw(mountdir compatible)) {
      $self->{$key} = $opts->{$key};
   }
   $self->{fs_opts} = {
      # one-level deep copy
      map {$_ => ref $feature_defaults{$_} ? { %{$feature_defaults{$_}} } : $feature_defaults{$_}}
      keys %feature_defaults,
   };
   $self->init;
   $self->{ntestdir} = 0;
   return $self;
}

sub init {
   # no-op, subclasses may override
   return;
}

{
   # Create a read-write accessor for each enabling feature
   no strict 'refs';  ## no critic(NoStrict)
   for my $field (keys %feature_defaults) {
      *{'enable_test_'.$field} = sub {
         return $_[0]->{fs_opts}->{$field} if @_ == 1;
         return $_[0]->{fs_opts}->{$field} = $_[1] if @_ == 2;
         croak 'wrong number of arguments to ' . $field;
      };
      my $val = $feature_defaults{$field};
      if (ref $val) {
         for my $subfield (keys %{$val}) {
            *{'enable_test_'.$subfield} = sub {
               return $_[0]->{fs_opts}->{$field} && $_[0]->{fs_opts}->{$field}->{$subfield} if @_ == 1;
               return ($_[0]->{fs_opts}->{$field} ||= {})->{$subfield} = $_[1] if @_ == 2;
               croak 'wrong number of arguments to ' . $subfield;
            };
         }
      }
   }
}

sub enable_test_all {
   my ($self, @arg) = @_;
   return $self->_enable_test_all($self->{fs_opts}, @arg);
}
sub _enable_test_all {

lib/Test/Virtual/Filesystem.pm  view on Meta::CPAN

   my $content = do { local $INPUT_RECORD_SEPARATOR = undef; <$fh> };
   close $fh or return;
   return $content;
}

sub _read_file_die {
   my ($self, $f) = @_;
   open my $fh, '<', $f or die $OS_ERROR;
   binmode $fh;
   my $content = do { local $INPUT_RECORD_SEPARATOR = undef; <$fh> };
   close $fh or die $OS_ERROR;
   return $content;
}

sub _read_dir {
   my ($self, $f) = @_;
   opendir my $fh, $f or return;
   my @content = readdir $fh;
   closedir $fh or return;
   return @content;
}

sub _read_dir_die {
   my ($self, $f) = @_;
   opendir my $fh, $f or die $OS_ERROR;
   my @content = readdir $fh;
   closedir $fh or die $OS_ERROR;
   return @content;
}

1;

__END__

=pod

=back

=head1 CODE PHILOSOPHY

These are some coding/design rules for the tests:

=over

=item Use only core filesystem functions

Don't use File::Slurp, File::Path, etc. because they abstract filesystem
operations and make it less clear what we're testing.

=item Keep the tests small

Test as little as possible in each method.  Let authors know what's failed by
the pattern of failing tests.  This also helps avoid needing to edit the tests later.

=item Avoid editing methods

Don't break published CPAN code.  If you want to test something new, write a new method.

=item Try to use a few different filesystem functions as practical in one method

For example, if you're testing C<chmod>, don't C<mkdir> or C<chown> unless
you're writing a C<chmod_mkdir_chown> test.

=item Minimize test infrastructure

Use method attributes and Test::Class features to keep the test methods really
simple.

=back

=head1 SEE ALSO

L<Test::Class>

L<Fuse::PDF>

=head1 AUTHOR

Chris Dolan, I<cdolan@cpan.org>

=cut

# Local Variables:
#   mode: perl
#   perl-indent-level: 3
#   cperl-indent-level: 3
#   fill-column: 78
#   indent-tabs-mode: nil
#   c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab :