Main   Changelog   Spec   Patches   Sources   Download   Gear   Bugs and FR  Repocop 

Directory-Scratch-0.14/000075500000000000000000000000001143472721200147705ustar00rootroot00000000000000Directory-Scratch-0.14/.gitignore000064400000000000000000000001031143472721200167520ustar00rootroot00000000000000META.yml
Makefile
Directory-Scratch-*
blib
inc
pm_to_blib
cover_db
Directory-Scratch-0.14/Changes000064400000000000000000000035111143472721200162630ustar00rootroot00000000000000Revision history for Directory-Scratch
0.14    8 June 2008
        * remove auto_install and update Module::Install

0.13    19 October 2007
        * add "chmod" and "stat" commands

0.12    25 January 2007
        * fix non-hard-coded '/' for Win32 users CORRECTLY; it
	  really works now, I promise!
        * add create_tree for quickly creating directory trees

0.11	27 December 2006
	* add environment variable to suppress auto-cleanup
	* fix hard-coded '/' for Win32 users

0.10    9 December 2006
	* up File::Slurp dependency to 9999.12, required for AS/Win32
	* increase test coverage
	* fix bug where a platform argument to new() is ignored

0.09    14 Septemeber 2006
        * decided to go back to File::Slurp
        * decided to croak if String::Random isn't installed
        * using Path::Class internally
        * added option to make UNIX paths Just Work on non-UNIX systems
          (perl has this already, but this converts to the right format
           internally, so that debugging messags make sense also)
        * actually works on Win32 now

0.08	3 September 2006
	More cleanups:
	 * clone => child
	 * binmode
	 * stringify
	doc fixes

0.06    22 August 2006
        Applied a patch (#21120) from TOBEYA.  API has changed a bit,
        but it's for the better.

0.05    7 August 2006
        Removed some debugging code that shouldn't have been pushed to
        CPAN :)

0.04	7 August 2006
	Added list, exists, read, write, append, and link; and lots
	more tests.

0.03    17 July 2006
	Fixed an even sillier bug: touch(@lines) didn't work because
	the touch looked like my @lines, not my @lines = @_; !!!
	Added a test for this

0.02    3 July 2006
	Fixed a silly bug: mkdir('a'); mkdir('a/b'); would fail because
	      	      	   a already existed.

0.01    2 July 2006
        First version, released on an unsuspecting world.

Directory-Scratch-0.14/MANIFEST000064400000000000000000000023051143472721200161210ustar00rootroot00000000000000.gitignore
Changes
examples/basic.pl
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/PAR.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/Directory/Scratch.pm
Makefile.PL
MANIFEST			This list of files
MANIFEST.SKIP
META.yml
README
t/00-load.t
t/developer/boilerplate.t
t/developer/pod-coverage.t
t/developer/pod.t
t/integration/01-parents_too.t
t/integration/01-scratch.t
t/integration/02-nesting.t
t/integration/03-list.t
t/integration/04-links.t
t/integration/05-readwrite.t
t/integration/06-append-prepend.t
t/integration/07-delete.t
t/integration/08-exists.t
t/integration/09-clone_object.t
t/integration/10-new-with-arguments.t
t/integration/11-cleanup.t
t/integration/11-stringify.t
t/integration/12-randfile.t
t/integration/other_output_seperator.t
t/os/mac.t
t/os/win32.t
t/unit/append.t
t/unit/chmod.t
t/unit/cleanup.t
t/unit/create_tree.t
t/unit/delete.t
t/unit/invalid_clone.t
t/unit/invalid_directory.t
t/unit/link.t
t/unit/ls.t
t/unit/mkdir.t
t/unit/openfile.t
t/unit/randfile.t
t/unit/read.t
t/unit/stat.t
t/unit/tempfile.t
t/unit/touch.t
t/unit/write.t
Directory-Scratch-0.14/MANIFEST.SKIP000064400000000000000000000001231143472721200166620ustar00rootroot00000000000000.git/
blib
pm_to_blib
MANIFEST.bak
MANIFEST.SKIP~
cover_db
Makefile$
Makefile.old$
Directory-Scratch-0.14/Makefile.PL000064400000000000000000000007431143472721200167460ustar00rootroot00000000000000use strict;
use warnings;
use inc::Module::Install;

name 'Directory-Scratch';
all_from 'lib/Directory/Scratch.pm';

requires 
  'File::Temp'  => 0,
  'File::Path'  => 0,
  'File::Slurp' => '9999.12',
  'Path::Class' => 0,
  'File::Copy'  => 0,
  'File::Spec'  => 0,
  'File::stat'  => 0, # core
  'Carp'        => 0;

build_requires
  'Test::More' => 0;

features 
  'String::Random for random files' => 
  ['String::Random' => 0];

par_base 'JROCKWAY';

tests 't/*/*.t';
WriteAll;
Directory-Scratch-0.14/README000064400000000000000000000020671143472721200156550ustar00rootroot00000000000000Directory-Scratch

Directory::Scratch creates a scratch space for your application to
(portably) manipulate files.  Designed for testing File::* modules,
but may be useful elsewhere.

INSTALLATION

To install this module, run the following commands:

    perl Makefile.PL
    make
    make test
    make install

If make test fails, don't install the module.  File a bug report instead.

SUPPORT AND DOCUMENTATION

After installing, you can find documentation for this module with the perldoc command.

    perldoc Directory::Scratch

You can also look for information at:

    Search CPAN
        http://search.cpan.org/dist/Directory-Scratch

    CPAN Request Tracker:
        http://rt.cpan.org/NoAuth/Bugs.html?Dist=Directory-Scratch

    AnnoCPAN, annotated CPAN documentation:
        http://annocpan.org/dist/Directory-Scratch

    CPAN Ratings:
        http://cpanratings.perl.org/d/Directory-Scratch

COPYRIGHT AND LICENCE

Copyright (C) 2006 Jonathan Rockway

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Directory-Scratch-0.14/examples/000075500000000000000000000000001143472721200166065ustar00rootroot00000000000000Directory-Scratch-0.14/examples/basic.pl000064400000000000000000000014171143472721200202270ustar00rootroot00000000000000#!/usr/bin/perl
# basic.pl 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use strict;
use warnings;
use Directory::Scratch;

=pod

Guided tour of Directory::Scratch.

First, create a Directory::Scratch object

=cut

my $tmp = Directory::Scratch->new;

=pod

Then create a file.

=cut

print "Hello reader!  Welcome to this Knuth-like journey!\n";

my $file = $tmp->touch('foo');
print "foo was created as $file\n";

=pod

We dont't have to remember $file, we can get the full path later:

=cut

my $path = $tmp->exists('foo');
print "$file and $path are the same\n";

=pod

C<exists> also checks for existence, of course.

=cut

print "No file called fake!\n" if(!$tmp->exists('fake'));

=pod

That's all for now.

=cut

print "Goodbye.  I'm cleaning up $tmp for you!";
Directory-Scratch-0.14/lib/000075500000000000000000000000001143472721200155365ustar00rootroot00000000000000Directory-Scratch-0.14/lib/Directory/000075500000000000000000000000001143472721200175025ustar00rootroot00000000000000Directory-Scratch-0.14/lib/Directory/Scratch.pm000064400000000000000000000476761143472721200214530ustar00rootroot00000000000000package Directory::Scratch;

# see POD after __END__.

use warnings;
use strict;
use Carp;
use File::Temp;
use File::Copy;
use Path::Class qw(dir file);
use File::Slurp qw(read_file write_file);
use File::Spec;
use File::stat (); # no imports

my ($OUR_PLATFORM) = $File::Spec::ISA[0] =~ /::(\w+)$/;
my $PLATFORM = 'Unix';
use Scalar::Util qw(blessed);

use overload q{""} => \&base,
  fallback => "yes, fallback";


our $VERSION = '0.14';

