view release on metacpan or  search on metacpan

bin/makedist  view on Meta::CPAN

#!/usr/bin/perl
# vim: ft=perl:fdm=marker:fmr=#<,#>:fen:et:sw=2:
package App::makedist;

use strict;
use warnings FATAL => 'all';
use vars     qw($VERSION);
use autodie  qw(:all);

#< init

$VERSION = '0.026';

sub usage {
  pod2usage(
    msg => "makedist v$VERSION\n",
    verbose => 1,
    exitval => 0,
  );
}


use Cwd;
use Pod::Usage;
use File::Basename        qw(basename);
use File::Copy::Recursive qw(rcopy);
use File::Path            qw(rmtree);
use File::LsColor         qw(ls_color);
use Term::ExtendedColor   qw(fg bg bold);
use Getopt::Long;
use Module::Extract::VERSION;
use File::Find::Rule;

my $opt_verbose  = 0;
my $opt_noconfig = 0;

GetOptions(
  'noconfig'  => \$opt_noconfig,
  'v|verbose' => \$opt_verbose,
  'h|help'    => \&usage,
);
#>

my $MANIFEST = './MANIFEST';

my @files_in_dist;

# load config file
our $command_on_success;
our $finished_product;
config_init() unless $opt_noconfig;


# First we need to make sure that all files that's listed in the MANIFEST
# actually exists.
verify_manifest();


makedist();


sub makedist {
  # App-makedist-0.020.tar.gz
  my $dist_tar = build_filename();

  # App-makedist-0.020
  my ($dist_dir) = $dist_tar =~ m/^([a-z0-9.-]+)[.]tar[.]gz$/i;

  mkdir $dist_dir or die "Can't mkdir '$dist_dir': $!\n";

  # copy all files in the MANIFEST to dist dir, i.e App-makedist-0.020
  for my $file(@files_in_dist) {
    # make sure to honor the dir structure
    if($file =~ m{^(.+)/}) {
      if(-d $1) {
        rcopy($file, "$dist_dir/$file");
        next;
      }
    }
    rcopy($file, $dist_dir) or die "Copy failed: '$file' -> '$dist_dir\n";
  }
  system('tar', 'czf', $dist_tar, $dist_dir);
  if($? == 0) {
    printf("- Distribution created: %s\n", ls_color($dist_tar)) if $opt_verbose;

    # remove the created dist dir
    rmtree($dist_dir) or die "Can't remove '$dist_dir': $!\n";

    # all good, execute code from config if defined
    # let the config have the value of $dist_tar as a variable
    $finished_product = $dist_tar;
    if(defined($command_on_success)) {
      $command_on_success->();
    }
  }
}


sub build_filename { #<
  my $file;
  my $rule = File::Find::Rule->new;
  $rule->file;
  $rule->name(qr/[.]pm$/);

  # try to get $VERSION from a perl module if it exists
  $file = ($rule->in(getcwd()))[0];

  # and resort to anything in bin/ directory if it fails
  if(!$file) {
    $file = (glob('./bin/*'))[0];
  }

  # no lib/**/*.pm and no bin/*, rip :(
  die "Can not find any suitable files!\n" if not defined $file;

  printf("- Getting \$VERSION from %s...\n",ls_color(basename($file))) if $opt_verbose;
  my $dist = get_package_name($file);

  printf("- Getting distribution name from %s...\n", ls_color(basename($file))) if $opt_verbose;
  my $version = scalar Module::Extract::VERSION->parse_version_safely($file);

  printf("  Looks like %s %s\n", bold(fg(214, $dist)), bold($version)) if $opt_verbose;

  my $dist_name = sprintf("%s-%s.tar.gz", $dist, $version);
  return $dist_name;
}
#>

sub get_package_name { #<
  my $file = shift;
  my $package;

  open(my $fh, '<', $file) or die "Can't open '$file': $!\n";
  while(<$fh>) {
    chomp;

    # package File::LsColor;
    # XXX Fix regex, this isn't good
    if($_ =~ m/^package\s+(.+);/) {
      $package = $1;
      $package =~ s/::/-/g;
      last;
    }
  }

  # if we can't figure out a package name, the dist probably isn't a perl
  # module, so we use the basename of the current working directory and apply the
  # App- prefix

  # File-LsColor-0.132.tar.gz
  # App-makedist-0.012.tar.gz
  return (defined $package ? $package : 'App-' . basename(getcwd()));
}
#>

sub verify_manifest { #<
  open(my $fh, '<', $MANIFEST) or die "Can't open '$MANIFEST': aborting\n";
  print "- Checking file integrity...\n" if $opt_verbose;
  while(<$fh>) {
    chomp;

    # sometimes the MANIFEST contains things like
    # MANIFEST\t\t\t this list of files

    s/MANIFEST.+$/MANIFEST/;

    if(-e $_) {
      print '   ' . ok($_) if $opt_verbose;
      push(@files_in_dist, $_);
    }
    else {
      printf("%s %s from MANIFEST. Aborting.\n", bold($_), bg('red1', 'MISSING'));
      exit;
    }
  }
  if($opt_verbose) {
    print "  All files in MANIFEST present!\n";
    printf("  %d files to be added to distribution.\n", scalar @files_in_dist);
  }
}
#>



sub config_init { #< config
  my $config;
  if(-f "$ENV{XDG_CONFIG_HOME}/makedist/makedist.conf") {
    $config = "$ENV{XDG_CONFIG_HOME}/makedist/makedist.conf";
  }
  elsif(-f "$ENV{HOME}/.makedist.conf") {
    $config = "$ENV{HOME}/.makedist.conf";
  }
  else {
    print "makedist: no configuratino file found.\n";
  }
  require($config);
  warn "$@" if $@;
}
#>


sub ok {
  my $str = shift;
  return sprintf("%4s %s\n", fg('greenyellow', 'OK'), ls_color($str));
}




__END__


=pod

=head1 NAME

makedist - make cpan distribution

=head1 USAGE

    makedist [OPTIONS]

=head1 DESCRIPTION

makedist automates the process of creating a distribution to be
uploaded to CPAN.

The MANIFEST file is inspected for files to be included.

We make an attempt to extract the package name from any perl module
file found, and the package name must follow this convention: