view release on metacpan or  search on metacpan

lib/App/FatPacker.pm  view on Meta::CPAN

package App::FatPacker;

use strict;
use warnings FATAL => 'all';
use 5.008001;
use Getopt::Long;
use Cwd qw(cwd);
use File::Find qw(find);
use File::Spec::Functions qw(
  catdir splitpath splitdir catpath rel2abs abs2rel
);
use File::Spec::Unix;
use File::Copy qw(copy);
use File::Path qw(mkpath rmtree);
use B qw(perlstring);

our $VERSION = '0.010008'; # v0.10.8

$VERSION = eval $VERSION;

sub call_parser {
  my $self = shift;
  my ($args, $options) = @_;

  local *ARGV = [ @{$args} ];
  $self->{option_parser}->getoptions(@$options);

  return [ @ARGV ];
}

sub lines_of {
  map +(chomp,$_)[1], do { local @ARGV = ($_[0]); <> };
}

sub stripspace {
  my ($text) = @_;
  $text =~ /^(\s+)/ && $text =~ s/^$1//mg;
  $text;
}

sub import {
  $_[1] && $_[1] eq '-run_script'
    and return shift->new->run_script;
}

sub new {
  bless {
    option_parser => Getopt::Long::Parser->new(
      config => [ qw(require_order pass_through bundling no_auto_abbrev) ]
    ),
  }, $_[0];
}

sub run_script {
  my ($self, $args) = @_;
  my @args = $args ? @$args : @ARGV;
  (my $cmd = shift @args || 'help') =~ s/-/_/g;

  if (my $meth = $self->can("script_command_${cmd}")) {
    $self->$meth(\@args);
  } else {
    die "No such command ${cmd}";
  }
}

sub script_command_help {
  print "Try `perldoc fatpack` for how to use me\n";
}

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

  my @modules = split /\r?\n/, $self->trace(args => $args);
  my @packlists = $self->packlists_containing(\@modules);

  my $base = catdir(cwd, 'fatlib');
  $self->packlists_to_tree($base, \@packlists);

  my $file = shift @$args;
  print $self->fatpack_file($file);
}

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

  $args = $self->call_parser($args => [
    'to=s' => \my $file,
    'to-stderr' => \my $to_stderr,
    'use=s' => \my @additional_use
  ]);

  die "Can't use to and to-stderr on same call" if $file && $to_stderr;