# allow the user to specify which OS's semantics he wants to use
# if platform is undef, then we won't do any translation at all
sub import {
    my $class = shift;
    return unless @_;
    $PLATFORM = shift;
    eval("require File::Spec::$PLATFORM");
    croak "Don't know how to deal with platform '$PLATFORM'" if $@;
    return $PLATFORM;
}

# create an instance
sub new {
    my $class = shift;
    my $self  = {};
    my %args;

    eval { %args = @_ };
    croak 'Invalid number of arguments to Directory::Scratch->new' if $@;
    my $platform = $PLATFORM;
    $platform = $args{platform} if defined $args{platform};
    
    # explicitly default CLEANUP to 1
    $args{CLEANUP} = 1 unless exists $args{CLEANUP};
    
    # don't clean up if environment variable is set
    $args{CLEANUP} = 0
    if(defined $ENV{PERL_DIRECTORYSCRATCH_CLEANUP} &&
       $ENV{PERL_DIRECTORYSCRATCH_CLEANUP} == 0);
    
    # TEMPLATE is a special case, since it's positional in File::Temp
    my @file_temp_args;

    # convert DIR from their format to a Path::Class
    $args{DIR} = Path::Class::foreign_dir($platform, $args{DIR}) if $args{DIR};
    
    # change our arg format to one that File::Temp::tempdir understands
    for(qw(CLEANUP DIR)){
	push @file_temp_args, ($_ => $args{$_}) if $args{$_};
    }
    
    # this is a positional argument, not a named argument
    unshift @file_temp_args, $args{TEMPLATE} if $args{TEMPLATE};
    
    # fix TEMPLATE to do what we mean; if TEMPLATE is set then TMPDIR
    # needs to be set also
    push @file_temp_args, (TMPDIR => 1) if($args{TEMPLATE} && !$args{DIR});
    
    # keep this around for C<child>
    $self->{args} = \%args;

    # create the directory!
    my $base = dir(File::Temp::tempdir(@file_temp_args));
    croak "Couldn't create a tempdir: $!" unless -d $base;
    $self->{base} = $base;

    bless $self, $class;    
    $self->platform($platform); # set platform for this instance
    return $self;
}

sub child {
    my $self = shift;
    my %args;
    
    croak 'Invalid reference passed to Directory::Scratch->child'
      if !blessed $self || !$self->isa(__PACKAGE__);
    
    # copy args from parent object
    %args = %{$self->{_args}} if exists $self->{_args};
    
    # force the directory end up as a child of the parent, though
    $args{DIR} = $self->base->stringify;
    
    return Directory::Scratch->new(%args);
}

sub base {
    my $self = shift;
    return $self->{base};#->stringify;
}

sub platform {
    my $self = shift;
    my $desired = shift;

    if($desired){
	eval "require File::Spec::$desired";
	croak "Unknown platform '$desired'" if $@;
	$self->{platform} = $desired;
    }
    
    return $self->{platform};
}

# make Path::Class's foreign_* respect the instance's desired platform
sub _foreign_file {
    my $self = shift;
    my $platform = $self->platform;

    if($platform){
	my $file = Path::Class::foreign_file($platform, @_);
	return $file->as_foreign($OUR_PLATFORM);
    }
    else {
	return Path::Class::file(@_);
    }
}

sub _foreign_dir {
    my $self = shift;
    my $platform = $self->platform;

    if($platform){
	my $dir = Path::Class::foreign_dir($platform, @_);
	return $dir->as_foreign($OUR_PLATFORM);
    }
    else {
	return Path::Class::dir(@_);
    }
}

sub exists {
    my $self = shift;
    my $file = shift;
    my $base = $self->base;
    my $path = $self->_foreign_file($base, $file);
    return dir($path) if -d $path;
    return $path if -e $path;
    return; # undef otherwise
}

sub stat {
    my $self = shift;
    my $file = shift;
    my $path = $self->_foreign_file($self->base, $file);

    if(wantarray){
        return stat $path; # core stat, returns a list
    }
    
    return File::stat::stat($path); # returns an object
}

sub mkdir {
    my $self = shift;
    my $dir  = shift;
    my $base = $self->base;
    $dir = $self->_foreign_dir($base, $dir);
    $dir->mkpath;
    return $dir if (-e $dir && -d $dir);
    croak "Error creating $dir: $!";
}

sub link {
    my $self = shift;
    my $from = shift;
    my $to   = shift;
    my $base = $self->base;

    croak "Symlinks are not supported on MSWin32" 
      if $^O eq 'MSWin32';

    $from = $self->_foreign_file($base, $from);
    $to   = $self->_foreign_file($base, $to);

    symlink($from, $to) 
      or croak "Couldn't link $from to $to: $!";
    
    return $to;
}

sub chmod {
    my $self  = shift;
    my $mode  = shift;
    my @paths = @_;
    
    my @translated = map { $self->_foreign_file($self->base, $_) } @paths;
    return chmod $mode, @translated;
}

sub read {
    my $self = shift;
    my $file = shift;
    my $base = $self->base;
    
    $file = $self->_foreign_file($base, $file);

    croak "Cannot read $file: is a directory" if -d $file;
    
    if(wantarray){
	my @lines = read_file($file->stringify);
	chomp @lines;
	return @lines;
    }
    else {
	my $scalar = read_file($file->stringify);
	chomp $scalar;
	return $scalar;
    }
}

sub write {
    my $self = shift;
    my $file = shift;
    my $base = $self->base;
    
    my $path = $self->_foreign_file($base, $file);
    $path->parent->mkpath;
    croak "Couldn't create parent dir ". $path->parent. ": $!"
      unless -e $path->parent;
    
    # figure out if we're "write" or "append"
    my (undef, undef, undef, $method) = caller(1);

    my $args;
    if(defined $method && $method eq 'Directory::Scratch::append'){
	$args->{append} = 1;
	write_file($path->stringify, $args, map { $_. ($, || "\n") } @_) 
	  or croak "Error writing file: $!";
    }
    else { # (cut'n'paste)++
	write_file($path->stringify, map { $_. ($, || "\n") } @_) 
	  or croak "Error writing file: $!";
    }
    return 1;
}

sub append {
    return &write(@_); # magic!
}

sub tempfile {
    my $self = shift;
    my $path = shift;

    if(!defined $path){
	$path = $self->base;
    }
    else {
	$path = $self->_foreign_dir($self->base, $path);
    }
    
    my ($fh, $filename) =  File::Temp::tempfile( DIR => $path );
    $filename = file($filename); # "class"ify the file
    if(wantarray){
	return ($fh, $filename);
    }
    
    # XXX: I don't know why you would want to do this...
    return $fh;
}

sub openfile {
    my $self = shift;
    my $file = shift;
    my $base = $self->base;

    my $path = $self->_foreign_file($base, $file);
    $path->dir->mkpath;
    croak 'Parent directory '. $path->dir. 
      ' does not exist, and could not be created' 
	unless -d $path->dir;
    open(my $fh, '+>', $path) or croak "Failed to open $path: $!"; 
    return ($fh, $path) if(wantarray);
    return $fh;
}

sub touch {
    my $self = shift;
    my $file = shift;
    my ($fh, $path) = $self->openfile($file);
    
    $self->write($file, @_) || croak 'failed to write file: $!';
    return $path;
}


sub ls {
    my $self = shift;
    my $dir = shift;
    my $base = $self->base;
    my $path = dir($base);
    my @result;

    if($dir){
	$dir = $self->_foreign_dir($dir); 
	$path = $self->exists($dir);    
	croak "No path `$dir' in temporary directory"  if !$path;
	
	return (file($dir)) if !-d $path;
	$path = dir($base, $dir);
    }
    
    $path->recurse( callback => 
		    sub {
			my $file = shift;
			return if $file eq $path;

			push @result, $file->relative($base);
		    }
		  );
    
    return @result;
}

