view release on metacpan or  search on metacpan

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

sub build {
  my $self = shift;

  $self->clean(0);
  $self->system(prove => split /\s/, $self->config('build_test_options'))
    if $self->config('build_test_options');
  $self->clean(0);
  $self->run_hook('before_build');
  $self->_render_makefile_pl if -e 'cpanfile';
  $self->_timestamp_to_changes;
  $self->_update_version_info;
  $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));
}

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

    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) {
      push @contributors, $1;
    }
  }

  return join ',', @contributors;
}

sub _build_config_param_new_version_format {
  return $ENV{GIT_SHIP_NEW_VERSION_FORMAT} || '%v %Y-%m-%dT%H:%M:%S%z';
}

sub _build_config_param_main_module_path {
  my $self = shift;
  return path($ENV{GIT_SHIP_MAIN_MODULE_PATH}) if $ENV{GIT_SHIP_MAIN_MODULE_PATH};

  my @project_name = split /-/, path->basename;
  my $path         = path 'lib';

PATH_PART:
  for my $p (@project_name) {
    opendir my $DH, $path or $self->abort("Cannot find project name from $path: $!");

    for (sort { length $b <=> length $a } readdir $DH) {
      my $f = "$_";
      s!\.pm$!!;
      next unless lc eq lc $p;
      $path = path $path, $f;
      last PATH_PART unless -d $path;
      next PATH_PART;
    }
  }

  return $path;
}

sub _build_config_param_project_name {
  my $self = shift;
  my @name = @{path($self->config('main_module_path'))};
  shift @name if $name[0] eq 'lib';
  $name[-1] =~ s!\.pm$!!;
  return join '::', @name;
}

sub _changes_to_commit_message {
  my $self      = shift;
  my $changelog = $self->config('changelog_filename');
  my ($version, @message);

  close ARGV;    # reset <> iterator
  local @ARGV = $changelog;
  while (<>) {
    last if @message and /^$VERSION_RE\s+/;
    push @message, $_ if @message;
    push @message, $_ and $version = $1 if /^$VERSION_RE\s+/;
  }

  $self->abort("Could not find any changes in $changelog") unless @message;
  $message[0] =~ s!.*?\n!Released version $version\n\n!s;
  local $" = '';
  return "@message";
}

sub _c_objects {
  my $self = shift;
  my @files;

  for my $d (qw(.)) {
    push @files,
      path($d)->list->grep(sub {/\.c|\.xs/})->map(sub { $_->basename('.c', '.xs') . '.o' })->each;
  }

  return @files;
}

sub _dist_files {
  my $self = shift;
  my $name = $self->config('project_name') =~ s!::!-!gr;

  return path->list->grep(sub {m!\b$name.*\.tar!i});
}

sub _exe_files {
  my $self = shift;
  my @files;

  for my $d (qw(bin script)) {
    push @files, path($d)->list->grep(sub {-x})->each;
  }

  return @files;
}

sub _include_mskip_file {
  my ($self, $file) = @_;
  my @lines;

  $file ||= do { require ExtUtils::Manifest; $ExtUtils::Manifest::DEFAULT_MSKIP; };

  unless (-r $file) {
    warn "MANIFEST.SKIP included file '$file' not found - skipping\n";
    return '';
  }

  @lines = ("#!start included $file\n");
  local @ARGV = ($file);
  push @lines, $_ while <>;
  return join "", @lines, "#!end included $file\n";
}

sub _make {
  my ($self, @args) = @_;

  $self->_render_makefile_pl unless -e 'Makefile.PL';
  $self->system(perl => 'Makefile.PL') unless -e 'Makefile';
  $self->system(make => @args);
}

sub _render_makefile_pl {
  my $self    = shift;
  my $prereqs = Module::CPANfile->load->prereqs;
  my $args    = {force => 1};
  my $r;

  $args->{PREREQ_PM}      = $prereqs->requirements_for(qw(runtime requires))->as_string_hash;
  $r                      = $prereqs->requirements_for(qw(build requires))->as_string_hash;
  $args->{BUILD_REQUIRES} = $r;
  $r                      = $prereqs->requirements_for(qw(test requires))->as_string_hash;
  $args->{TEST_REQUIRES}  = $r;
  $args->{RECOMMENDS}     = $prereqs->requirements_for(qw(runtime recommends))->as_string_hash;
  $args->{CONTRIBUTORS}   = [split /,\s*/, $self->config('contributors')];

  $self->render_template('Makefile.PL', $args);
  $self->system(qw(perl -c Makefile.PL));    # test Makefile.PL
}

