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

Added clear() and copy_to() methods to Path::Class::Dir

lib/Path/Class/Dir.pm

@@ -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

lib/Path/Class/File.pm

@@ -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 {
+    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

t/03-filesystem.t

@@ -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;