File Coverage

blib/lib/Acme/Module/Build/Tiny.pm

Criterion	Covered	Total	%
statement	42	187	22.4
branch	0	30	0.0
condition	0	21	0.0
subroutine	14	45	31.1
pod	6	9	66.6
total	62	292	21.2

package Acme::Module::Build::Tiny;
use strict;
use warnings;
use Config;
use Data::Dumper 0 ();
use ExtUtils::Install 0 ();
use ExtUtils::MakeMaker 0 ();
use File::Find 0 ();
use File::Path 0 ();
use File::Spec 0 ();
use Getopt::Long 0 ();
use Test::Harness 0 ();
use Tie::File 0 ();
use Text::ParseWords 0 ();
our $VERSION = '0.06';

my %re = (
  lib     => qr{\.(?:pm|pod)$},
  t       => qr{\.t},
  't/lib' => qr{\.(?:pm|pod)$},
  prereq  => qr{^\s*use[ \t]+(\S+)[ \t]+(v?[0-9._]+)[^;]*;}m,
  authors => qr{^=head1 AUTHORS?\s*\n(.*?)^=\w}sm,
);

my %install_map = map { +"blib/$_"  => $Config{"installsite$_"} } qw/lib script/;

my %install_base = ( lib => [qw/lib perl5/], script => [qw/lib bin/] );

my @opts_spec = ( 'install_base:s', 'uninst:i' );

sub _split_like_shell {
  my $string = shift;
  $string =~ s/^\s+|\s+$//g;
  return Text::ParseWords::shellwords($string);
}

sub _home { return $ENV{HOME} || $ENV{USERPROFILE} }

sub _default_rc { return File::Spec->catfile( _home(), '.modulebuildrc' ) }