sub create_tree {
    my $self = shift;
    my %tree = %{shift()||{}};
    
    foreach my $element (keys %tree){
	my $value = $tree{$element};
	if('SCALAR' eq ref $value){
	    $self->mkdir($element);
	}
	else {
	    my @lines = ($value);
	    @lines = @$value if 'ARRAY' eq ref $value;
	    $self->touch($element, @lines);
	}
    }
}

sub delete {
    my $self = shift;
    my $path = shift;
    my $base = $self->base;

    $path = $self->_foreign_file($base, $path);
    
    croak "No such file or directory '$path'" if !-e $path;
    
    if(-d _){ # reuse stat() from -e test
	return (scalar rmdir $path or croak "Couldn't remove directory $path: $!");
    }
    else {
	return (scalar unlink $path or croak "Couldn't unlink $path: $!");
    }
    
}

sub cleanup {
    my $self = shift;
    my $base = $self->base;
    
    # capture warnings
    my @errors;
    local $SIG{__WARN__} = sub {
        push @errors, @_;
    };
    
    File::Path::rmtree( $base->stringify );

    if ( @errors > 0 ) {
        croak "cleanup() method failed: $!\n@errors";
    }

    $self->{args}->{CLEANUP} = 1; # it happened, so update this
    return 1;
}

sub randfile {
    my $self = shift;

    # make sure we can do this
    eval {
	require String::Random;
    };
    croak 'randfile: String::Random is required' if $@;

    # setup some defaults
    my( $min, $max ) = ( 1024, 131072 );

    if ( @_ == 2 ) {
	($min, $max) = @_;
    }
    elsif ( @_ == 1 ) {
        $max = $_[0];
        $min = int(rand($max)) if ( $min > $max );
    }
    confess "randfile: Cannot request a maximum length < 1"
      if ( $max < 1 );
    
    my ($fh, $name) = $self->tempfile;
    croak "Could not open $name: $!" if !$fh;
    $name = file($name);
    
    my $rand = String::Random->new();
    write_file($fh, $rand->randregex(".{$min,$max}"));    
    
    return file($name);
}

# throw a warning if CLEANUP is off and cleanup hasn't been called
sub DESTROY {
    my $self = shift;
    carp "Warning: not cleaning up files in ". $self->base
      if !$self->{args}->{CLEANUP};
}

1;

__END__

=head1 NAME

Directory::Scratch - Easy-to-use self-cleaning scratch space.

=head1 SYNOPSIS

When writing test suites for modules that operate on files, it's often
inconvenient to correctly create a platform-independent temporary
storage space, manipulate files inside it, then clean it up when the
test exits.  The inconvenience usually results in tests that don't work
everwhere, or worse, no tests at all.

This module aims to eliminate that problem by making it easy to do
things right.

Example:

    use Directory::Scratch;

    my $temp = Directory::Scratch->new();
    my $dir  = $temp->mkdir('foo/bar');
    my @lines= qw(This is a file with lots of lines);
    my $file = $temp->touch('foo/bar/baz', @lines);

    my $fh = openfile($file);
    print {$fh} "Here is another line.\n";
    close $fh;

    $temp->delete('foo/bar/baz');

    undef $temp; # everything else is removed

    # Directory::Scratch objects stringify to base
    $temp->touch('foo');
    ok(-e "$temp/foo");  # /tmp/xYz837/foo should exist 

=head1 EXPORT

The first argument to the module is optional, but if specified, it's
interperted as the name of the OS whose file naming semantics you want
to use with Directory::Scratch.  For example, if you choose "Unix",
then you can provide paths to Directory::Scratch in UNIX-form
('foo/bar/baz') on any platform.  Unix is the default if you don't
choose anything explicitly.

If you want to use the local platform's flavor (not recommended),
specify an empty import list:

    use Directory::Scratch ''; # use local path flavor

Recognized platforms (from L<File::Spec|File::Spec>):

=over 4

=item Mac

=item UNIX

=item Win32

=item VMS

=item OS2

=back

The names are case sensitive, since they simply specify which
C<File::Spec::> module to use when splitting the path.

=head2 EXAMPLE

    use Directory::Scratch 'Win32';
    my $tmp = Directory::Scratch->new();
    $tmp->touch("foo\\bar\\baz"); # and so on

=head1 METHODS

The file arguments to these methods are always relative to the
temporary directory.  If you specify C<touch('/etc/passwd')>, then a
file called C</tmp/whatever/etc/passwd> will be created instead.

This means that the program's PWD is ignored (for these methods), and
that a leading C</> on the filename is meaningless (and will cause
portability problems).

Finally, whenever a filename or path is returned, it is a
L<Path::Class|Path::Class> object rather than a string containing the
filename.  Usually, this object will act just like the string, but to
be extra-safe, call C<< $path->stringify >> to ensure that you're
really getting a string.  (Some clever modules try to determine
whether a variable is a filename or a filehandle; these modules
usually guess wrong when confronted with a C<Path::Class> object.)

=head2 new

Creates a new temporary directory (via File::Temp and its defaults).
When the object returned by this method goes out of scope, the
directory and its contents are removed.

    my $temp = Directory::Scratch->new;
    my $another = $temp->new(); # will be under $temp

    # some File::Temp arguments get passed through (may be less portable)
    my $temp = Directory::Scratch->new(
        DIR      => '/var/tmp',       # be specific about where your files go
        CLEANUP  => 0,                # turn off automatic cleanup
        TEMPLATE => 'ScratchDirXXXX', # specify a template for the dirname
    );

If C<DIR>, C<CLEANUP>, or C<TEMPLATE> are omitted, reasonable defaults
are selected.  C<CLEANUP> is on by default, and C<DIR> is set to C<File::Spec->tmpdir>;

=head2 child

Creates a new C<Directory::Scratch> directory inside the current
C<base>, copying TEMPLATE and CLEANUP options from the current
instance.  Returns a C<Directory::Scratch> object.

=head2 base

Returns the full path of the temporary directory, as a Path::Class
object.

=head2 platform([$platform])

Returns the name of the platform that the filenames are being
interperted as (i.e., "Win32" means that this module expects paths
like C<\foo\bar>, whereas "UNIX" means it expects C</foo/bar>).

If $platform is sepcified, the platform is changed to the passed
value.  (Overrides the platform specified at module C<use> time, for
I<this instance> only, not every C<Directory::Scratch> object.)

=head2 touch($filename, [@lines])

Creates a file named C<$filename>, optionally containing the elements
of C<@lines> separated by the output record separator C<$\>.

The Path::Class object representing the new file is returned if the
operation is successful, an exception is thrown otherwise.

=head2 create_tree(%tree)

Creates a file for every key/value pair if the hash, using the key as
the filename and the value as the contents.  If the value is an
arrayref, the array is used as the optional @lines argument to
C<touch>.  If the value is a reference to C<undef>, then a directory
is created instead of a file.

Example:

    %tree = ( 'foo'     => 'this is foo',
              'bar/baz' => 'this is baz inside bar',
              'lines'   => [qw|this file contains 5 lines|],
              'dir'     => \undef,
            );
    $tmp->create_tree(%tree);

In this case, two directories are created, C<dir> and C<bar>; and
three files are created, C<foo>, C<baz> (inside C<bar>), and
C<lines>. C<foo> and C<baz> contain a single line, while C<lines>
contains 5 lines.

=head2 openfile($filename)

Opens $filename for writing and reading (C<< +> >>), and returns the
filehandle.  If $filename already exists, it will be truncated.  It's
up to you to take care of flushing/closing.

In list context, returns both the filehandle and the filename C<($fh,
$path)>.

=head2 mkdir($directory)

Creates a directory (and its parents, if necessary) inside the
temporary directory and returns its name.  Any leading C</> on the
directory name is ignored; all directories are created inside the
C<base>.

The full path of this directory is returned if the operation is
successful, otherwise an exception is thrown.

=head2 tempfile([$path])

