lib/MooseX/Runnable/Util/ArgParser.pm

   1 package MooseX::Runnable::Util::ArgParser;
   2 use Moose;
   3 use MooseX::Types::Moose qw(HashRef ArrayRef Str Bool);
   4 use MooseX::Types::Path::Class qw(Dir);
   5 use List::MoreUtils qw(first_index);
   6
   7 use namespace::autoclean -also => ['_look_for_dash_something', '_delete_first'];
   8
   9 has 'argv' => (
  10     is         => 'ro',
  11     isa        => ArrayRef,
  12     required   => 1,
  13     auto_deref => 1,
  14 );
  15
  16 has 'class_name' => (
  17     is         => 'ro',
  18     isa        => Str,
  19     lazy_build => 1,
  20 );
  21
  22 has 'modules' => (
  23     is         => 'ro',
  24     isa        => ArrayRef[Str],
  25     lazy_build => 1,
  26     auto_deref => 1,
  27 );
  28
  29 has 'include_paths' => (
  30     is         => 'ro',
  31     isa        => ArrayRef[Dir],
  32     lazy_build => 1,
  33     auto_deref => 1,
  34 );
  35
  36 has 'plugins' => (
  37     is         => 'ro',
  38     isa        => HashRef[ArrayRef[Str]],
  39     lazy_build => 1,
  40 );
  41
  42 has 'app_args' => (
  43     is         => 'ro',
  44     isa        => ArrayRef[Str],
  45     lazy_build => 1,
  46     auto_deref => 1,
  47 );
  48
  49 has 'is_help' => (
  50     is       => 'ro',
  51     isa      => Bool,
  52     lazy_build => 1,
  53 );
  54
  55
  56 sub _build_class_name {
  57     my $self = shift;
  58     my @args = $self->argv;
  59
  60     my $next_is_it = 0;
  61     my $need_dash_dash = 0;
  62
  63   ARG:
  64     for my $arg (@args) {
  65         if($next_is_it){
  66             return $arg;
  67         }
  68
  69         if($arg eq '--'){
  70             $next_is_it = 1;
  71             next ARG;
  72         }
  73
  74         next ARG if $arg =~ /^-[A-Za-z]/;
  75
  76         if($arg =~ /^[+]/){
  77             $need_dash_dash = 1;
  78             next ARG;
  79         }
  80
  81         return $arg unless $need_dash_dash;
  82     }
  83
  84     if($next_is_it){
  85         confess 'Parse error: expecting ClassName, got EOF';
  86     }
  87     if($need_dash_dash){
  88         confess 'Parse error: expecting --, got EOF';
  89     }
  90
  91     confess "Parse error: looking for ClassName, but can't find it; perhaps you meant '--help' ?";
  92 }
  93
  94 sub _look_for_dash_something($@) {
  95     my ($something, @args) = @_;
  96     my @result;
  97
  98     my $rx = qr/^-$something(.*)$/;
  99   ARG:
 100     for my $arg (@args) {
 101         last ARG if $arg eq '--';
 102         last ARG unless $arg =~ /^-/;
 103         if($arg =~ /$rx/){
 104             push @result, $1;
 105         }
 106     }
 107
 108     return @result;
 109 }
 110
 111 sub _build_modules {
 112     my $self = shift;
 113     my @args = $self->argv;
 114     return [ _look_for_dash_something 'M', @args ];
 115 }
 116
 117 sub _build_include_paths {
 118     my $self = shift;
 119     my @args = $self->argv;
 120     return [ map { Path::Class::dir($_) } _look_for_dash_something 'I', @args ];
 121 }
 122
 123 sub _build_is_help {
 124     my $self = shift;
 125     my @args = $self->argv;
 126     return
 127       (_look_for_dash_something 'h', @args) ||
 128       (_look_for_dash_something '\\?', @args) ||
 129       (_look_for_dash_something '-help', @args) ;;
 130 }
 131
 132 sub _build_plugins {
 133     my $self = shift;
 134     my @args = $self->argv;
 135     $self->class_name; # causes death when plugin syntax is wrong
 136
 137     my %plugins;
 138     my @accumulator;
 139     my $in_plugin = undef;
 140
 141   ARG:
 142     for my $arg (@args) {
 143         if(defined $in_plugin){
 144             if($arg eq '--'){
 145                 $plugins{$in_plugin} = [@accumulator];
 146                 @accumulator = ();
 147                 return \%plugins;
 148             }
 149             elsif($arg =~ /^[+](.+)$/){
 150                 $plugins{$in_plugin} = [@accumulator];
 151                 @accumulator = ();
 152                 $in_plugin = $1;
 153                 next ARG;
 154             }
 155             else {
 156                 push @accumulator, $arg;
 157             }
 158         }
 159         else { # once we are $in_plugin, we can never be out again
 160             if($arg eq '--'){
 161                 return {};
 162             }
 163             elsif($arg =~ /^[+](.+)$/){
 164                 $in_plugin = $1;
 165                 next ARG;
 166             }
 167         }
 168     }
 169
 170     if($in_plugin){
 171         confess "Parse error: expecting arguments for plugin $in_plugin, but got EOF. ".
 172           "Perhaps you forgot '--' ?";
 173     }
 174
 175     return {};
 176 }
 177
 178 sub _delete_first($\@) {
 179     my ($to_delete, $list) = @_;
 180     my $idx = first_index { $_ eq $to_delete } @$list;
 181     splice @$list, $idx, 1;
 182     return;
 183 }
 184
 185 # this is a dumb way to do it, but i forgot about it until just now,
 186 # and don't want to rewrite the whole class ;) ;)
 187 sub _build_app_args {
 188     my $self = shift;
 189     my @args = $self->argv;
 190
 191     return [] if $self->is_help; # LIES!!11!, but who cares
 192
 193     # functional programmers may wish to avert their eyes
 194     _delete_first $_, @args for map { "-M$_" } $self->modules;
 195     _delete_first $_, @args for map { "-I$_" } $self->include_paths;
 196
 197     my %plugins = %{ $self->plugins };
 198     for my $p (keys %plugins){
 199         my $vl = scalar @{ $plugins{$p} };
 200         splice @args, first_index { $_ eq "+$p" } @args, $vl + 1;
 201     }
 202
 203     # sanity check
 204     if($args[0] eq '--'){
 205         shift @args;
 206     }
 207
 208     if($args[0] eq $self->class_name){
 209         shift @args;
 210     }
 211     else {
 212         confess 'Parse error: Some residual crud was found before the app name: '.
 213           join ', ', @args;
 214     }
 215
 216     return [@args];
 217 }
 218
 219 1;
 220
 221 __END__
 222
 223 =head1 NAME
 224
 225 MooseX::Runnable::Util::ArgParser - parse @ARGV for mx-run
 226
 227 =head1 SYNOPSIS
 228
 229     my $parser = MooseX::Runnable::Util::ArgParser->new(
 230         argv => \@ARGV,
 231     );
 232
 233     $parser->class_name;
 234     $parser->modules;
 235     $parser->include_paths;
 236     $parser->plugins;
 237     $parser->is_help;
 238     $parser->app_args;
 239