r37102 - in /branches/upstream/libtest-tempdir-perl: ./ current/ current/lib/ current/lib/Test/ current/lib/Test/TempDir/ current/t/
franck-guest at users.alioth.debian.org
franck-guest at users.alioth.debian.org
Mon Jun 1 08:40:35 UTC 2009
Author: franck-guest
Date: Mon Jun 1 08:40:30 2009
New Revision: 37102
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=37102
Log:
[svn-inject] Installing original source of libtest-tempdir-perl
Added:
branches/upstream/libtest-tempdir-perl/
branches/upstream/libtest-tempdir-perl/current/
branches/upstream/libtest-tempdir-perl/current/MANIFEST
branches/upstream/libtest-tempdir-perl/current/MANIFEST.SKIP
branches/upstream/libtest-tempdir-perl/current/META.yml
branches/upstream/libtest-tempdir-perl/current/Makefile.PL
branches/upstream/libtest-tempdir-perl/current/SIGNATURE
branches/upstream/libtest-tempdir-perl/current/lib/
branches/upstream/libtest-tempdir-perl/current/lib/Test/
branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/
branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir.pm
branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Factory.pm
branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Handle.pm
branches/upstream/libtest-tempdir-perl/current/t/
branches/upstream/libtest-tempdir-perl/current/t/00_load.t
branches/upstream/libtest-tempdir-perl/current/t/basic.t
branches/upstream/libtest-tempdir-perl/current/t/factory.t
branches/upstream/libtest-tempdir-perl/current/t/handle.t
Added: branches/upstream/libtest-tempdir-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/MANIFEST?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/MANIFEST (added)
+++ branches/upstream/libtest-tempdir-perl/current/MANIFEST Mon Jun 1 08:40:30 2009
@@ -1,0 +1,12 @@
+lib/Test/TempDir.pm
+lib/Test/TempDir/Factory.pm
+lib/Test/TempDir/Handle.pm
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.SKIP
+t/00_load.t
+t/basic.t
+t/factory.t
+t/handle.t
+META.yml Module meta-data (added by MakeMaker)
+SIGNATURE Public-key signature (added by MakeMaker)
Added: branches/upstream/libtest-tempdir-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/MANIFEST.SKIP?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libtest-tempdir-perl/current/MANIFEST.SKIP Mon Jun 1 08:40:30 2009
@@ -1,0 +1,43 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\b_darcs\b
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+
+# Avoid Devel::Cover files.
+\bcover_db\b
+
+### DEFAULT MANIFEST.SKIP ENDS HERE ####
+
+\.DS_Store$
+\.sw.$
+(\w+-)*(\w+)-\d\.\d+(?:\.tar\.gz)?$
+
+\.t\.log$
+
+\.prove$
+
+# XS shit
+\.(?:bs|c|o)$
Added: branches/upstream/libtest-tempdir-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/META.yml?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/META.yml (added)
+++ branches/upstream/libtest-tempdir-perl/current/META.yml Mon Jun 1 08:40:30 2009
@@ -1,0 +1,22 @@
+--- #YAML:1.0
+name: Test-TempDir
+version: 0.04
+abstract: ~
+license: ~
+author: ~
+generated_by: ExtUtils::MakeMaker version 6.44
+distribution_type: module
+requires:
+ File::NFSLock: 0
+ File::Path: 2.04
+ File::Spec: 0
+ File::Temp: 0
+ Moose: 0.50
+ MooseX::Types::Path::Class: 0
+ namespace::clean: 0.08
+ Path::Class: 0
+ Sub::Exporter: 0
+ Test::use::ok: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Added: branches/upstream/libtest-tempdir-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/Makefile.PL?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/Makefile.PL (added)
+++ branches/upstream/libtest-tempdir-perl/current/Makefile.PL Mon Jun 1 08:40:30 2009
@@ -1,0 +1,26 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Test::TempDir',
+ VERSION_FROM => 'lib/Test/TempDir.pm',
+ INSTALLDIRS => 'site',
+ SIGN => 1,
+ PL_FILES => { },
+ PREREQ_PM => {
+ 'Test::use::ok' => 0,
+ 'File::Path' => '2.04', # reliable keep_root
+ 'File::Spec' => 0,
+ 'File::Temp' => 0,
+ 'File::NFSLock' => 0,
+ 'Moose' => '0.50',
+ 'MooseX::Types::Path::Class' => 0,
+ 'Path::Class' => 0,
+ 'Sub::Exporter' => 0,
+ 'namespace::clean' => "0.08",
+ },
+);
+
Added: branches/upstream/libtest-tempdir-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/SIGNATURE?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/SIGNATURE (added)
+++ branches/upstream/libtest-tempdir-perl/current/SIGNATURE Mon Jun 1 08:40:30 2009
@@ -1,0 +1,34 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.55.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It will check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 90f6402727c73a12b7a388630b09ad9321ab24aa MANIFEST
+SHA1 e8482690dad0ff3aaa335aa5b8b650851e504871 MANIFEST.SKIP
+SHA1 aea50868f304f01fc026858b933a10b1ac1c4891 META.yml
+SHA1 48bed2739dd21bd2554286785d82ffc1442aaac5 Makefile.PL
+SHA1 a37ac9d4051933d91884df5123993c228fc7b755 lib/Test/TempDir.pm
+SHA1 4b4ec4bfce5a9f4e5226116871fdf10a0ac27c0e lib/Test/TempDir/Factory.pm
+SHA1 39b5ff35cc6c90f61f280c418c096514f7ca8274 lib/Test/TempDir/Handle.pm
+SHA1 309b503ae2fb188d6329a99c77fff1f26f5130af t/00_load.t
+SHA1 ff5768d09781f96bad90ac0d9b204434593d3d2b t/basic.t
+SHA1 fec74f380524777572ea4412c42c90d4e619ed42 t/factory.t
+SHA1 e944e3373485fec1418c0ac616aab11904b5bff5 t/handle.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.7 (Darwin)
+
+iD8DBQFIaeMmVCwRwOvSdBgRAoeHAJ4ki/tBaFR58fMJTZim1LBka5bc9ACeJidT
+MWBUsOUnDn8GtuiguoEYPmA=
+=HQFq
+-----END PGP SIGNATURE-----
Added: branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir.pm?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir.pm (added)
+++ branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir.pm Mon Jun 1 08:40:30 2009
@@ -1,0 +1,148 @@
+#!/usr/bin/perl
+
+package Test::TempDir;
+
+use strict;
+use warnings;
+
+our $VERSION = "0.04";
+
+use File::Temp ();
+
+use Test::TempDir::Factory;
+
+use Sub::Exporter -setup => {
+ exports => [qw(temp_root tempdir tempfile scratch)],
+ groups => {
+ default => [qw(temp_root tempdir tempfile)],
+ },
+};
+
+our ( $factory, $dir );
+
+sub _factory { $factory ||= Test::TempDir::Factory->new }
+sub _dir { $dir ||= _factory->create }
+
+END { undef $dir; undef $factory };
+
+sub temp_root () { _dir->dir }
+
+sub _temp_args { DIR => temp_root()->stringify, CLEANUP => 0 }
+sub _template_args {
+ if ( @_ % 2 == 0 ) {
+ return ( _temp_args, @_ );
+ } else {
+ return ( $_[0], _temp_args, @_[1 .. $#_] );
+ }
+}
+
+sub tempdir { File::Temp::tempdir( _template_args(@_) ) }
+
+sub tempfile { File::Temp::tempfile( _template_args(@_) ) }
+
+sub scratch {
+ require Directory::Scratch;
+ Directory::Scratch->new( _temp_args, @_ );
+}
+
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Test::TempDir - Temporary files support for testing.
+
+=head1 SYNOPSIS
+
+ use Test::TempDir;
+
+ my $test_tempdir = temp_root();
+
+ my ( $fh, $file ) = tempfile();
+
+ my $directory_scratch_obj = scratch();
+
+=head1 DESCRIPTION
+
+Test::TempDir provides temporary directory creation with testing in mind.
+
+The differences between using this and using L<File::Temp> are:
+
+=over 4
+
+=item *
+
+If C<t/tmp> is available (writable, creatable, etc) it's preferred over
+C<$ENV{TMPDIR}> etc. Otherwise a temporary directory will be used.
+
+This is C<temp_root>
+
+=item *
+
+Lockfiles are used on C<t/tmp>, to prevent race conditions when running under a
+parallel test harness.
+
+=item *
+
+The C<temp_root> is cleaned at the end of a test run, but not if tests failed.
+
+=item *
+
+C<temp_root> is emptied at the begining of a test run unconditionally.
+
+=item *
+
+The default policy is not to clean the individual C<tempfiles> and C<tempdirs>
+within C<temp_root>, in order to aid in debugging of failed tests.
+
+=back
+
+=head1 EXPORTS
+
+=over 4
+
+=item temp_root
+
+The root of the temporary stuff.
+
+=item tempfile
+
+=item tempdir
+
+Wrappers for the L<File::Temp> functions of the same name.
+
+The default options are changed to use C<temp_root> for C<DIR> and disable
+C<CLEANUP>, but these are overridable.
+
+=item scrach
+
+Loads L<Directory::Scratch> and instantiates a new one, with the same default
+options as C<tempfile> and C<tempdir>.
+
+=back
+
+=head1 SEE ALSO
+
+L<File::Temp>, L<Directory::Scratch>, L<Path::Class>
+
+=head1 VERSION CONTROL
+
+This module is maintained using Darcs. You can get the latest version from
+L<http://nothingmuch.woobling.org/code>, and use C<darcs send> to commit
+changes.
+
+=head1 AUTHOR
+
+Yuval Kogman E<lt>nothingmuch at woobling.orgE<gt>
+
+=head1 COPYRIGHT
+
+ Copyright (c) 2008 Yuval Kogman. All rights reserved
+ This program is free software; you can redistribute
+ it and/or modify it under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Factory.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Factory.pm?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Factory.pm (added)
+++ branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Factory.pm Mon Jun 1 08:40:30 2009
@@ -1,0 +1,296 @@
+#!/usr/bin/perl
+
+package Test::TempDir::Factory;
+use Moose;
+
+use Carp qw(croak carp);
+use File::Spec;
+use File::Temp;
+use Path::Class;
+
+use MooseX::Types::Path::Class qw(Dir);
+
+use Test::TempDir::Handle;
+
+use namespace::clean -except => [qw(meta)];
+
+has lock => (
+ isa => "Bool",
+ is => "rw",
+ default => 1,
+);
+
+has lock_opts => (
+ isa => "HashRef",
+ is => "rw",
+ default => sub { { lock_type => "NONBLOCKING" } },
+);
+
+has lock_attempts => (
+ isa => "Int",
+ is => "rw",
+ default => 2,
+);
+
+has dir_name => (
+ isa => Dir,
+ is => "rw",
+ coerce => 1,
+ default => sub { dir($ENV{TEST_TEMPDIR} || $ENV{TEST_TMPDIR} || "tmp") },
+);
+
+has cleanup_policy => (
+ isa => "Str",
+ is => "rw",
+ default => sub { $ENV{TEST_TEMPDIR_CLEANUP} || "success" },
+);
+
+has t_dir => (
+ isa => Dir,
+ is => "rw",
+ coerce => 1,
+ default => sub { dir("t") },
+);
+
+has options => (
+ isa => "HashRef",
+ is => "rw",
+ default => sub { {} },
+);
+
+has use_subdir => (
+ isa => "Bool",
+ is => "rw",
+ default => 1,
+);
+
+has subdir_template => (
+ isa => "Str",
+ is => "rw",
+ default => File::Temp::TEMPXXX,
+);
+
+has handle_class => (
+ isa => "ClassName",
+ is => "rw",
+ default => "Test::TempDir::Handle",
+ handles => { new_handle => "new" },
+);
+
+has verbose => (
+ isa => "Bool",
+ is => "rw",
+ default => 0,
+);
+
+sub create {
+ my ( $self, @args ) = @_;
+
+ my ( $path, $lock ) = $self->create_and_lock( $self->base_path(@args), @args );
+
+ my $h = $self->new_handle(
+ dir => $path,
+ ( defined($lock) ? ( lock => $lock ) : () ),
+ cleanup_policy => $self->cleanup_policy,
+ @args,
+ );
+
+ $h->empty;
+
+ return $h;
+}
+
+sub create_and_lock {
+ my ( $self, $preferred, @args ) = @_;
+
+ if ( $self->use_subdir ) {
+ $preferred = $self->make_subdir($preferred);
+ } else {
+ $preferred->mkpath unless -d $preferred;
+ }
+
+ unless ( $self->lock ) {
+ return $preferred;
+ } else {
+ croak "When locking is enabled you must call create_and_lock in list context" unless wantarray;
+ if ( my $lock = $self->try_lock($preferred) ) {
+ return ( $preferred, $lock );
+ }
+
+ return $self->create_and_lock_fallback(@args);
+ }
+}
+
+sub create_and_lock_fallback {
+ my ( $self, @args ) = @_;
+
+ my $base = $self->fallback_base_path;
+
+ for ( 1 .. $self->lock_attempts ) {
+ my $dir = $self->make_subdir($base);
+
+ if ( $self->lock ) {
+ if ( my $lock = $self->try_lock($dir) ) {
+ return ( $dir, $lock );
+ }
+
+ rmdir $dir;
+ } else {
+ return $dir;
+ }
+ }
+
+ croak "Unable to create locked tempdir";
+}
+
+sub try_lock {
+ my ( $self, $path ) = @_;
+
+ return 1 if !$self->lock;
+
+ require File::NFSLock;
+ File::NFSLock->new({
+ file => $path->stringify . ".lock", # FIXME $path->file ? make sure it's not zapped by empty
+ %{ $self->lock_opts },
+ });
+}
+
+sub make_subdir {
+ my ( $self, $dir ) = @_;
+ $dir->mkpath unless -d $dir;
+ dir( File::Temp::tempdir( $self->subdir_template, DIR => $dir->stringify ) );
+}
+
+sub base_path {
+ my ( $self, @args ) = @_;
+
+ my $dir = $self->dir_name;
+
+ return $dir if -d $dir and -w $dir;
+
+ my $t = $self->t_dir;
+
+ if ( -d $t and -w $t ) {
+ $dir = $t->subdir($dir);
+ return $dir if -d $dir && -w $dir or not -e $dir;
+ }
+
+ $self->blurt("$t is not writable, using fallback");
+
+ return $self->fallback_base_path(@args);
+}
+
+sub blurt {
+ my ( $self, @blah ) = @_;
+ if ( $self->can("logger") and my $logger = $self->logger ) {
+ $logger->warn(@blah);
+ } else {
+ return unless $self->verbose;
+ carp(@blah);
+ }
+}
+
+sub fallback_base_path {
+ return dir(File::Spec->tmpdir);
+}
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Test::TempDir::Factory - A factory for creating L<Test::TempDir::Handle>
+objects.
+
+=head1 SYNOPSIS
+
+ my $f = Test::TempDir::Factory->new;
+
+ my $d = $f->create;
+
+ $d->empty;
+
+ # ...
+
+ $d->cleanup
+
+=head1 DESCRIPTION
+
+This class creates L<Test::TempDir::Handle> objects with the right C<dir>
+parameter, taking care of obtaining locks, creating directories, and handling
+fallback logic.
+
+=head1 ATTRIBUTES
+
+=over 4
+
+=item lock
+
+Whether or not to enable locking.
+
+Defaults to true.
+
+=item lock_opts
+
+A hash reference to pass to L<File::NFSLock>.
+
+Defaults to C<NONBLOCKING>
+
+=item lock_attempts
+
+How many times to try to create and lock a dir.
+
+Defaults to 2.
+
+=item dir_name
+
+The directory under C<t_dir> to use.
+
+Defaults to C<tmp>
+
+=item t_dir
+
+Defaults to C<t>
+
+=item use_subdir
+
+Whether to always use a temporary subdirectory under the temporary root.
+
+This means that with a C<success> cleanup policy all failures are retained.
+
+When disabled, C<t/tmp> will be used directly as C<temp_root>.
+
+Defaults to true.
+
+=item subdir_template
+
+The template to pass to C<tempdir>. Defaults to C<File::Temp::TEMPXXX>.
+
+=item handle_class
+
+Defaults to L<Test::TempDir::Handle>.
+
+=item verbose
+
+Whether or not to C<carp> diagnostics when falling back.
+
+If you subclass this factory and add a C<logger> method a la L<MooseX::Logger>
+then this parameter is ignored and all messages will be C<warn>ed on the
+logger.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item create
+
+Create a L<Test::TempDir::Handle> object with a proper C<dir> attribute.
+
+=back
+
+=cut
Added: branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Handle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Handle.pm?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Handle.pm (added)
+++ branches/upstream/libtest-tempdir-perl/current/lib/Test/TempDir/Handle.pm Mon Jun 1 08:40:30 2009
@@ -1,0 +1,180 @@
+#!/usr/bin/perl
+
+package Test::TempDir::Handle;
+use Moose;
+
+use MooseX::Types::Path::Class qw(Dir);
+use Moose::Util::TypeConstraints;
+
+use namespace::clean -except => [qw(meta)];
+
+has dir => (
+ isa => Dir,
+ is => "ro",
+ handles => [qw(file subdir rmtree)],
+);
+
+has lock => (
+ isa => "File::NFSLock",
+ is => "ro",
+ predicate => "has_lock",
+ clearer => "clear_lock",
+);
+
+has cleanup_policy => (
+ isa => enum( __PACKAGE__ . "::CleanupPolicy", qw(success always never) ),
+ is => "rw",
+ default => "success",
+);
+
+has test_builder => (
+ isa => "Test::Builder",
+ is => "rw",
+ lazy_build => 1,
+ handles => { test_summary => "summary" },
+);
+
+sub _build_test_builder {
+ require Test::Builder;
+ Test::Builder->new;
+}
+
+sub failing_tests {
+ my $self = shift;
+ grep { !$_ } $self->test_summary;
+}
+
+sub empty {
+ my $self = shift;
+ return unless -d $self->dir;
+ $self->rmtree({ keep_root => 1 });
+}
+
+sub delete {
+ my $self = shift;
+ return unless -d $self->dir;
+ $self->rmtree({ keep_root => 0 });
+}
+
+sub release_lock {
+ my $self = shift;
+
+ $self->clear_lock;
+
+ # FIXME always unlock? or allow people to keep the locks around by enrefing them?
+
+ #if ( $self->has_lock ) {
+ # $self->lock->unlock;
+ # $self->clear_lock;
+ #}
+}
+
+sub DEMOLISH {
+ my $self = shift;
+ $self->cleanup;
+}
+
+sub cleanup {
+ my ( $self, @args ) = @_;
+
+ $self->release_lock;
+
+ my $policy = "cleanup_policy_" . $self->cleanup_policy;
+
+ $self->can($policy) or die "Unknown cleanup policy " . $self->cleanup_policy;
+
+ $self->$policy(@args);
+}
+
+sub cleanup_policy_never {}
+
+sub cleanup_policy_always {
+ my ( $self, @args ) = @_;
+
+ $self->delete;
+}
+
+sub cleanup_policy_success {
+ my ( $self, @args ) = @_;
+
+ if ( $self->failing_tests ) {
+ $self->test_builder->diag("Leaving temporary directory '" . $self->dir . "' due to test fails");
+ } else {
+ $self->cleanup_policy_always(@args);
+ }
+}
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Test::TempDir::Handle - A handle for managing a temporary directory root.
+
+=head1 SYNOPSIS
+
+ use Test::TempDir::Handle;
+
+ my $h = Test::TempDir::Handle->new( dir => dir("t/tmp") );
+
+ $h->empty;
+
+ # ...
+
+ $h->cleanup; # will delete on success by default
+
+=head1 DESCRIPTION
+
+This class manages a temporary directory.
+
+=head1 ATTRIBUTES
+
+=over 4
+
+=item dir
+
+The L<Path::Class::Dir> that is being managed.
+
+=item lock
+
+An optional lock object (L<File::NFSLock>). Just kept around for reference counting.
+
+=item cleanup_policy
+
+One of C<success>, C<always> or C<never>.
+
+C<success> means that C<cleanup> deletes only if C<test_builder> says the tests
+have passed.
+
+=item test_builder
+
+The L<Test::Builder> singleton.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item empty
+
+Cleans out the directory but doesn't delete it.
+
+=item delete
+
+Cleans out the directory and removes it.
+
+=item cleanup
+
+Calls C<delete> if the C<cleanup_policy> dictates to do so.
+
+This is normally called automatically at destruction.
+
+=back
+
+=cut
+
+
Added: branches/upstream/libtest-tempdir-perl/current/t/00_load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/t/00_load.t?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/t/00_load.t (added)
+++ branches/upstream/libtest-tempdir-perl/current/t/00_load.t Mon Jun 1 08:40:30 2009
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use ok 'Test::TempDir::Handle';
+use ok 'Test::TempDir::Factory';
+use ok 'Test::TempDir';
+
Added: branches/upstream/libtest-tempdir-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/t/basic.t?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/t/basic.t (added)
+++ branches/upstream/libtest-tempdir-perl/current/t/basic.t Mon Jun 1 08:40:30 2009
@@ -1,0 +1,41 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ use File::Spec;
+ plan skip_all => "No writable temp dir" unless grep { -d && -w } File::Spec->tmpdir;
+ plan 'no_plan';
+}
+
+use ok 'Test::TempDir' => qw(temp_root scratch tempfile);
+
+isa_ok( my $root = temp_root, "Path::Class::Dir" );
+
+ok( -d $root, "root exists" );
+
+ok( my ( $fh, $file ) = tempfile(), "tempfile" );
+
+ok( $fh, "file handle returned" );
+ok( $file, "file name returned" );
+
+ok( ref($fh), "filehandle is a ref" );
+ok( eval { fileno($fh) }, "file opened" );
+ok( (print $fh "bar"), "writable" );;
+
+ok( !ref($file), "file name is not a ref" );
+ok( -f $file, "file exists" );
+
+ok( $root->contains($file), "root contains file" );
+
+SKIP: {
+ skip "no Directory::Scratch", 2 unless eval { require Directory::Scratch };
+
+ isa_ok( my $s = scratch(), "Directory::Scratch" );
+
+ ok( $root->contains($s->base), "root contains scratch dir" );
+}
+
Added: branches/upstream/libtest-tempdir-perl/current/t/factory.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/t/factory.t?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/t/factory.t (added)
+++ branches/upstream/libtest-tempdir-perl/current/t/factory.t Mon Jun 1 08:40:30 2009
@@ -1,0 +1,96 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Path::Class;
+use File::Temp qw(tempdir);
+
+my $tmp;
+
+BEGIN {
+ use File::Spec;
+
+ plan skip_all => "No writable temp dir" unless grep { -d && -w } File::Spec->tmpdir;
+ $tmp = dir( tempdir( CLEANUP => 1 ) );
+ plan skip_all => "couldn't create temp dir" unless -d $tmp && -w $tmp;
+
+ plan 'no_plan';
+}
+
+use ok 'Test::TempDir::Factory';
+
+delete @ENV{qw(TEST_TEMPDIR TEST_TMPDIR TEST_TEMPDIR_CLEANUP)};
+
+my $f = Test::TempDir::Factory->new;
+
+isa_ok( $f, "Test::TempDir::Factory" );
+
+is( $f->dir_name, dir("tmp"), "default dir_name" );
+is( $f->t_dir, dir("t"), "default t_dir" );
+
+$f->t_dir($tmp);
+
+my $subdir = $tmp->subdir($f->dir_name);
+
+is( $f->base_path, $subdir, "base path" );
+
+ok( not(-d $f->base_path), "base path doesn't exist yet" );
+
+ok( $f->use_subdir, "subdirs enabled" );
+
+my ( $path, $lock ) = $f->create_and_lock($f->base_path);
+
+isa_ok( $path, "Path::Class::Dir" );
+
+ok( $subdir->contains($path), "preferred path used" );
+
+ok( -d $path, "created" );
+
+isa_ok( $lock, "File::NFSLock", "lock" );
+
+my ( $fallback_path, $fallback_lock ) = $f->create_and_lock_fallback($f->base_path);
+
+isa_ok( $fallback_path, "Path::Class::Dir" );
+
+isnt( $fallback_path, $path, "fallback path is different" );
+
+isa_ok( $fallback_lock, "File::NFSLock" );
+
+{
+ $f->lock(0);
+
+ my ( $new_fb ) = $f->create_and_lock_fallback($f->base_path);
+
+ isnt( $new_fb, $path, "second fallback is different from base path" );
+ isnt( $new_fb, $fallback_path, "and from first fallback path" );
+
+ rmdir $new_fb;
+}
+
+
+$f->lock(1);
+
+isa_ok( my $dir = $f->create, "Test::TempDir::Handle" );
+
+isa_ok( $dir->dir, "Path::Class::Dir" );
+
+ok( $subdir->contains( $dir->dir ), "created in the right place" );
+
+isa_ok( $dir->lock, "File::NFSLock" );
+
+SKIP: {
+ my $lockfile = $dir->lock->{lock_file} or skip "no lockfile", 2;
+
+ ok( -f $lockfile, "lockfile exists" );
+
+ $dir->empty;
+
+ ok( -f $lockfile, "lockfile exists after ->empty" );
+}
+
+rmdir $fallback_path;
+
+
Added: branches/upstream/libtest-tempdir-perl/current/t/handle.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-tempdir-perl/current/t/handle.t?rev=37102&op=file
==============================================================================
--- branches/upstream/libtest-tempdir-perl/current/t/handle.t (added)
+++ branches/upstream/libtest-tempdir-perl/current/t/handle.t Mon Jun 1 08:40:30 2009
@@ -1,0 +1,65 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Path::Class;
+use File::Temp qw(tempdir);
+use File::Path;
+
+my $tmp;
+
+BEGIN {
+ use File::Spec;
+
+ plan skip_all => "No writable temp dir" unless grep { -d && -w } File::Spec->tmpdir;
+ $tmp = dir( tempdir( CLEANUP => 1 ) );
+ plan skip_all => "couldn't create temp dir" unless -d $tmp && -w $tmp;
+
+ plan 'no_plan';
+}
+
+use ok 'Test::TempDir::Handle';
+
+isa_ok( my $h = Test::TempDir::Handle->new( dir => $tmp ), "Test::TempDir::Handle" );
+
+is( $h->dir, $tmp, "dir set" );
+
+is( $h->cleanup_policy, "success", "default cleanup policy" );
+
+my $file = $h->dir->file("foo");
+my $subdir = $h->dir->subdir("bar");
+
+$file->touch;
+$subdir->mkpath;
+
+ok( -f $file, "file created" );
+ok( -d $subdir, "subdir created" );
+
+$h->empty;
+
+ok( not(-f $file), "file removed by empty" );
+ok( not(-d $subdir), "subdir removed by empty" );
+
+is_deeply( [ $h->dir->children ], [], "no children" );
+
+ok( -d $tmp, "dir exists" );
+
+$file->touch;
+
+ok( -f $file, "file exists" );
+
+$h->cleanup_policy("never");
+
+$h->cleanup;
+
+ok( -f $file, "file exists" );
+
+$h->cleanup_policy("always");
+
+$h->cleanup;
+
+ok( not(-d $tmp), "dir removed by delete" );
+
More information about the Pkg-perl-cvs-commits
mailing list