File Coverage

lib/Module/New/Path.pm

Criterion	Covered	Total	%
statement	64	85	75.2
branch	19	42	45.2
condition	7	8	87.5
subroutine	13	15	86.6
pod	8	8	100.0
total	111	158	70.2

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__