sub _render_readme {
  my $self = shift;
  my $skip;

  if (-e 'README.md') {
    my $re = "# NAME[\\n\\r\\s]+@{[$self->config('project_name')]}\\s-\\s";
    $skip = path('README.md')->slurp =~ m!$re! ? undef : 'Custom README.md is in place';
  }
  elsif (my @alternative = path->list->grep(sub {/^README/i})->each) {
    $skip = "@alternative exists.";
  }

  if ($skip) {
    say "# Will not generate README.md: $skip" unless $self->SILENT;
    return;
  }

  open my $README, '>:encoding(UTF-8)', 'README.md' or die "Write README.md: $!";
  my $parser = Pod::Markdown->new;
  $parser->output_fh($README);
  $parser->parse_string_document(path($self->config('main_module_path'))->slurp);
  say '# Generated README.md' unless $self->SILENT;
}

sub _timestamp_to_changes {
  my $self      = shift;
  my $changelog = $self->config('changelog_filename');
  my $loc       = setlocale(LC_TIME);
  my $release_line;

  $release_line = sub {
    my $v   = shift;
    my $str = $self->config('new_version_format');
    $str =~ s!(%-?\d*)v!{ sprintf "${1}s", $v }!e;
    setlocale LC_TIME, 'C';
    $str = strftime $str, localtime;
    setlocale LC_TIME, $loc;
    return $str;
  };

  local @ARGV = $changelog;
  local $^I   = '';
  while (<>) {
    $self->config(next_version => $1)
      if s/^$VERSION_RE\x20*(?:Not Released)?\x20*([\r\n]+)/{ $release_line->($1) . $2 }/e;
    print;    # print back to same file
  }

  say '# Building version ', $self->config('next_version') unless $self->SILENT;
  $self->abort('Unable to add timestamp to ./%s', $changelog) unless $self->config('next_version');
}

sub _update_changes {
  my $self = shift;

  unless (eval "require CPAN::Changes; 1") {
    say "# Cannot update './Changes' without CPAN::Changes. Install using 'cpanm CPAN::Changes'."
      unless $self->SILENT;
    return;
  }

  my $changes = CPAN::Changes->load('Changes');
  $changes->preamble(
    'Revision history for perl distribution ' . ($self->config('project_name') =~ s!::!-!gr));
  path('Changes')->spurt($changes->serialize);
  say "# Generated Changes" unless $self->SILENT;
}

sub _update_version_info {
  my $self    = shift;
  my $version = $self->config('next_version')
    or $self->abort('Internal error: Are you sure Changes has a timestamp?');

  local @ARGV = ($self->config('main_module_path'));
  local $^I   = '';
  my %r;
  while (<>) {
    $r{pod} ||= s/$VERSION_RE/$version/ if /^=head1 VERSION/ .. $r{pod} && /^=(cut|head1)/ || eof;
    $r{var} ||= s/((?:our)?\s*\$VERSION)\s*=.*/$1 = '$version';/;
    print;    # print back to same file
  }

  $self->abort('Could not update VERSION in %s', $self->config('main_module_path')) unless $r{var};
}

1;

=encoding utf8

=head1 NAME

App::git::ship::perl - Ship your Perl module

=head1 SYNOPSIS

  # Set up basic files for a Perl repo
  # (Not needed if you already have an existing repo)
  $ git ship start lib/My/Project.pm
  $ git ship start

  # Make changes
  $ $EDITOR lib/My/Project.pm

  # Build first if you want to investigate the changes
  $ git ship build

  # Ship the project to git (and CPAN)
  $ git ship ship

=head1 DESCRIPTION

L<App::git::ship::perl> is a module that can ship your Perl module. This tool
differs from other tools like dzil by *NOT* requiring any configuration, except
for a file containing the credentials for uploading to CPAN.

See also L<App::git::ship/DESCRIPTION>.

Example structure and how L<App::git::ship> works on your files:

=over 4

=item * my-app/cpanfile and my-app/Makefile.PL

The C<cpanfile> is used to build the "PREREQ_PM" and "BUILD_REQUIRES"
structures in the L<ExtUtils::MakeMaker> based C<Makefile.PL> build file.
The reason for this is that C<cpanfile> is a more powerful format that can
be used by L<Carton> and other tools, so generating C<cpanfile> from
Makefile.PL would simply not be possible. Other data used to generate
Makefile.PL are:

Note that the C<cpanfile> is optional and C<Makefile.PL> will be kept untouched
unless C<cpanfile> exists.

"NAME" and "LICENSE" will have values from L</GIT_SHIP_PROJECT_NAME> and