package Module::New::Path;

use strict;
use warnings;
use Carp;
use Path::Tiny ();

sub new { bless { _root => '' }, shift }

sub _root { shift->{_root} }

sub _child {
  my $self = shift;

  croak "root is not defined; set it first" unless $self->_root;

  my $context = Module::New->context;
  my $subdir  = $context->config('subdir');

  $self->_root->child(grep {defined && length} $subdir, @_ );
}

sub __child {
  my $class = shift;
  if (ref $_[0] eq 'Path::Tiny') {
    shift->child(grep {defined && length} @_);
  } else {
    Path::Tiny::path(grep {defined && length} @_);
  }
}

*file = *dir = \&_child;
*_file = *_dir = \&__child;

sub guess_root {
  my ($self, $path) = @_;

  if ( defined $path ) {
    my $dir = $self->_dir('.', $path);
       $dir->mkpath unless $dir->exists;
    return $self->set_root($dir);
  }

  my $try = 30;
  my $dir = $self->_dir('.');
  while ( $try-- and $dir->parent ne $dir ) {
    if ( $dir->child('lib')->exists ) {
      if ( $dir->child('Makefile.PL')->exists
        or $dir->child('Build.PL')->exists
      ) {
        return $self->set_root($dir);
      }
    }
    $dir = $dir->parent;
  }
  croak "Can't guess root";
}

sub set_root {
  my ($self, $path) = @_;

  my $root = $self->{_root} = Path::Tiny::path($path || '.')->absolute;
  croak "$root does not exist" unless $root->exists;

  Module::New->context->log( debug => "set root to $root" );

  chdir $root;

  return $root;
}

sub create_dir {
  my ($self, $path, $absolute) = @_;

  my $dir;
  if ( $absolute ) {
    $dir = $self->_dir($path);
  }
  else {
    $dir = $self->dir($path);
  }
  unless ( $dir->exists ) {
    $dir->mkpath;
    Module::New->context->log( info => "created $path" );
  }
}

sub remove_dir {
  my ($self, $path, $absolute) = @_;

  my $dir;
  if ( $absolute ) {
    $dir = $self->_dir($path);
  }
  else {
    $dir = $self->dir($path);
  }
  if ( $dir->exists ) {
    $dir->remove_tree;
    Module::New->context->log( info => "removed $path" );
  }
}

sub create_file {
  my ($self, %files) = @_;

  croak "root is not defined; set it first" unless $self->_root;

  my $context = Module::New->context;

  foreach my $path ( sort keys %files ) {
    next unless $path;

    my $file = $self->file($path);
    $self->create_dir( $file->parent->relative( $self->_root ) );

    if ( $file->exists ) {
      if ( $context->config('grace') ) {
        $file->rename("$file.bak");
        Module::New->context->log( info => "renamed $path to $path.bak" );
      }
      elsif ( $context->config('force') ) {
        # just skip and do nothing
      }
      else {
        next if $file->slurp eq $files{$path};
        Carp::confess "$path already exists";
      }
    }
    $file->parent->mkpath;
    $file->spew( $files{$path} );
    Module::New->context->log( info => "created $path" );
  }
}

sub remove_file {
  my ($self, @paths) = @_;

  croak "root is not defined; set it first" unless $self->_root;

  foreach my $path ( @paths ) {
    $self->file($path)->remove;
    Module::New->context->log( info => "removed $path" );
  }
}

sub change_dir {
  my ($self, $path) = @_;
  chdir $self->dir($path);
  Module::New->context->log( info => "changed directory to $path" );
}

1;

__END__

=head1 NAME

Module::New::Path

=head1 DESCRIPTION

This is to handle files/directories in a distribution.

=head1 METHODS

=head2 new

creates an object.

=head2 set_root

takes a path and sets a root/base directory of a distribution.

=head2 guess_root

looks for a Makefile.PL/Build.PL to make/build and makes there a root/base directory for the distribution.

=head2 file, dir

takes a (relative) path and returns a C<Path::Tiny> object respectively. 

=head2 create_dir, remove_dir

takes a path and creates/removes a (relative) directory. If the second argument is passed and true, the directory is regarded as an absolute one.

=head2 create_file

creates a file (and makes a parent directory if necessary).

=head2 remove_file

removes a file.

=head2 change_dir

takes a (relative) path and changes the current directory to there.

=head1 AUTHOR

Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009 by Kenichi Ishigaki.

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

=cut