Returns an empty filehandle + filename in $path.  If $path is omitted,
the base directory is assumed.

See L<File::Temp::tempfile|File::Temp/FUNCTIONS/tempfile>.

    my($fh,$name) = $scratch->tempfile;

=head2 exists($file)

Returns the file's real (system) path if $file exists, undefined
otherwise.

Example:

    my $path = $tmp->exists($file);
    if(defined $path){
       say "Looks like you have a file at $path!";
       open(my $fh, '>>', $path) or die $!;
       print {$fh} "add another line\n";
       close $fh or die $!;
    }
    else {
       say "No file called $file."
    }

=head2 stat($file)

Stats C<$file>.  In list context, returns the list returned by the
C<stat> builtin.  In scalar context, returns a C<File::stat> object.

=head2 read($file)

Returns the contents of $file.  In array context, returns a list of
chompped lines.  In scalar context, returns the raw octets of the
file (with any trailing newline removed).

If you wrote the file with C<$,> set, you'll want to set C<$/> to
C<$,> when reading the file back in:

    local $, = '!';
    $tmp->touch('foo', qw{foo bar baz}); # writes "foo!bar!baz!" to disk
    scalar $tmp->read('foo') # returns "foo!bar!baz!"
    $tmp->read('foo') # returns ("foo!bar!baz!")
    local $/ = '!';
    $tmp->read('foo') # returns ("foo", "bar", "baz")

=head2 write($file, @lines)

Replaces the contents of file with @lines.  Each line will be ended
with a C<\n>, or C<$,> if it is defined.  The file will be created if
necessary.

=head2 append($file, @lines)

Appends @lines to $file, as per C<write>.

=head2 randfile()

Generates a file with random string data in it.   If String::Random is
available, it will be used to generate the file's data.  Takes 0,
1, or 2 arguments - default size, max size, or size range.

A max size of 0 will cause an exception to be thrown.

Examples:

    my $file = $temp->randfile(); # size is between 1024 and 131072
    my $file = $temp->randfile( 4192 ); # size is below 4129
    my $file = $temp->randfile( 1000000, 4000000 ); 

=head2 link($from, $to)

Symlinks a file in the temporary directory to another file in the
temporary directory.

