view release on metacpan or  search on metacpan

lib/File/Fu/File.pm  view on Meta::CPAN

    print $fh $content;
    close($fh) or croak("write '$self' failed: $!");
  }

  return $self;
} # end subroutine write definition
########################################################################
} # File::Slurp closure
########################################################################

=head2 copy

Copies $file to $dest (which can be a file or directory) and returns the
name of the new file as an object.

  my $new = $file->copy($dest);

Note that if $dest is already a File object, that existing object will
be returned.

=cut

sub copy {
  my $self = shift;
  my ($dest) = shift;
  my (%opts) = @_;

  # decide if this is file-to-dir or file-to-file
  if(-d $dest) {
    $dest = $self->dir_class->new($dest)->file($self->basename);
  }
  else {
    $dest = $self->new($dest) unless(ref($dest));
  }
  if($dest->e) {
    croak("'$dest' and '$self' are the same file")
      if($self->is_same($dest));
  }

  # TODO here's another good reason to have our own filehandle object:
  # This fh-copy should be in there.
  my $ifh = $self->open;
  my $ofh = $dest->open('>');
  binmode($_) for($ifh, $ofh);
  while(1) {
    my $buf;
    defined(my $r = sysread($ifh, $buf, 1024)) or
      croak("sysread failed $!");
    $r or last;
    # why did File::Copy::copy do it like this?
    for(my $t = my $w = 0; $w < $r; $w += $t) {
      $t = syswrite($ofh, $buf, $r - $w, $w) or
        croak("syswrite failed $!");
    }
  }
  close($ofh) or croak("write '$dest' failed: $!");
  # TODO some form of rollback?

  # TODO handle opts
  #if($opts{preserve}) {
  #  # TODO chmod/chown and such
  #  $dest->utime($self->stat->mtime);
  #}

  return($dest);
} # copy ###############################################################

=head2 move

  my $new = $file->move($dest);

=cut

sub move {
  my $self = shift;
  my $new = $self->copy(@_); # TODO can use rename?
  $self->unlink;
  return($new);
} # move ###############################################################

########################################################################

=head1 AUTHOR

Eric Wilhelm @ <ewilhelm at cpan dot org>

http://scratchcomputing.com/

=head1 BUGS

If you found this module on CPAN, please report any bugs or feature
requests through the web interface at L<http://rt.cpan.org>.  I will be
notified, and then you'll automatically be notified of progress on your
bug as I make changes.

If you pulled this development version from my /svn/, please contact me
directly.

=head1 COPYRIGHT

Copyright (C) 2008 Eric L. Wilhelm, All Rights Reserved.

=head1 NO WARRANTY

Absolutely, positively NO WARRANTY, neither express or implied, is
offered with this software.  You use this software at your own risk.  In
case of loss, no person or entity owes you anything whatsoever.  You
have been warned.

=head1 LICENSE

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

=cut

require File::Fu;
# vi:ts=2:sw=2:et:sta
1;