view release on metacpan or  search on metacpan

lib/Module/ScanDeps/Static.pm  view on Meta::CPAN

    if ( $is_extra{$o} ) {
      $extra_values{$o} = $options->{$o};
    }
    else {
      $cli_values{$o} = $options->{$o};
    }
  }

  # classify each known option_spec as negatable ('!'), plain boolean
  # (no type suffix at all -- presence-only, no --no-X form), or
  # value-taking ('=s' etc.), so the hashref -> @ARGV translation below
  # can represent each key correctly instead of treating them all the
  # same way.
  my %spec_type;

  foreach my $spec ( @{ _option_specs() } ) {
    my ($name) = split /[^\w-]/xsm, $spec;

    if ( $spec =~ /[!]\z/xsm ) {
      $spec_type{$name} = 'negatable';
    }
    elsif ( $spec =~ /[=:]/xsm ) {
      $spec_type{$name} = 'value';
    }
    else {
      $spec_type{$name} = 'boolean';
    }
  }

  my @argv;

  foreach my $o ( keys %cli_values ) {
    ( my $dashed = $o ) =~ s/_/-/gxsm;

    my $arg_name = length $dashed == 1 ? "-$dashed" : "--$dashed";

    my $type = $spec_type{$dashed};

    if ( !defined $type ) {
      # unrecognized key that isn't an extra_options field either --
      # not something we know how to represent; pass through as-is
      # and let GetOptions report the error.
      push @argv, ( $arg_name => $cli_values{$o} );
    }
    elsif ( $type eq 'negatable' ) {
      push @argv, $cli_values{$o} ? $arg_name : "--no-$dashed";
    }
    elsif ( $type eq 'boolean' ) {
      # no negated form exists for these -- omit entirely when false
      # rather than emitting a flag GetOptions won't recognize.
      push @argv, $arg_name if $cli_values{$o};
    }
    elsif ( defined $cli_values{$o} ) {
      push @argv, ( $arg_name => $cli_values{$o} );
    }
    else {
      push @argv, $arg_name;
    }
  }

  local @ARGV = @argv;

  my $self = __PACKAGE__->main($TRUE);

  foreach my $k ( keys %extra_values ) {
    my $setter = "set_$k";
    $self->$setter( $extra_values{$k} );
  }

  return $self;
}

########################################################################
sub main {
########################################################################
  my ( $class, $setup ) = @_;

  my $cli = __PACKAGE__->SUPER::new(
    commands         => { scan => \&cmd_scan },
    option_specs     => _option_specs(),
    default_options  => _default_options(),
    extra_options    => _extra_options(),
    validate_command => $FALSE,
  );

  return $setup ? $cli : return $cli->run;
}

########################################################################
sub init {
########################################################################
  my ($self) = @_;

  my @args = $self->get_args;

  if ( !@args ) {
    $self->command_args( $self->command() );  # set the args to the command
    $self->command('scan');  # set the command to your default
  }
  else {
    die "ERROR: unknown command\n"
      if !$self->commands->{ $self->command };  # validate the command
  }

  my @file_list = eval {

    if ( my $file_list = $self->get_file_list ) {
      my $list = slurp($file_list);

      $self->set_json($FALSE);

      return split /\n/xsm, $list;
    }

    return $self->get_path
      if $self->get_path;

    return $self->get_args;
  };

  $self->set_files( \@file_list );