Permalink
Browse files

Added put(), append(), and copy_to() methods to Path::Class::File

Added clear() and copy_to() methods to Path::Class::Dir
  • Loading branch information...
1 parent ce39599 commit df8f35c8becf659875277c77ba4820a5d7e3c0ea @Egga committed Oct 13, 2011
Showing with 131 additions and 1 deletion.
  1. +32 −0 lib/Path/Class/Dir.pm
  2. +34 −0 lib/Path/Class/File.pm
  3. +65 −1 t/03-filesystem.t
View
@@ -9,6 +9,7 @@ use base qw(Path::Class::Entity);
use IO::Dir ();
use File::Path ();
use File::Temp ();
+use File::Copy::Recursive ();
# updir & curdir on the local machine, for screening them out in
# children(). Note that they don't respect 'foreign' semantics.
@@ -135,6 +136,25 @@ sub remove {
rmdir( shift() );
}
+sub clear {
+ my ( $self ) = @_;
+ $self->rmtree;
+ $self->mkpath;
+
+ Carp::croak "Dir $self was not created successfully!" unless -d $self;
+ Carp::croak "Dir $self is not empty!" if $self->children;
+}
+
+sub copy_to {
+ my ( $self, $destination, $name ) = @_;
+ $name = $self->basename unless defined $name;
+
+ my $dest_dir = Path::Class::dir ( $destination, $name );
+ File::Copy::Recursive::dircopy( $self, $dest_dir ) or Carp::croak "Copy '$self' to '$dest_dir' failed: $!";
+
+ return $dest_dir;
+}
+
sub traverse {
my $self = shift;
my ($callback, @args) = @_;
@@ -604,6 +624,18 @@ indicating whether or not the directory was successfully removed.
This method is mainly provided for consistency with
C<Path::Class::File>'s C<remove()> method.
+=item $dir->clear()
+
+Deletes all contents of the directory - actually deletes the directory and
+creates a new one with the same name. Croaks if deletion fails or the new
+directory is not empty.
+
+=item $dir->copy_to($destination, [$name])
+
+Passes C<$dir> and C<< $destination/$name >> to
+C<File::Copy::Recursive::dircopy> and returns the created dir or croaks if
+the copy fails. C<$name> defaults to C<< $dir->basename >>.
+
=item $dir->tempfile(...)
An interface to C<File::Temp>'s C<tempfile()> function. Just like
View
@@ -7,6 +7,7 @@ use base qw(Path::Class::Entity);
use Carp;
use IO::File ();
+use File::Copy ();
sub new {
my $self = shift->SUPER::new;
@@ -61,6 +62,19 @@ sub open { IO::File->new(@_) }
sub openr { $_[0]->open('r') or croak "Can't read $_[0]: $!" }
sub openw { $_[0]->open('w') or croak "Can't write $_[0]: $!" }
+sub put {
@yanick

yanick Mar 21, 2012

I was about to write roughly the same patch. :-)

Three comments:

a) maybe 'put' should be 'write' ? It's just a tad more descriptive.
b) have the functions put and append return $self, so that they can be chained with other Path::Class actions
c) submit a pull request to the main repo! :-)

+ my ( $self, @data ) = @_;
+ my $fh = $self->open ( 'w' ) or Carp::croak "Can't write $self: $!";
+ print $fh @data;
+}
+
+sub append {
+ my ( $self, @data ) = @_;
+ my $fh = $self->open ( 'a' ) or Carp::croak "Can't append to $self: $!";
+ print $fh @data;
+}
+
+
sub touch {
my $self = shift;
if (-e $self) {
@@ -92,6 +106,11 @@ sub remove {
return not -e $file;
}
+sub copy_to {
+ my ( $self, $destination ) = @_;
+ File::Copy::copy( $self, $destination ) or croak "Copy '$self' to '$destination' failed: $!";
+}
+
sub traverse {
my $self = shift;
my ($callback, @args) = @_;
@@ -292,6 +311,16 @@ Sets the modification and access time of the given file to right now,
if the file exists. If it doesn't exist, C<touch()> will I<make> it
exist, and - YES! - set its modification and access time to now.
+=item $file->put(@data)
+
+Opens the file for writing, prints given C<@data> to it and returns the
+result or croaks if opening fails.
+
+=item $file->append(@data)
+
+Opens the file for appending, prints given C<@data> to it and returns the
+result or croaks if opening fails.
+
=item $file->slurp()
In a scalar context, returns the contents of C<$file> in a string. In
@@ -330,6 +359,11 @@ because on some platforms (notably VMS) you actually may need to call
C<unlink()> several times before all versions of the file are gone -
the C<remove()> method handles this process for you.
+=item $file->copy_to($destination)
+
+Passes C<$file> and C<$destination> to C<File::Copy::copy> and returns the
+result or croaks if the copy fails.
+
=item $st = $file->stat()
Invokes C<< File::stat::stat() >> on this file and returns a
View
@@ -4,7 +4,7 @@ use Test::More;
use File::Temp qw(tmpnam tempdir);
use File::Spec;
-plan tests => 78;
+plan tests => 90;
use_ok 'Path::Class';
@@ -147,6 +147,70 @@ ok !-e $dir, "$dir no longer exists";
ok not -e $file;
}
+{
+ # test put()
+ my $file = file('t', 'put');
+ ok $file;
+
+ my @data = ( "Hello ", "File\n" );
+ $file->put(@data);
+
+ ok -e $file;
+ is $file->slurp, join( '' => @data );
+
+
+ # test append()
+ my @details = ( "I need ", "more details\n" );
+
+ $file->append(@details);
+ is $file->slurp, join( '' => @data, @details );
+
+
+ # test copy_to()
+ my $copy = file('t', 'copy_file');
+ $file->copy_to( $copy );
+
+ ok -e $copy;
+ is $copy->slurp, join( '' => @data, @details );
+
+ $copy->remove;
+ ok not -e $copy;
+
+ $file->remove;
+ ok not -e $file;
+}
+
+{
+ my $test_dir = dir('t', 'copy_dir');
+ my $orig_dir = $test_dir->subdir('orig');
+ $orig_dir->mkpath;
+
+ my @sub_dirs = 'a' .. 'f';
+ $orig_dir->subdir( $_ )->mkpath for @sub_dirs;
+
+ my @sub_files = 'u' .. 'z';
+ $orig_dir->file( $_ )->touch for @sub_files;
+
+ my $named_dir = $orig_dir->copy_to($test_dir, 'named');
+ ok -d $named_dir;
+ is_deeply content_of( $named_dir ), content_of( $orig_dir );
+
+ my $unnamed_dir = $orig_dir->copy_to( $test_dir->subdir( 'unnamed' ) );
+ ok -d $unnamed_dir;
+ is_deeply content_of( $unnamed_dir ), content_of( $orig_dir );
+
+ $test_dir->rmtree;
+
+ sub content_of {
+ my ( $dir ) = @_;
+ return [
+ sort map {
+ ( $_->is_dir ? 'dir' : 'file' ) . $_->basename
+ } $dir->children
+ ];
+ }
+}
+
SKIP: {
my $file = file('t', 'slurp');
ok $file;

0 comments on commit df8f35c

Please sign in to comment.