package Class::Usul::TraitFor::RunningMethods; use namespace::autoclean; use Class::Usul::Constants qw( FAILED NUL OK TRUE UNDEFINED_RV ); use Class::Usul::Functions qw( dash2under elapsed emit_to exception is_member logname throw untaint_identifier ); use Class::Usul::Types qw( HashRef Int SimpleStr ); use English qw( -no_match_vars ); use File::DataClass::Types qw( OctalNum ); use Scalar::Util qw( blessed ); use Try::Tiny; use Moo::Role; use Class::Usul::Options; requires qw( app_version can_call debug error exit_usage extra_argv file next_argv output quiet ); # Public attributes option 'method' => is => 'rwp', isa => SimpleStr, format => 's', documentation => 'Name of the method to call', default => NUL, order => 1, short => 'c'; option 'options' => is => 'ro', isa => HashRef, format => 's%', documentation => 'Zero, one or more key=value pairs available to the method call', default => sub { {} }, short => 'o'; option 'umask' => is => 'rw', isa => OctalNum, format => 's', documentation => 'Set the umask to this octal number', builder => sub { $_[ 0 ]->config->umask }, coerce => TRUE, lazy => TRUE; option 'verbose' => is => 'ro', isa => Int, documentation => 'Increase the verbosity of the output', default => 0, repeatable => TRUE, short => 'v'; has 'params' => is => 'ro', isa => HashRef, default => sub { {} }; # Private functions my $_output_stacktrace = sub { my ($e, $verbose) = @_; ($e and blessed $e) or return; $verbose //= 0; $verbose > 0 and $e->can( 'trace' ) and return emit_to \*STDERR, $e->trace.NUL; $e->can( 'stacktrace' ) and emit_to \*STDERR, $e->stacktrace.NUL; return; }; # Private methods my $handle_result = sub { my ($self, $method, $rv) = @_; if (defined $rv and $rv == OK) { $self->quiet or $self->output ( 'Finished in [_1] seconds', { args => [ elapsed ] } ); } elsif (defined $rv and $rv > OK) { $self->error( 'Terminated code [_1]', { args => [ $rv ] } ); } else { not defined $rv and $rv = UNDEFINED_RV and $self->error( 'Method [_1] error uncaught or rv undefined', { args => [ $method ] } ); $self->error( 'Terminated with undefined rv' ); } return; }; my $_handle_run_exception = sub { my ($self, $method, $error) = @_; my $e; unless ($e = exception $error) { $self->error ( 'Method [_1] exception without error', { args => [ $method ] } ); return UNDEFINED_RV; } $e->out and $self->output( $e->out ); $self->error( $e->error, { args => $e->args } ); $self->debug and $_output_stacktrace->( $error, $self->verbose ); return $e->rv || (defined $e->rv ? FAILED : UNDEFINED_RV); }; # Public methods sub run { my $self = shift; my $method = $self->select_method; my $text = 'Started by [_1] Version [_2] Pid [_3]'; my $args = { args => [ logname, $self->app_version, abs $PID ] }; (is_member $method, 'help', 'run_chain') and $self->quiet( TRUE ); $self->quiet or $self->output( $text, $args ); umask $self->umask; my $rv; if ($method eq 'run_chain' or $self->can_call( $method )) { my $params = exists $self->params->{ $method } ? $self->params->{ $method } : []; try { defined ($rv = $self->$method( @{ $params } )) or throw 'Method [_1] return value undefined', args => [ $method ], rv => UNDEFINED_RV; } catch { $rv = $self->$_handle_run_exception( $method, $_ ) }; } else { $self->error( 'Class [_1] method [_2] not found', { args => [ blessed $self, $method ] } ); $rv = UNDEFINED_RV; } $self->$handle_result( $method, $rv ); $self->file->delete_tmp_files; return $rv; } sub run_chain { my $self = shift; my $args = { args => [ $self->method ] }; $self->method ? $self->error( 'Method [_1] unknown', $args ) : $self->error( 'Method not specified' ); $self->exit_usage( 0 ); return; # Not reached } sub select_method { my $self = shift; my $method = untaint_identifier dash2under $self->method; unless ($self->can_call( $method )) { $method = untaint_identifier dash2under $self->extra_argv( 0 ); $method and $self->_set_method( $method ); ($method and $self->can_call( $method ) and $self->next_argv) or $method = undef; } return $method ? $method : 'run_chain'; } 1; __END__ =pod =encoding utf-8 =head1 Name Class::Usul::TraitFor::RunningMethods - Try and run a method catch and handle any exceptions =head1 Synopsis use Moo; extends 'Class::Usul'; with 'Class::Usul::TraitFor::RunningMethods'; =head1 Description Implements the L</run> method which calls the target method in a try / catch block. Handles any resulting exceptions =head1 Configuration and Environment Defines the following command line options; =over 3 =item C<c method> The method in the subclass to dispatch to =item C<o options key=value> The method that is dispatched to can access the key/value pairs from the C<< $self->options >> hash ref =item C<umask> An octal number which is used to set the umask by the L</run> method =item C<v verbose> Repeatable boolean that increases the verbosity of the output =back Defines the following attributes; =over 3 =item C<params> A hash reference keyed by method name. The values are array references which are flattened and passed to the method call by L</run> =back =head1 Subroutines/Methods =head2 run $exit_code = $self->run; Call the method specified by the C<-c> option on the command line. Returns the exit code =head2 run_chain $exit_code = $self->run_chain( $method ); Called by L</run> when L</select_method> cannot determine which method to call. Outputs usage if C<method> is undefined. Logs an error if C<method> is defined but not (by definition a callable method). Returns exit code C<FAILED> =head2 select_method $method = $self->select_method; Called by L</run> it examines the L</method> attribute and if necessary the extra command line arguments to determine the method to call =head1 Diagnostics None =head1 Dependencies =over 3 =item L<Class::Usul::Options> =item L<File::DataClass> =item L<Moo::Role> =item L<Try::Tiny> =back =head1 Incompatibilities There are no known incompatibilities in this module =head1 Bugs and Limitations There are no known bugs in this module. Please report problems to http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-Usul. Patches are welcome =head1 Acknowledgements Larry Wall - For the Perl programming language =head1 Author Peter Flanigan, C<< <pjfl@cpan.org> >> =head1 License and Copyright Copyright (c) 2015 Peter Flanigan. All rights reserved This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<perlartistic> This program is distributed in the hope that it will be useful, but WITHOUT WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE =cut # Local Variables: # mode: perl # tab-width: 3 # End: # vim: expandtab shiftwidth=3: