The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Prophet::CLI;
{
  $Prophet::CLI::VERSION = '0.751';
}
use Any::Moose;

use Prophet;
use Prophet::Replica;
use Prophet::CLI::Command;
use Prophet::CLI::Dispatcher;
use Prophet::CLIContext;
use Prophet::Record;

use List::Util 'first';
use Text::ParseWords qw(shellwords);

has app_class => (
    is      => 'rw',
    isa     => 'ClassName',
    default => 'Prophet::App',
);


has dispatcher_class => (
    is      => 'rw',
    isa     => 'ClassName',
    lazy    => 1,
    default => sub {
        my $self = shift;

        my $app_class = $self->app_class;
        my $class     = $app_class . '::CLI::Dispatcher';
        return $class if $app_class->try_to_require($class);
        return 'Prophet::CLI::Dispatcher';
    },
);

has record_class => (
    is      => 'rw',
    isa     => 'ClassName',
    lazy    => 1,
    default => 'Prophet::Record',
);

has app_handle => (
    is      => 'rw',
    isa     => 'Prophet::App',
    lazy    => 1,
    handles => [qw/handle config/],
    default => sub {
        return $_[0]->app_class->new;
    },
);

has context => (
    is      => 'rw',
    isa     => 'Prophet::CLIContext',
    lazy    => 1,
    default => sub {
        return Prophet::CLIContext->new( app_handle => shift->app_handle );
      }

);

has interactive_shell => (
    is      => 'rw',
    isa     => 'Bool',
    default => 0,
);

# default line length for CLI-related things that ought to wrap
use constant LINE_LENGTH => 80;


sub run_one_command {
    my $self = shift;
    my @args = (@_);

    # find the first alias that matches, rerun the aliased cmd
    # note: keys of aliases are treated as regex,
    # we need to substitute $1, $2 ... in the value if there's any
    my $ori_cmd = join ' ', @args;

    if ( $self->app_handle->local_replica_url ) {
        my $aliases = $self->app_handle->config->aliases;
        while ( my ( $alias, $replacement ) = each %$aliases ) {
            my $command =
              $self->_command_matches_alias( \@args, $alias, $replacement, )
              || next;

            # we don't want to recursively call if people stupidly write
            # alias pull --local = pull --local
            next if ( join( ' ', @$command ) eq $ori_cmd );
            return $self->run_one_command(@$command);
        }
    }

    #  really, we shouldn't be doing this stuff from the command dispatcher
    $self->context(
        Prophet::CLIContext->new( app_handle => $self->app_handle ) );
    $self->context->setup_from_args(@args);
    my $dispatcher = $self->dispatcher_class->new;

    # Path::Dispatcher is string-based, so we need to join the args
    # hash with spaces before passing off (args with whitespace in
    # them are quoted, double quotes are escaped)
    my $dispatch_command_string = join(
        ' ',
        map {
            s/"/\\"/g;    # escape double quotes
            /\s/ ? qq{"$_"} : $_;
        } @{ $self->context->primary_commands }
    );

    local $Prophet::CLI::Dispatcher::cli = $self;
    my $dispatch = $dispatcher->dispatch($dispatch_command_string);
    $self->start_pager();
    $dispatch->run($dispatcher);
    $self->end_pager();
}

sub _command_matches_alias {
    my $self      = shift;
    my @words     = @{ +shift };
    my @alias     = shellwords(shift);
    my @expansion = shellwords(shift);

    # Compare @words against @alias
    return if ( scalar(@words) < scalar(@alias) );

    while (@alias) {
        if ( shift @words ne shift @alias ) {
            return;
        }
    }

    # @words now contains the remaining words given on the
    # command-line, and @expansion contains the words in the
    # expansion.

    if ( first sub {m{\$\d+\b}}, @expansion ) {

        # Expand $n placeholders
        for (@expansion) {
            s/\$(\d+)\b/$words[$1 - 1]||""/ge;
        }
        return [@expansion];
    } else {
        return [ @expansion, @words ];
    }
}

sub is_interactive {
    return -t STDIN && -t STDOUT;
}

sub get_pager {
    my $self = shift;
    return $ENV{'PAGER'} || `which less` || `which more`;
}

our $ORIGINAL_STDOUT;

sub start_pager {
    my $self    = shift;
    my $content = shift;
    if ( is_interactive() && !$ORIGINAL_STDOUT ) {
        local $ENV{'LESS'} ||= '-FXe';
        local $ENV{'MORE'};
        $ENV{'MORE'} ||= '-FXe' unless $^O =~ /^MSWin/;

        my $pager = $self->get_pager();
        return unless $pager;
        open( my $cmd, "|-", $pager ) || return;
        $|++;
        $ORIGINAL_STDOUT = *STDOUT;

        # $pager will be closed once we restore STDOUT to $ORIGINAL_STDOUT
        *STDOUT = $cmd;
    }
}

sub in_pager {
    return $ORIGINAL_STDOUT ? 1 : 0;
}

sub end_pager {
    my $self = shift;
    return unless ( $self->in_pager );
    *STDOUT = $ORIGINAL_STDOUT;

    # closes the pager
    $ORIGINAL_STDOUT = undef;
}


sub get_script_name {
    my $self = shift;
    return '' if $self->interactive_shell;
    require File::Spec;
    my ($cmd) = ( File::Spec->splitpath($0) )[2];
    return $cmd . ' ';
}

END {
    *STDOUT = $ORIGINAL_STDOUT if $ORIGINAL_STDOUT;
}

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

1;

__END__

=pod

=head1 NAME

Prophet::CLI

=head1 VERSION

version 0.751

=head1 ATTRIBUTES

=head2 dispatcher_class -> Class

Returns class name of the dispatcher used to dispatch command lines. By default
app_class::CLI::Dispatcher is used if it can be loaded otherwise
L<Prophet::CLI::Dispatcher>. Override using:

    has '+dispatcher_class' => ( default => 'MyApp::Dispatcher' );

=head1 METHODS

=head2 run_one_command

Runs a command specified by commandline arguments given in an ARGV-like array
of argumnents and key value pairs . To use in a commandline front-end, create a
L<Prophet::CLI> object and pass in your main app class as app_class, then run
this routine.

Example:

 my $cli = Prophet::CLI->new({ app_class => 'App::SD' });
 $cli->run_one_command(@ARGV);

=head2 get_script_name

Return the name of the script that was run. This is the empty string if we're
in a shell, otherwise the script name concatenated with a space character. This
is so you can just use this for e.g. printing usage messages or help docs that
might be run from either a shell or the command line.

=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