File::Fu::Base - nothing to see here

  my $obj = $obj->clone;

  $clone = $self->clonedo($action, @args);

  $package->error($op);

  my $rel = $abs->relative;

  my $rel = $abs->relative($to);

  my $path = $path->resolve;

  $path->relative_symlink($linkname);

  $file->utime($atime, $mtime);

  $file->utime($time);

  $path->chmod($mode);

  $path = $path->rename($newname);

  my $st = $obj->stat;

  my $st = $obj->lstat;

  $bool = $path->is_same($other);

package File::Fu::Base;
$VERSION = v0.0.7;

use warnings;
use strict;
use Carp;

use File::stat ();

use overload (
  '='  => sub {shift->clone(@_)},
  '""' => 'stringify',
  '%=' => 'append',
  '%'  => sub {shift->clonedo('append', @_)},
  # can't overload s/// or accomplish anything with prototypes
  '&'  => sub {shift->clonedo('map', @_)},
  '&=' => 'map',
  cmp  => sub {"$_[0]" cmp "$_[1]"},

  # invalid methods
  '-'      => sub {shift->error('-')},
  '*'      => sub {shift->error('*')},
  nomethod => sub {shift->error($_[2])},
);

sub clone {
  my $self = shift;
  my $clone = {%$self};
  bless($clone, ref($self));
  #carp("clone the ", overload::StrVal($self));
  foreach my $item (values(%$clone)) {
    my $ref = ref($item) or next;
    if($ref eq 'ARRAY') {
      #warn "clone [@$item]\n";
      $item = [@$item];
    }
    elsif($ref eq 'HASH') {
      $item = {%$item};
    }
    elsif(eval {$item->can('clone')}) {
      $item = $item->clone
    }
    else {
      croak("cannot deref $item");
    }
  }
  #carp("now ", overload::StrVal($clone));
  return($clone);
} # end subroutine clone definition
########################################################################

sub clonedo {
  my $self = shift;
  my ($action, $arg, $rev) = @_;
  #carp("clonedo $action", $rev ? ' backwards' : '');
  if($rev) {
    return($arg . $self->stringify) if($action eq 'append');
    croak("$action is invalid in that order");
  }

  # perl doesn't know how to stringify
  # TODO how can I tell when this is just a quoted string?
  #if($action eq 'append' and $arg =~ m/\n/) { return($self->stringify . $arg); }

  $self = $self->clone;
  $self->$action($arg);
  #carp("now ", overload::StrVal($self));
  return($self);
} # end subroutine clonedo definition
########################################################################

sub error {
  my $self = shift;
  my ($op) = @_;
  croak("$op is not a valid op for a ", ref($self), " object");
} # end subroutine error definition
########################################################################

foreach my $test (split(//, 'rwxoRWXOezsfdlpSbctugkTBMAC')) {
  my $subref = eval("sub {-$test shift}");
  $@ and croak("I broke this -- $@");
  no strict 'refs';
  *{"$test"} = $subref;
}

use File::Spec; # GRR

sub is_absolute {
  # XXX this is immutable, no?
  File::Spec->file_name_is_absolute($_[0]->stringify);
}

sub relative {
  my $self = shift;
  my $base = shift;
  return $self->new(File::Spec->abs2rel($self->stringify,
    defined($base) ? "$base" : ()
  ));
}

sub resolve {
  my $self = shift;
  while(1) {
    return $self unless($self->l);
    my $to = $self->readlink;
    return $to  if($to->is_absolute);
    $self = $self->new($self->dirname . $to);
  }
} # end subroutine resolve definition
########################################################################

sub relative_symlink {
  my $self = shift;
  my ($link) = @_;

  my $rel = $self->relative($self->new($link)->dirname);
  return($rel->symlink($link));
} # end subroutine relative_symlink definition
########################################################################

sub utime {
  my $self = shift;
  @_ or croak("not enough arguments to utime()");
  my $at = shift;
  my $mt = @_ ? shift(@_) : $at;
  if($self->is_dir) {
    $self = $self->bare;
  }
  utime($at, $mt, $self) or croak("cannot utime '$self' $!");
} # end subroutine utime definition
########################################################################

sub chmod :method {
  my $self = shift;
  my ($mode) = @_;

  chmod($mode, "$self") or croak("cannot chmod '$self' $!");
} # end subroutine chmod definition
########################################################################

sub rename :method {
  my $self = shift;
  my ($name) = @_;

  rename($self, $name) or
    croak("cannot rename '$self' to '$name' $!");
  return($self->new($name));
} # end subroutine rename definition
########################################################################

sub stat {
  my $self = shift;
  my $st = File::stat::stat("$self") or
    croak("cannot stat '$self' $!");
  return($st);
} # end subroutine stat definition
########################################################################

sub lstat {
  my $self = shift;

  if($self->is_dir and $self->l) {
    $self = $self->bare;
  }
  my $st = File::stat::lstat("$self") or
    croak("cannot lstat '$self' $!");
  return($st);
} # end subroutine lstat definition
########################################################################

sub is_same {
  my $self = shift;
  my ($other) = @_;
  unless(ref $other) {
    my $proto = ($self->is_file and $other =~ m#/$#) ?
      $self->dir_class : $self;
    $other =  $proto->new($other);
  }
  return(1) if($self eq $other);
  return(0) if($self->is_dir != $other->is_dir);
  my $n = 0;
  # TODO just check absolutely?
  # this currently probably misses non-existent files where the dirname
  # resolves to the same location.
  my ($s1, $s2) = map({eval {$_->stat}} $self, $other);
  return(0) unless($s1 and $s2);
  return(
    $s1->dev eq $s2->dev and
    $s1->ino eq $s2->ino
  );
} # end subroutine is_same definition
########################################################################

# vi:ts=2:sw=2:et:sta
1;