view release on metacpan or  search on metacpan

lib/App/Easer/V1.pm  view on Meta::CPAN

} ## end sub list_commands

sub load_application ($application) {
   return $application if 'HASH' eq ref $application;

   my $text;
   if ('SCALAR' eq ref $application) {
      $text = $$application;
   }
   else {
      my $fh =
        'GLOB' eq ref $application
        ? $application
        : do {
         open my $fh, '<:encoding(UTF-8)', $application
           or die "cannot open '$application'\n";
         $fh;
        };
      local $/;    # slurp mode
      $text = <$fh>;
      close $fh;
   } ## end else [ if ('SCALAR' eq ref $application)]

   return eval {
      require JSON::PP;
      JSON::PP::decode_json($text);
   } // eval { eval $text; } // die "cannot load application\n";
} ## end sub load_application ($application)

sub merger ($self, $spec = {}) {
   my $merger = $spec->{merge}
     // $self->{application}{configuration}{merge} // \&hash_merge;
   return $self->{factory}->($merger, 'merge');    # "resolve"
}

sub env_namer ($self, $cspec) {
   my $namenv = $cspec->{namenv}
     // $self->{application}{configuration}{namenv} // \&stock_NamEnv;
   $namenv = $self->{factory}->($namenv, 'namenv'); # "resolve"
   return sub ($ospec) { $namenv->($self, $cspec, $ospec) };
} ## end sub name_for_option ($o)

sub name_for_option ($o) {
   return $o->{name} if defined $o->{name};
   return $1 if defined $o->{getopt} && $o->{getopt} =~ m{\A(\w+)}mxs;
   return lc $o->{environment}
      if defined $o->{environment} && $o->{environment} ne '1';
   return '~~~';
} ## end sub name_for_option ($o)

sub params_validate ($self, $spec, $args) {
   my $validator = $spec->{validate}
     // $self->{application}{configuration}{validate} // return;
   require Params::Validate;
   Params::Validate::validate($self->{configs}[-1]->%*, $validator);
} ## end sub params_validate

sub print_commands ($self, $target) {
   my $command = fetch_spec_for($self, $target);
   my $fh =
     $self->{application}{configuration}{'help-on-stderr'}
     ? \*STDERR
     : \*STDOUT;
   if (my @children = get_children($self, $command)) {
      print {$fh} list_commands($self, \@children);
   }
   else {
      print {$fh} "no sub-commands\n";
   }
}

sub print_help ($self, $target) {
   my $command = fetch_spec_for($self, $target);
   my $enamr   = env_namer($self, $command);
   my $fh =
     $self->{application}{configuration}{'help-on-stderr'}
     ? \*STDERR
     : \*STDOUT;

   print {$fh} $command->{help}, "\n\n";

   if (defined(my $description = $command->{description})) {
      $description =~ s{\A\s+|\s+\z}{}gmxs;    # trim
      $description =~ s{^}{    }gmxs;          # add some indentation
      print {$fh} "Description:\n$description\n\n";
   }

   printf {$fh} "Can be called as: %s\n\n", join ', ',
     $command->{supports}->@*
     if $command->{supports};

   my $options = $command->{options} // [];
   if ($options->@*) {
      print {$fh} "Options:\n";
      my $n = 0; # count the option
      for my $option ($options->@*) {
         print {$fh} "\n" if $n++;

         printf {$fh} "%15s: %s\n", name_for_option($option),
           $option->{help} // '';

         if (exists $option->{getopt}) {
            my @lines = commandline_help($option->{getopt});
            printf {$fh} "%15s  command-line: %s\n", '', shift(@lines);
            printf {$fh} "%15s                %s\n", '', $_ for @lines;
         }

         if (defined(my $env_name = $enamr->($option))) {
            printf {$fh} "%15s  environment : %s\n", '', $env_name;
         }

         printf {$fh} "%15s  default     : %s\n", '',
           $option->{default} // '*undef*'
           if exists $option->{default};
      } ## end for my $option ($options...)
      print {$fh} "\n";
   } ## end if ($options->@*)
   else {
      print {$fh} "This command has no options.\n\n";
   }

   if (my @children = get_children($self, $command)) {
      print {$fh} "Sub commands:\n", list_commands($self, \@children),
        "\n";
   }
   else {
      print {$fh} "no sub-commands\n\n";
   }
}

sub stock_SpecFromHash ($s, $cmd) {
   return $cmd if ref($cmd) eq 'HASH';
   return $s->{application}{commands}{$cmd} // undef;
}

sub stock_SpecFromHashOrModule ($s, $cmd) {