view release on metacpan or  search on metacpan

lib/Class/Usul/TraitFor/Usage.pm  view on Meta::CPAN

package Class::Usul::TraitFor::Usage;

use attributes ();
use namespace::autoclean;

use Class::Inspector;
use Class::Usul::Constants qw( FAILED FALSE NUL OK SPC TRUE );
use Class::Usul::File;
use Class::Usul::Functions qw( dash2under emit emit_to ensure_class_loaded
                               find_source is_member list_attr_of pad throw
                               untaint_cmdline untaint_identifier );
use Class::Usul::IPC;
use Class::Usul::Types     qw( Bool DataEncoding DataLumper ProcCommer );
use Scalar::Util           qw( blessed );
use Try::Tiny;
use Moo::Role;
use Class::Usul::Options;

requires qw( config dumper next_argv options_usage output quiet );

# Public attributes
option 'encoding'     => is => 'lazy', isa => DataEncoding,
   documentation      => 'Decode/encode input/output using this encoding',
   default            => sub { $_[ 0 ]->config->encoding }, format => 's';

option 'help_manual'  => is => 'ro',   isa => Bool, default => FALSE,
   documentation      => 'Displays the documentation for the program',
   short              => 'H';

option 'help_options' => is => 'ro',   isa => Bool, default => FALSE,
   documentation      => 'Describes program options and methods',
   short              => 'h';

option 'help_usage'   => is => 'ro',   isa => Bool, default => FALSE,
   documentation      => 'Displays this command line usage',
   short              => '?';

option 'show_version' => is => 'ro',   isa => Bool, default => FALSE,
   documentation      => 'Displays the version number of the program class';

has 'file'            => is => 'lazy', isa => DataLumper,
   builder            => sub { Class::Usul::File->new( builder => $_[ 0 ] ) };

has 'ipc'             => is => 'lazy', isa => ProcCommer,
   builder            => sub { Class::Usul::IPC->new( builder => $_[ 0 ] ) },
   handles            => [ 'run_cmd' ];

# Class attributes
my $_can_call_cache = {}; my $_method_cache = {};

# Private functions
my $_list_methods_of = sub {
   my $class = blessed $_[ 0 ] || $_[ 0 ];

   exists $_method_cache->{ $class } or $_method_cache->{ $class }
      = [ map  { s{ \A .+ :: }{}msx; $_ }
          grep { my $subr = $_;
                 grep { $_ eq 'method' } attributes::get( \&{ $subr } ) }
              @{ Class::Inspector->methods( $class, 'full', 'public' ) } ];

   return $_method_cache->{ $class };
};

my $_get_pod_header_for_method = sub {
   my ($class, $method) = @_;

   my $src = find_source $class
      or throw 'Class [_1] cannot find source', [ $class ];
   my $ev  = [ grep { $_->{content} =~ m{ (?: ^|[< ]) $method (?: [ >]|$ ) }msx}
               grep { $_->{type} eq 'command' }
                   @{ Pod::Eventual::Simple->read_file( $src ) } ]->[ 0 ];
   my $pod = $ev ? $ev->{content} : undef; $pod and chomp $pod;

   return $pod;
};