sub _get_rc_opts {
  my $rc_file = ($ENV{MODULEBUILDRC} || _default_rc());
  return {} unless -f $rc_file;
  my $guts = _slurp( $rc_file );
  $guts =~ s{\n[ \t]+}{ }mg; # join lines with leading whitespace
  $guts =~ s{^#.*$}{}mg; # strip comments
  $guts =~ s{\n\s*\n}{\n}mg; # empty lines
  my %opt = map  { my ($k,$v) = $_ =~ /(\S+)\s+(.*)/; $k => $v }
            grep { /\S/ } split /\n/, $guts;
  return \%opt;
}

sub _get_options {
  my ($action,$opt) = @_;
  my $rc_opts = _get_rc_opts;
  for my $s ( $ENV{PERL_MB_OPT}, $rc_opts->{$action}, $rc_opts->{'*'} ) {
    unshift @ARGV, _split_like_shell($s) if defined $s && length $s;
  }
  Getopt::Long::GetOptions($opt, @opts_spec);
}

sub run {
  my $opt = eval { do '_build/build_params' } || {};
  my $action = ! defined $ARGV[0]    ? 'build'
             : $ARGV[0] =~ /\A\w+\z/ ? $ARGV[0]
             : 'build';
  _get_options($action, $opt);
  my $fcn = __PACKAGE__->can($action) or die "$action not implemented\n";
  $fcn->(%$opt);
}

sub debug {
  my %opt = @_;
  print _data_dump(\%opt) . "\n";
}

sub import {
  _get_options('Build_PL', my $opt = {});
  my @f = _files('lib');
  my $meta = {
    name     => _mod2dist(_path2mod($f[0])),
    version  => MM->parse_version($f[0]),
  };
  print "Creating new 'Build' script for '$meta->{name}'" .
        " version '$meta->{version}'\n";
  my $perl = $^X =~ /\Aperl[.0-9]*\z/ ? $Config{perlpath} : $^X;
  _spew('Build' => "#!$perl\n", _slurp( $INC{_mod2pm(shift)} ) );
  chmod 0755, 'Build';
  _spew( '_build/prereqs', _data_dump(_find_prereqs()) );
  _spew( '_build/build_params', _data_dump($opt) );
  _spew( '_build/meta', _data_dump(_fill_meta($meta, $f[0])) );
  _spew( 'MYMETA.yml', _slurp('META.yml')) if -f 'META.yml';
}

sub build {
  my $map = {
    (map {$_=>"blib/$_"} _files('lib')),
    (map {;"bin/$_"=>"blib/script/$_"} map {s{^bin/}{}; $_} _files('bin')),
  };
  ExtUtils::Install::pm_to_blib($map, 'blib/lib/auto');
  ExtUtils::MM->fixin($_), chmod(0555, $_) for _files('blib/script');
  return 1;
}

sub test {
  build();
  local @INC = (File::Spec->rel2abs('blib/lib'), @INC);
  Test::Harness::runtests(_files('t'));
}

sub _install_base {
  my $map = {map {$_=>File::Spec->catdir($_[0],@{$install_base{$_}})} keys %install_base};
}

sub install {
  my %opt = @_;
  build();
  ExtUtils::Install::install(
    ($opt{install_base} ? _install_base($opt{install_base}) : \%install_map), 1
  );
  return 1;
}

sub distdir {
  require ExtUtils::Manifest; ExtUtils::Manifest->VERSION(1.57);
  File::Path::rmtree(_distdir());
  _spew('MANIFEST.SKIP', "#!include_default\n^"._distbase()."\n") unless -f 'MANIFEST.SKIP';
  local $ExtUtils::Manifest::Quiet = 1;
  ExtUtils::Manifest::mkmanifest();
  ExtUtils::Manifest::manicopy( ExtUtils::Manifest::maniread(), _distdir() );
  _spew(_distdir("/inc/",_mod2pm(__PACKAGE__)) => _slurp( __FILE__ ) );
  _append(_distdir("MANIFEST"), "inc/" . _mod2pm(__PACKAGE__) . "\n");
  _write_meta(_distdir("META.yml"));
  _append(_distdir("MANIFEST"), "META.yml");
}

sub dist {
  require Archive::Tar; Archive::Tar->VERSION(1.09);
  distdir();
  my ($distdir,@f) = (_distdir(),_files(_distdir()));
  no warnings 'once';
  $Archive::Tar::DO_NOT_USE_PREFIX = (grep { length($_) >= 100 } @f) ? 0 : 1;
  my $tar = Archive::Tar->new;
  $tar->add_files(@f);
  $_->mode($_->mode & ~022) for $tar->get_files;
  $tar->write("$distdir.tar.gz", 1);
  File::Path::rmtree($distdir);
}

sub clean { File::Path::rmtree('blib'); 1 }

sub realclean { clean(); File::Path::rmtree($_) for _distdir(), qw/Build _build/; 1; }

sub _slurp { do { local (@ARGV,$/)=$_[0]; <> } }
sub _spew {
  my $file = shift;
  File::Path::mkpath(File::Basename::dirname($file));
  open my $fh, '>', $file;
  print {$fh} @_;
}
sub _append { open my $fh, ">>", shift; print {$fh} @_ }

sub _data_dump {
  'do{ my ' . Data::Dumper->new([shift],['x'])->Purity(1)->Dump() . '$x; }'
}

sub _mod2pm   { (my $mod = shift) =~ s{::}{/}g; return "$mod.pm" }
sub _path2mod { (my $pm  = shift) =~ s{/}{::}g; return substr $pm, 5, -3 }
sub _mod2dist { (my $mod = shift) =~ s{::}{-}g; return $mod; }

sub _files {
  my ($dir,@f) = shift;
  return unless -d $dir;
  my $regex = $re{$dir} || qr/./;
  File::Find::find( sub { -f && /$regex/ && push @f, $File::Find::name},$dir);
  return sort { length $a <=> length $b } @f;
}

sub _distbase { my @f = _files('lib'); return _mod2dist(_path2mod($f[0])) }

sub _distdir {
  my @f = _files('lib');
  return File::Spec->catfile(_distbase ."-". MM->parse_version($f[0]), @_);
}

sub _fill_meta {
  my ($m, $src) = @_;
  for ( split /\n/, _slurp($src) ) {
    next unless /^=(?!cut)/ .. /^=cut/;  # in POD
    ($m->{abstract}) = /^  (?:  [a-z:]+  \s+ - \s+  )  (.*\S)  /ix
      unless $m->{abstract};
  }
  $m->{author} = _find_authors($src);
  return $m;
}

sub _find_authors {
  my $guts = _slurp($_[0]);
  my ($block) = $guts =~ $re{authors};
  return $block ? [ map { s{^\s+}{}; s{\s+$}{}; $_ } grep { /\S/ } split /\n/, $block ] : [];
}

sub _write_meta {
  my $file = shift;
  my $meta = eval { do '_build/meta' } || {};
  my $prereqs = eval { do '_build/prereqs' } || {};
  $meta->{$_} = $prereqs->{$_} for keys %$prereqs;
  $meta->{generated_by} = sprintf("%s version %s", __PACKAGE__, $VERSION);
  $meta->{'meta-spec'} = { version => 1.4, url => 'http://module-build.sourceforge.net/META-spec-v1.4.html' };
  $meta->{'license'} = 'perl';
  require CPAN::Meta::YAML;
  CPAN::Meta::YAML::DumpFile($file,$meta);
}

sub _find_prereqs {
  my (%requires, %build_requires);
  for my $guts ( map { _slurp($_) } _files('lib'), _files('bin') ) {
    while ( $guts =~ m{$re{prereq}}g ) { $requires{$1}=$2; }
  }
  for my $guts ( map { _slurp($_) } _files('t'), _files('t/lib') ) {
    while ( $guts =~ m{$re{prereq}}g ) { $build_requires{$1}=$2; }
  }
  return { requires => \%requires, build_requires => \%build_requires };
}

run() unless caller; # modulino :-)

1;

__END__