view release on metacpan or  search on metacpan

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

package App::EPAN;

use 5.012;
{ our $VERSION = '0.002' }
use warnings;
use English qw( -no_match_vars );
use version;
use autodie;
use Getopt::Long qw< :config gnu_getopt >;
use Pod::Usage qw< pod2usage >;
use Dist::Metadata ();
use Path::Class qw< file dir >;
use Cwd qw< cwd >;
use File::Find::Rule ();
use Compress::Zlib   ();
use Log::Log4perl::Tiny qw< :easy :dead_if_first >;
use Moo;
use IPC::Run   ();
use File::Copy ();
use File::Which qw< which >;

has configuration => (
   is        => 'rw',
   lazy      => 1,
   predicate => 'has_config',
   clearer   => 'clear_config',
   default   => sub { {} },
);
has action     => (is => 'rw',);
has last_index => (is => 'rw',);

sub run {
   my $package = shift;
   my $self    = $package->new();
   $self->get_options(@_);

   my $action = $self->action();
   pod2usage(-verbose => 99, -sections => 'USAGE') unless defined $action;
   if (my $method = $self->can("action_$action")) {
      $self->$method();
   }
   else {
      FATAL "action '$action' is not supported\n";
      $self->action_list_actions;
      exit 1;
   }
   return;
} ## end sub run

sub get_options {
   my $self = shift;
   my $action =
     (scalar(@_) && length($_[0]) && (substr($_[0], 0, 1) ne '-'))
     ? shift(@_)
     : 'list-actions';
   $action =~ s{-}{_}gmxs;
   local @ARGV = @_;
   $self->action($action);
   my %config = ();
   GetOptions(
      \%config,
      qw(
        mailrc|m|1=s
        output|packages-details|o|2=s
        modlist|modlist-data|l|3=s
        target|t=s
        test|T!
        author|a=s
        usage! help! man! version!
        )
   ) or pod2usage(-verbose => 99, -sections => 'USAGE');
   our $VERSION ||= 'whateva';
   pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ')
     if $config{version};
   pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
   pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
     if $config{help};
   pod2usage(-verbose => 2) if $config{man};
   $self->configuration(
      {
         cmdline_config => \%config,
         config         => \%config,
         args           => [@ARGV],
      }
   );
   return;
} ## end sub get_options

sub args {
   return @{$_[0]->configuration()->{args}};
}

sub config {
   my $self = shift;
   return @{$self->configuration()->{config}}{@_} if wantarray();
   return $self->configuration()->{config}{shift @_};
}

sub target_dir {
   my $self = shift;
   return dir($self->config('target') // 'epan');
}

sub execute_tests {
   my $self = shift;
   return $self->config('test');
}

sub action_index { return shift->_do_index }

{
   no strict 'refs';
   *{action_idx} = \&action_index;
}

sub _save {
   my ($self, $name, $contents, $config_key, $output) = @_;