line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Prophet::CLI::Dispatcher; |
2
|
39
|
|
|
39
|
|
40451
|
use Path::Dispatcher::Declarative -base; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
use Any::Moose; |
4
|
|
|
|
|
|
|
extends 'Path::Dispatcher::Declarative', any_moose('Object'); |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
require Prophet::CLIContext; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
with 'Prophet::CLI::Parameters'; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our @PREFIXES = qw(Prophet::CLI::Command); |
11
|
|
|
|
|
|
|
sub add_command_prefix { unshift @PREFIXES, @_ } |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
on '' => sub { |
14
|
|
|
|
|
|
|
my $self = shift; |
15
|
|
|
|
|
|
|
if ($self->context->has_arg('version')) { run_command("Version")->($self) } |
16
|
|
|
|
|
|
|
elsif( $self->context->has_arg('help') ){ run_command("Help")->($self) } |
17
|
|
|
|
|
|
|
else { next_rule } |
18
|
|
|
|
|
|
|
}; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# publish foo@bar.com:www/baz => publish --to foo@bar.com:www/baz |
21
|
|
|
|
|
|
|
on qr{^(publish|push) (\S+)$} => sub { |
22
|
|
|
|
|
|
|
my $self = shift; |
23
|
|
|
|
|
|
|
$self->context->set_arg(to => $2); |
24
|
|
|
|
|
|
|
run($1, $self); |
25
|
|
|
|
|
|
|
}; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# clone http://fsck.com/~jesse/sd-bugs => clone --from http://fsck.com/~jesse/sd-bugs |
28
|
|
|
|
|
|
|
on qr{^(clone|pull) (\S+)$} => sub { |
29
|
|
|
|
|
|
|
my $self = shift; |
30
|
|
|
|
|
|
|
$self->context->set_arg(from => $2); |
31
|
|
|
|
|
|
|
run($1, $self); |
32
|
|
|
|
|
|
|
}; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# log range => log --range range |
35
|
|
|
|
|
|
|
on qr{log\s+([0-9LATEST.~]+)} => sub { |
36
|
|
|
|
|
|
|
my $self = shift; |
37
|
|
|
|
|
|
|
$self->context->set_arg(range => $1); |
38
|
|
|
|
|
|
|
run('log', $self); |
39
|
|
|
|
|
|
|
}; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
under settings => sub { |
42
|
|
|
|
|
|
|
my $self = shift; |
43
|
|
|
|
|
|
|
on edit => sub { |
44
|
|
|
|
|
|
|
my $self = shift; |
45
|
|
|
|
|
|
|
$self->context->set_arg( 'edit' ); |
46
|
|
|
|
|
|
|
run('settings', $self); |
47
|
|
|
|
|
|
|
}; |
48
|
|
|
|
|
|
|
on show => sub { |
49
|
|
|
|
|
|
|
my $self = shift; |
50
|
|
|
|
|
|
|
$self->context->set_arg( 'show' ); |
51
|
|
|
|
|
|
|
run('settings', $self); |
52
|
|
|
|
|
|
|
}; |
53
|
|
|
|
|
|
|
on set => sub { |
54
|
|
|
|
|
|
|
my $self = shift; |
55
|
|
|
|
|
|
|
$self->context->set_arg( 'set' ); |
56
|
|
|
|
|
|
|
run('settings', $self); |
57
|
|
|
|
|
|
|
}; |
58
|
|
|
|
|
|
|
}; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
on [ qr/^(update|edit|show|display|delete|del|rm|history)$/, |
61
|
|
|
|
|
|
|
qr/^$Prophet::CLIContext::ID_REGEX$/i ] => sub { |
62
|
|
|
|
|
|
|
my $self = shift; |
63
|
|
|
|
|
|
|
$self->context->set_id_from_primary_commands; |
64
|
|
|
|
|
|
|
run($1, $self, @_); |
65
|
|
|
|
|
|
|
}; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
on [ [ 'update', 'edit' ] ] => run_command("Update"); |
68
|
|
|
|
|
|
|
on [ [ 'show', 'display' ] ] => run_command("Show"); |
69
|
|
|
|
|
|
|
on [ [ 'delete', 'del', 'rm' ] ] => run_command("Delete"); |
70
|
|
|
|
|
|
|
on history => run_command("History"); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
on [ ['create', 'new'] ] => run_command("Create"); |
73
|
|
|
|
|
|
|
on [ ['search', 'list', 'ls' ] ] => run_command("Search"); |
74
|
|
|
|
|
|
|
on [ ['aliases', 'alias'] ] => run_command('Aliases'); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
on version => run_command("Version"); |
77
|
|
|
|
|
|
|
on init => run_command("Init"); |
78
|
|
|
|
|
|
|
on clone => run_command("Clone"); |
79
|
|
|
|
|
|
|
on merge => run_command("Merge"); |
80
|
|
|
|
|
|
|
on mirror => run_command('Mirror'); |
81
|
|
|
|
|
|
|
on pull => run_command("Pull"); |
82
|
|
|
|
|
|
|
on publish => run_command("Publish"); |
83
|
|
|
|
|
|
|
on server => run_command("Server"); |
84
|
|
|
|
|
|
|
on config => run_command("Config"); |
85
|
|
|
|
|
|
|
on settings => run_command("Settings"); |
86
|
|
|
|
|
|
|
on log => run_command("Log"); |
87
|
|
|
|
|
|
|
on shell => run_command("Shell"); |
88
|
|
|
|
|
|
|
on export => run_command('Export'); |
89
|
|
|
|
|
|
|
on info => run_command('Info'); |
90
|
|
|
|
|
|
|
on push => run_command('Push'); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
on qr/^(alias(?:es)?|config)?\s+(.*)/ => sub { |
93
|
|
|
|
|
|
|
my ( $self ) = @_; |
94
|
|
|
|
|
|
|
my $cmd = $1; |
95
|
|
|
|
|
|
|
my $arg = $2; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
my $class = $cmd =~ /^alias/ ? 'Aliases' : 'Config'; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# Load command class so we can run |
100
|
|
|
|
|
|
|
# its arg-parsing sub (the syntax is complex) |
101
|
|
|
|
|
|
|
my @classes = $self->class_names($class); |
102
|
|
|
|
|
|
|
for my $class (@classes) { |
103
|
|
|
|
|
|
|
Prophet::App->try_to_require($class) or next; |
104
|
|
|
|
|
|
|
my $cmd_obj = $class->new( |
105
|
|
|
|
|
|
|
context => $self->context, |
106
|
|
|
|
|
|
|
cli => $self->cli, |
107
|
|
|
|
|
|
|
); |
108
|
|
|
|
|
|
|
$cmd_obj->parse_cli_arg($cmd, $arg); |
109
|
|
|
|
|
|
|
return run( $cmd, $self, @_ ); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# Something is wrong with the app layout... |
113
|
|
|
|
|
|
|
die "Could not find '$class' command class"; |
114
|
|
|
|
|
|
|
}; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub run_command { |
117
|
|
|
|
|
|
|
my $name = shift; |
118
|
|
|
|
|
|
|
return sub { |
119
|
|
|
|
|
|
|
my $self = shift; |
120
|
|
|
|
|
|
|
my %constructor_args = ( |
121
|
|
|
|
|
|
|
cli => $self->cli, |
122
|
|
|
|
|
|
|
context => $self->context, |
123
|
|
|
|
|
|
|
commands => $self->context->primary_commands, |
124
|
|
|
|
|
|
|
type => $self->context->type, |
125
|
|
|
|
|
|
|
uuid => $self->context->uuid, |
126
|
|
|
|
|
|
|
); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# undef causes type constraint violations |
129
|
|
|
|
|
|
|
for my $key (keys %constructor_args) { |
130
|
|
|
|
|
|
|
delete $constructor_args{$key} |
131
|
|
|
|
|
|
|
if !defined($constructor_args{$key}); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
my @classes = $self->class_names($name); |
135
|
|
|
|
|
|
|
for my $class (@classes) { |
136
|
|
|
|
|
|
|
Prophet::App->try_to_require($class) or next; |
137
|
|
|
|
|
|
|
$class->new(%constructor_args)->run; |
138
|
|
|
|
|
|
|
return; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
die "Invalid command command class suffix '$name'"; |
142
|
|
|
|
|
|
|
}; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub class_names { |
146
|
|
|
|
|
|
|
my $self = shift; |
147
|
|
|
|
|
|
|
my $command = shift; |
148
|
|
|
|
|
|
|
return map { $_."::".$command } @PREFIXES; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
153
|
|
|
|
|
|
|
no Any::Moose; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
1; |
156
|
|
|
|
|
|
|
|