The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Prophet::CLI::Dispatcher;
{
  $Prophet::CLI::Dispatcher::VERSION = '0.751';
}
use Path::Dispatcher::Declarative -base;
use Any::Moose;
extends 'Path::Dispatcher::Declarative', any_moose('Object');

use Prophet::CLI::Dispatcher::Rule::RecordId;

with 'Prophet::CLI::Parameters';

our $cli;

our @PREFIXES = qw(Prophet::CLI::Command);
sub add_command_prefix { unshift @PREFIXES, @_ }

on '' => sub {
    my $self = shift;
    if ( $self->context->has_arg('version') ) {
        run_command("Version")->($self);
    } elsif ( $self->context->has_arg('help') ) {
        run_command("Help")->($self);
    } else {
        next_rule;
    }
};

# publish foo@bar.com:www/baz => publish --to foo@bar.com:www/baz
on qr{^(publish|push) (\S+)$} => sub {
    my $self = shift;
    $self->context->set_arg( to => $2 );
    run( $1, $self );
};

# clone http://fsck.com/~jesse/sd-bugs => clone --from http://fsck.com/~jesse/sd-bugs
on qr{^(clone|pull) (\S+)$} => sub {
    my $self = shift;
    $self->context->set_arg( from => $2 );
    run( $1, $self );
};

# log range => log --range range
on qr{log\s+([0-9LATEST.~]+)} => sub {
    my $self = shift;
    $self->context->set_arg( range => $1 );
    run( 'log', $self );
};

under settings => sub {
    my $self = shift;
    on edit => sub {
        my $self = shift;
        $self->context->set_arg('edit');
        run( 'settings', $self );
    };
    on show => sub {
        my $self = shift;
        $self->context->set_arg('show');
        run( 'settings', $self );
    };
    on set => sub {
        my $self = shift;
        $self->context->set_arg('set');
        run( 'settings', $self );
    };
};

dispatcher->add_rule(
    Path::Dispatcher::Rule::Sequence->new(
        rules => [
            Path::Dispatcher::Rule::Regex->new(
                regex =>
                  qr/^(update|edit|show|display|delete|del|rm|history)$/,
            ),
            Prophet::CLI::Dispatcher::Rule::RecordId->new,
        ],
        block => sub {
            my $match = shift;
            my $self  = shift;
            $self->context->set_id_from_primary_commands;
            run( $match->pos(1), $self, @_ );
        },
    )
);

on [ [ 'update', 'edit' ] ]    => run_command("Update");
on [ [ 'show',   'display' ] ] => run_command("Show");
on [ [ 'delete', 'del', 'rm' ] ] => run_command("Delete");
on history => run_command("History");

on [ [ 'create', 'new' ] ] => run_command("Create");
on [ [ 'search', 'list', 'ls' ] ] => run_command("Search");
on [ [ 'aliases', 'alias' ] ] => run_command('Aliases');

on version  => run_command("Version");
on init     => run_command("Init");
on clone    => run_command("Clone");
on merge    => run_command("Merge");
on mirror   => run_command('Mirror');
on pull     => run_command("Pull");
on publish  => run_command("Publish");
on server   => run_command("Server");
on config   => run_command("Config");
on settings => run_command("Settings");
on log      => run_command("Log");
on shell    => run_command("Shell");
on export   => run_command('Export');
on info     => run_command('Info');
on push     => run_command('Push');

on qr/^(alias(?:es)?|config)?\s+(.*)/ => sub {
    my ($self) = @_;
    my $cmd    = $1;
    my $arg    = $2;

    my $class = $cmd =~ /^alias/ ? 'Aliases' : 'Config';

    # Load command class so we can run
    # its arg-parsing sub (the syntax is complex)
    my @classes = $self->class_names($class);
    for my $class (@classes) {
        Prophet::App->try_to_require($class) or next;
        my $cmd_obj = $class->new(
            context => $self->context,
            cli     => $self->cli,
        );
        $cmd_obj->parse_cli_arg( $cmd, $arg );
        return run( $cmd, $self, @_ );
    }

    # Something is wrong with the app layout...
    die "Could not find '$class' command class";
};

on qr/^_gencomp\s*(.*)/ => sub {
    my $self = shift;
    my $path = $1;
    $path = "" if !defined($path);
    print "$_\n" for $self->dispatcher->complete($path);
};

sub run_command {
    my $name = shift;
    return sub {
        my $self             = shift;
        my %constructor_args = (
            cli      => $self->cli,
            context  => $self->context,
            commands => $self->context->primary_commands,
            type     => $self->context->type,
            uuid     => $self->context->uuid,
        );

        # undef causes type constraint violations
        for my $key ( keys %constructor_args ) {
            delete $constructor_args{$key}
              if !defined( $constructor_args{$key} );
        }

        my @classes = $self->class_names($name);
        for my $class (@classes) {
            Prophet::App->try_to_require($class) or next;
            $class->new(%constructor_args)->run;
            return;
        }

        die "Invalid command command class suffix '$name'";
    };
}

sub class_names {
    my $self    = shift;
    my $command = shift;
    return map { $_ . "::" . $command } @PREFIXES;

}

__PACKAGE__->meta->make_immutable;
no Any::Moose;

1;

__END__

=pod

=head1 NAME

Prophet::CLI::Dispatcher

=head1 VERSION

version 0.751

=head1 AUTHORS

=over 4

=item *

Jesse Vincent <jesse@bestpractical.com>

=item *

Chia-Liang Kao <clkao@bestpractical.com>

=item *

Christine Spang <christine@spang.cc>

=back

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2009 by Best Practical Solutions.

This is free software, licensed under:

  The MIT (X11) License

=head1 BUGS AND LIMITATIONS

You can make new bug reports, and view existing ones, through the
web interface at L<https://rt.cpan.org/Public/Dist/Display.html?Name=Prophet>.

=head1 CONTRIBUTORS

=over 4

=item *

Alex Vandiver <alexmv@bestpractical.com>

=item *

Casey West <casey@geeknest.com>

=item *

Cyril Brulebois <kibi@debian.org>

=item *

Florian Ragwitz <rafl@debian.org>

=item *

Ioan Rogers <ioanr@cpan.org>

=item *

Jonas Smedegaard <dr@jones.dk>

=item *

Kevin Falcone <falcone@bestpractical.com>

=item *

Lance Wicks <lw@judocoach.com>

=item *

Nelson Elhage <nelhage@mit.edu>

=item *

Pedro Melo <melo@simplicidade.org>

=item *

Rob Hoelz <rob@hoelz.ro>

=item *

Ruslan Zakirov <ruz@bestpractical.com>

=item *

Shawn M Moore <sartak@bestpractical.com>

=item *

Simon Wistow <simon@thegestalt.org>

=item *

Stephane Alnet <stephane@shimaore.net>

=item *

Unknown user <nobody@localhost>

=item *

Yanick Champoux <yanick@babyl.dyndns.org>

=item *

franck cuny <franck@lumberjaph.net>

=item *

robertkrimen <robertkrimen@gmail.com>

=item *

sunnavy <sunnavy@bestpractical.com>

=back

=cut