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