1 package MooseX::Runnable::Util::ArgParser;
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);
9 use namespace::autoclean -also => ['_look_for_dash_something', '_delete_first'];
31 has 'include_paths' => (
40 isa => HashRef[ArrayRef[Str]],
58 sub _build_class_name {
60 my @args = $self->argv;
63 my $need_dash_dash = 0;
76 next ARG if $arg =~ /^-[A-Za-z]/;
83 return $arg unless $need_dash_dash;
87 confess 'Parse error: expecting ClassName, got EOF';
90 confess 'Parse error: expecting --, got EOF';
93 confess "Parse error: looking for ClassName, but can't find it; perhaps you meant '--help' ?";
96 sub _look_for_dash_something($@) {
97 my ($something, @args) = @_;
100 my $rx = qr/^-$something(.*)$/;
102 for my $arg (@args) {
103 last ARG if $arg eq '--';
104 last ARG unless $arg =~ /^-/;
115 my @args = $self->argv;
116 return [ _look_for_dash_something 'M', @args ];
119 sub _build_include_paths {
121 my @args = $self->argv;
122 return [ map { Path::Class::dir($_) } _look_for_dash_something 'I', @args ];
127 my @args = $self->argv;
129 (_look_for_dash_something 'h', @args) ||
130 (_look_for_dash_something '\\?', @args) ||
131 (_look_for_dash_something '-help', @args) ;;
136 my @args = $self->argv;
137 $self->class_name; # causes death when plugin syntax is wrong
141 my $in_plugin = undef;
144 for my $arg (@args) {
145 if(defined $in_plugin){
147 $plugins{$in_plugin} = [@accumulator];
151 elsif($arg =~ /^[+](.+)$/){
152 $plugins{$in_plugin} = [@accumulator];
158 push @accumulator, $arg;
161 else { # once we are $in_plugin, we can never be out again
165 elsif($arg =~ /^[+](.+)$/){
173 confess "Parse error: expecting arguments for plugin $in_plugin, but got EOF. ".
174 "Perhaps you forgot '--' ?";
180 sub _delete_first($\@) {
181 my ($to_delete, $list) = @_;
182 my $idx = first_index { $_ eq $to_delete } @$list;
183 splice @$list, $idx, 1;
187 # this is a dumb way to do it, but i forgot about it until just now,
188 # and don't want to rewrite the whole class ;) ;)
189 sub _build_app_args {
191 my @args = $self->argv;
193 return [] if $self->is_help; # LIES!!11!, but who cares
195 # functional programmers may wish to avert their eyes
196 _delete_first $_, @args for map { "-M$_" } $self->modules;
197 _delete_first $_, @args for map { "-I$_" } $self->include_paths;
199 my %plugins = %{ $self->plugins };
202 for my $p (keys %plugins){
203 my $vl = scalar @{ $plugins{$p} };
204 my $idx = first_index { $_ eq "+$p" } @args;
205 next PLUGIN if $idx == -1; # HORRIBLE API!
207 splice @args, $idx, $vl + 1;
210 if($args[0] eq '--'){
214 if($args[0] eq $self->class_name){
218 confess 'Parse error: Some residual crud was found before the app name: '.
227 my ($self, %opts) = @_;
229 confess 'Parser is help' if $self->is_help;
231 my @perl_flags = @{$opts{perl_flags} || []};
232 my @without_plugins = @{$opts{without_plugins} || []};
235 my @cmdline = ($^X, @perl_flags, $FindBin::Bin.'/'.$FindBin::Script);
236 push @cmdline, map { "-I$_" } $self->include_paths;
237 push @cmdline, map { "-M$_" } $self->modules;
240 for my $plugin (keys %{$self->plugins}){
241 for my $without (@without_plugins) {
242 next p if $without eq $plugin;
244 push @cmdline, "+$plugin", @{$self->plugins->{$plugin} || []};
247 push @cmdline, $self->class_name;
248 push @cmdline, $self->app_args;
259 MooseX::Runnable::Util::ArgParser - parse @ARGV for mx-run
263 my $parser = MooseX::Runnable::Util::ArgParser->new(
269 $parser->include_paths;