1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
# ABSTRACT: Base class for pinto commands
package App::Pinto::Command;
use strict;
use warnings;
use IO::String;
use Pod::Usage qw(pod2usage);
#-----------------------------------------------------------------------------
use App::Cmd::Setup -command;
#-----------------------------------------------------------------------------
our $VERSION = '0.14'; # VERSION
#-----------------------------------------------------------------------------
sub usage_desc {
my ( $class_or_self, @args ) = @_;
my $class = ref $class_or_self || $class_or_self;
my $file = $class . '.pm';
$file =~ s{::}{/}xg;
my $path = $INC{$file} or return;
my $handle = IO::String->new;
pod2usage( -output => $handle, -input => $path, -exitval => 'NOEXIT' );
return ${ $handle->string_ref };
}
#-----------------------------------------------------------------------------
sub pinto {
my ($self) = @_;
return $self->app->pinto;
}
#-----------------------------------------------------------------------------
sub validate_args {
my ( $self, $opts, $args ) = @_;
$self->usage_error("Arguments are not allowed")
if @{$args} and not $self->args_attribute;
return 1;
}
#------------------------------------------------------------------------------
sub execute {
my ( $self, $opts, $args ) = @_;
my %args = $self->process_args($opts, $args);
my $result = $self->pinto->run( $self->action_name, %{$opts}, %args );
return $result->exit_status;
}
#-----------------------------------------------------------------------------
sub process_args {
my ( $self, $opts, $args ) = @_;
my $attr_name = $self->args_attribute or return;
if ( !@{$args} && $self->args_from_stdin($opts) ) {
return ( $attr_name => [ _args_from_fh( \*STDIN ) ] );
}
return ( $attr_name => $args );
}
#-----------------------------------------------------------------------------
sub action_name {
my ($self) = @_;
my $class = ref $self;
my $prefix = $self->command_namespace_prefix();
$class =~ m/ ^ ${prefix}:: (.+) /mx
or die "Unable to parse Action name from $class\n";
# Convert foo::bar::baz -> Foo::Bar:Baz
# TODO: consider using a regex to do the conversion
my $action_name = join '::', map {ucfirst} split '::', $1;
return $action_name;
}
#-----------------------------------------------------------------------------
sub _args_from_fh {
my ($fh) = @_;
my @args;
while ( my $line = <$fh> ) {
chomp $line;
next if not length $line;
next if $line =~ m/^ \s* [;#]/x;
next if $line !~ m/\S/x;
push @args, $line;
}
return @args;
}
#-------------------------------------------------------------------------------
sub args_attribute { return '' }
#-----------------------------------------------------------------------------
sub args_from_stdin { return 0 }
#-----------------------------------------------------------------------------
sub command_namespace_prefix { return __PACKAGE__ }
#-----------------------------------------------------------------------------
1;
__END__
=pod
=encoding UTF-8
=for :stopwords Jeffrey Ryan Thalhammer
=head1 NAME
App::Pinto::Command - Base class for pinto commands
=head1 VERSION
version 0.14
=head1 AUTHOR
Jeffrey Ryan Thalhammer <jeff@stratopan.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Jeffrey Ryan Thalhammer.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
