view release on metacpan or  search on metacpan

lib/App/git/ship/perl.pm  view on Meta::CPAN

  $self->_render_readme;
  $self->_make('manifest');
  $self->_make('dist', '-e');
  $self->run_hook('after_build');
  $self;
}

sub can_handle_project {
  my ($class, $file) = @_;
  return $file =~ /\.pm$/ ? 1 : 0 if $file;
  return path('lib')->list_tree->grep(sub {/\.pm$/})->size;
}

sub clean {
  my $self  = shift;
  my $all   = shift // 1;
  my @files = qw(Makefile Makefile.old MANIFEST MYMETA.json MYMETA.yml);

  unlink 'Makefile' and $self->_make('clean') if -e 'Makefile';

  push @files, qw(Changes.bak META.json META.yml) if $all;
  push @files, $self->_dist_files->each;

  for my $file (@files) {
    next unless -e $file;
    unlink $file or warn "!! rm $file: $!" and next;
    say "\$ rm $file" unless $self->SILENT;
  }

  return $self;
}

sub ship {
  my $self      = shift;
  my $dist_file = $self->_dist_files->[0];
  my $changelog = $self->config('changelog_filename');
  my $uploader;

  require CPAN::Uploader;
  $uploader = CPAN::Uploader->new(CPAN::Uploader->read_config_file);

  unless ($dist_file) {
    $self->build;
    $self->abort(
      "Project built. Run 'git ship' again to post dist to CPAN and remote repostitory.");
  }
  unless ($self->config('next_version')) {
    close ARGV;
    local @ARGV = $changelog;
    while (<>) {
      /^$VERSION_RE\s*/ or next;
      $self->config(next_version => $1);
      last;
    }
  }

  $self->run_hook('before_ship');
  $self->system(qw(git add Makefile.PL), $changelog);
  $self->system(qw(git add README.md)) if -e 'README.md';
  $self->system(qw(git commit -a -m), $self->_changes_to_commit_message);
  $self->SUPER::ship(@_);    # after all the changes
  $uploader->upload_file($dist_file);
  $self->run_hook('after_ship');
}

sub start {
  my $self      = shift;
  my $changelog = $self->config('changelog_filename');

  if (my $file = $_[0]) {
    $file = $file =~ m!^.?lib! ? path($file) : path(lib => $file);
    $self->config(main_module_path => $file);
    unless (-e $file) {
      my $work_dir = lc($self->config('project_name')) =~ s!::!-!gr;
      mkdir $work_dir;
      chdir $work_dir or $self->abort("Could not chdir to $work_dir");
      $self->config('main_module_path')->dirname->make_path;
      open my $MAINMODULE, '>>', $self->config('main_module_path')
        or $self->abort("Could not create %s", $self->config('main_module_path'));
    }
  }

  $self->SUPER::start(@_);
  $self->render_template('.travis.yml');
  $self->render_template('.perltidyrc', {template_from_home => 1});
  $self->render_template('cpanfile');
  $self->render_template('Changes') if $changelog eq 'Changes';
  $self->render_template('MANIFEST.SKIP');
  $self->render_template('t/00-basic.t');
  $self->system(qw(git add .perltidyrc .travis.yml cpanfile MANIFEST.SKIP t), $changelog);
  $self->system(qw(git commit --amend -C HEAD --allow-empty)) if @_;
  $self;
}

sub test_coverage {
  my $self = shift;

  unless (eval 'require Devel::Cover; 1') {
    $self->abort(
      'Devel::Cover is not installed. Install it with curl -L http://cpanmin.us | perl - Devel::Cover'
    );
  }

  local $ENV{DEVEL_COVER_OPTIONS}   = $ENV{DEVEL_COVER_OPTIONS} || '+ignore,^t\b';
  local $ENV{HARNESS_PERL_SWITCHES} = '-MDevel::Cover';
  $self->system(qw(cover -delete));
  $self->system(qw(prove -l));
  $self->system(qw(cover));
}

sub update {
  my $self = shift;

  $self->_render_makefile_pl if -e 'cpanfile';
  $self->_update_changes if $self->config('changelog_filename') eq 'Changes';
  $self->_render_readme;
  $self->render_template('t/00-basic.t', {force => 1});
  $self;
}

sub _build_config_param_changelog_filename {
  (grep {-w} qw(CHANGELOG.md Changes))[0] || 'Changes';
}

sub _build_config_param_contributors {
  my $self = shift;
  return decode 'UTF-8', $ENV{GIT_SHIP_CONTRIBUTORS} if $ENV{GIT_SHIP_CONTRIBUTORS};

  my @contributors;
  my $module = decode 'UTF-8', path($self->config('main_module_path'))->slurp;
  my $contrib_block;
  for my $line (split /\n/, $module) {
    if ($line =~ $CONTRIB_START_RE) {
      $contrib_block = 1;
      next;
    }
    $contrib_block = 0 if $line =~ $CONTRIB_END_RE;
    next unless $contrib_block;

    if ($line =~ $CONTRIB_NAME_EMAIL_RE) {
      push @contributors, "$1 <$2>";
    }
    elsif ($line =~ $CONTRIB_NAME_RE) {