Note: symlinks are not supported on Win32.  Portable code must not use
this method.  (The method will C<croak> if it won't work.)

=head2 ls([$path])

Returns a list (in no particular order) of all files below C<$path>.
If C<$path> is omitted, the root is assumed.  Note that directories
are not returned.

If C<$path> does not exist, an exception is thrown.

=head2 delete($path)

Deletes the named file or directory at $path.

If the path is removed successfully, the method returns true.
Otherwise, an exception is thrown.

(Note: delete means C<unlink> for a file and C<rmdir> for a directory.
C<delete>-ing an unempty directory is an error.)

=head2 chmod($octal_permissions, @files)

Sets the permissions C<$octal_permissions> on C<@files>, returning the
number of files successfully changed. Note that C<'0644'> is
C<--w----r-T>, not C<-rw-r--r-->.  You need to pass in C<oct('0644')>
or a literal C<0644> for this method to DWIM.  The method is just a
passthru to perl's built-in C<chmod> function, so see C<perldoc -f
chmod> for full details.

=head2 cleanup

Forces an immediate cleanup of the current object's directory.  See
File::Path's rmtree().  It is not safe to use the object after this
method is called.

=head1 ENVIRONMENT

If the C<PERL_DIRECTORYSCRATCH_CLEANUP> variable is set to 0, automatic
cleanup will be suppressed.

=head1 PATCHES

Commentary, patches, etc. are most welcome.  If you send a patch,
try patching the git version available from:

L<git://git.jrock.us/Directory-Scratch>.

You can check out a copy by running:

    git clone git://git.jrock.us/Directory-Scratch

Then you can use git to commit changes and then e-mail me a patch, or
you can publish the repository and ask me to pull the changes.  More
information about git is available from

L<http://git.or.cz/>

=head1 SEE ALSO

 L<File::Temp>
 L<File::Path>
 L<File::Spec>
 L<Path::Class>

=head1 BUGS

Please report any bugs or feature through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Directory-Scratch>.

=head1 ACKNOWLEDGEMENTS

Thanks to Al Tobey (TOBEYA) for some excellent patches, notably:

=over 4

=item C<child>

=item Random Files (C<randfile>)

=item C<tempfile>

=item C<openfile>

=back

=head1 COPYRIGHT & LICENSE

Copyright 2006 Jonathan Rockway, all rights reserved.

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

=cut
Directory-Scratch-0.14/t/000075500000000000000000000000001143472721200152335ustar00rootroot00000000000000Directory-Scratch-0.14/t/00-load.t000064400000000000000000000002441143472721200165540ustar00rootroot00000000000000#!perl -T

use Test::More tests => 1;

BEGIN {
	use_ok( 'Directory::Scratch' );
}

diag( "Testing Directory::Scratch $Directory::Scratch::VERSION, Perl $], $^X" );
Directory-Scratch-0.14/t/developer/000075500000000000000000000000001143472721200172205ustar00rootroot00000000000000Directory-Scratch-0.14/t/developer/boilerplate.t000064400000000000000000000023301143472721200217050ustar00rootroot00000000000000#!perl -T

use strict;
use warnings;
use Test::More tests => 3;

sub not_in_file_ok {
    my ($filename, %regex) = @_;
    open my $fh, "<", $filename
        or die "couldn't open $filename for reading: $!";

    my %violated;

    while (my $line = <$fh>) {
        while (my ($desc, $regex) = each %regex) {
            if ($line =~ $regex) {
                push @{$violated{$desc}||=[]}, $.;
            }
        }
    }

    if (%violated) {
        fail("$filename contains boilerplate text");
        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
    } else {
        pass("$filename contains no boilerplate text");
    }
}

not_in_file_ok(README =>
    "The README is used..."       => qr/The README is used/,
    "'version information here'"  => qr/to provide version information/,
);

not_in_file_ok(Changes =>
    "placeholder date/time"       => qr(Date/time)
);

sub module_boilerplate_ok {
    my ($module) = @_;
    not_in_file_ok($module =>
        'the great new $MODULENAME'   => qr/ - The great new /,
        'boilerplate description'     => qr/Quick summary of what the module/,
        'stub function definition'    => qr/function[12]/,
    );
}

module_boilerplate_ok('lib/Directory/Scratch.pm');
Directory-Scratch-0.14/t/developer/pod-coverage.t000064400000000000000000000002541143472721200217610ustar00rootroot00000000000000#!perl -T

use Test::More;
eval "use Test::Pod::Coverage 1.04";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
all_pod_coverage_ok();
Directory-Scratch-0.14/t/developer/pod.t000064400000000000000000000002141143472721200201640ustar00rootroot00000000000000#!perl -T

use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
all_pod_files_ok();
Directory-Scratch-0.14/t/integration/000075500000000000000000000000001143472721200175565ustar00rootroot00000000000000Directory-Scratch-0.14/t/integration/01-parents_too.t000064400000000000000000000005271143472721200225220ustar00rootroot00000000000000#!/usr/bin/perl
# 01-parents_too.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 2;
use Directory::Scratch;
use strict;
use warnings;

my $t = Directory::Scratch->new;

ok($t->touch('foo/bar/baz/bat/yay', qw(foo bar baz bat yay)));
is_deeply([$t->read('foo/bar/baz/bat/yay')], [qw(foo bar baz bat yay)]);
Directory-Scratch-0.14/t/integration/01-scratch.t000064400000000000000000000026141143472721200216130ustar00rootroot00000000000000#!/usr/bin/perl
# 01-scratch.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 19;
use Directory::Scratch;

my $temp = Directory::Scratch->new;
my $base = $temp->base;

# create (4)
ok($temp);
ok(-e $base, 'tempdir exists');
ok(-d _, 'tempdir is a directory');
ok(-w _, 'tempdir is writable');

# mkdir (3)
my $dir = $temp->mkdir('foo/bar/baz');
ok($dir =~ m{foo.?bar.?baz.?$}, 'dir has a reasonable name');
ok(-e $dir, 'dir exists');
ok(-d $dir, 'dir is a directory');

# openfile (5)
ok(my $fh = $temp->openfile('baaa'), "openfile" );
ok(fileno($fh), "openfile() returned a filehandle" );
ok($temp->exists('baaa'), 'the file exists');
ok(print {$fh} "hello\n");
ok(close($fh), "can close the opened filehandle");

# touch (2)
my $file = $temp->touch('foo/bar/baz/bat', qw{Here are some lines});
ok(-e $file, 'file exists');
ok(-r $file, 'file readable');

# touch with lines (2)
my $lfile = $temp->touch('baa', "This is a single line");
open($fh, '<', $lfile);
my @lines = <$fh>;
is($lines[0], "This is a single line\n");
is($lines[1], undef);
close $fh;

$lfile = $temp->touch('baaa', qw{There is more than one line});
open($fh, '<', $lfile);
@lines = <$fh>;
chomp @lines;
is_deeply(\@lines, [qw{There is more than one line}]);
close $fh;

# delete (2)
$temp->delete('foo/bar/baz/bat');
ok(!-e $file, 'file went away');
$temp->delete('foo/bar/baz');
ok(!-e $dir, 'dir went away');
Directory-Scratch-0.14/t/integration/02-nesting.t000064400000000000000000000005401143472721200216300ustar00rootroot00000000000000#!/usr/bin/perl
# 02-nesting.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

# make sure nesting directories is ok
use Test::More tests => 4;
use Directory::Scratch;

my $tmp = Directory::Scratch->new;

my $a = $tmp->mkdir('a');
ok(-d $a);
my $b = $tmp->mkdir('a/b');
ok(-d $a);
ok(-d $b);

my $c = $tmp->mkdir('foo/bar/baz');
ok(-d $c);
Directory-Scratch-0.14/t/integration/03-list.t000064400000000000000000000017201143472721200211360ustar00rootroot00000000000000#!/usr/bin/perl
# 03-list.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use strict;
use warnings;
use Test::More tests=>16;
use Directory::Scratch;
use Path::Class;

my @files = qw(foo bar baz);
my @dirs  = qw(1 2 3);

my $t = Directory::Scratch->new;
my @list;

foreach my $dir (@dirs){
    my $tmp = $t->mkdir($dir);
    ok($tmp, "mkdir $dir");
    push @list, $dir;
    foreach my $file (@files){
	my $name = file($dir, $file);
	$tmp = $t->touch($name); 
	ok($tmp, "touch $tmp");
	push @list, $name;
    }
}

# do it
my @result = $t->ls;

@list   = sort @list;
@result = sort @result;

is_deeply(\@result, \@list, "listed everything");

@result = $t->ls;
@result = sort @result;
is_deeply(\@result, \@list, "listed everything (with /)");

@result = sort $t->ls('1');

my @possible = map {file('1', $_)} qw(bar baz foo);

is_deeply(\@result, \@possible, 'listed 1');

$t->touch('fooo');
is_deeply([$t->ls('fooo')], ['fooo'], "listing a single file is OK");

Directory-Scratch-0.14/t/integration/04-links.t000064400000000000000000000017211143472721200213050ustar00rootroot00000000000000#!/usr/bin/perl
# 04-links.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Directory::Scratch;
use Test::More;
use strict;
use warnings;
plan skip_all => "links don't work under Win32" if $^O eq 'MSWin32';
plan tests => 14;

my $t = Directory::Scratch->new;
my $file1 = $t->touch('test', "this is a test");
my $dir   = $t->mkdir('foo');
my $file2 = $t->touch('foo/test', "this is also a test");

ok($file1);
ok($dir);
ok($file2);

ok($t->link('test', 'new_test'));
ok($t->link('foo', 'new_foo'));
ok($t->link('foo/test', 'new_foo_test'));
ok($t->link('new_foo/test', 'newer_test'));

is($t->read('test'), "this is a test");

is($t->read('foo/test'), "this is also a test");
is($t->read('newer_test'), "this is also a test");
is($t->read('new_foo/test'), "this is also a test");

ok($t->touch('bar'));
eval {
    $t->link('test', 'bar');
};
ok($@, 'cannot link over an existing file');

eval {
    $t->link('test', 'test');
};
ok($@, 'cannot link over self');
Directory-Scratch-0.14/t/integration/05-readwrite.t000064400000000000000000000016651143472721200221630ustar00rootroot00000000000000#!/usr/bin/perl
# 05-readwrite.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Directory::Scratch;
use Test::More tests=>15;
use strict;
use warnings;

my $t = Directory::Scratch->new;
ok($t->touch('foo'));
is($t->read('foo'), q{}, "nothing in foo");
ok($t->write('foo', "this is a test"));
is(scalar $t->read('foo'), "this is a test", 'read test');
is_deeply([$t->read('foo')], ["this is a test"]);

ok($t->touch('bar', qw(this is a test)));
is(scalar $t->read('bar'), "this\nis\na\ntest");
is_deeply([$t->read('bar')], [qw(this is a test)]);

ok($t->touch('baz', "this already has a line"));
ok($t->write('baz', "oh no, it went away"));
is(scalar $t->read('baz'), "oh no, it went away");
ok($t->write('baz', qw(foo bar baz yay!)));
is(scalar $t->read('baz'), "foo\nbar\nbaz\nyay!");
is_deeply([$t->read('baz')], [qw(foo bar baz yay!)]);

eval {
    $t->write('/made/up/filename', qw(foo bar));
};
ok(!$@, "didn't get an error");
Directory-Scratch-0.14/t/integration/06-append-prepend.t000064400000000000000000000013611143472721200230710ustar00rootroot00000000000000#!/usr/bin/perl
# 06-append-prepend.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>
use Directory::Scratch;
use Test::More tests=>8;
use strict;
use warnings;

my $t = Directory::Scratch->new;
ok($t->write('baz', qw(foo bar baz yay!)));
is(scalar $t->read('baz'), "foo\nbar\nbaz\nyay!");
is_deeply([$t->read('baz')], [qw(foo bar baz yay!)]);
ok($t->append('baz', qw(yay! again)));

is(scalar $t->read('baz'), "foo\nbar\nbaz\nyay!\nyay!\nagain");
is_deeply([$t->read('baz')], [qw(foo bar baz yay! yay! again)]);

SKIP: {
    skip "waiting for prepend from uri", 2;
    ok($t->prepend('baz', [qw(what are we gonna do tonight brain)]));
    is_deeply([$t->read('baz')], [qw(what are we gonna do tonight brain foo bar baz yay! yay! again)]);
}
Directory-Scratch-0.14/t/integration/07-delete.t000064400000000000000000000013751143472721200214370ustar00rootroot00000000000000#!/usr/bin/perl
# 07-delete.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>
use Directory::Scratch;
use Test::More tests=>15;
use strict;
use warnings;

my $t = Directory::Scratch->new;

eval {
    $t->delete('fake');
};
ok($@, "can't delete things that don't exist");

ok($t->mkdir('foo'));
ok($t->touch('foo/bar'));

eval {
    $t->delete('foo');
};
ok($@, "can't delete non-empty directories");

ok($t->exists('foo'));
ok($t->exists('foo/bar'));
ok($t->delete('foo/bar'));
ok($t->delete('foo'));
ok(!$t->exists('foo'));
ok(!$t->exists('foo/bar'));

ok($t->touch('foo'));

SKIP: {
    skip 'no links on win32', 4 if $^O eq 'MSWin32';
    ok($t->link('foo', 'bar'));
    ok($t->exists('bar'));
    ok($t->delete('bar'));
    ok(!$t->exists('bar'));
}
Directory-Scratch-0.14/t/integration/08-exists.t000064400000000000000000000006711143472721200215130ustar00rootroot00000000000000#!/usr/bin/perl
# 08-exists.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Directory::Scratch;
use Test::More tests=>7;
use strict;
use warnings;

my $t    = Directory::Scratch->new;
my $base = $t->base;

ok(!$t->exists('foo/bar'));
ok(!$t->exists('foo'));
ok(!$t->exists('bar'));

my $foobar = $t->touch('foo/bar');
ok($foobar);
is($t->exists('foo/bar'), $foobar);
ok($t->exists('foo'));
ok($t->exists('foo') =~ /foo$/);
Directory-Scratch-0.14/t/integration/09-clone_object.t000064400000000000000000000022511143472721200226170ustar00rootroot00000000000000#!/usr/bin/perl
# 09-clone_object.t 
# Copyright (c) 2006 Al Tobey           <tobeya@cpan.org>
#                and Jonathan Rockway <jrockway@cpan.org>

use Directory::Scratch;
use Test::More tests=>12;
use strict;
use warnings;

my $t = Directory::Scratch->new;
isa_ok($t, 'Directory::Scratch'); 
can_ok( $t, 'child' );

ok( my $sub_t = $t->child, 
    "Call child on a parent Directory::Scratch object." );

my @parent = $t->base->dir_list;
my @child  = $sub_t->base->dir_list;

ok( @child > @parent, "Child should have more nodes than the parent." );
my $subdir = pop @child;

is_deeply( \@child, \@parent, "Child with last element popped should == parent." );

#diag( "chdir into the parent directory" );
chdir($t->base);

ok( -d $subdir, "child subdirectory basename exists under parent" );

ok( my $sub_sub_t = $sub_t->child, "create a grandchild" );

my $subsub_dir = $sub_sub_t->base;
ok( -d $subsub_dir, "grandchild directory exists" );

ok( $sub_t->cleanup, "call cleanup() on the child" );

ok( !-d $subsub_dir, "grandchild no longer exists after cleanup()" );
ok( !-d $subdir, "child no longer exists after cleanup()" );
ok( -d $t->base, "parent still exists after cleanup()" );

Directory-Scratch-0.14/t/integration/10-new-with-arguments.t000064400000000000000000000013301143472721200237230ustar00rootroot00000000000000#!/usr/bin/perl
# 10-new-with-arguments.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use strict;
use warnings;
use Test::More tests => 5;
use Directory::Scratch;
use File::Spec;

my $tmp = Directory::Scratch->new(
				  TEMPLATE => 'foo_bar_baz_XXXX',
				 );
ok($tmp);

my $dir = $tmp->base;
like($dir, qr/[^\w]foo_bar_baz_....[^\w]?$/, 'base matches template');

$tmp    = Directory::Scratch->new(
				  DIR      => File::Spec->tmpdir,
				  TEMPLATE => 'foo_bar_baz_XXXX',
				 );
ok($tmp);

my $new_dir = $tmp->base;
like($new_dir, qr/[^\w]foo_bar_baz_....[^\w]?$/, 'base matches template');
$dir =~ s/....$//;
$new_dir =~ s/....$//;
is($dir, $new_dir, 'DIR = tmpdir, and no DIR produce identical paths');

Directory-Scratch-0.14/t/integration/11-cleanup.t000064400000000000000000000014231143472721200216110ustar00rootroot00000000000000#!/usr/bin/perl
# 11-cleanup.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>


use strict;
use warnings;
use Test::More tests=>8;
use Directory::Scratch;
use File::Path;

my $tmp = Directory::Scratch->new;
isa_ok($tmp, 'Directory::Scratch');
my $base_1 = $tmp->base;
$tmp->touch('foo');
ok(-e $base_1);
undef $tmp;
diag("Manually verify that $base_1 got cleaned up.");

$tmp = Directory::Scratch->new;
isa_ok($tmp, 'Directory::Scratch');
my $base = $tmp->base;
ok(-e $base);
$tmp->cleanup;
ok(!-e $base, 'explicitly cleaned up OK'); 

$tmp = Directory::Scratch->new(CLEANUP => 0);
isa_ok($tmp, 'Directory::Scratch');
$base = $tmp->base;
$SIG{__WARN__} = sub {};
ok(-e $base);
undef $tmp;
File::Path::rmtree($base->stringify, 0, 1);
ok(!-e $base, 'cleaned up manually OK');

Directory-Scratch-0.14/t/integration/11-stringify.t000064400000000000000000000004051143472721200221770ustar00rootroot00000000000000#!/usr/bin/perl
# 11-stringify.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use strict;
use warnings;
use Test::More tests => 1;
use Directory::Scratch;

my $tmp = Directory::Scratch->new;
is($tmp->base, "$tmp", 'tmp stringifies to its base');
Directory-Scratch-0.14/t/integration/12-randfile.t000064400000000000000000000030231143472721200217450ustar00rootroot00000000000000#!/usr/bin/perl
# 12-randfile.t 
# Copyright (c) 2006 Rockway <jrockway@cpan.org>
# Copyright (c) 2006 Al Tobey <tobeya@cpan.org>

use Test::More;
use Directory::Scratch;
eval "use String::Random";
plan skip_all => "Requires String::Random" if $@;
plan tests => 109;

# I run local tests of 512 or more to exhaust the chances entropy is causing
# tests to pass that might fail on client machines
# 20 should suffice for clients downloading from CPAN
my $loop_iterations = 20;

my $temp = Directory::Scratch->new;

ok( my $rfile = $temp->randfile, "randfile()" );
ok( length($rfile), "randfile() returned a string" );
ok( -e $rfile, "file exists" );
ok( unlink($rfile), "file unlink() succeeds" );

$rfile = undef;

sub test_iterations {
    for my $i (1..$loop_iterations) {
        ok( $rfile = $temp->randfile( 1024, 2048 ), "$i: randfile( 1024, 2048 )" );
        my $size = -s $rfile;
        ok( -e $rfile, "  $i: File exists." );
        cmp_ok( $size, '>=', 1024, "  $i: size of file: $size > 1024" );
        cmp_ok( $size, '<=', 2048, "  $i: size of file: $size < 2048" );
    }
}

test_iterations();

my $j = 1;
for ( my $i=1; $i<=1000000; $i *= 10 ) {
    ok( my $file = $temp->randfile($j, $i), "randfile($j, $i)" );
    my $size = -s $file;
    if ( $size <= $i && $size >= $j ) {
        pass( "  check file size" );
    }
    else {
        fail( "  check file size ( $size <= $i && $size >= $j )" );
    }
    $j = $i;
    unlink $file;
}

for ( my $i=1; $i<=1024;  $i *= 2 ) {
    ok( my $file = $temp->randfile($i), "randfile($i)" );
}

Directory-Scratch-0.14/t/integration/other_output_seperator.t000064400000000000000000000016061143472721200245730ustar00rootroot00000000000000#!/usr/bin/perl
# other_output_seperator.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 8;
use Directory::Scratch;
use File::Slurp qw(read_file);

my $tmp = Directory::Scratch->new;

local $, = '!';
local $/ = '!';

ok($tmp->touch('foo', qw(these are some lines)), 'create foo');
my $file = read_file(''. $tmp->exists('foo'));
ok($file, 'read it back in');
is($file, 'these!are!some!lines!', 'lines end in !');

my @file = $tmp->read('foo');
is_deeply(\@file, [qw(these are some lines)], 'works in array context too');

ok($tmp->append('foo', qw(now there are more)), 'add more lines');

$file = read_file(''. $tmp->exists('foo'));
ok($file, 'read it back in');
is($file, 'these!are!some!lines!now!there!are!more!', 'lines end in !');

@file = $tmp->read('foo');
is_deeply(\@file, [qw(these are some lines now there are more)], 
	  'works in array context too');
Directory-Scratch-0.14/t/os/000075500000000000000000000000001143472721200156545ustar00rootroot00000000000000Directory-Scratch-0.14/t/os/mac.t000064400000000000000000000013131143472721200165770ustar00rootroot00000000000000#!/usr/bin/perl
# mac.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 6;
use Directory::Scratch qw(Mac);
use Path::Class;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');
my $file = $tmp->touch("foo:bar:baz");
ok(-e $file, "$file (foo:bar:baz) exists");
my @files = sort $tmp->ls;
is_deeply(\@files, [sort (dir('foo'), dir(qw'foo bar'), dir(qw'foo bar baz'))]);

# test per-instance override

my $tmp2 = Directory::Scratch->new(platform => 'Unix');
ok($tmp2, 'created $tmp2');
$file = $tmp2->touch("foo/bar/baz");
ok(-e $file, "$file (foo/bar/baz) exists");
@files = sort $tmp2->ls;
is_deeply(\@files, [sort (dir('foo'), dir(qw'foo bar'), dir(qw'foo bar baz'))]);
Directory-Scratch-0.14/t/os/win32.t000064400000000000000000000006461143472721200170110ustar00rootroot00000000000000#!/usr/bin/perl
# win32.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 3;
use Directory::Scratch qw(Win32);
use Path::Class;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');
my $file = $tmp->touch("foo\\bar\\baz");
ok(-e $file, "$file (foo\\bar\\baz) exists");
my @files = sort $tmp->ls;
is_deeply(\@files, [sort (dir('foo'), dir(qw'foo bar'), dir(qw'foo bar baz'))]);

Directory-Scratch-0.14/t/unit/000075500000000000000000000000001143472721200162125ustar00rootroot00000000000000Directory-Scratch-0.14/t/unit/append.t000064400000000000000000000011711143472721200176460ustar00rootroot00000000000000#!/usr/bin/perl
# append.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>
use Test::More tests => 6;
use Directory::Scratch;
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');
# this tests touch a bit too, sorry.
ok($tmp->touch('foo', qw(Foo bar baz quux)), 'created foo');
my @lines = $tmp->read('foo');
is(scalar @lines, 4, 'read 4 lines');
is_deeply(\@lines, [qw(Foo bar baz quux)]);

$tmp->append('foo', qw(Now the lines are different));
@lines = $tmp->read('foo');
is(scalar @lines, 9, 'read all 9 lines');
is_deeply(\@lines, [qw(Foo bar baz quux Now the lines are different)]);
Directory-Scratch-0.14/t/unit/chmod.t000064400000000000000000000010761143472721200174750ustar00rootroot00000000000000#!/usr/bin/env perl

use Test::More tests => 7;
use Directory::Scratch;
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
ok $tmp, 'created $tmp' ;

my @files = qw/foo bar baz/;
my @paths = map { $tmp->touch($_, "this is $_") } @files;
is scalar @paths, 3, '3 files created';

$tmp->chmod(0666, @files);
is mode($_), 0666, 'mode is 0666' for @paths;

$tmp->chmod(0444, 'foo');
is mode($paths[0]), 0444, 'mode is 0444 for foo';
is mode($paths[1]), 0666, 'mode is 0666 for bar';

sub mode {
    my $mode = [stat $_[0]]->[2];
    $mode &= 0777;
    return $mode;
}
Directory-Scratch-0.14/t/unit/cleanup.t000064400000000000000000000007221143472721200200270ustar00rootroot00000000000000#!/usr/bin/perl
# cleanup.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 8;
use Directory::Scratch;
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
ok($tmp, 'create $tmp');
ok($tmp->touch('foo'), 'touch foo');
ok($tmp->mkdir('bar'), 'mkdir bar');
ok($tmp->touch('bar/baz'), 'touch baz');
$tmp->cleanup;
ok(!$tmp->exists('foo'));
ok(!$tmp->exists('bar'));
ok(!$tmp->exists('baz'));
ok(!-e $tmp->base, 'no base');

Directory-Scratch-0.14/t/unit/create_tree.t000064400000000000000000000017121143472721200206620ustar00rootroot00000000000000#!/usr/bin/perl
# create_tree.t 
# Copyright (c) 2007 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 14;
use Directory::Scratch;
use strict;
use warnings;
use Path::Class;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');

eval { $tmp->create_tree() };
ok(!$@, 'creating an empty tree works');
is(scalar $tmp->ls, 0, 'no files created');

my %tree = ( foo       => 'foo',
	     'bar/baz' => 'this is bar/baz',
	     'quux'    => 'this is quux',
	     'lines'   => ['lots', 'of', 'lines'],
	     'dir'     => \undef,
	   );
$tmp->create_tree(\%tree);

foreach my $file (keys %tree){
    ok($tmp->exists($file), "$file exists")
}

ok(-d $tmp->exists('bar'), 'bar is a directory');
ok(-d $tmp->exists('dir'), 'dir is a dir');

foreach my $file (keys %tree){
    is_deeply([$tmp->read($file)], [$tree{$file}], 
	      "$file contains expected text")
      unless ref $tree{$file};
}

is_deeply($tree{lines}, [$tmp->read('lines')], 'read lines');

Directory-Scratch-0.14/t/unit/delete.t000064400000000000000000000017171143472721200176470ustar00rootroot00000000000000#!/usr/bin/perl
# delete.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 17;
use Directory::Scratch;
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
ok($tmp, '1 ko'); # palindromic > informative 
ok($tmp->touch('foo'), 'touch foo');
ok($tmp->mkdir('bar'), 'mkdir bar');
ok($tmp->touch('bar/baz'), 'touch bar/baz');

ok( $tmp->exists('bar/baz'), 'bar/baz exists');
ok( $tmp->delete('bar/baz'), 'delete bar/baz');
ok(!$tmp->exists('bar/baz'), 'bar/baz !exists');

ok( $tmp->exists('bar'), 'bar exists');
ok( $tmp->delete('bar'), 'rmdir bar');
ok(!$tmp->exists('bar'), 'bar !exists');

ok( $tmp->exists('foo'), 'foo exists');
ok( $tmp->delete('foo'), 'delete foo');
ok(!$tmp->exists('foo'), 'foo !exists');

ok($tmp->mkdir('bar'), 'create bar again');
ok($tmp->touch('bar/baz'), 'create bar/baz again');
ok($tmp->exists('bar/baz'), 'bar/baz exists');
eval {
    $tmp->delete('bar');
};
ok($@, q{can't remove full directory});
Directory-Scratch-0.14/t/unit/invalid_clone.t000064400000000000000000000006211143472721200212040ustar00rootroot00000000000000#!/usr/bin/perl
# invalid_clone.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 2;
use Directory::Scratch;
use strict;
use warnings;

eval {
    Directory::Scratch::child({});
};
ok($@, "can't clone an unblessed ref");

eval {
    my $ref = {};
    bless $ref => 'Foo';
    Directory::Scratch::child($ref);
};
ok($@, "can't clone a non-Directory::Scratch ref");

Directory-Scratch-0.14/t/unit/invalid_directory.t000064400000000000000000000016761143472721200221230ustar00rootroot00000000000000#!/usr/bin/perl
# invalid_directory.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 7;
use Directory::Scratch;
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
my $d;

ok($tmp->touch('foo'), 'create a file called foo');

$d = eval {
    $tmp->mkdir('foo');
};
ok(!$d, 'no directory');
ok($@, "can't create a directory with the same name as a file: $@");

undef $d;
$d = eval {
    no warnings 'redefine';
    # mostly here to make devel::cover happy; the above is the real test
    *Path::Class::Dir::mkpath = sub { mkdir $tmp->exists('foo') };
    $tmp->mkdir('foo');
};
ok(!$d, 'no directory');
ok($@, "can't create a directory with the same name as a file: $@");

undef $d;
$d = eval {
    # make mkdir not work
    no warnings 'redefine';
    *Path::Class::Dir::mkpath = sub { return };
    $tmp->mkdir('bar');
};
ok(!$d, 'no directory');
ok($@, "can't create a directory when mkdir doesn't work: $@");
Directory-Scratch-0.14/t/unit/link.t000064400000000000000000000007051143472721200173360ustar00rootroot00000000000000#!/usr/bin/perl
# link.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More;
use Directory::Scratch;
use strict;
use warnings;

plan skip_all => "Win32 can't symlink" if $^O eq 'MSWin32';
plan tests => 4;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');
# this tests touch a bit too, sorry.
ok($tmp->touch('foo'), 'created foo');
ok($tmp->link('foo', 'bar'), 'created bar');
ok($tmp->exists('bar'), 'bar exists!');

Directory-Scratch-0.14/t/unit/ls.t000064400000000000000000000024261143472721200170210ustar00rootroot00000000000000#!/usr/bin/perl
# ls.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 12;
use Directory::Scratch;
use strict;
use warnings;
use Path::Class;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');

ok($tmp->touch('foo'), 'foo');
ok($tmp->mkdir('bar/baz'), 'bar/baz');
ok($tmp->touch('bar/quux'), 'bar/quux');
ok($tmp->touch('bar/baz/quux'), 'bar/baz/quux');

my @files = sort $tmp->ls;
is(scalar @files, 5, 'got 5 files under /');
my @reference = (file('bar'), dir(qw|bar baz|), file(qw|bar baz quux|),
		 file(qw|bar quux|), file('foo'));
is_deeply([map {$_->stringify} @files],
	  [map {$_->stringify} @reference],
	  'check that paths agree');

# test ls /
@files = sort $tmp->ls('/');
is(scalar @files, 5, 'got 5 files under /');
@reference = (file('bar'), dir(qw|bar baz|), file(qw|bar baz quux|),
	     file(qw|bar quux|), file('foo'));
is_deeply([map {$_->stringify} @files],
	  [map {$_->stringify} @reference],
	  'check that paths agree');

eval {
    @files = sort $tmp->ls('this filename is fake');
};
ok($@, "can't ls files that don't exist");

@files = sort $tmp->ls('foo');
is_deeply(\@files, [file('foo')], 'single file = list');

@files = sort $tmp->ls('bar/baz');
is_deeply(\@files, [file(qw|bar baz quux|)], 'got bar/baz/quux in bar/baz');
Directory-Scratch-0.14/t/unit/mkdir.t000064400000000000000000000005731143472721200175120ustar00rootroot00000000000000#!/usr/bin/perl
# mkdir.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 9;
use Directory::Scratch;
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');

my $dir = $tmp->mkdir('foo/bar/baz/bat');
for(1..4){
    ok(-e $dir, "$dir exists");
    ok(-d $dir, '  and is a directory');
    $dir = $dir->parent;
}
Directory-Scratch-0.14/t/unit/openfile.t000064400000000000000000000014201143472721200201750ustar00rootroot00000000000000#!/usr/bin/perl
# openfile.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 8;
use Directory::Scratch;
use File::Slurp qw(read_file);
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');
my ($fh, $path) = $tmp->openfile('foo');
is($path->stringify, $tmp->exists('foo')->stringify, 
   'openfile returned sane path'); 
eval {
    print {$fh} "Foo\nbar\nbaz\n";
};
ok(!$@, 'writing to fh works');
ok(close $fh, 'closed fh');

$fh = $tmp->openfile('bar');
eval {
    print {$fh} "Foo\nbar\nbaz\n";
};
ok(!$@, 'writing to fh works');
ok(close $fh, 'closed fh');

ok($tmp->exists('bar'), 'bar exists');
my $contents = read_file($tmp->exists('bar')->stringify);
is($contents, "Foo\nbar\nbaz\n", 'bar can be read');

 
Directory-Scratch-0.14/t/unit/randfile.t000064400000000000000000000010371143472721200201640ustar00rootroot00000000000000#!/usr/bin/perl
# randfile.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More;
use Directory::Scratch;
eval "use String::Random";
plan skip_all => "Requires String::Random" if $@;
plan tests => 321;

my $tmp = Directory::Scratch->new;
ok($tmp, 'create $tmp');

for(1..80){
    my $name;
    ok($name = $tmp->randfile(60, 100), 'create random file');
    ok(-e $name, 'created ok');
    my @stat = stat _;
    ok($stat[7] <= 100 && $stat[7] >= 60, 'file is the correct size');
    ok(unlink($name), "delete $name");
}
Directory-Scratch-0.14/t/unit/read.t000064400000000000000000000006651143472721200173210ustar00rootroot00000000000000#!/usr/bin/perl
# read.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 4;
use Directory::Scratch;
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');
# this tests touch a bit too, sorry.
ok($tmp->touch('foo', qw(Foo bar baz quux)), 'created foo');
my @lines = $tmp->read('foo');
is(scalar @lines, 4, 'read 4 lines');
is_deeply(\@lines, [qw(Foo bar baz quux)]);


Directory-Scratch-0.14/t/unit/stat.t000064400000000000000000000005211143472721200173500ustar00rootroot00000000000000#!/usr/bin/env perl

use strict;
use warnings;
use Test::More tests => 2;
use Directory::Scratch;

my $tmp = Directory::Scratch->new;
my $file = $tmp->touch('foo', 'foo bar baz');

my $stats = $tmp->stat('foo');
isa_ok $stats, 'File::stat', '$stats';

my @stats = $tmp->stat('foo');
ok scalar @stats > 10, 'got an array, not an object';
Directory-Scratch-0.14/t/unit/tempfile.t000064400000000000000000000011021143472721200201760ustar00rootroot00000000000000#!/usr/bin/perl
# tempfile.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 8;
use Directory::Scratch;
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');
my ($fh, $filename) = $tmp->tempfile;
eval {
    print {$fh} "Foo\nbar\nbaz\n";
};
ok(!$@, 'writing to fh works');
ok(close $fh, 'closed fh');
ok(-e $filename, 'file exists');

# try this in scalar context
$fh = $tmp->tempfile;
ok($fh, 'got a filehandle');
ok(print {$fh} "A line\n");
ok(seek $fh, 0, 0);
is(<$fh>, "A line\n", 'read the line back');
Directory-Scratch-0.14/t/unit/touch.t000064400000000000000000000012331143472721200175200ustar00rootroot00000000000000#!/usr/bin/perl
# touch.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 8;
use Directory::Scratch;
use strict;
use warnings;
use File::Slurp qw(read_file);

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');
ok($tmp->touch('foo', qw(foo bar baz)), 'created foo');
ok($tmp->exists('foo'), 'foo exists');
my @lines = read_file($tmp->exists('foo')->stringify);
is(chomp @lines, 3, 'right number of lines');
is_deeply(\@lines, [qw(foo bar baz)], 'foo has correct contents');
ok($tmp->touch('bar'), 'created bar');
ok($tmp->exists('bar'), 'bar exists');
ok(!read_file($tmp->exists('bar')->stringify), 'bar has no content');
Directory-Scratch-0.14/t/unit/write.t000064400000000000000000000011531143472721200175310ustar00rootroot00000000000000#!/usr/bin/perl
# write.t 
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>

use Test::More tests => 6;
use Directory::Scratch;
use strict;
use warnings;

my $tmp = Directory::Scratch->new;
ok($tmp, 'created $tmp');
# this tests touch a bit too, sorry.
ok($tmp->touch('foo', qw(Foo bar baz quux)), 'created foo');
my @lines = $tmp->read('foo');
is(scalar @lines, 4, 'read 4 lines');
is_deeply(\@lines, [qw(Foo bar baz quux)]);

$tmp->write('foo', qw(Now the lines are different));
@lines = $tmp->read('foo');
is(scalar @lines, 5, 'read the 5 new lines');
is_deeply(\@lines, [qw(Now the lines are different)]);