File Coverage

blib/lib/Module/New/Command/Basic.pm

Criterion	Covered	Total	%
statement	94	114	82.4
branch	25	52	48.0
condition	13	30	43.3
subroutine	24	26	92.3
pod			n/a
total	156	222	70.2

package Module::New::Command::Basic;

use strict;
use warnings;
use Carp;
use Module::New::Meta;
use Module::New::Queue;

functions {

  set_distname => sub () { Module::New::Queue->register(sub {
    my ($self, $name) = @_;
    croak "distribution/main module name is required" unless $name;
    Module::New->context->distname( $name );
  })},

  guess_root => sub () { Module::New::Queue->register(sub {
    my $self = shift;
    my $context = Module::New->context;
    $context->path->guess_root( $context->config('root') );
  })},

  set_file => sub () { Module::New::Queue->register(sub {
    my ($self, $name) = @_;

    croak "filename is required" unless $name;

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

    unless ($type) {
      if ( $name =~ /::/ or $name =~ /\.pm$/ or $name =~ m{^lib/} ) {
        $type = 'Module';
      }
      elsif ( $name =~ /\.t$/ or $name =~ m{^t/} ) {
        $type = 'Test';
      }
      elsif ( $name =~ /\.pl/ or $name =~ m{^(?:bin|scripts?)/} ) {
        $type = 'Script';
      }
      elsif ( $name = /\./ ) {
        $type = 'Plain';
      }
    }
    $type ||= 'Module';
    $context->config( type => $type );

    if ( $type =~ /Module$/ ) {
      $context->module( $name );
    }
    else {
      $context->mainfile( $name );
    }
  })},

  create_distdir => sub () { Module::New::Queue->register(sub {
    my $self = shift;

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

    $context->path->set_root;
    unless ( $context->config('no_dirs') ) {
      my $distname = $context->distname;
      my $distdir  = $context->path->dir($distname);
      if ( $distdir->exists ) {
        if ( $context->config('force') ) {
          $context->path->remove_dir( $distdir, 'absolute' );
        }
        elsif ( $context->config('grace') ) {
          # just skip and do nothing
        }
        else {
          croak "$distname already exists";
        }
      }
      $context->path->create_dir($distname);
      $context->path->change_dir($distname);
    }
    else {
      $context->path->change_dir(".");
    }
    $context->path->set_root;
  })},

  create_maketool => sub (;$) {
    my $type = shift;
    Module::New::Queue->register(sub {
      my $self = shift;

      my $context = Module::New->context;
      $type ||= $context->config('make') || 'MakeMakerCPANfile';
      $type = 'ModuleBuild'   if $type eq 'MB';
      $type = 'MakeMaker'     if $type eq 'EUMM';

      $context->files->add( $type );
    });
  },

  create_general_files => sub () { Module::New::Queue->register(sub {
    my $self = shift;

    Module::New->context->files->add(qw( Readme Changes ManifestSkip License ));
  })},

  create_tests => sub (;@) {
    my @files = @_;
    Module::New::Queue->register(sub {
      my $self = shift;

      my $context = Module::New->context;
      if ( ref $context->config('test') eq 'ARRAY' ) {
        $context->files->add( @{ Module::New->context->config('test') } );
      }
      elsif ( @files ) {
        $context->files->add( @files );
      }
      else {
        $context->files->add(qw( LoadTest PodTest PodCoverageTest ));
      }
    });
  },

  create_files => sub (;@) {
    my @files = @_;
    Module::New::Queue->register(sub {
      my $self = shift;

      my $context = Module::New->context;
         $context->files->add( @files );
      if ($context->config('xs')) {
        $context->files->add('XS');
        eval {
          require Devel::PPPort;
          Devel::PPPort::WriteFile();
          $context->log( info => "created ppport.h" );
        };
        $context->log( warn => $@ ) if $@;
      }
      while ( my $name = $context->files->next ) {
        if ( $name eq '{ANY_TYPE}' ) {
          $name = $context->config('type') || 'Module';
        }
        my $file = $context->loader->reload_class( File => $name );
        $context->path->create_file( $file->render );
      }
    });
  },

  create_manifest => sub () { Module::New::Queue->register(sub {
    my $self = shift;

    my $context = Module::New->context;
    $context->path->remove_file('MANIFEST') if $context->config('force');

    local $ENV{PERL_MM_MANIFEST_VERBOSE} = 0 if $context->config('silent');

    require ExtUtils::Manifest;
    ExtUtils::Manifest::mkmanifest();

    $context->log( info => 'updated manifest' );
  })},

  edit_mainfile => sub (;%) {
    my %options = @_;
    return if $ENV{HARNESS_ACTIVE} || $INC{'Test/Classy.pm'};
    Module::New::Queue->register(sub {
      my $self = shift;

      my $context = Module::New->context;
      return if $options{optional};

      my $editor = $context->config('editor') || $ENV{EDITOR};
      unless ( $editor ) { carp 'editor is not set'; return; }
      my $file = $options{file} || $context->mainfile;
      exec( _shell_quote($editor) => _shell_quote($file) );
    });
  },
};

sub _shell_quote {
  my $str = shift;
  return $str unless $str =~ /\s/;
  return ( $^O eq 'MSWin32' ) ? qq{"$str"} : qq{'$str'};
}

1;

__END__