├── .github └── workflows │ └── linux.yaml ├── .gitignore ├── CONTRIBUTING.md ├── Changes ├── LICENSE ├── MANIFEST.SKIP ├── Makefile.PL ├── Makefile.dev ├── README.md ├── dist.ini ├── examples ├── bash │ ├── myapp.bash │ ├── mysimpleapp.bash │ ├── nometa.bash │ ├── pcorelist.bash │ └── subrepo.bash ├── bin │ ├── myapp │ ├── mysimpleapp │ ├── nometa │ ├── pcorelist │ └── subrepo ├── html │ ├── myapp.html │ ├── mysimpleapp.html │ ├── nometa.html │ ├── pcorelist.html │ └── subrepo.html ├── myapp-spec.yaml ├── mysimpleapp-spec.yaml ├── nometa-spec.yaml ├── pcorelist-spec.yaml ├── pod │ ├── myapp.pod │ ├── mysimpleapp.pod │ ├── nometa.pod │ ├── pcorelist.pod │ └── subrepo.pod ├── subrepo-spec.yaml └── zsh │ ├── _myapp │ ├── _mysimpleapp │ ├── _nometa │ ├── _pcorelist │ └── _subrepo ├── lib └── App │ ├── Spec.pm │ └── Spec │ ├── Argument.pm │ ├── Completion.pm │ ├── Completion │ ├── Bash.pm │ └── Zsh.pm │ ├── Option.pm │ ├── Parameter.pm │ ├── Plugin │ ├── Format.pm │ ├── Help.pm │ └── Meta.pm │ ├── Pod.pm │ ├── Role │ ├── Command.pm │ ├── Plugin.pm │ └── Plugin │ │ ├── GlobalOptions.pm │ │ └── Subcommand.pm │ ├── Run.pm │ ├── Run │ ├── Cmd.pm │ ├── Output.pm │ ├── Response.pm │ └── Validator.pm │ ├── Schema.pm │ ├── Subcommand.pm │ └── Tutorial.pod ├── share └── schema.yaml ├── t ├── 00.compile.t ├── 00.load.t ├── 11.appspecrun.t ├── 12.dsl.t ├── 13.argv.t ├── 14.disable-plugins.t ├── 15.generate-pod.t ├── data │ ├── 11.completion.yaml │ ├── 11.invalid.yaml │ ├── 11.valid.yaml │ └── 12.dsl.yaml └── lib │ └── App │ └── Spec │ └── Example │ ├── MyApp.pm │ ├── MySimpleApp.pm │ └── Nometa.pm ├── utils ├── generate-schema-pm.pl └── process-pod.pl └── xt ├── 02.pod-cover.t └── 10.validate-spec.t /.github/workflows/linux.yaml: -------------------------------------------------------------------------------- 1 | name: linux 2 | 3 | on: 4 | push: 5 | branches: [ '*' ] 6 | pull_request: 7 | branches: [ master ] 8 | workflow_dispatch: 9 | branches: [ '*' ] 10 | 11 | jobs: 12 | 13 | perl: 14 | runs-on: ubuntu-latest 15 | strategy: 16 | matrix: 17 | perl-version: 18 | - '5.12-buster' 19 | - '5.14-buster' 20 | - '5.16-buster' 21 | - '5.18-buster' 22 | - '5.20-buster' 23 | - '5.22-buster' 24 | - '5.24-buster' 25 | - '5.26-buster' 26 | - '5.28-buster' 27 | - '5.30-bullseye' 28 | - '5.32-bullseye' 29 | - '5.34-bullseye' 30 | - '5.36-bookworm' 31 | - '5.38-bookworm' 32 | - 'latest' 33 | 34 | container: 35 | image: perl:${{ matrix.perl-version }} 36 | 37 | steps: 38 | - uses: actions/checkout@v3 39 | - run: env | sort 40 | - run: perl -V 41 | - name: Install deps 42 | run: > 43 | cpanm --quiet --notest 44 | Test::Deep List::MoreUtils YAML::PP Text::Table Ref::Util Moo 45 | Module::Runtime List::Util 46 | - name: Run Tests 47 | run: prove -lr t 48 | 49 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | pod2htmd.tmp 3 | cover_db 4 | dev 5 | local 6 | .build 7 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # How to contribute 2 | 3 | This module uses Dist::Zilla for creating releases, but you should 4 | be able to develop and test it without Dist::Zilla. 5 | 6 | ## Commits 7 | 8 | I try to follow these guidelines: 9 | 10 | * Commit messages 11 | * Short commit message headline (if possible, up to 60 characters) 12 | * Blank line before message body 13 | * Message should be like: "Add foo ...", "Fix ..." 14 | * Git workflow 15 | * I rebase every branch before merging it with --no-ff 16 | * I avoid merging master into branches and try to rebase always 17 | * User branches might be heavily rebased/reordered/squashed because 18 | I like a clean history 19 | 20 | 21 | ## Code 22 | 23 | * No Tabs please 24 | * No trailing whitespaces please 25 | * Look at existing code for formatting ;-) 26 | 27 | ## Testing 28 | 29 | prove -lr t xt 30 | 31 | There is also a make target which re-runs the tests if a file has changed: 32 | 33 | make -f Makefile.dev watch-test 34 | 35 | You can check coverage with 36 | 37 | make -f Makefile.dev cover 38 | 39 | ## Contact 40 | 41 | Email: tinita at cpan.org 42 | IRC: tinita on freenode and irc.perl.org 43 | 44 | Chances are good that contacting me on IRC is the fastest way. 45 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Perl module App::Spec 2 | 3 | v0.15.0 2025-03-25 21:54:22+01:00 4 | 5 | - Use '/usr/bin/env bash' (#22 @alexiswl) 6 | - Support multiline descriptions 7 | 8 | 0.013 2019-09-09 19:22:34+02:00 9 | 10 | - Add types filename and dirname 11 | - Improve completion for directories 12 | 13 | 0.012 2019-07-06 00:02:35+02:00 14 | 15 | - Generate App::Spec::Schema from schema.yaml so File::Share is not needed 16 | (makes fatpacking possible) 17 | 18 | 0.011 2019-07-03 21:48:09+02:00 19 | 20 | - Allow to disable default plugins 21 | 22 | 0.010 2019-06-16 00:21:29+02:00 23 | 24 | - Fix bug in dynamic option completion (bash) 25 | 26 | 0.009 2019-06-09 15:16:28+02:00 27 | 28 | - Several completion fixes regarding colons and spaces 29 | - Provide a variable for the last word for both shells 30 | 31 | 0.008 2019-05-18 19:22:11+02:00 32 | 33 | - Fix schema: Option/Parameter spec can be a string also 34 | 35 | 0.007 2019-05-18 16:01:59+02:00 36 | 37 | - dsl values should not override other values 38 | 39 | 0.006 2019-05-05 13:21:09+02:00 40 | 41 | - Autogenerate META.json using dzil plugin (PR#16 @manwar) 42 | - Fix pod error (PR##21 @manwar) 43 | - Add support for float argument type (PR#18 @s-nez) 44 | - Fix bug (undefined reference) in zsh completion 45 | - Fix bug (wrong type of default) in App::Spec::Run::Response 46 | - Format plugin: encode output 47 | - Allow dynamic completion also for options 48 | 49 | 0.005 2019-04-22 12:40:14+02:00 50 | 51 | - Support completion for apps without subcommands 52 | - Support plugins (turn help and meta commands into plugins) 53 | - And lots of refactoring for that 54 | - Pass a data structure to $run->out and it will be formatted with 55 | Data::Dumper 56 | - Add a format plugin that formats data output as YAML, JSON, Text::Table, 57 | Data::Dump 58 | - Output via $run->out is not buffered anymore 59 | 60 | 0.004 Mon Oct 31 18:56:05 CET 2016 61 | 62 | - Lots of refactoring 63 | - More documentation 64 | - Update schema 65 | - Integer validation fix 66 | - Feature: allow 'mapping' options and parameters (Like Getopt::Long 67 | supports via '%') 68 | - Feature: add DSL for defining options 69 | 70 | 0.003 Thu Oct 13 21:06:00 CEST 2016 71 | - Change: refactoring. Apps should now inherit from App::Spec::Run::Cmd 72 | - Feature: add 'unique' feature for params/options 73 | 74 | 0.002 Sun Sep 4 16:57:00 CEST 2016 75 | - developer version 76 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | cover_db 2 | pod2htmd.tmp 3 | dev 4 | local 5 | Makefile.dev 6 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.032. 2 | use strict; 3 | use warnings; 4 | 5 | use 5.010000; 6 | 7 | use ExtUtils::MakeMaker; 8 | 9 | use File::ShareDir::Install; 10 | $File::ShareDir::Install::INCLUDE_DOTFILES = 1; 11 | $File::ShareDir::Install::INCLUDE_DOTDIRS = 1; 12 | install_share dist => "share"; 13 | 14 | 15 | my %WriteMakefileArgs = ( 16 | "ABSTRACT" => "Specification for commandline app", 17 | "AUTHOR" => "Tina M\x{fc}ller ", 18 | "CONFIGURE_REQUIRES" => { 19 | "ExtUtils::MakeMaker" => 0, 20 | "File::ShareDir::Install" => "0.06" 21 | }, 22 | "DISTNAME" => "App-Spec", 23 | "LICENSE" => "perl", 24 | "MIN_PERL_VERSION" => "5.010000", 25 | "NAME" => "App::Spec", 26 | "PREREQ_PM" => { 27 | "Data::Dumper" => 0, 28 | "Encode" => 0, 29 | "Exporter" => 0, 30 | "Getopt::Long" => 0, 31 | "List::MoreUtils" => 0, 32 | "List::Util" => "1.33", 33 | "Module::Runtime" => 0, 34 | "Moo" => 0, 35 | "Moo::Role" => 0, 36 | "Ref::Util" => 0, 37 | "Scalar::Util" => 0, 38 | "Term::ANSIColor" => 0, 39 | "Text::Table" => 0, 40 | "YAML::PP" => "0.015", 41 | "base" => 0, 42 | "strict" => 0, 43 | "warnings" => 0 44 | }, 45 | "TEST_REQUIRES" => { 46 | "File::Spec" => 0, 47 | "FindBin" => 0, 48 | "IO::Handle" => 0, 49 | "IPC::Open3" => 0, 50 | "Test::Deep" => 0, 51 | "Test::More" => 0, 52 | "constant" => 0, 53 | "lib" => 0 54 | }, 55 | "VERSION" => "v0.15.0", 56 | "test" => { 57 | "TESTS" => "t/*.t" 58 | } 59 | ); 60 | 61 | 62 | my %FallbackPrereqs = ( 63 | "Data::Dumper" => 0, 64 | "Encode" => 0, 65 | "Exporter" => 0, 66 | "File::Spec" => 0, 67 | "FindBin" => 0, 68 | "Getopt::Long" => 0, 69 | "IO::Handle" => 0, 70 | "IPC::Open3" => 0, 71 | "List::MoreUtils" => 0, 72 | "List::Util" => "1.33", 73 | "Module::Runtime" => 0, 74 | "Moo" => 0, 75 | "Moo::Role" => 0, 76 | "Ref::Util" => 0, 77 | "Scalar::Util" => 0, 78 | "Term::ANSIColor" => 0, 79 | "Test::Deep" => 0, 80 | "Test::More" => 0, 81 | "Text::Table" => 0, 82 | "YAML::PP" => "0.015", 83 | "base" => 0, 84 | "constant" => 0, 85 | "lib" => 0, 86 | "strict" => 0, 87 | "warnings" => 0 88 | ); 89 | 90 | 91 | unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { 92 | delete $WriteMakefileArgs{TEST_REQUIRES}; 93 | delete $WriteMakefileArgs{BUILD_REQUIRES}; 94 | $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; 95 | } 96 | 97 | delete $WriteMakefileArgs{CONFIGURE_REQUIRES} 98 | unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; 99 | 100 | WriteMakefile(%WriteMakefileArgs); 101 | 102 | { 103 | package 104 | MY; 105 | use File::ShareDir::Install qw(postamble); 106 | } 107 | -------------------------------------------------------------------------------- /Makefile.dev: -------------------------------------------------------------------------------- 1 | completion: 2 | for i in myapp mysimpleapp pcorelist subrepo nometa ; do \ 3 | appspec completion examples/$$i-spec.yaml --zsh > examples/zsh/_$$i; \ 4 | appspec completion examples/$$i-spec.yaml --bash > examples/bash/$$i.bash; \ 5 | done 6 | 7 | pod: 8 | for i in myapp mysimpleapp pcorelist subrepo nometa ; do \ 9 | appspec pod examples/$$i-spec.yaml > examples/pod/$$i.pod; \ 10 | done 11 | 12 | html: 13 | for i in myapp mysimpleapp pcorelist subrepo nometa ; do \ 14 | pod2html examples/pod/$$i.pod | perl -plE's/mailto:.*(?=")/mailto:/' > examples/html/$$i.html; \ 15 | done 16 | 17 | update: completion pod html 18 | 19 | cover: 20 | HARNESS_PERL_SWITCHES="-MDevel::Cover=+ignore,local,+ignore,^t/,+ignore,^xt/" prove -lr t xt 21 | cover 22 | 23 | process-pod: 24 | ./utils/process-pod.pl 25 | 26 | # https://leanpub.com/the-tao-of-tmux/read/ 27 | watch-test: 28 | (find t/ xt/ -name "*.t"; \ 29 | find lib/ -name "*.pm"; \ 30 | find examples/ share/ -name "*.yaml" \ 31 | ) | entr -c prove -lr t xt 32 | 33 | lib/App/Spec/Schema.pm: share/schema.yaml 34 | perl utils/generate-schema-pm.pl 35 | 36 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # App::Spec 2 | Writing command line apps made easy 3 | 4 | ## Status 5 | 6 | The structure of the spec will probably change. 7 | 8 | I wait for your suggestions, wishes, bug reports. 9 | 10 | ## Purpose 11 | 12 | Write a specification for your command line application (currently in YAML) and get: 13 | * Subcommands (nested), options, parameters 14 | * a Perl 5 (and possibly other) framework that 15 | * automatically calls the specified method for the subcommand 16 | * validates options and parameters 17 | * outputs help 18 | * Automatic creation of pod, man pages 19 | * Automatic creation of zsh and bash completion scripts. Completion includes: 20 | * Subcommands, parameter values, option names and option values. 21 | * Description for completion items are shown, in zsh builtin, in bash with a cute little trick. 22 | * Generating dynamic completion. When completing a parameter or option, you can call an external 23 | command returning possible completion values 24 | * Possibly even creating a specification for your favourite app which lacks shell completion 25 | 26 | Writing the specification in YAML takes advantage of YAML aliases, for example when you have 27 | options or parameters which are not global, but are used in more than one place. Alternatively the 28 | spec could allow to create definitions which you can just link to, kind of like Swagger does it. 29 | 30 | ## Documentation 31 | 32 | For now just an example in the examples directory called "myapp". 33 | Just play with it and use your tab key! 34 | Also try zsh if you haven't yet. 35 | 36 | ### For authors 37 | 38 | There is a command line tool called appspec 39 | which is useful for you as an author of an app. You can use it to 40 | create completion and pod from a spec file. 41 | 42 | ### Example 43 | 44 | For a first overview, here is how an app looks like: 45 | 46 | ```perl 47 | use strict; 48 | use warnings; 49 | use 5.010; 50 | # your app class 51 | # you could even go without an extra class and simply use the "main" namespace 52 | package App::Spec::Example::MyApp; 53 | use base 'App::Spec::Run'; 54 | 55 | # the method for the subcommand frobnicate 56 | sub frobnicate { 57 | my ($self) = @_; 58 | my $options = $self->options; # just a hashref 59 | my $parameters = $self->parameters; # just a hashref 60 | say "frobnicate"; 61 | } 62 | 63 | package main; 64 | use App::Spec; 65 | 66 | # read YAML from __DATA__ section 67 | my $spec = App::Spec->read("myapp-spec.yaml"); 68 | my $run = App::Spec::Example::MyApp->new({ spec => $spec }); 69 | # this will check input and call frobnicate 70 | $run->run; 71 | ``` 72 | 73 | See https://github.com/perlpunk/App-Spec-p5/blob/master/examples/myapp-spec.yaml 74 | for the specification of the example app. It's supposed to cover all currently 75 | implemented features. 76 | 77 | ## Getting the completion to work 78 | 79 | Here is how you get the completion for the example app. 80 | 81 | First, add the bin directory to your path: 82 | 83 | `% PATH=$PWD/examples/bin:$PATH` 84 | 85 | Locate the modules: 86 | 87 | ` % export PERL5LIB=$PWD/lib:$PERL5LIB` 88 | 89 | ### Bash 90 | 91 | Simply source the bash completion script: 92 | ``` 93 | $ source examples/bash/myapp.bash 94 | $ myapp 95 | ``` 96 | 97 | ### Zsh 98 | 99 | When using a new script/completion, you have to do two things: 100 | 101 | Add the path to the completion dir to your .zshrc before the compinit call: 102 | 103 | `fpath=('/path/to/App-Spec-p5/examples/zsh' $fpath)` 104 | 105 | Then: 106 | 107 | `% exec zsh` 108 | 109 | If you change the completion script later, you just need to source it: 110 | 111 | `% source examples/zsh/_myapp` 112 | 113 | Note that the completion script must also be executable! 114 | 115 | ## Reinventing the wheel? 116 | 117 | Yes, I know MooseX::App::Cmd, MooseX::App::Command, MouseX::App::Cmd, MooX::Cmd. I've written https://github.com/perlpunk/MooseX-App-Plugin-ZshCompletion. 118 | 119 | But all are a little bit different and lack things. 120 | 121 | My use case which got me into this required automatic creation of the spec, and I would have been 122 | forced to dynamically generate a whole bunch of Mo*X classes when I actually just needed one. 123 | 124 | I also like the idea of having a language independent specification. 125 | 126 | I'm lazy and I didn't want to write a completion for all the other app frameworks and getopt modules. 127 | I just want to do it once. 128 | 129 | ## TODO 130 | 131 | See https://github.com/perlpunk/App-Spec-p5/issues 132 | 133 | * Write a schema 134 | * Write tests 135 | * Complete the help output 136 | * Generate pod, man pages 137 | * Allow Getopt::Long, Getopt::Long::Descriptive, ... input as a specification 138 | * Allow caching of dynamic completion values that take long to compute 139 | * Options/parameters imply other options 140 | * Options with multiple values 141 | * Allow apps without subcommands 142 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = App-Spec 2 | author = Tina Müller 3 | license = Perl_5 4 | copyright_holder = Tina Müller 5 | copyright_year = 2025 6 | 7 | version = v0.15.0 8 | 9 | [@Filter] 10 | -bundle = @Basic 11 | -remove = GatherDir 12 | option = for_basic 13 | 14 | [AutoPrereqs] 15 | skip = Swim 16 | skip = Data::Dump$ 17 | skip = JSON::XS 18 | [Prereqs] 19 | perl = 5.10.0 20 | List::Util = 1.33 21 | YAML::PP = 0.015 22 | [OverridePkgVersion] 23 | [MetaProvides::Package] 24 | [Test::Compile] 25 | filename = t/00.compile.t 26 | 27 | [CopyFilesFromBuild] 28 | copy = Makefile.PL 29 | ; requires CopyFilesFromBuild >= 0.163040 30 | copy = t/00.compile.t 31 | copy = LICENSE 32 | 33 | [GatherDir] 34 | exclude_filename = Makefile.PL 35 | exclude_filename = t/00.compile.t 36 | exclude_filename = LICENSE 37 | 38 | [MetaResources] 39 | bugtracker.web = https://github.com/perlpunk/App-Spec-p5/issues 40 | repository.url = git://github.com/perlpunk/App-Spec-p5.git 41 | repository.web = https://github.com/perlpunk/App-Spec-p5 42 | repository.type = git 43 | 44 | [MetaJSON] 45 | -------------------------------------------------------------------------------- /examples/bash/mysimpleapp.bash: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # Generated with perl module App::Spec v0.000 4 | 5 | _mysimpleapp() { 6 | 7 | COMPREPLY=() 8 | local program=mysimpleapp 9 | local cur prev words cword 10 | _init_completion -n : || return 11 | declare -a FLAGS 12 | declare -a OPTIONS 13 | declare -a MYWORDS 14 | 15 | local INDEX=`expr $cword - 1` 16 | MYWORDS=("${words[@]:1:$cword}") 17 | 18 | FLAGS=('--verbose' 'be verbose' '-v' 'be verbose' '--wc' 'word count' '--lc' 'line count' '--longoption' 'some long option description split over several lines to demonstrate ' '--help' 'Show command help' '-h' 'Show command help') 19 | OPTIONS=('--with' 'with ...' '--file1' 'existing file' '--file2' 'possible file' '--dir1' 'existing dir' '--dir2' 'possible dir' '--longoption2' 'some other long option description split over several lines to demonstrate ') 20 | __mysimpleapp_handle_options_flags 21 | 22 | case ${MYWORDS[$INDEX-1]} in 23 | --with) 24 | _mysimpleapp_compreply "ab" "cd" "ef" 25 | return 26 | ;; 27 | --file1) 28 | compopt -o filenames 29 | return 30 | ;; 31 | --file2) 32 | compopt -o filenames 33 | return 34 | ;; 35 | --dir1) 36 | compopt -o dirnames 37 | return 38 | ;; 39 | --dir2) 40 | compopt -o dirnames 41 | return 42 | ;; 43 | --longoption2) 44 | ;; 45 | 46 | esac 47 | case $INDEX in 48 | 0) 49 | __comp_current_options || return 50 | _mysimpleapp_compreply "dist.ini" "Makefile.PL" "Changes" 51 | ;; 52 | 1) 53 | __comp_current_options || return 54 | _mysimpleapp_compreply "a" "b" "c" 55 | ;; 56 | 57 | 58 | *) 59 | __comp_current_options || return 60 | ;; 61 | esac 62 | 63 | } 64 | 65 | _mysimpleapp_compreply() { 66 | local prefix="" 67 | cur="$(printf '%q' "$cur")" 68 | IFS=$'\n' COMPREPLY=($(compgen -P "$prefix" -W "$*" -- "$cur")) 69 | __ltrim_colon_completions "$prefix$cur" 70 | 71 | # http://stackoverflow.com/questions/7267185/bash-autocompletion-add-description-for-possible-completions 72 | if [[ ${#COMPREPLY[*]} -eq 1 ]]; then # Only one completion 73 | COMPREPLY=( "${COMPREPLY[0]%% -- *}" ) # Remove ' -- ' and everything after 74 | COMPREPLY=( "${COMPREPLY[0]%%+( )}" ) # Remove trailing spaces 75 | fi 76 | } 77 | 78 | 79 | __mysimpleapp_dynamic_comp() { 80 | local argname="$1" 81 | local arg="$2" 82 | local name desc cols desclength formatted 83 | local comp=() 84 | local max=0 85 | 86 | while read -r line; do 87 | name="$line" 88 | desc="$line" 89 | name="${name%$'\t'*}" 90 | if [[ "${#name}" -gt "$max" ]]; then 91 | max="${#name}" 92 | fi 93 | done <<< "$arg" 94 | 95 | while read -r line; do 96 | name="$line" 97 | desc="$line" 98 | name="${name%$'\t'*}" 99 | desc="${desc/*$'\t'}" 100 | if [[ -n "$desc" && "$desc" != "$name" ]]; then 101 | # TODO portable? 102 | cols=`tput cols` 103 | [[ -z $cols ]] && cols=80 104 | desclength=`expr $cols - 4 - $max` 105 | formatted=`printf "%-*s -- %-*s" "$max" "$name" "$desclength" "$desc"` 106 | comp+=("$formatted") 107 | else 108 | comp+=("'$name'") 109 | fi 110 | done <<< "$arg" 111 | _mysimpleapp_compreply ${comp[@]} 112 | } 113 | 114 | function __mysimpleapp_handle_options() { 115 | local i j 116 | declare -a copy 117 | local last="${MYWORDS[$INDEX]}" 118 | local max=`expr ${#MYWORDS[@]} - 1` 119 | for ((i=0; i<$max; i++)) 120 | do 121 | local word="${MYWORDS[$i]}" 122 | local found= 123 | for ((j=0; j<${#OPTIONS[@]}; j+=2)) 124 | do 125 | local option="${OPTIONS[$j]}" 126 | if [[ "$word" == "$option" ]]; then 127 | found=1 128 | i=`expr $i + 1` 129 | break 130 | fi 131 | done 132 | if [[ -n $found && $i -lt $max ]]; then 133 | INDEX=`expr $INDEX - 2` 134 | else 135 | copy+=("$word") 136 | fi 137 | done 138 | MYWORDS=("${copy[@]}" "$last") 139 | } 140 | 141 | function __mysimpleapp_handle_flags() { 142 | local i j 143 | declare -a copy 144 | local last="${MYWORDS[$INDEX]}" 145 | local max=`expr ${#MYWORDS[@]} - 1` 146 | for ((i=0; i<$max; i++)) 147 | do 148 | local word="${MYWORDS[$i]}" 149 | local found= 150 | for ((j=0; j<${#FLAGS[@]}; j+=2)) 151 | do 152 | local flag="${FLAGS[$j]}" 153 | if [[ "$word" == "$flag" ]]; then 154 | found=1 155 | break 156 | fi 157 | done 158 | if [[ -n $found ]]; then 159 | INDEX=`expr $INDEX - 1` 160 | else 161 | copy+=("$word") 162 | fi 163 | done 164 | MYWORDS=("${copy[@]}" "$last") 165 | } 166 | 167 | __mysimpleapp_handle_options_flags() { 168 | __mysimpleapp_handle_options 169 | __mysimpleapp_handle_flags 170 | } 171 | 172 | __comp_current_options() { 173 | local always="$1" 174 | if [[ -n $always || ${MYWORDS[$INDEX]} =~ ^- ]]; then 175 | 176 | local options_spec='' 177 | local j= 178 | 179 | for ((j=0; j<${#FLAGS[@]}; j+=2)) 180 | do 181 | local name="${FLAGS[$j]}" 182 | local desc="${FLAGS[$j+1]}" 183 | options_spec+="$name"$'\t'"$desc"$'\n' 184 | done 185 | 186 | for ((j=0; j<${#OPTIONS[@]}; j+=2)) 187 | do 188 | local name="${OPTIONS[$j]}" 189 | local desc="${OPTIONS[$j+1]}" 190 | options_spec+="$name"$'\t'"$desc"$'\n' 191 | done 192 | __mysimpleapp_dynamic_comp 'options' "$options_spec" 193 | 194 | return 1 195 | else 196 | return 0 197 | fi 198 | } 199 | 200 | 201 | complete -o default -F _mysimpleapp mysimpleapp 202 | 203 | -------------------------------------------------------------------------------- /examples/bash/nometa.bash: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # Generated with perl module App::Spec v0.000 4 | 5 | _nometa() { 6 | 7 | COMPREPLY=() 8 | local program=nometa 9 | local cur prev words cword 10 | _init_completion -n : || return 11 | declare -a FLAGS 12 | declare -a OPTIONS 13 | declare -a MYWORDS 14 | 15 | local INDEX=`expr $cword - 1` 16 | MYWORDS=("${words[@]:1:$cword}") 17 | 18 | FLAGS=('--help' 'Show command help' '-h' 'Show command help') 19 | OPTIONS=() 20 | __nometa_handle_options_flags 21 | 22 | case $INDEX in 23 | 24 | 0) 25 | __comp_current_options || return 26 | __nometa_dynamic_comp 'commands' 'foo'$'\t''Test command'$'\n''help'$'\t''Show command help'$'\n''longsubcommand'$'\t''A subcommand with a very long summary split over multiple lines ' 27 | 28 | ;; 29 | *) 30 | # subcmds 31 | case ${MYWORDS[0]} in 32 | foo) 33 | __nometa_handle_options_flags 34 | case ${MYWORDS[$INDEX-1]} in 35 | 36 | esac 37 | case $INDEX in 38 | 1) 39 | __comp_current_options || return 40 | _nometa_compreply "a" "b" "c" 41 | ;; 42 | 43 | 44 | *) 45 | __comp_current_options || return 46 | ;; 47 | esac 48 | ;; 49 | help) 50 | FLAGS+=('--all' '') 51 | __nometa_handle_options_flags 52 | case $INDEX in 53 | 54 | 1) 55 | __comp_current_options || return 56 | __nometa_dynamic_comp 'commands' 'foo'$'\n''longsubcommand' 57 | 58 | ;; 59 | *) 60 | # subcmds 61 | case ${MYWORDS[1]} in 62 | foo) 63 | __nometa_handle_options_flags 64 | __comp_current_options true || return # no subcmds, no params/opts 65 | ;; 66 | longsubcommand) 67 | __nometa_handle_options_flags 68 | __comp_current_options true || return # no subcmds, no params/opts 69 | ;; 70 | esac 71 | 72 | ;; 73 | esac 74 | ;; 75 | longsubcommand) 76 | __nometa_handle_options_flags 77 | case ${MYWORDS[$INDEX-1]} in 78 | 79 | esac 80 | case $INDEX in 81 | 1) 82 | __comp_current_options || return 83 | ;; 84 | 85 | 86 | *) 87 | __comp_current_options || return 88 | ;; 89 | esac 90 | ;; 91 | esac 92 | 93 | ;; 94 | esac 95 | 96 | } 97 | 98 | _nometa_compreply() { 99 | local prefix="" 100 | cur="$(printf '%q' "$cur")" 101 | IFS=$'\n' COMPREPLY=($(compgen -P "$prefix" -W "$*" -- "$cur")) 102 | __ltrim_colon_completions "$prefix$cur" 103 | 104 | # http://stackoverflow.com/questions/7267185/bash-autocompletion-add-description-for-possible-completions 105 | if [[ ${#COMPREPLY[*]} -eq 1 ]]; then # Only one completion 106 | COMPREPLY=( "${COMPREPLY[0]%% -- *}" ) # Remove ' -- ' and everything after 107 | COMPREPLY=( "${COMPREPLY[0]%%+( )}" ) # Remove trailing spaces 108 | fi 109 | } 110 | 111 | 112 | __nometa_dynamic_comp() { 113 | local argname="$1" 114 | local arg="$2" 115 | local name desc cols desclength formatted 116 | local comp=() 117 | local max=0 118 | 119 | while read -r line; do 120 | name="$line" 121 | desc="$line" 122 | name="${name%$'\t'*}" 123 | if [[ "${#name}" -gt "$max" ]]; then 124 | max="${#name}" 125 | fi 126 | done <<< "$arg" 127 | 128 | while read -r line; do 129 | name="$line" 130 | desc="$line" 131 | name="${name%$'\t'*}" 132 | desc="${desc/*$'\t'}" 133 | if [[ -n "$desc" && "$desc" != "$name" ]]; then 134 | # TODO portable? 135 | cols=`tput cols` 136 | [[ -z $cols ]] && cols=80 137 | desclength=`expr $cols - 4 - $max` 138 | formatted=`printf "%-*s -- %-*s" "$max" "$name" "$desclength" "$desc"` 139 | comp+=("$formatted") 140 | else 141 | comp+=("'$name'") 142 | fi 143 | done <<< "$arg" 144 | _nometa_compreply ${comp[@]} 145 | } 146 | 147 | function __nometa_handle_options() { 148 | local i j 149 | declare -a copy 150 | local last="${MYWORDS[$INDEX]}" 151 | local max=`expr ${#MYWORDS[@]} - 1` 152 | for ((i=0; i<$max; i++)) 153 | do 154 | local word="${MYWORDS[$i]}" 155 | local found= 156 | for ((j=0; j<${#OPTIONS[@]}; j+=2)) 157 | do 158 | local option="${OPTIONS[$j]}" 159 | if [[ "$word" == "$option" ]]; then 160 | found=1 161 | i=`expr $i + 1` 162 | break 163 | fi 164 | done 165 | if [[ -n $found && $i -lt $max ]]; then 166 | INDEX=`expr $INDEX - 2` 167 | else 168 | copy+=("$word") 169 | fi 170 | done 171 | MYWORDS=("${copy[@]}" "$last") 172 | } 173 | 174 | function __nometa_handle_flags() { 175 | local i j 176 | declare -a copy 177 | local last="${MYWORDS[$INDEX]}" 178 | local max=`expr ${#MYWORDS[@]} - 1` 179 | for ((i=0; i<$max; i++)) 180 | do 181 | local word="${MYWORDS[$i]}" 182 | local found= 183 | for ((j=0; j<${#FLAGS[@]}; j+=2)) 184 | do 185 | local flag="${FLAGS[$j]}" 186 | if [[ "$word" == "$flag" ]]; then 187 | found=1 188 | break 189 | fi 190 | done 191 | if [[ -n $found ]]; then 192 | INDEX=`expr $INDEX - 1` 193 | else 194 | copy+=("$word") 195 | fi 196 | done 197 | MYWORDS=("${copy[@]}" "$last") 198 | } 199 | 200 | __nometa_handle_options_flags() { 201 | __nometa_handle_options 202 | __nometa_handle_flags 203 | } 204 | 205 | __comp_current_options() { 206 | local always="$1" 207 | if [[ -n $always || ${MYWORDS[$INDEX]} =~ ^- ]]; then 208 | 209 | local options_spec='' 210 | local j= 211 | 212 | for ((j=0; j<${#FLAGS[@]}; j+=2)) 213 | do 214 | local name="${FLAGS[$j]}" 215 | local desc="${FLAGS[$j+1]}" 216 | options_spec+="$name"$'\t'"$desc"$'\n' 217 | done 218 | 219 | for ((j=0; j<${#OPTIONS[@]}; j+=2)) 220 | do 221 | local name="${OPTIONS[$j]}" 222 | local desc="${OPTIONS[$j+1]}" 223 | options_spec+="$name"$'\t'"$desc"$'\n' 224 | done 225 | __nometa_dynamic_comp 'options' "$options_spec" 226 | 227 | return 1 228 | else 229 | return 0 230 | fi 231 | } 232 | 233 | 234 | complete -o default -F _nometa nometa 235 | 236 | -------------------------------------------------------------------------------- /examples/bash/subrepo.bash: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # Generated with perl module App::Spec v0.000 4 | 5 | _subrepo() { 6 | 7 | COMPREPLY=() 8 | local program=subrepo 9 | local cur prev words cword 10 | _init_completion -n : || return 11 | declare -a FLAGS 12 | declare -a OPTIONS 13 | declare -a MYWORDS 14 | 15 | local INDEX=`expr $cword - 1` 16 | MYWORDS=("${words[@]:1:$cword}") 17 | 18 | FLAGS=('--help' 'Show command help' '-h' 'Show command help') 19 | OPTIONS=() 20 | __subrepo_handle_options_flags 21 | 22 | case $INDEX in 23 | 24 | 0) 25 | __comp_current_options || return 26 | __subrepo_dynamic_comp 'commands' 'branch'$'\t''Create a branch with local subrepo commits since last pull.'$'\n''clean'$'\t''Remove artifacts created by '"'"'fetch'"'"' and '"'"'branch'"'"' commands.'$'\n''clone'$'\t''Add a repository as a subrepo in a subdir of your repository.'$'\n''commit'$'\t''Add subrepo branch to current history as a single commit.'$'\n''fetch'$'\t''Fetch the remote/upstream content for a subrepo.'$'\n''help'$'\t''Same as '"'"'git help subrepo'"'"''$'\n''init'$'\t''Turn an existing subdirectory into a subrepo.'$'\n''pull'$'\t''Update the subrepo subdir with the latest upstream changes.'$'\n''push'$'\t''Push a properly merged subrepo branch back upstream.'$'\n''status'$'\t''Get the status of a subrepo.'$'\n''version'$'\t''display version information about git-subrepo' 27 | 28 | ;; 29 | *) 30 | # subcmds 31 | case ${MYWORDS[0]} in 32 | branch) 33 | FLAGS+=('--all' 'All subrepos') 34 | __subrepo_handle_options_flags 35 | case ${MYWORDS[$INDEX-1]} in 36 | 37 | esac 38 | case $INDEX in 39 | 1) 40 | __comp_current_options || return 41 | _subrepo_branch_param_subrepo_completion 42 | ;; 43 | 44 | 45 | *) 46 | __comp_current_options || return 47 | ;; 48 | esac 49 | ;; 50 | clean) 51 | FLAGS+=('--all' 'All subrepos') 52 | __subrepo_handle_options_flags 53 | case ${MYWORDS[$INDEX-1]} in 54 | 55 | esac 56 | case $INDEX in 57 | 1) 58 | __comp_current_options || return 59 | _subrepo_clean_param_subrepo_completion 60 | ;; 61 | 62 | 63 | *) 64 | __comp_current_options || return 65 | ;; 66 | esac 67 | ;; 68 | clone) 69 | FLAGS+=('--force' 'reclone (completely replace) an existing subdir.' '-f' 'reclone (completely replace) an existing subdir.') 70 | OPTIONS+=('--branch' 'Upstream branch' '-b' 'Upstream branch') 71 | __subrepo_handle_options_flags 72 | case ${MYWORDS[$INDEX-1]} in 73 | --branch|-b) 74 | ;; 75 | 76 | esac 77 | case $INDEX in 78 | 1) 79 | __comp_current_options || return 80 | ;; 81 | 2) 82 | __comp_current_options || return 83 | compopt -o filenames 84 | ;; 85 | 86 | 87 | *) 88 | __comp_current_options || return 89 | ;; 90 | esac 91 | ;; 92 | commit) 93 | __subrepo_handle_options_flags 94 | case ${MYWORDS[$INDEX-1]} in 95 | 96 | esac 97 | case $INDEX in 98 | 1) 99 | __comp_current_options || return 100 | _subrepo_commit_param_subrepo_completion 101 | ;; 102 | 2) 103 | __comp_current_options || return 104 | ;; 105 | 106 | 107 | *) 108 | __comp_current_options || return 109 | ;; 110 | esac 111 | ;; 112 | fetch) 113 | FLAGS+=('--all' 'All subrepos') 114 | __subrepo_handle_options_flags 115 | case ${MYWORDS[$INDEX-1]} in 116 | 117 | esac 118 | case $INDEX in 119 | 1) 120 | __comp_current_options || return 121 | _subrepo_fetch_param_subrepo_completion 122 | ;; 123 | 124 | 125 | *) 126 | __comp_current_options || return 127 | ;; 128 | esac 129 | ;; 130 | help) 131 | __subrepo_handle_options_flags 132 | __comp_current_options true || return # no subcmds, no params/opts 133 | ;; 134 | init) 135 | OPTIONS+=('--remote' 'Specify remote repository' '-r' 'Specify remote repository' '--branch' 'Upstream branch' '-b' 'Upstream branch') 136 | __subrepo_handle_options_flags 137 | case ${MYWORDS[$INDEX-1]} in 138 | --remote|-r) 139 | ;; 140 | --branch|-b) 141 | ;; 142 | 143 | esac 144 | case $INDEX in 145 | 1) 146 | __comp_current_options || return 147 | compopt -o filenames 148 | ;; 149 | 150 | 151 | *) 152 | __comp_current_options || return 153 | ;; 154 | esac 155 | ;; 156 | pull) 157 | FLAGS+=('--all' 'All subrepos') 158 | OPTIONS+=('--branch' 'Upstream branch' '-b' 'Upstream branch' '--remote' 'Specify remote repository' '-r' 'Specify remote repository' '--update' 'update' '-u' 'update') 159 | __subrepo_handle_options_flags 160 | case ${MYWORDS[$INDEX-1]} in 161 | --branch|-b) 162 | ;; 163 | --remote|-r) 164 | ;; 165 | --update|-u) 166 | ;; 167 | 168 | esac 169 | case $INDEX in 170 | 1) 171 | __comp_current_options || return 172 | _subrepo_pull_param_subrepo_completion 173 | ;; 174 | 175 | 176 | *) 177 | __comp_current_options || return 178 | ;; 179 | esac 180 | ;; 181 | push) 182 | FLAGS+=('--all' 'All subrepos') 183 | OPTIONS+=('--branch' 'Upstream branch' '-b' 'Upstream branch' '--remote' 'Specify remote repository' '-r' 'Specify remote repository' '--update' 'update' '-u' 'update') 184 | __subrepo_handle_options_flags 185 | case ${MYWORDS[$INDEX-1]} in 186 | --branch|-b) 187 | ;; 188 | --remote|-r) 189 | ;; 190 | --update|-u) 191 | ;; 192 | 193 | esac 194 | case $INDEX in 195 | 1) 196 | __comp_current_options || return 197 | _subrepo_push_param_subrepo_completion 198 | ;; 199 | 200 | 201 | *) 202 | __comp_current_options || return 203 | ;; 204 | esac 205 | ;; 206 | status) 207 | OPTIONS+=('--quiet' 'Just print names' '-q' 'Just print names') 208 | __subrepo_handle_options_flags 209 | case ${MYWORDS[$INDEX-1]} in 210 | --quiet|-q) 211 | ;; 212 | 213 | esac 214 | case $INDEX in 215 | 1) 216 | __comp_current_options || return 217 | _subrepo_status_param_subrepo_completion 218 | ;; 219 | 220 | 221 | *) 222 | __comp_current_options || return 223 | ;; 224 | esac 225 | ;; 226 | version) 227 | __subrepo_handle_options_flags 228 | __comp_current_options true || return # no subcmds, no params/opts 229 | ;; 230 | esac 231 | 232 | ;; 233 | esac 234 | 235 | } 236 | 237 | _subrepo_compreply() { 238 | local prefix="" 239 | cur="$(printf '%q' "$cur")" 240 | IFS=$'\n' COMPREPLY=($(compgen -P "$prefix" -W "$*" -- "$cur")) 241 | __ltrim_colon_completions "$prefix$cur" 242 | 243 | # http://stackoverflow.com/questions/7267185/bash-autocompletion-add-description-for-possible-completions 244 | if [[ ${#COMPREPLY[*]} -eq 1 ]]; then # Only one completion 245 | COMPREPLY=( "${COMPREPLY[0]%% -- *}" ) # Remove ' -- ' and everything after 246 | COMPREPLY=( "${COMPREPLY[0]%%+( )}" ) # Remove trailing spaces 247 | fi 248 | } 249 | 250 | _subrepo_branch_param_subrepo_completion() { 251 | local CURRENT_WORD="${words[$cword]}" 252 | local param_subrepo="$($program 'status' '--quiet')" 253 | _subrepo_compreply "$param_subrepo" 254 | } 255 | _subrepo_clean_param_subrepo_completion() { 256 | local CURRENT_WORD="${words[$cword]}" 257 | local param_subrepo="$($program 'status' '--quiet')" 258 | _subrepo_compreply "$param_subrepo" 259 | } 260 | _subrepo_commit_param_subrepo_completion() { 261 | local CURRENT_WORD="${words[$cword]}" 262 | local param_subrepo="$($program 'status' '--quiet')" 263 | _subrepo_compreply "$param_subrepo" 264 | } 265 | _subrepo_fetch_param_subrepo_completion() { 266 | local CURRENT_WORD="${words[$cword]}" 267 | local param_subrepo="$($program 'status' '--quiet')" 268 | _subrepo_compreply "$param_subrepo" 269 | } 270 | _subrepo_pull_param_subrepo_completion() { 271 | local CURRENT_WORD="${words[$cword]}" 272 | local param_subrepo="$($program 'status' '--quiet')" 273 | _subrepo_compreply "$param_subrepo" 274 | } 275 | _subrepo_push_param_subrepo_completion() { 276 | local CURRENT_WORD="${words[$cword]}" 277 | local param_subrepo="$($program 'status' '--quiet')" 278 | _subrepo_compreply "$param_subrepo" 279 | } 280 | _subrepo_status_param_subrepo_completion() { 281 | local CURRENT_WORD="${words[$cword]}" 282 | local param_subrepo="$($program 'status' '--quiet')" 283 | _subrepo_compreply "$param_subrepo" 284 | } 285 | 286 | __subrepo_dynamic_comp() { 287 | local argname="$1" 288 | local arg="$2" 289 | local name desc cols desclength formatted 290 | local comp=() 291 | local max=0 292 | 293 | while read -r line; do 294 | name="$line" 295 | desc="$line" 296 | name="${name%$'\t'*}" 297 | if [[ "${#name}" -gt "$max" ]]; then 298 | max="${#name}" 299 | fi 300 | done <<< "$arg" 301 | 302 | while read -r line; do 303 | name="$line" 304 | desc="$line" 305 | name="${name%$'\t'*}" 306 | desc="${desc/*$'\t'}" 307 | if [[ -n "$desc" && "$desc" != "$name" ]]; then 308 | # TODO portable? 309 | cols=`tput cols` 310 | [[ -z $cols ]] && cols=80 311 | desclength=`expr $cols - 4 - $max` 312 | formatted=`printf "%-*s -- %-*s" "$max" "$name" "$desclength" "$desc"` 313 | comp+=("$formatted") 314 | else 315 | comp+=("'$name'") 316 | fi 317 | done <<< "$arg" 318 | _subrepo_compreply ${comp[@]} 319 | } 320 | 321 | function __subrepo_handle_options() { 322 | local i j 323 | declare -a copy 324 | local last="${MYWORDS[$INDEX]}" 325 | local max=`expr ${#MYWORDS[@]} - 1` 326 | for ((i=0; i<$max; i++)) 327 | do 328 | local word="${MYWORDS[$i]}" 329 | local found= 330 | for ((j=0; j<${#OPTIONS[@]}; j+=2)) 331 | do 332 | local option="${OPTIONS[$j]}" 333 | if [[ "$word" == "$option" ]]; then 334 | found=1 335 | i=`expr $i + 1` 336 | break 337 | fi 338 | done 339 | if [[ -n $found && $i -lt $max ]]; then 340 | INDEX=`expr $INDEX - 2` 341 | else 342 | copy+=("$word") 343 | fi 344 | done 345 | MYWORDS=("${copy[@]}" "$last") 346 | } 347 | 348 | function __subrepo_handle_flags() { 349 | local i j 350 | declare -a copy 351 | local last="${MYWORDS[$INDEX]}" 352 | local max=`expr ${#MYWORDS[@]} - 1` 353 | for ((i=0; i<$max; i++)) 354 | do 355 | local word="${MYWORDS[$i]}" 356 | local found= 357 | for ((j=0; j<${#FLAGS[@]}; j+=2)) 358 | do 359 | local flag="${FLAGS[$j]}" 360 | if [[ "$word" == "$flag" ]]; then 361 | found=1 362 | break 363 | fi 364 | done 365 | if [[ -n $found ]]; then 366 | INDEX=`expr $INDEX - 1` 367 | else 368 | copy+=("$word") 369 | fi 370 | done 371 | MYWORDS=("${copy[@]}" "$last") 372 | } 373 | 374 | __subrepo_handle_options_flags() { 375 | __subrepo_handle_options 376 | __subrepo_handle_flags 377 | } 378 | 379 | __comp_current_options() { 380 | local always="$1" 381 | if [[ -n $always || ${MYWORDS[$INDEX]} =~ ^- ]]; then 382 | 383 | local options_spec='' 384 | local j= 385 | 386 | for ((j=0; j<${#FLAGS[@]}; j+=2)) 387 | do 388 | local name="${FLAGS[$j]}" 389 | local desc="${FLAGS[$j+1]}" 390 | options_spec+="$name"$'\t'"$desc"$'\n' 391 | done 392 | 393 | for ((j=0; j<${#OPTIONS[@]}; j+=2)) 394 | do 395 | local name="${OPTIONS[$j]}" 396 | local desc="${OPTIONS[$j+1]}" 397 | options_spec+="$name"$'\t'"$desc"$'\n' 398 | done 399 | __subrepo_dynamic_comp 'options' "$options_spec" 400 | 401 | return 1 402 | else 403 | return 0 404 | fi 405 | } 406 | 407 | 408 | complete -o default -F _subrepo subrepo 409 | 410 | -------------------------------------------------------------------------------- /examples/bin/myapp: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # vim:et:sts=4:sws=4:sw=4 3 | use strict; 4 | use warnings; 5 | use 5.010; 6 | use Data::Dumper; 7 | use FindBin '$Bin'; 8 | use lib "$Bin/../../lib"; 9 | use lib "$Bin/../../t/lib"; 10 | # t/lib/App/Spec/Example/MyApp.pm 11 | use App::Spec::Example::MyApp; 12 | 13 | use App::Spec; 14 | 15 | my $spec = App::Spec->read("$Bin/../myapp-spec.yaml"); 16 | my $run = $spec->runner; 17 | # or: 18 | #my $run = App::Spec::Example::MyApp->new({ 19 | # spec => $spec, 20 | #}); 21 | $run->run; 22 | 23 | 24 | -------------------------------------------------------------------------------- /examples/bin/mysimpleapp: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # vim:et:sts=4:sws=4:sw=4 3 | use strict; 4 | use warnings; 5 | use 5.010; 6 | use Data::Dumper; 7 | use FindBin '$Bin'; 8 | use lib "$Bin/../../lib"; 9 | use lib "$Bin/../../t/lib"; 10 | # t/lib/App/Spec/Example/MySimpleApp.pm 11 | use App::Spec::Example::MySimpleApp; 12 | 13 | use App::Spec; 14 | 15 | my $spec = App::Spec->read("$Bin/../mysimpleapp-spec.yaml"); 16 | my $run = $spec->runner; 17 | $run->run; 18 | 19 | 20 | -------------------------------------------------------------------------------- /examples/bin/nometa: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use 5.010; 5 | 6 | use Data::Dumper; 7 | use FindBin '$Bin'; 8 | use lib "$Bin/../../lib"; 9 | use lib "$Bin/../../t/lib"; 10 | 11 | use App::Spec::Example::Nometa; 12 | 13 | package main; 14 | 15 | use App::Spec; 16 | 17 | my $spec = App::Spec->read("$Bin/../nometa-spec.yaml"); 18 | my $run = $spec->runner; 19 | $run->run; 20 | 21 | 22 | -------------------------------------------------------------------------------- /examples/bin/pcorelist: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use 5.010; 5 | 6 | use Data::Dumper; 7 | use Text::Table; 8 | use FindBin '$Bin'; 9 | package App::Spec::Example::PCorelist; 10 | 11 | use base 'App::Spec::Run::Cmd'; 12 | 13 | sub module { 14 | my ($self, $run) = @_; 15 | my $options = $run->options; 16 | my $param = $run->parameters; 17 | 18 | my @cmd = qw/ corelist /; 19 | if ($options->{all}) { 20 | push @cmd, "-a"; 21 | } 22 | if ($options->{date}) { 23 | push @cmd, "-d"; 24 | } 25 | push @cmd, $param->{module}; 26 | system(@cmd); 27 | } 28 | 29 | sub perl { 30 | my ($self, $run) = @_; 31 | if ($run->options->{release}) { 32 | my @cmd = qw/ corelist -r /; 33 | my @out = qx{@cmd}; 34 | shift @out; 35 | shift @out; 36 | if ($run->options->{raw}) { 37 | @out = map { 38 | (split ' ', $_)[1] . "\n" 39 | } @out; 40 | } 41 | say @out; 42 | return; 43 | } 44 | my @cmd = qw/ corelist -v /; 45 | if ($run->options->{raw}) { 46 | my @out = qx{@cmd}; 47 | shift @out; 48 | shift @out; 49 | say @out; 50 | } 51 | else { 52 | system(@cmd); 53 | } 54 | } 55 | 56 | sub diff { 57 | my ($self, $run) = @_; 58 | my $options = $run->options; 59 | my $param = $run->parameters; 60 | 61 | my @cmd = (qw/ corelist --diff /, $param->{perl1}, $param->{perl2}); 62 | chomp(my @out = qx{@cmd}); 63 | my @result; 64 | if ($options->{added} or $options->{removed}) { 65 | for my $line (@out) { 66 | my ($mod, $v1, $v2) = split ' ', $line; 67 | if ($options->{added} and $v1 =~ m/absent/) { 68 | push @result, $line; 69 | } 70 | if ($options->{removed} and $v2 =~ m/absent/) { 71 | push @result, $line; 72 | } 73 | } 74 | } 75 | else { 76 | @result = @out; 77 | } 78 | say for @result; 79 | } 80 | 81 | sub features { 82 | my ($self, $run) = @_; 83 | my $param = $run->parameters; 84 | 85 | no warnings 'once'; 86 | require feature; 87 | my $param_feature = $param->{feature}; 88 | 89 | my %feature2version; 90 | my @bundles = map { $_->[0] } 91 | sort { $b->[1] <=> $a->[1] } 92 | map { [$_, numify_version($_)] } 93 | grep { not /[^0-9.]/ } 94 | keys %feature::feature_bundle; 95 | for my $version (@bundles) { 96 | my $f = $feature::feature_bundle{$version}; 97 | $feature2version{$_} = $version =~ /^\d\.\d+$/ ? "$version.0" : $version 98 | for @$f; 99 | } 100 | my @features = sort keys %feature2version; 101 | 102 | # allow internal feature names, just in case someone gives us __SUB__ 103 | # instead of current_sub. 104 | while (my ($name, $internal) = each %feature::feature) { 105 | $internal =~ s/^feature_//; 106 | $feature2version{$internal} = $feature2version{$name} 107 | if $feature2version{$name}; 108 | } 109 | 110 | if (defined $param_feature) { 111 | if ($feature2version{ $param_feature }) { 112 | say sprintf "feature '%s' was first released with the perl" 113 | . " %s feature bundle", 114 | $param_feature, $feature2version{ $param_feature }; 115 | } 116 | else { 117 | say sprintf "feature '%s' doesn't exist (or so I think)", 118 | $param_feature; 119 | } 120 | } 121 | else { 122 | if ($run->options->{raw}) { 123 | say for @features; 124 | } 125 | else { 126 | my $tb = Text::Table->new; 127 | for my $f (@features) { 128 | $tb->add($f, $feature2version{ $f }); 129 | } 130 | say $tb; 131 | } 132 | } 133 | } 134 | 135 | sub numify_version { 136 | my $ver = shift; 137 | if ($ver =~ /\..+\./) { 138 | $ver = version->new($ver)->numify; 139 | } 140 | $ver += 0; 141 | return $ver; 142 | } 143 | 144 | sub modules { 145 | my ($self, $run) = @_; 146 | 147 | my %modules; 148 | require Module::CoreList; 149 | for my $v (keys %Module::CoreList::delta) { 150 | my $changes = $Module::CoreList::delta{ $v }; 151 | my $changed = $changes->{changed}; 152 | my $removed = $changes->{removed}; 153 | @modules{ (keys %$changed), (keys %$removed) } = (); 154 | } 155 | say for sort keys %modules; 156 | } 157 | 158 | package main; 159 | 160 | use App::Spec; 161 | 162 | my $spec = App::Spec->read("$Bin/../pcorelist-spec.yaml"); 163 | my $run = $spec->runner; 164 | $run->run; 165 | 166 | 167 | -------------------------------------------------------------------------------- /examples/bin/subrepo: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use 5.010; 5 | system "git", "subrepo", @ARGV; 6 | 7 | -------------------------------------------------------------------------------- /examples/html/myapp.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 42 | 43 |

NAME

44 | 45 |

myapp - My Very Cool App

46 | 47 |

ABSTRACT

48 | 49 |

This app can do very cool things

50 | 51 |

DESCRIPTION

52 | 53 |

This is a very useful description for myapp. This is a very useful description for myapp. This is a very useful description for myapp. This is a very useful description for myapp.

54 | 55 |

GLOBAL OPTIONS

56 | 57 | 
    --verbose -v   [] be verbose (flag; multiple)
 58 |     --help -h         Show command help (flag)   
 59 |     --format          Format output
60 | 61 |

SUBCOMMANDS

62 | 63 |

config

64 | 65 | 
    myapp  config [options]
66 | 67 |

configuration

68 | 69 |

Options:

70 | 71 | 
    --set   {} key=value pair(s) (multiple; mapping)
72 | 73 |

convert

74 | 75 | 
    myapp  convert <type> <source> <value> <target>+
76 | 77 |

Various unit conversions

78 | 79 |

Parameters:

80 | 81 | 
    type    *    The type of unit to convert    
 82 |     source  *    The source unit to convert from
 83 |     value   *    The value to convert           
 84 |     target  * [] The target unit (multiple)
85 | 86 |

cook

87 | 88 | 
    myapp  cook [options] <drink>
89 | 90 |

Cook something

91 | 92 |

Options:

93 | 94 | 
    --with        Drink with ...  
 95 |     --sugar -s    add sugar (flag)
96 | 97 |

Parameters:

98 | 99 | 
    drink  *  What to drink
100 | 101 |

data

102 | 103 | 
    myapp  data [options]
104 | 105 |

output some data

106 | 107 |

Options:

108 | 109 | 
    --item
110 | 111 |

palindrome

112 | 113 | 
    myapp  palindrome <string>
114 | 115 |

Check if a string is a palindrome

116 | 117 |

Parameters:

118 | 119 | 
    string  *
120 | 121 |

weather

122 | 123 | 
    myapp  weather <subcommands>
124 | 125 |

Weather

126 | 127 |

weather cities

128 | 129 | 
    myapp weather cities [options]
130 | 131 |

show list of cities

132 | 133 |

Options:

134 | 135 | 
    --country -c   [] country name(s) (multiple)
136 | 137 |

weather countries

138 | 139 | 
    myapp weather countries
140 | 141 |

show list of countries

142 | 143 |

weather show

144 | 145 | 
    myapp weather show [options] <country> <city>+
146 | 147 |

Show Weather forecast

148 | 149 |

Options:

150 | 151 | 
    --temperature -T    show temperature (flag)              
152 |     --celsius -C        show temperature in celsius (flag)   
153 |     --fahrenheit -F     show temperature in fahrenheit (flag)
154 | 155 |

Parameters:

156 | 157 | 
    country  *    Specify country                  
158 |     city     * [] Specify city or cities (multiple)
159 | 160 |

help

161 | 162 | 
    myapp  help <subcommands> [options]
163 | 164 |

Show command help

165 | 166 |

Options:

167 | 168 | 
    --all     (flag)
169 | 170 |

_meta

171 | 172 | 
    myapp  _meta <subcommands>
173 | 174 |

Information and utilities for this app

175 | 176 |

_meta completion

177 | 178 | 
    myapp _meta completion <subcommands>
179 | 180 |

Shell completion functions

181 | 182 |

_meta completion generate

183 | 184 | 
    myapp _meta completion generate [options]
185 | 186 |

Generate self completion

187 | 188 |

Options:

189 | 190 | 
    --name    name of the program (optional, override name in spec)
191 |     --zsh     for zsh (flag)                                       
192 |     --bash    for bash (flag)
193 | 194 |

_meta pod

195 | 196 | 
    myapp _meta pod <subcommands>
197 | 198 |

Pod documentation

199 | 200 |

_meta pod generate

201 | 202 | 
    myapp _meta pod generate
203 | 204 |

Generate self pod

205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | -------------------------------------------------------------------------------- /examples/html/mysimpleapp.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 24 | 25 |

NAME

26 | 27 |

mysimpleapp - a simple app

28 | 29 |

ABSTRACT

30 | 31 |

Just a very simple example app to document some features

32 | 33 |

DESCRIPTION

34 | 35 |

GLOBAL OPTIONS

36 | 37 | 
    --verbose -v    [] be verbose (flag; multiple)        
38 |     --wc               word count (flag)                  
39 |     --lc               line count (flag)                  
40 |     --with             with ...                           
41 |     --file1            existing file                      
42 |     --file2            possible file                      
43 |     --dir1             existing dir                       
44 |     --dir2             possible dir                       
45 |     --longoption       some long option description (flag)
46 |                        split over several lines to        
47 |                        demonstrate                        
48 |     --longoption2      some other long option             
49 |                        description split over several     
50 |                        lines to demonstrate               
51 |     --help -h          Show command help (flag)
52 | 53 |

SUBCOMMANDS

54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /examples/html/nometa.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 30 | 31 |

NAME

32 | 33 |

nometa - Test app for disabling plugins

34 | 35 |

ABSTRACT

36 | 37 |

DESCRIPTION

38 | 39 |

GLOBAL OPTIONS

40 | 41 | 
    --help -h    Show command help (flag)
42 | 43 |

SUBCOMMANDS

44 | 45 |

foo

46 | 47 | 
    nometa  foo <test>
48 | 49 |

Test command

50 | 51 |

Parameters:

52 | 53 | 
    test  *
54 | 55 |

longsubcommand

56 | 57 | 
    nometa  longsubcommand [<longparam>]
58 | 59 |

A subcommand with a very long summary split over multiple lines

60 | 61 |

Parameters:

62 | 63 | 
    longparam    A parameter with a     
64 |                  very long summary split
65 |                  over multiple lines
66 | 67 |

help

68 | 69 | 
    nometa  help <subcommands> [options]
70 | 71 |

Show command help

72 | 73 |

Options:

74 | 75 | 
    --all     (flag)
76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | -------------------------------------------------------------------------------- /examples/html/pcorelist.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 38 | 39 |

NAME

40 | 41 |

pcorelist - corelist with shell completion

42 | 43 |

ABSTRACT

44 | 45 |

This is a wrapper around the corelist tool which adds shell completion

46 | 47 |

DESCRIPTION

48 | 49 |

GLOBAL OPTIONS

50 | 51 | 
    --help -h    Show command help (flag)
52 | 53 |

SUBCOMMANDS

54 | 55 |

diff

56 | 57 | 
    pcorelist  diff [options] <perl1> <perl2>
58 | 59 |

Show diff between two Perl versions

60 | 61 |

Options:

62 | 63 | 
    --added      Show only added modules (flag)  
 64 |     --removed    Show only removed modules (flag)
65 | 66 |

Parameters:

67 | 68 | 
    perl1  *  Perl version 1
 69 |     perl2  *  Perl version 2
70 | 71 |

features

72 | 73 | 
    pcorelist  features [options] [<feature>]
74 | 75 |

List features with perl versions

76 | 77 |

If given a feature name as a parameter, show the perl feature bundle it was first released with.

78 | 79 |

Options:

80 | 81 | 
    --raw    List only feature names (flag)
82 | 83 |

Parameters:

84 | 85 | 
    feature    feature name
86 | 87 |

module

88 | 89 | 
    pcorelist  module [options] <module>
90 | 91 |

Show for which perl version the module was first released

92 | 93 |

Options:

94 | 95 | 
    --all -a     Show all perl and module versions (flag)
 96 |     --date -d    Show by date (flag)                     
 97 |     --perl -p    Show by Perl Version
98 | 99 |

Parameters:

100 | 101 | 
    module  *  Module name
102 | 103 |

modules

104 | 105 | 
    pcorelist  modules
106 | 107 |

List all modules

108 | 109 |

perl

110 | 111 | 
    pcorelist  perl [options]
112 | 113 |

Perl Versions

114 | 115 |

Options:

116 | 117 | 
    --raw -r     Show raw output without header (flag)
118 |     --release    Show perl releases with dates (flag)
119 | 120 |

help

121 | 122 | 
    pcorelist  help <subcommands> [options]
123 | 124 |

Show command help

125 | 126 |

Options:

127 | 128 | 
    --all     (flag)
129 | 130 |

_meta

131 | 132 | 
    pcorelist  _meta <subcommands>
133 | 134 |

Information and utilities for this app

135 | 136 |

_meta completion

137 | 138 | 
    pcorelist _meta completion <subcommands>
139 | 140 |

Shell completion functions

141 | 142 |

_meta completion generate

143 | 144 | 
    pcorelist _meta completion generate [options]
145 | 146 |

Generate self completion

147 | 148 |

Options:

149 | 150 | 
    --name    name of the program (optional, override name in spec)
151 |     --zsh     for zsh (flag)                                       
152 |     --bash    for bash (flag)
153 | 154 |

_meta pod

155 | 156 | 
    pcorelist _meta pod <subcommands>
157 | 158 |

Pod documentation

159 | 160 |

_meta pod generate

161 | 162 | 
    pcorelist _meta pod generate
163 | 164 |

Generate self pod

165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | -------------------------------------------------------------------------------- /examples/html/subrepo.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 39 | 40 |

NAME

41 | 42 |

subrepo - Git Submodule Alternative

43 | 44 |

ABSTRACT

45 | 46 |

DESCRIPTION

47 | 48 |

This is just an example for generating completion for an existing command, https://github.com/ingydotnet/git-subrepo

49 | 50 |

This git command "clones" an external git repo into a subdirectory of your repo. Later on, upstream changes can be pulled in, and local changes can be pushed back. Simple.

51 | 52 |

Benefits

53 | 54 |

This command is an improvement from git-submodule and git-subtree; two other git commands with similar goals, but various problems.

55 | 56 |

GLOBAL OPTIONS

57 | 58 | 
    --help -h    Show command help (flag)
59 | 60 |

SUBCOMMANDS

61 | 62 |

branch

63 | 64 | 
    subrepo  branch [options] [<subrepo>]
65 | 66 |

Create a branch with local subrepo commits since last pull.

67 | 68 |

Options:

69 | 70 | 
    --all    All subrepos (flag)
71 | 72 |

Parameters:

73 | 74 | 
    subrepo    Subrepo
75 | 76 |

clean

77 | 78 | 
    subrepo  clean [options] [<subrepo>]
79 | 80 |

Remove artifacts created by fetch and branch commands.

81 | 82 |

Options:

83 | 84 | 
    --all    All subrepos (flag)
85 | 86 |

Parameters:

87 | 88 | 
    subrepo    Subrepo
89 | 90 |

clone

91 | 92 | 
    subrepo  clone [options] <repository> [<subdir>]
93 | 94 |

Add a repository as a subrepo in a subdir of your repository.

95 | 96 |

Options:

97 | 98 | 
    --branch -b    Upstream branch                                        
 99 |     --force -f     reclone (completely replace) an existing subdir. (flag)
100 | 101 |

Parameters:

102 | 103 | 
    repository  *  
104 |     subdir
105 | 106 |

commit

107 | 108 | 
    subrepo  commit <subrepo> [<subreporef>]
109 | 110 |

Add subrepo branch to current history as a single commit.

111 | 112 |

Parameters:

113 | 114 | 
    subrepo     *  Subrepo    
115 |     subreporef     Subrepo ref
116 | 117 |

fetch

118 | 119 | 
    subrepo  fetch [options] [<subrepo>]
120 | 121 |

Fetch the remote/upstream content for a subrepo.

122 | 123 |

Options:

124 | 125 | 
    --all    All subrepos (flag)
126 | 127 |

Parameters:

128 | 129 | 
    subrepo    Subrepo
130 | 131 |

init

132 | 133 | 
    subrepo  init [options] <subdir>
134 | 135 |

Turn an existing subdirectory into a subrepo.

136 | 137 |

Options:

138 | 139 | 
    --remote -r    Specify remote repository
140 |     --branch -b    Upstream branch
141 | 142 |

Parameters:

143 | 144 | 
    subdir  *
145 | 146 |

pull

147 | 148 | 
    subrepo  pull [options] [<subrepo>]
149 | 150 |

Update the subrepo subdir with the latest upstream changes.

151 | 152 |

Options:

153 | 154 | 
    --all          All subrepos (flag)      
155 |     --branch -b    Upstream branch          
156 |     --remote -r    Specify remote repository
157 |     --update -u    update
158 | 159 |

Parameters:

160 | 161 | 
    subrepo    Subrepo
162 | 163 |

push

164 | 165 | 
    subrepo  push [options] [<subrepo>]
166 | 167 |

Push a properly merged subrepo branch back upstream.

168 | 169 |

Options:

170 | 171 | 
    --all          All subrepos (flag)      
172 |     --branch -b    Upstream branch          
173 |     --remote -r    Specify remote repository
174 |     --update -u    update
175 | 176 |

Parameters:

177 | 178 | 
    subrepo    Subrepo
179 | 180 |

status

181 | 182 | 
    subrepo  status [options] [<subrepo>]
183 | 184 |

Get the status of a subrepo.

185 | 186 |

Options:

187 | 188 | 
    --quiet -q    Just print names
189 | 190 |

Parameters:

191 | 192 | 
    subrepo    Subrepo
193 | 194 |

version

195 | 196 | 
    subrepo  version
197 | 198 |

display version information about git-subrepo

199 | 200 |

help

201 | 202 | 
    subrepo  help
203 | 204 |

Same as git help subrepo

205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | -------------------------------------------------------------------------------- /examples/myapp-spec.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | name: myapp 3 | plugins: [Format] 4 | appspec: { "version": 0.001 } 5 | class: App::Spec::Example::MyApp 6 | title: My Very Cool App 7 | abstract: This app can do very cool things 8 | description: | 9 | This is a very useful description for myapp. 10 | This is a very useful description for myapp. 11 | This is a very useful description for myapp. 12 | This is a very useful description for myapp. 13 | options: 14 | - 15 | name: verbose 16 | summary: be verbose 17 | type: flag 18 | multiple: true 19 | aliases: ["v"] 20 | 21 | subcommands: 22 | cook: 23 | summary: Cook something 24 | op: cook 25 | parameters: 26 | - 27 | name: drink 28 | summary: What to drink 29 | required: true 30 | type: string 31 | enum: ["tea", "coffee"] 32 | options: 33 | - 34 | name: with 35 | summary: Drink with ... 36 | type: string 37 | enum: ["almond milk", "soy milk", "oat milk", "spelt milk", "cow milk"] 38 | - 39 | name: sugar 40 | type: flag 41 | aliases: ["s"] 42 | summary: add sugar 43 | 44 | weather: 45 | summary: Weather 46 | subcommands: 47 | show: 48 | summary: Show Weather forecast 49 | op: weather 50 | options: 51 | - name: temperature 52 | summary: show temperature 53 | aliases: [T] 54 | type: flag 55 | - name: celsius 56 | summary: show temperature in celsius 57 | aliases: [C] 58 | type: flag 59 | - name: fahrenheit 60 | summary: show temperature in fahrenheit 61 | aliases: [F] 62 | type: flag 63 | parameters: 64 | - name: country 65 | required: true 66 | summary: Specify country 67 | values: 68 | op: weather_complete 69 | completion: 70 | op: weather_complete 71 | - name: city 72 | required: true 73 | multiple: true 74 | summary: Specify city or cities 75 | values: 76 | op: weather_complete 77 | completion: 78 | op: weather_complete 79 | countries: 80 | summary: show list of countries 81 | op: countries 82 | cities: 83 | summary: show list of cities 84 | op: cities 85 | options: 86 | - name: country 87 | aliases: ["c"] 88 | multiple: true 89 | summary: country name(s) 90 | completion: 91 | command: 92 | - replace: SELF 93 | - weather 94 | - countries 95 | 96 | palindrome: 97 | summary: Check if a string is a palindrome 98 | op: palindrome 99 | parameters: 100 | - name: string 101 | required: true 102 | completion: 103 | command_string: | 104 | cat /usr/share/dict/words | perl -nle'print if $_ eq reverse $_' 105 | 106 | convert: 107 | summary: Various unit conversions 108 | op: convert 109 | parameters: 110 | - name: type 111 | summary: The type of unit to convert 112 | type: string 113 | required: true 114 | values: 115 | op: convert_complete 116 | completion: true 117 | - name: source 118 | summary: The source unit to convert from 119 | type: string 120 | required: true 121 | values: 122 | op: convert_complete 123 | completion: true 124 | - name: value 125 | summary: The value to convert 126 | required: true 127 | type: integer 128 | - name: target 129 | summary: The target unit 130 | type: string 131 | required: true 132 | multiple: true 133 | unique: true 134 | values: 135 | op: convert_complete 136 | completion: true 137 | 138 | config: 139 | summary: configuration 140 | op: config 141 | options: 142 | - name: set 143 | summary: key=value pair(s) 144 | multiple: true 145 | mapping: true 146 | values: 147 | mapping: 148 | color: [auto, never, always] 149 | push.default: [current, matching, nothing, simple, upstream] 150 | name: null 151 | email: null 152 | 153 | data: 154 | summary: output some data 155 | op: data 156 | options: 157 | - name: item 158 | type: string 159 | enum: [hash, table] 160 | default: hash 161 | # vim:et:sts=2:sws=2:sw=2:foldmethod=indent 162 | -------------------------------------------------------------------------------- /examples/mysimpleapp-spec.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | name: mysimpleapp 3 | appspec: { version: 0.001 } 4 | class: App::Spec::Example::MySimpleApp 5 | title: a simple app 6 | abstract: Just a very simple example app to document some features 7 | options: 8 | - name: verbose 9 | summary: be verbose 10 | type: flag 11 | multiple: true 12 | aliases: [v] 13 | - name: wc 14 | summary: word count 15 | type: flag 16 | - name: lc 17 | summary: line count 18 | type: flag 19 | - name: with 20 | summary: with ... 21 | type: string 22 | enum: [ab, cd, ef] 23 | - name: file1 24 | summary: existing file 25 | type: file 26 | - name: file2 27 | summary: possible file 28 | type: filename 29 | - name: dir1 30 | summary: existing dir 31 | type: dir 32 | - name: dir2 33 | summary: possible dir 34 | type: dirname 35 | - | 36 | longoption --some long option description 37 | split over several lines to 38 | demonstrate 39 | - name: longoption2 40 | summary: | 41 | some other long option 42 | description split over several 43 | lines to demonstrate 44 | 45 | parameters: 46 | - name: foo 47 | summary: foo 48 | type: string 49 | enum: [dist.ini, Makefile.PL, Changes] 50 | - name: bar 51 | summary: bar 52 | type: string 53 | enum: [a,b,c] 54 | # vim:et:sts=2:sws=2:sw=2:foldmethod=indent 55 | -------------------------------------------------------------------------------- /examples/nometa-spec.yaml: -------------------------------------------------------------------------------- 1 | name: nometa 2 | appspec: { "version": 0.001 } 3 | title: Test app for disabling plugins 4 | plugins: [ -Meta ] 5 | class: App::Spec::Example::Nometa 6 | 7 | options: [] 8 | subcommands: 9 | foo: 10 | summary: Test command 11 | op: foo 12 | parameters: 13 | - name: test 14 | type: string 15 | required: true 16 | enum: [a, b, c] 17 | longsubcommand: 18 | summary: | 19 | A subcommand with a 20 | very long summary split 21 | over multiple lines 22 | parameters: 23 | - name: longparam 24 | summary: | 25 | A parameter with a 26 | very long summary split 27 | over multiple lines 28 | 29 | # vim:et:sts=2:sws=2:sw=2:foldmethod=indent 30 | -------------------------------------------------------------------------------- /examples/pcorelist-spec.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | name: pcorelist 3 | appspec: { "version": 0.001 } 4 | class: App::Spec::Example::PCorelist 5 | title: corelist with shell completion 6 | abstract: This is a wrapper around the corelist tool which adds shell completion 7 | options: [] 8 | subcommands: 9 | module: 10 | summary: Show for which perl version the module was first released 11 | op: module 12 | options: 13 | - 14 | name: all 15 | summary: Show all perl and module versions 16 | type: flag 17 | aliases: ["a"] 18 | - 19 | name: date 20 | summary: Show by date 21 | type: flag 22 | aliases: ["d"] 23 | - 24 | name: perl 25 | summary: Show by Perl Version 26 | type: string 27 | aliases: ["p"] 28 | completion: &complete_perl_version 29 | command: 30 | - replace: SELF 31 | - perl 32 | - "--raw" 33 | parameters: 34 | - 35 | name: module 36 | summary: Module name 37 | type: string 38 | required: true 39 | completion: 40 | command: 41 | - replace: SELF 42 | - modules 43 | perl: 44 | summary: Perl Versions 45 | op: perl 46 | options: 47 | - 48 | name: raw 49 | summary: Show raw output without header 50 | type: flag 51 | aliases: ["r"] 52 | - 53 | name: release 54 | summary: Show perl releases with dates 55 | type: flag 56 | diff: 57 | summary: Show diff between two Perl versions 58 | op: diff 59 | options: 60 | - 61 | name: added 62 | summary: Show only added modules 63 | type: flag 64 | - 65 | name: removed 66 | summary: Show only removed modules 67 | type: flag 68 | parameters: 69 | - 70 | name: perl1 71 | summary: Perl version 1 72 | type: string 73 | required: true 74 | completion: *complete_perl_version 75 | - 76 | name: perl2 77 | summary: Perl version 2 78 | type: string 79 | required: true 80 | completion: *complete_perl_version 81 | features: 82 | summary: List features with perl versions 83 | description: | 84 | If given a feature name as a parameter, show the 85 | perl feature bundle it was first released with. 86 | op: features 87 | parameters: 88 | - 89 | name: feature 90 | summary: feature name 91 | completion: 92 | command: 93 | - replace: SELF 94 | - features 95 | - '--raw' 96 | options: 97 | - 98 | name: raw 99 | summary: List only feature names 100 | type: flag 101 | modules: 102 | summary: List all modules 103 | op: modules 104 | # vim:et:sts=2:sws=2:sw=2:foldmethod=indent 105 | 106 | -------------------------------------------------------------------------------- /examples/pod/myapp.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | myapp - My Very Cool App 4 | 5 | =head1 ABSTRACT 6 | 7 | This app can do very cool things 8 | 9 | =head1 DESCRIPTION 10 | 11 | This is a very useful description for myapp. 12 | This is a very useful description for myapp. 13 | This is a very useful description for myapp. 14 | This is a very useful description for myapp. 15 | 16 | 17 | =head2 GLOBAL OPTIONS 18 | 19 | --verbose -v [] be verbose (flag; multiple) 20 | --help -h Show command help (flag) 21 | --format Format output 22 | 23 | 24 | =head2 SUBCOMMANDS 25 | 26 | =head3 config 27 | 28 | myapp config [options] 29 | 30 | configuration 31 | 32 | Options: 33 | 34 | --set {} key=value pair(s) (multiple; mapping) 35 | 36 | 37 | =head3 convert 38 | 39 | myapp convert + 40 | 41 | Various unit conversions 42 | 43 | Parameters: 44 | 45 | type * The type of unit to convert 46 | source * The source unit to convert from 47 | value * The value to convert 48 | target * [] The target unit (multiple) 49 | 50 | =head3 cook 51 | 52 | myapp cook [options] 53 | 54 | Cook something 55 | 56 | Options: 57 | 58 | --with Drink with ... 59 | --sugar -s add sugar (flag) 60 | 61 | Parameters: 62 | 63 | drink * What to drink 64 | 65 | =head3 data 66 | 67 | myapp data [options] 68 | 69 | output some data 70 | 71 | Options: 72 | 73 | --item 74 | 75 | 76 | =head3 palindrome 77 | 78 | myapp palindrome 79 | 80 | Check if a string is a palindrome 81 | 82 | Parameters: 83 | 84 | string * 85 | 86 | =head3 weather 87 | 88 | myapp weather 89 | 90 | Weather 91 | 92 | 93 | =head3 weather cities 94 | 95 | myapp weather cities [options] 96 | 97 | show list of cities 98 | 99 | Options: 100 | 101 | --country -c [] country name(s) (multiple) 102 | 103 | 104 | =head3 weather countries 105 | 106 | myapp weather countries 107 | 108 | show list of countries 109 | 110 | 111 | =head3 weather show 112 | 113 | myapp weather show [options] + 114 | 115 | Show Weather forecast 116 | 117 | Options: 118 | 119 | --temperature -T show temperature (flag) 120 | --celsius -C show temperature in celsius (flag) 121 | --fahrenheit -F show temperature in fahrenheit (flag) 122 | 123 | Parameters: 124 | 125 | country * Specify country 126 | city * [] Specify city or cities (multiple) 127 | 128 | =head3 help 129 | 130 | myapp help [options] 131 | 132 | Show command help 133 | 134 | Options: 135 | 136 | --all (flag) 137 | 138 | 139 | =head3 _meta 140 | 141 | myapp _meta 142 | 143 | Information and utilities for this app 144 | 145 | 146 | =head3 _meta completion 147 | 148 | myapp _meta completion 149 | 150 | Shell completion functions 151 | 152 | 153 | =head3 _meta completion generate 154 | 155 | myapp _meta completion generate [options] 156 | 157 | Generate self completion 158 | 159 | Options: 160 | 161 | --name name of the program (optional, override name in spec) 162 | --zsh for zsh (flag) 163 | --bash for bash (flag) 164 | 165 | 166 | =head3 _meta pod 167 | 168 | myapp _meta pod 169 | 170 | Pod documentation 171 | 172 | 173 | =head3 _meta pod generate 174 | 175 | myapp _meta pod generate 176 | 177 | Generate self pod 178 | 179 | 180 | 181 | 182 | -------------------------------------------------------------------------------- /examples/pod/mysimpleapp.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | mysimpleapp - a simple app 4 | 5 | =head1 ABSTRACT 6 | 7 | Just a very simple example app to document some features 8 | 9 | =head1 DESCRIPTION 10 | 11 | 12 | 13 | =head2 GLOBAL OPTIONS 14 | 15 | --verbose -v [] be verbose (flag; multiple) 16 | --wc word count (flag) 17 | --lc line count (flag) 18 | --with with ... 19 | --file1 existing file 20 | --file2 possible file 21 | --dir1 existing dir 22 | --dir2 possible dir 23 | --longoption some long option description (flag) 24 | split over several lines to 25 | demonstrate 26 | --longoption2 some other long option 27 | description split over several 28 | lines to demonstrate 29 | --help -h Show command help (flag) 30 | 31 | 32 | =head2 SUBCOMMANDS 33 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /examples/pod/nometa.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | nometa - Test app for disabling plugins 4 | 5 | =head1 ABSTRACT 6 | 7 | 8 | 9 | =head1 DESCRIPTION 10 | 11 | 12 | 13 | =head2 GLOBAL OPTIONS 14 | 15 | --help -h Show command help (flag) 16 | 17 | 18 | =head2 SUBCOMMANDS 19 | 20 | =head3 foo 21 | 22 | nometa foo 23 | 24 | Test command 25 | 26 | Parameters: 27 | 28 | test * 29 | 30 | =head3 longsubcommand 31 | 32 | nometa longsubcommand [] 33 | 34 | A subcommand with a 35 | very long summary split 36 | over multiple lines 37 | 38 | 39 | Parameters: 40 | 41 | longparam A parameter with a 42 | very long summary split 43 | over multiple lines 44 | 45 | =head3 help 46 | 47 | nometa help [options] 48 | 49 | Show command help 50 | 51 | Options: 52 | 53 | --all (flag) 54 | 55 | 56 | 57 | 58 | -------------------------------------------------------------------------------- /examples/pod/pcorelist.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | pcorelist - corelist with shell completion 4 | 5 | =head1 ABSTRACT 6 | 7 | This is a wrapper around the corelist tool which adds shell completion 8 | 9 | =head1 DESCRIPTION 10 | 11 | 12 | 13 | =head2 GLOBAL OPTIONS 14 | 15 | --help -h Show command help (flag) 16 | 17 | 18 | =head2 SUBCOMMANDS 19 | 20 | =head3 diff 21 | 22 | pcorelist diff [options] 23 | 24 | Show diff between two Perl versions 25 | 26 | Options: 27 | 28 | --added Show only added modules (flag) 29 | --removed Show only removed modules (flag) 30 | 31 | Parameters: 32 | 33 | perl1 * Perl version 1 34 | perl2 * Perl version 2 35 | 36 | =head3 features 37 | 38 | pcorelist features [options] [] 39 | 40 | List features with perl versions 41 | 42 | If given a feature name as a parameter, show the 43 | perl feature bundle it was first released with. 44 | 45 | 46 | Options: 47 | 48 | --raw List only feature names (flag) 49 | 50 | Parameters: 51 | 52 | feature feature name 53 | 54 | =head3 module 55 | 56 | pcorelist module [options] 57 | 58 | Show for which perl version the module was first released 59 | 60 | Options: 61 | 62 | --all -a Show all perl and module versions (flag) 63 | --date -d Show by date (flag) 64 | --perl -p Show by Perl Version 65 | 66 | Parameters: 67 | 68 | module * Module name 69 | 70 | =head3 modules 71 | 72 | pcorelist modules 73 | 74 | List all modules 75 | 76 | 77 | =head3 perl 78 | 79 | pcorelist perl [options] 80 | 81 | Perl Versions 82 | 83 | Options: 84 | 85 | --raw -r Show raw output without header (flag) 86 | --release Show perl releases with dates (flag) 87 | 88 | 89 | =head3 help 90 | 91 | pcorelist help [options] 92 | 93 | Show command help 94 | 95 | Options: 96 | 97 | --all (flag) 98 | 99 | 100 | =head3 _meta 101 | 102 | pcorelist _meta 103 | 104 | Information and utilities for this app 105 | 106 | 107 | =head3 _meta completion 108 | 109 | pcorelist _meta completion 110 | 111 | Shell completion functions 112 | 113 | 114 | =head3 _meta completion generate 115 | 116 | pcorelist _meta completion generate [options] 117 | 118 | Generate self completion 119 | 120 | Options: 121 | 122 | --name name of the program (optional, override name in spec) 123 | --zsh for zsh (flag) 124 | --bash for bash (flag) 125 | 126 | 127 | =head3 _meta pod 128 | 129 | pcorelist _meta pod 130 | 131 | Pod documentation 132 | 133 | 134 | =head3 _meta pod generate 135 | 136 | pcorelist _meta pod generate 137 | 138 | Generate self pod 139 | 140 | 141 | 142 | 143 | -------------------------------------------------------------------------------- /examples/pod/subrepo.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | subrepo - Git Submodule Alternative 4 | 5 | =head1 ABSTRACT 6 | 7 | 8 | 9 | =head1 DESCRIPTION 10 | 11 | This is just an example for generating completion for an existing command, L 12 | 13 | This git command "clones" an external git repo into a subdirectory of your repo. Later on, upstream changes can be pulled in, and local changes can be pushed back. Simple. 14 | 15 | =head1 Benefits 16 | 17 | This command is an improvement from C and C; two other git commands with similar goals, but various problems. 18 | 19 | 20 | =head2 GLOBAL OPTIONS 21 | 22 | --help -h Show command help (flag) 23 | 24 | 25 | =head2 SUBCOMMANDS 26 | 27 | =head3 branch 28 | 29 | subrepo branch [options] [] 30 | 31 | Create a branch with local subrepo commits since last pull. 32 | 33 | 34 | Options: 35 | 36 | --all All subrepos (flag) 37 | 38 | Parameters: 39 | 40 | subrepo Subrepo 41 | 42 | =head3 clean 43 | 44 | subrepo clean [options] [] 45 | 46 | Remove artifacts created by C and C commands. 47 | 48 | 49 | Options: 50 | 51 | --all All subrepos (flag) 52 | 53 | Parameters: 54 | 55 | subrepo Subrepo 56 | 57 | =head3 clone 58 | 59 | subrepo clone [options] [] 60 | 61 | Add a repository as a subrepo in a subdir of your repository. 62 | 63 | 64 | Options: 65 | 66 | --branch -b Upstream branch 67 | --force -f reclone (completely replace) an existing subdir. (flag) 68 | 69 | Parameters: 70 | 71 | repository * 72 | subdir 73 | 74 | =head3 commit 75 | 76 | subrepo commit [] 77 | 78 | Add subrepo branch to current history as a single commit. 79 | 80 | 81 | Parameters: 82 | 83 | subrepo * Subrepo 84 | subreporef Subrepo ref 85 | 86 | =head3 fetch 87 | 88 | subrepo fetch [options] [] 89 | 90 | Fetch the remote/upstream content for a subrepo. 91 | 92 | 93 | Options: 94 | 95 | --all All subrepos (flag) 96 | 97 | Parameters: 98 | 99 | subrepo Subrepo 100 | 101 | =head3 init 102 | 103 | subrepo init [options] 104 | 105 | Turn an existing subdirectory into a subrepo. 106 | 107 | 108 | Options: 109 | 110 | --remote -r Specify remote repository 111 | --branch -b Upstream branch 112 | 113 | Parameters: 114 | 115 | subdir * 116 | 117 | =head3 pull 118 | 119 | subrepo pull [options] [] 120 | 121 | Update the subrepo subdir with the latest upstream changes. 122 | 123 | 124 | Options: 125 | 126 | --all All subrepos (flag) 127 | --branch -b Upstream branch 128 | --remote -r Specify remote repository 129 | --update -u update 130 | 131 | Parameters: 132 | 133 | subrepo Subrepo 134 | 135 | =head3 push 136 | 137 | subrepo push [options] [] 138 | 139 | Push a properly merged subrepo branch back upstream. 140 | 141 | 142 | Options: 143 | 144 | --all All subrepos (flag) 145 | --branch -b Upstream branch 146 | --remote -r Specify remote repository 147 | --update -u update 148 | 149 | Parameters: 150 | 151 | subrepo Subrepo 152 | 153 | =head3 status 154 | 155 | subrepo status [options] [] 156 | 157 | Get the status of a subrepo. 158 | 159 | 160 | Options: 161 | 162 | --quiet -q Just print names 163 | 164 | Parameters: 165 | 166 | subrepo Subrepo 167 | 168 | =head3 version 169 | 170 | subrepo version 171 | 172 | display version information about git-subrepo 173 | 174 | 175 | 176 | =head3 help 177 | 178 | subrepo help 179 | 180 | Same as C 181 | 182 | 183 | 184 | 185 | 186 | -------------------------------------------------------------------------------- /examples/subrepo-spec.yaml: -------------------------------------------------------------------------------- 1 | name: subrepo 2 | appspec: { "version": 0.001 } 3 | title: Git Submodule Alternative 4 | plugins: [ -Meta ] 5 | markup: swim 6 | description: | 7 | This is just an example for generating completion for an existing 8 | command, https://github.com/ingydotnet/git-subrepo 9 | 10 | This git command "clones" an external git repo into a subdirectory of your 11 | repo. Later on, upstream changes can be pulled in, and local changes can be 12 | pushed back. Simple. 13 | 14 | = Benefits 15 | 16 | This command is an improvement from `git-submodule` and `git-subtree`; two 17 | other git commands with similar goals, but various problems. 18 | 19 | options: [] 20 | subcommands: 21 | clone: 22 | summary: Add a repository as a subrepo in a subdir of your repository. 23 | parameters: 24 | - 25 | name: repository 26 | type: string 27 | required: true 28 | - 29 | name: subdir 30 | type: file 31 | options: 32 | - &option_branch 33 | name: branch 34 | summary: Upstream branch 35 | aliases: ["b"] 36 | - 37 | name: force 38 | aliases: ["f"] 39 | summary: 'reclone (completely replace) an existing subdir.' 40 | type: flag 41 | init: 42 | summary: Turn an existing subdirectory into a subrepo. 43 | parameters: 44 | - 45 | name: subdir 46 | required: true 47 | type: file 48 | options: 49 | - &option_remote 50 | name: remote 51 | aliases: ["r"] 52 | summary: Specify remote repository 53 | - *option_branch 54 | pull: 55 | summary: Update the subrepo subdir with the latest upstream changes. 56 | parameters: &pull_parameters 57 | - ¶m_subrepo_optional 58 | name: subrepo 59 | required: false 60 | summary: Subrepo 61 | completion: 62 | command: 63 | - replace: SELF 64 | - status 65 | - '--quiet' 66 | options: &pull_options 67 | - &option_all 68 | name: all 69 | type: flag 70 | summary: All subrepos 71 | - *option_branch 72 | - *option_remote 73 | - 74 | name: update 75 | aliases: ["u"] 76 | summary: update 77 | push: 78 | summary: Push a properly merged subrepo branch back upstream. 79 | parameters: *pull_parameters 80 | options: *pull_options 81 | fetch: 82 | summary: Fetch the remote/upstream content for a subrepo. 83 | parameters: 84 | - *param_subrepo_optional 85 | options: 86 | - *option_all 87 | branch: 88 | summary: Create a branch with local subrepo commits since last pull. 89 | parameters: 90 | - *param_subrepo_optional 91 | options: 92 | - *option_all 93 | commit: 94 | summary: Add subrepo branch to current history as a single commit. 95 | parameters: 96 | - ¶m_subrepo 97 | name: subrepo 98 | required: true 99 | summary: Subrepo 100 | completion: 101 | command: 102 | - replace: SELF 103 | - status 104 | - '--quiet' 105 | - 106 | name: subreporef 107 | summary: Subrepo ref 108 | status: 109 | summary: Get the status of a subrepo. 110 | parameters: 111 | - *param_subrepo_optional 112 | options: 113 | - 114 | name: quiet 115 | aliases: ["q"] 116 | summary: Just print names 117 | clean: 118 | summary: 'Remove artifacts created by `fetch` and `branch` commands.' 119 | parameters: 120 | - *param_subrepo_optional 121 | options: 122 | - *option_all 123 | help: 124 | summary: 'Same as `git help subrepo`' 125 | version: 126 | summary: 'display version information about git-subrepo' 127 | # vim:et:sts=2:sws=2:sw=2:foldmethod=indent 128 | -------------------------------------------------------------------------------- /examples/zsh/_mysimpleapp: -------------------------------------------------------------------------------- 1 | #compdef mysimpleapp 2 | 3 | # Generated with perl module App::Spec v0.000 4 | 5 | _mysimpleapp() { 6 | local program=mysimpleapp 7 | typeset -A opt_args 8 | local curcontext="$curcontext" state line context 9 | 10 | 11 | # ---- Command: 12 | _arguments -s \ 13 | '1: :->foo' \ 14 | '2: :->bar' \ 15 | '*--verbose[be verbose]' \ 16 | '*-v[be verbose]' \ 17 | '--wc[word count]' \ 18 | '--lc[line count]' \ 19 | '--with[with ...]:with:("ab" "cd" "ef")' \ 20 | '--file1[existing file]:file1:_files' \ 21 | '--file2[possible file]:file2:_files' \ 22 | '--dir1[existing dir]:dir1:_path_files -/' \ 23 | '--dir2[possible dir]:dir2:_path_files -/' \ 24 | '--longoption[some long option description split over several lines to demonstrate ]' \ 25 | '--longoption2[some other long option description split over several lines to demonstrate ]:longoption2' \ 26 | '--help[Show command help]' \ 27 | '-h[Show command help]' \ 28 | && ret=0 29 | 30 | case $state in 31 | foo) 32 | compadd -X 'foo:' 'dist.ini' 'Makefile.PL' 'Changes' 33 | ;; 34 | bar) 35 | compadd -X 'bar:' 'a' 'b' 'c' 36 | ;; 37 | esac 38 | 39 | 40 | } 41 | 42 | 43 | __mysimpleapp_dynamic_comp() { 44 | local argname="$1" 45 | local arg="$2" 46 | local comp="arg:$argname:((" 47 | local line 48 | while read -r line; do 49 | local name="$line" 50 | local desc="$line" 51 | name="${name%$'\t'*}" 52 | desc="${desc/*$'\t'}" 53 | comp="$comp$name" 54 | if [[ -n "$desc" && "$name" != "$desc" ]]; then 55 | comp="$comp\\:"'"'"$desc"'"' 56 | fi 57 | comp="$comp " 58 | done <<< "$arg" 59 | 60 | comp="$comp))" 61 | _alternative "$comp" 62 | } 63 | 64 | -------------------------------------------------------------------------------- /examples/zsh/_nometa: -------------------------------------------------------------------------------- 1 | #compdef nometa 2 | 3 | # Generated with perl module App::Spec v0.000 4 | 5 | _nometa() { 6 | local program=nometa 7 | typeset -A opt_args 8 | local curcontext="$curcontext" state line context 9 | 10 | 11 | # ---- Command: 12 | _arguments -s \ 13 | '1: :->cmd1' \ 14 | '*: :->args' \ 15 | && ret=0 16 | 17 | 18 | case $state in 19 | cmd1) 20 | _alternative 'args:cmd2:((foo\:"Test command" help\:"Show command help" longsubcommand\:"A subcommand with a very long summary split over multiple lines "))' 21 | ;; 22 | 23 | args) 24 | case $line[1] in 25 | foo) 26 | 27 | # ---- Command: foo 28 | _arguments -s -C \ 29 | '1: :->cmd1' \ 30 | '2: :->test' \ 31 | '--help[Show command help]' \ 32 | '-h[Show command help]' \ 33 | && ret=0 34 | 35 | case $state in 36 | test) 37 | compadd -X 'test:' 'a' 'b' 'c' 38 | ;; 39 | esac 40 | 41 | ;; 42 | help) 43 | 44 | # ---- Command: help 45 | _arguments -s -C \ 46 | '1: :->cmd1' \ 47 | '2: :->cmd2' \ 48 | '*: :->args' \ 49 | && ret=0 50 | 51 | 52 | case $state in 53 | cmd2) 54 | _alternative 'args:cmd3:((foo longsubcommand))' 55 | ;; 56 | 57 | args) 58 | case $line[2] in 59 | foo) 60 | 61 | # ---- Command: help foo 62 | _arguments -s -C \ 63 | '1: :->cmd1' \ 64 | '2: :->cmd2' \ 65 | '--help[Show command help]' \ 66 | '-h[Show command help]' \ 67 | '--all[]' \ 68 | && ret=0 69 | 70 | 71 | ;; 72 | longsubcommand) 73 | 74 | # ---- Command: help longsubcommand 75 | _arguments -s -C \ 76 | '1: :->cmd1' \ 77 | '2: :->cmd2' \ 78 | '--help[Show command help]' \ 79 | '-h[Show command help]' \ 80 | '--all[]' \ 81 | && ret=0 82 | 83 | 84 | ;; 85 | esac 86 | 87 | ;; 88 | 89 | esac 90 | ;; 91 | longsubcommand) 92 | 93 | # ---- Command: longsubcommand 94 | _arguments -s -C \ 95 | '1: :->cmd1' \ 96 | '2: :->longparam' \ 97 | '--help[Show command help]' \ 98 | '-h[Show command help]' \ 99 | && ret=0 100 | 101 | case $state in 102 | longparam) 103 | 104 | ;; 105 | esac 106 | 107 | ;; 108 | esac 109 | 110 | ;; 111 | 112 | esac 113 | 114 | } 115 | 116 | 117 | __nometa_dynamic_comp() { 118 | local argname="$1" 119 | local arg="$2" 120 | local comp="arg:$argname:((" 121 | local line 122 | while read -r line; do 123 | local name="$line" 124 | local desc="$line" 125 | name="${name%$'\t'*}" 126 | desc="${desc/*$'\t'}" 127 | comp="$comp$name" 128 | if [[ -n "$desc" && "$name" != "$desc" ]]; then 129 | comp="$comp\\:"'"'"$desc"'"' 130 | fi 131 | comp="$comp " 132 | done <<< "$arg" 133 | 134 | comp="$comp))" 135 | _alternative "$comp" 136 | } 137 | 138 | -------------------------------------------------------------------------------- /examples/zsh/_subrepo: -------------------------------------------------------------------------------- 1 | #compdef subrepo 2 | 3 | # Generated with perl module App::Spec v0.000 4 | 5 | _subrepo() { 6 | local program=subrepo 7 | typeset -A opt_args 8 | local curcontext="$curcontext" state line context 9 | 10 | 11 | # ---- Command: 12 | _arguments -s \ 13 | '1: :->cmd1' \ 14 | '*: :->args' \ 15 | && ret=0 16 | 17 | 18 | case $state in 19 | cmd1) 20 | _alternative 'args:cmd2:((branch\:"Create a branch with local subrepo commits since last pull." clean\:"Remove artifacts created by '"'"'fetch'"'"' and '"'"'branch'"'"' commands." clone\:"Add a repository as a subrepo in a subdir of your repository." commit\:"Add subrepo branch to current history as a single commit." fetch\:"Fetch the remote/upstream content for a subrepo." help\:"Same as '"'"'git help subrepo'"'"'" init\:"Turn an existing subdirectory into a subrepo." pull\:"Update the subrepo subdir with the latest upstream changes." push\:"Push a properly merged subrepo branch back upstream." status\:"Get the status of a subrepo." version\:"display version information about git-subrepo"))' 21 | ;; 22 | 23 | args) 24 | case $line[1] in 25 | branch) 26 | 27 | # ---- Command: branch 28 | _arguments -s -C \ 29 | '1: :->cmd1' \ 30 | '2: :->subrepo' \ 31 | '--help[Show command help]' \ 32 | '-h[Show command help]' \ 33 | '--all[All subrepos]' \ 34 | && ret=0 35 | 36 | case $state in 37 | subrepo) 38 | _subrepo_branch_param_subrepo_completion 39 | ;; 40 | esac 41 | 42 | ;; 43 | clean) 44 | 45 | # ---- Command: clean 46 | _arguments -s -C \ 47 | '1: :->cmd1' \ 48 | '2: :->subrepo' \ 49 | '--help[Show command help]' \ 50 | '-h[Show command help]' \ 51 | '--all[All subrepos]' \ 52 | && ret=0 53 | 54 | case $state in 55 | subrepo) 56 | _subrepo_clean_param_subrepo_completion 57 | ;; 58 | esac 59 | 60 | ;; 61 | clone) 62 | 63 | # ---- Command: clone 64 | _arguments -s -C \ 65 | '1: :->cmd1' \ 66 | '2: :->repository' \ 67 | '3: :->subdir' \ 68 | '--help[Show command help]' \ 69 | '-h[Show command help]' \ 70 | '--branch[Upstream branch]:branch' \ 71 | '-b[Upstream branch]:branch' \ 72 | '--force[reclone (completely replace) an existing subdir.]' \ 73 | '-f[reclone (completely replace) an existing subdir.]' \ 74 | && ret=0 75 | 76 | case $state in 77 | repository) 78 | 79 | ;; 80 | subdir) 81 | _files 82 | ;; 83 | esac 84 | 85 | ;; 86 | commit) 87 | 88 | # ---- Command: commit 89 | _arguments -s -C \ 90 | '1: :->cmd1' \ 91 | '2: :->subrepo' \ 92 | '3: :->subreporef' \ 93 | '--help[Show command help]' \ 94 | '-h[Show command help]' \ 95 | && ret=0 96 | 97 | case $state in 98 | subrepo) 99 | _subrepo_commit_param_subrepo_completion 100 | ;; 101 | subreporef) 102 | 103 | ;; 104 | esac 105 | 106 | ;; 107 | fetch) 108 | 109 | # ---- Command: fetch 110 | _arguments -s -C \ 111 | '1: :->cmd1' \ 112 | '2: :->subrepo' \ 113 | '--help[Show command help]' \ 114 | '-h[Show command help]' \ 115 | '--all[All subrepos]' \ 116 | && ret=0 117 | 118 | case $state in 119 | subrepo) 120 | _subrepo_fetch_param_subrepo_completion 121 | ;; 122 | esac 123 | 124 | ;; 125 | help) 126 | 127 | # ---- Command: help 128 | _arguments -s -C \ 129 | '1: :->cmd1' \ 130 | '--help[Show command help]' \ 131 | '-h[Show command help]' \ 132 | && ret=0 133 | 134 | 135 | ;; 136 | init) 137 | 138 | # ---- Command: init 139 | _arguments -s -C \ 140 | '1: :->cmd1' \ 141 | '2: :->subdir' \ 142 | '--help[Show command help]' \ 143 | '-h[Show command help]' \ 144 | '--remote[Specify remote repository]:remote' \ 145 | '-r[Specify remote repository]:remote' \ 146 | '--branch[Upstream branch]:branch' \ 147 | '-b[Upstream branch]:branch' \ 148 | && ret=0 149 | 150 | case $state in 151 | subdir) 152 | _files 153 | ;; 154 | esac 155 | 156 | ;; 157 | pull) 158 | 159 | # ---- Command: pull 160 | _arguments -s -C \ 161 | '1: :->cmd1' \ 162 | '2: :->subrepo' \ 163 | '--help[Show command help]' \ 164 | '-h[Show command help]' \ 165 | '--all[All subrepos]' \ 166 | '--branch[Upstream branch]:branch' \ 167 | '-b[Upstream branch]:branch' \ 168 | '--remote[Specify remote repository]:remote' \ 169 | '-r[Specify remote repository]:remote' \ 170 | '--update[update]:update' \ 171 | '-u[update]:update' \ 172 | && ret=0 173 | 174 | case $state in 175 | subrepo) 176 | _subrepo_pull_param_subrepo_completion 177 | ;; 178 | esac 179 | 180 | ;; 181 | push) 182 | 183 | # ---- Command: push 184 | _arguments -s -C \ 185 | '1: :->cmd1' \ 186 | '2: :->subrepo' \ 187 | '--help[Show command help]' \ 188 | '-h[Show command help]' \ 189 | '--all[All subrepos]' \ 190 | '--branch[Upstream branch]:branch' \ 191 | '-b[Upstream branch]:branch' \ 192 | '--remote[Specify remote repository]:remote' \ 193 | '-r[Specify remote repository]:remote' \ 194 | '--update[update]:update' \ 195 | '-u[update]:update' \ 196 | && ret=0 197 | 198 | case $state in 199 | subrepo) 200 | _subrepo_push_param_subrepo_completion 201 | ;; 202 | esac 203 | 204 | ;; 205 | status) 206 | 207 | # ---- Command: status 208 | _arguments -s -C \ 209 | '1: :->cmd1' \ 210 | '2: :->subrepo' \ 211 | '--help[Show command help]' \ 212 | '-h[Show command help]' \ 213 | '--quiet[Just print names]:quiet' \ 214 | '-q[Just print names]:quiet' \ 215 | && ret=0 216 | 217 | case $state in 218 | subrepo) 219 | _subrepo_status_param_subrepo_completion 220 | ;; 221 | esac 222 | 223 | ;; 224 | version) 225 | 226 | # ---- Command: version 227 | _arguments -s -C \ 228 | '1: :->cmd1' \ 229 | '--help[Show command help]' \ 230 | '-h[Show command help]' \ 231 | && ret=0 232 | 233 | 234 | ;; 235 | esac 236 | 237 | ;; 238 | 239 | esac 240 | 241 | } 242 | 243 | _subrepo_branch_param_subrepo_completion() { 244 | local __dynamic_completion 245 | local CURRENT_WORD="$words[CURRENT]" 246 | IFS=$'\n' __dynamic_completion=( $( $program 'status' '--quiet' ) ) 247 | compadd -X "subrepo:" $__dynamic_completion 248 | } 249 | _subrepo_clean_param_subrepo_completion() { 250 | local __dynamic_completion 251 | local CURRENT_WORD="$words[CURRENT]" 252 | IFS=$'\n' __dynamic_completion=( $( $program 'status' '--quiet' ) ) 253 | compadd -X "subrepo:" $__dynamic_completion 254 | } 255 | _subrepo_commit_param_subrepo_completion() { 256 | local __dynamic_completion 257 | local CURRENT_WORD="$words[CURRENT]" 258 | IFS=$'\n' __dynamic_completion=( $( $program 'status' '--quiet' ) ) 259 | compadd -X "subrepo:" $__dynamic_completion 260 | } 261 | _subrepo_fetch_param_subrepo_completion() { 262 | local __dynamic_completion 263 | local CURRENT_WORD="$words[CURRENT]" 264 | IFS=$'\n' __dynamic_completion=( $( $program 'status' '--quiet' ) ) 265 | compadd -X "subrepo:" $__dynamic_completion 266 | } 267 | _subrepo_pull_param_subrepo_completion() { 268 | local __dynamic_completion 269 | local CURRENT_WORD="$words[CURRENT]" 270 | IFS=$'\n' __dynamic_completion=( $( $program 'status' '--quiet' ) ) 271 | compadd -X "subrepo:" $__dynamic_completion 272 | } 273 | _subrepo_push_param_subrepo_completion() { 274 | local __dynamic_completion 275 | local CURRENT_WORD="$words[CURRENT]" 276 | IFS=$'\n' __dynamic_completion=( $( $program 'status' '--quiet' ) ) 277 | compadd -X "subrepo:" $__dynamic_completion 278 | } 279 | _subrepo_status_param_subrepo_completion() { 280 | local __dynamic_completion 281 | local CURRENT_WORD="$words[CURRENT]" 282 | IFS=$'\n' __dynamic_completion=( $( $program 'status' '--quiet' ) ) 283 | compadd -X "subrepo:" $__dynamic_completion 284 | } 285 | 286 | __subrepo_dynamic_comp() { 287 | local argname="$1" 288 | local arg="$2" 289 | local comp="arg:$argname:((" 290 | local line 291 | while read -r line; do 292 | local name="$line" 293 | local desc="$line" 294 | name="${name%$'\t'*}" 295 | desc="${desc/*$'\t'}" 296 | comp="$comp$name" 297 | if [[ -n "$desc" && "$name" != "$desc" ]]; then 298 | comp="$comp\\:"'"'"$desc"'"' 299 | fi 300 | comp="$comp " 301 | done <<< "$arg" 302 | 303 | comp="$comp))" 304 | _alternative "$comp" 305 | } 306 | 307 | -------------------------------------------------------------------------------- /lib/App/Spec.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: Specification for commandline app 2 | use strict; 3 | use warnings; 4 | package App::Spec; 5 | use 5.010; 6 | 7 | our $VERSION = '0.000'; # VERSION 8 | 9 | use App::Spec::Subcommand; 10 | use App::Spec::Option; 11 | use App::Spec::Parameter; 12 | 13 | use Moo; 14 | 15 | with('App::Spec::Role::Command'); 16 | 17 | has title => ( is => 'rw' ); 18 | has abstract => ( is => 'rw' ); 19 | 20 | 21 | 22 | 23 | sub runner { 24 | my ($self, %args) = @_; 25 | my $class = $self->class; 26 | my $cmd = $class->new; 27 | my $run = App::Spec::Run->new({ 28 | spec => $self, 29 | cmd => $cmd, 30 | %args, 31 | }); 32 | return $run; 33 | } 34 | 35 | sub usage { 36 | my ($self, %args) = @_; 37 | my $cmds = $args{commands}; 38 | my %highlights = %{ $args{highlights} || {} }; 39 | my $colored = $args{colored} || sub { $_[1] }; 40 | my $appname = $self->name; 41 | 42 | my $abstract = $self->abstract // ''; 43 | my $title = $self->title; 44 | my ($options, $parameters, $subcmds) = $self->_gather_options_parameters($cmds); 45 | my $header = $colored->(['bold'], "$appname - $title"); 46 | my $usage = <<"EOM"; 47 | $header 48 | $abstract 49 | 50 | EOM 51 | 52 | my $body = ''; 53 | my $usage_header = $colored->([qw/ bold /], "Usage:"); 54 | $usage .= "$usage_header $appname"; 55 | $usage .= " @$cmds" if @$cmds; 56 | if (keys %$subcmds) { 57 | my $maxlength = 0; 58 | my @table; 59 | my $usage_string = ""; 60 | my $header = "Subcommands:"; 61 | if ($highlights{subcommands}) { 62 | $colored->([qw/ bold red /], $usage_string); 63 | $colored->([qw/ bold red /], $header); 64 | } 65 | else { 66 | $colored->([qw/ bold /], $header); 67 | } 68 | $usage .= " $usage_string"; 69 | $body .= "$header\n"; 70 | 71 | my %keys; 72 | @keys{ keys %$subcmds } = (); 73 | my @keys; 74 | if (@$cmds) { 75 | @keys = sort keys %keys; 76 | } 77 | else { 78 | for my $key (qw/ help _meta /) { 79 | if (exists $keys{ $key }) { 80 | push @keys, $key; 81 | delete $keys{ $key }; 82 | } 83 | } 84 | unshift @keys, sort keys %keys; 85 | } 86 | for my $name (@keys) { 87 | my $cmd_spec = $subcmds->{ $name }; 88 | my $summary = $cmd_spec->summary; 89 | my @lines = split m/\n/, $summary; 90 | push @table, [$name, $lines[0] // '']; 91 | push @table, ['', $_] for map { s/^ +//; $_ } @lines[1 .. $#lines]; 92 | if (length $name > $maxlength) { 93 | $maxlength = length $name; 94 | } 95 | } 96 | $body .= $self->_output_table(\@table, [$maxlength]); 97 | } 98 | 99 | if (@$parameters) { 100 | my $maxlength = 0; 101 | my @table; 102 | my @highlights; 103 | for my $param (@$parameters) { 104 | my $name = $param->name; 105 | my $highlight = $highlights{parameters}->{ $name }; 106 | push @highlights, $highlight ? 1 : 0; 107 | my $summary = $param->summary; 108 | my $param_usage_header = $param->to_usage_header; 109 | if ($highlight) { 110 | $colored->([qw/ bold red /], $param_usage_header); 111 | } 112 | $usage .= " " . $param_usage_header; 113 | my ($req, $multi) = (' ', ' '); 114 | if ($param->required) { 115 | $req = "*"; 116 | } 117 | if ($param->mapping) { 118 | $multi = '{}'; 119 | } 120 | elsif ($param->multiple) { 121 | $multi = '[]'; 122 | } 123 | 124 | my $flags = $self->_param_flags_string($param); 125 | 126 | my @lines = split m/\n/, $summary; 127 | push @table, [$name, $req, $multi, ($lines[0] // '') . $flags]; 128 | push @table, ['', ' ', ' ', $_] for map { s/^ +//; $_ } @lines[1 .. $#lines]; 129 | if (length $name > $maxlength) { 130 | $maxlength = length $name; 131 | } 132 | } 133 | my $parameters_string = $colored->([qw/ bold /], "Parameters:"); 134 | $body .= "$parameters_string\n"; 135 | my @lines = $self->_output_table(\@table, [$maxlength]); 136 | my $lines = $self->_colorize_lines(\@lines, \@highlights, $colored); 137 | $body .= $lines; 138 | } 139 | 140 | if (@$options) { 141 | my @highlights; 142 | $usage .= " [options]"; 143 | my $maxlength = 0; 144 | my @table; 145 | for my $opt (sort { $a->name cmp $b->name } @$options) { 146 | my $name = $opt->name; 147 | my $highlight = $highlights{options}->{ $name }; 148 | push @highlights, $highlight ? 1 : 0; 149 | my $aliases = $opt->aliases; 150 | my $summary = $opt->summary; 151 | my @names = map { 152 | length $_ > 1 ? "--$_" : "-$_" 153 | } ($name, @$aliases); 154 | my $string = "@names"; 155 | if (length $string > $maxlength) { 156 | $maxlength = length $string; 157 | } 158 | my ($req, $multi) = (' ', ' '); 159 | if ($opt->required) { 160 | $req = "*"; 161 | } 162 | if ($opt->mapping) { 163 | $multi = '{}'; 164 | } 165 | elsif ($opt->multiple) { 166 | $multi = '[]'; 167 | } 168 | 169 | my $flags = $self->_param_flags_string($opt); 170 | 171 | my @lines = split m/\n/, $summary; 172 | push @table, [$string, $req, $multi, ($lines[0] // '') . $flags]; 173 | push @table, ['', ' ', ' ', $_ ] for map { s/^ +//; $_ } @lines[1 .. $#lines]; 174 | } 175 | my $options_string = $colored->([qw/ bold /], "Options:"); 176 | $body .= "\n$options_string\n"; 177 | my @lines = $self->_output_table(\@table, [$maxlength]); 178 | my $lines = $self->_colorize_lines(\@lines, \@highlights, $colored); 179 | $body .= $lines; 180 | } 181 | 182 | return "$usage\n\n$body"; 183 | } 184 | 185 | sub _param_flags_string { 186 | my ($self, $param) = @_; 187 | my @flags; 188 | if ($param->type eq 'flag') { 189 | push @flags, "flag"; 190 | } 191 | if ($param->multiple) { 192 | push @flags, "multiple"; 193 | } 194 | if ($param->mapping) { 195 | push @flags, "mapping"; 196 | } 197 | my $flags = @flags ? " (" . join("; ", @flags) . ")" : ''; 198 | return $flags; 199 | } 200 | 201 | sub _colorize_lines { 202 | my ($self, $lines, $highlights, $colored) = @_; 203 | my $output = ''; 204 | for my $i (0 .. $#$lines) { 205 | my $line = $lines->[ $i ]; 206 | if ($highlights->[ $i ]) { 207 | $colored->([qw/ bold red /], $line); 208 | } 209 | $output .= $line; 210 | } 211 | return $output; 212 | } 213 | 214 | sub _output_table { 215 | my ($self, $table, $lengths) = @_; 216 | my @lines; 217 | my @lengths = map { 218 | defined $lengths->[$_] ? "%-$lengths->[$_]s" : "%s" 219 | } 0 .. @{ $table->[0] } - 1; 220 | for my $row (@$table) { 221 | no warnings 'uninitialized'; 222 | push @lines, sprintf join(' ', @lengths) . "\n", @$row; 223 | } 224 | return wantarray ? @lines : join '', @lines; 225 | } 226 | 227 | 228 | sub _gather_options_parameters { 229 | my ($self, $cmds) = @_; 230 | my @options; 231 | my @parameters; 232 | my $global_options = $self->options; 233 | my $commands = $self->subcommands; 234 | push @options, @$global_options; 235 | 236 | for my $cmd (@$cmds) { 237 | my $cmd_spec = $commands->{ $cmd }; 238 | my $options = $cmd_spec->options || []; 239 | my $parameters = $cmd_spec->parameters || []; 240 | push @options, @$options; 241 | push @parameters, @$parameters; 242 | 243 | $commands = $cmd_spec->subcommands || {}; 244 | 245 | } 246 | return \@options, \@parameters, $commands; 247 | } 248 | 249 | sub generate_completion { 250 | my ($self, %args) = @_; 251 | my $shell = delete $args{shell}; 252 | 253 | if ($shell eq "zsh") { 254 | require App::Spec::Completion::Zsh; 255 | my $completer = App::Spec::Completion::Zsh->new( 256 | spec => $self, 257 | ); 258 | return $completer->generate_completion(%args); 259 | } 260 | elsif ($shell eq "bash") { 261 | require App::Spec::Completion::Bash; 262 | my $completer = App::Spec::Completion::Bash->new( 263 | spec => $self, 264 | ); 265 | return $completer->generate_completion(%args); 266 | } 267 | } 268 | 269 | 270 | sub make_getopt { 271 | my ($self, $options, $result, $specs) = @_; 272 | my @getopt; 273 | for my $opt (@$options) { 274 | my $name = $opt->name; 275 | my $spec = $name; 276 | if (my $aliases = $opt->aliases) { 277 | $spec .= "|$_" for @$aliases; 278 | } 279 | unless ($opt->type eq 'flag') { 280 | $spec .= "=s"; 281 | } 282 | $specs->{ $name } = $opt; 283 | if ($opt->multiple) { 284 | if ($opt->type eq 'flag') { 285 | $spec .= '+'; 286 | } 287 | elsif ($opt->mapping) { 288 | $result->{ $name } = {}; 289 | $spec .= '%'; 290 | } 291 | else { 292 | $result->{ $name } = []; 293 | $spec .= '@'; 294 | } 295 | } 296 | push @getopt, $spec, \$result->{ $name }, 297 | } 298 | return @getopt; 299 | } 300 | 301 | =pod 302 | 303 | =head1 NAME 304 | 305 | App::Spec - Specification for commandline apps 306 | 307 | =head1 SYNOPSIS 308 | 309 | WARNING: This is still experimental. The spec is subject to change. 310 | 311 | This module represents a specification of a command line tool. 312 | Currently it can read the spec from a YAML file or directly from a data 313 | structure in perl. 314 | 315 | It uses the role L. 316 | 317 | The L module is the framework which will run the actual 318 | app. 319 | 320 | Have a look at the L for how to write an app. 321 | 322 | In the examples directory you will find the app C which is supposed 323 | to demonstrate everything that App::Spec supports right now. 324 | 325 | Your script: 326 | 327 | use App::Spec; 328 | my $spec = App::Spec->read("/path/to/myapp-spec.yaml"); 329 | 330 | my $run = $spec->runner; 331 | $run->run; 332 | 333 | # this is equivalent to 334 | #my $run = App::Spec::Run->new( 335 | # spec => $spec, 336 | # cmd => Your::App->new, 337 | #); 338 | #$run->run; 339 | 340 | Your App class: 341 | 342 | package Your::App; 343 | use base 'App::Spec::Run::Cmd'; 344 | 345 | sub command1 { 346 | my ($self, $run) = @_; 347 | my $options = $run->options; 348 | my $param = $run->parameters; 349 | # Do something 350 | $run->out("Hello world!"); 351 | $run->err("oops"); 352 | # you can also use print directly 353 | } 354 | 355 | 356 | =head1 METHODS 357 | 358 | =over 4 359 | 360 | =item read 361 | 362 | my $spec = App::Spec->read("/path/to/myapp-spec.yaml"); 363 | 364 | =item load_data 365 | 366 | Takes a file, hashref or glob and returns generated appspec hashref 367 | 368 | my $hash = $class->load_data($file); 369 | 370 | =item build 371 | 372 | Builds objects out of the hashref 373 | 374 | my $appspec = App::Spec->build(%hash); 375 | 376 | =item runner 377 | 378 | Returns an instance of the your app class 379 | 380 | my $run = $spec->runner; 381 | $run->run; 382 | 383 | # this is equivalent to 384 | my $run = App::Spec::Example::MyApp->new({ 385 | spec => $spec, 386 | }); 387 | $run->run; 388 | 389 | =item usage 390 | 391 | Returns usage output for the specified subcommands: 392 | 393 | my $usage = $spec->usage( 394 | commands => ["subcommand1","subcommand2"], 395 | ); 396 | 397 | =item generate_completion 398 | 399 | Generates shell completion script for the spec. 400 | 401 | my $completion = $spec->generate_completion( 402 | shell => "zsh", 403 | ); 404 | 405 | =item make_getopt 406 | 407 | Returns options for Getopt::Long 408 | 409 | my @getopt = $spec->make_getopt($global_options, \%options, $option_specs); 410 | 411 | =item abstract, appspec, class, description, has_subcommands, markup, name, options, parameters, subcommands, title 412 | 413 | Accessors for the things defined in the spec (file) 414 | 415 | =back 416 | 417 | =head1 SEE ALSO 418 | 419 | L - Utilities for App::Spec authors 420 | 421 | =head1 LICENSE 422 | 423 | This library is free software and may be distributed under the same terms 424 | as perl itself. 425 | 426 | =cut 427 | 428 | 1; 429 | 430 | -------------------------------------------------------------------------------- /lib/App/Spec/Argument.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: App::Spec objects representing command line options or parameters 2 | use strict; 3 | use warnings; 4 | package App::Spec::Argument; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use Moo; 9 | 10 | has name => ( is => 'ro' ); 11 | has type => ( is => 'ro' ); 12 | has multiple => ( is => 'ro' ); 13 | has mapping => ( is => 'ro' ); 14 | has required => ( is => 'ro' ); 15 | has unique => ( is => 'ro' ); 16 | has summary => ( is => 'ro' ); 17 | has description => ( is => 'ro' ); 18 | has default => ( is => 'ro' ); 19 | has completion => ( is => 'ro' ); 20 | has enum => ( is => 'ro' ); 21 | has values => ( is => 'ro' ); 22 | 23 | sub common { 24 | my ($class, %args) = @_; 25 | my %dsl; 26 | if (defined $args{spec}) { 27 | %dsl = $class->from_dsl(delete $args{spec}); 28 | } 29 | my $description = $args{description}; 30 | my $summary = $args{summary}; 31 | $summary //= ''; 32 | $description //= ''; 33 | my $type = $args{type} // 'string'; 34 | my %hash = ( 35 | name => $args{name}, 36 | summary => $summary, 37 | description => $description, 38 | type => $type, 39 | multiple => $args{multiple} ? 1 : 0, 40 | mapping => $args{mapping} ? 1 : 0, 41 | required => $args{required} ? 1 : 0, 42 | unique => $args{unique} ? 1 : 0, 43 | default => $args{default}, 44 | completion => $args{completion}, 45 | enum => $args{enum}, 46 | values => $args{values}, 47 | %dsl, 48 | ); 49 | not defined $hash{ $_ } and delete $hash{ $_ } for keys %hash; 50 | return %hash; 51 | } 52 | 53 | my $name_re = qr{[\w-]+}; 54 | 55 | sub from_dsl { 56 | my ($class, $dsl) = @_; 57 | my %hash; 58 | 59 | my $name; 60 | my $type = "flag"; 61 | my $multiple; 62 | $dsl =~ s/^\s+//; 63 | 64 | if ($dsl =~ s/^\+//) { 65 | my $required = 1; 66 | $hash{required} = $required; 67 | } 68 | 69 | if ($dsl =~ s/^ ($name_re) //x) { 70 | $name = $1; 71 | $hash{name} = $name; 72 | } 73 | else { 74 | die "invalid spec: '$dsl'"; 75 | } 76 | 77 | my @aliases; 78 | while ($dsl =~ s/^ \| (\w) //x) { 79 | push @aliases, $1; 80 | } 81 | if (@aliases) { 82 | $hash{aliases} = \@aliases; 83 | } 84 | 85 | my $getopt_type = ''; 86 | if ($dsl =~ s/^=//) { 87 | # not a flag, default string 88 | $type = "string"; 89 | if ($dsl =~ s/^([isf])//) { 90 | $getopt_type = $1; 91 | if ($getopt_type eq "i") { 92 | $type = "integer"; 93 | } 94 | elsif ($getopt_type eq "f") { 95 | $type = "float"; 96 | } 97 | elsif ($getopt_type eq "s") { 98 | } 99 | else { 100 | die "Option $name: type $getopt_type not supported"; 101 | } 102 | } 103 | } 104 | 105 | if ($type eq 'flag' and $dsl =~ s/^\+//) { 106 | # incremental flag 107 | $multiple = 1; 108 | $hash{multiple} = 1; 109 | } 110 | elsif ($type eq 'string' and $dsl =~ s/^\@//) { 111 | $hash{multiple} = 1; 112 | } 113 | elsif ($type eq 'string' and $dsl =~ s/^\%//) { 114 | $hash{multiple} = 1; 115 | $hash{mapping} = 1; 116 | } 117 | 118 | $dsl =~ s/^\s+//; 119 | 120 | while ($dsl =~ s/^\s*([=+])(\S+)//) { 121 | if ($1 eq '+') { 122 | $type = $2; 123 | if ($getopt_type and $type ne $getopt_type) { 124 | die "Explicit type '$type' conflicts with getopt type '$getopt_type'"; 125 | } 126 | } 127 | else { 128 | $hash{default} = $2; 129 | } 130 | } 131 | 132 | if ($dsl =~ s/^\s*--\s*(.*)//s) { 133 | # TODO only summary should be supported 134 | $hash{summary} = $1; 135 | } 136 | 137 | if (length $dsl) { 138 | die "Invalid spec: trailing '$dsl'"; 139 | } 140 | 141 | $hash{type} = $type; 142 | return %hash; 143 | } 144 | 145 | 1; 146 | 147 | =pod 148 | 149 | =head1 NAME 150 | 151 | App::Spec::Argument - App::Spec objects representing command line options or parameters 152 | 153 | =head1 SYNOPSIS 154 | 155 | =head1 EXAMPLES 156 | 157 | Options can be defined in a verbose way via key value pairs, but you can also 158 | use a shorter syntax. 159 | 160 | The idea comes from Ingy's L. 161 | 162 | The first item of the string is the name of the option using a syntax 163 | very similar to the one from L. 164 | 165 | Then you can optionally define a type, a default value and a summary. 166 | 167 | You can see a list of supported syntax in this example from C: 168 | 169 | =for comment 170 | START INLINE t/data/12.dsl.yaml 171 | 172 | --- 173 | # version with short dsl syntax 174 | name: myapp 175 | appspec: { version: 0.001 } 176 | class: App::Spec::Example::MyApp 177 | title: My Very Cool App 178 | options: 179 | - spec: foo --Foo 180 | - spec: verbose|v+ --be verbose 181 | - spec: +req --Some required flag 182 | - spec: number=i --integer option 183 | - spec: number2|n= +integer --integer option 184 | - spec: fnumber=f --float option 185 | - spec: fnumber2|f= +float --float option 186 | - spec: date|d=s =today 187 | - spec: items=s@ --multi option 188 | - spec: set=s% --multiple key=value pairs 189 | 190 | --- 191 | # version with verbose syntax 192 | name: myapp 193 | appspec: { version: 0.001 } 194 | class: App::Spec::Example::MyApp 195 | title: My Very Cool App 196 | options: 197 | - name: foo 198 | type: flag 199 | summary: Foo 200 | - name: verbose 201 | summary: be verbose 202 | type: flag 203 | multiple: true 204 | aliases: ["v"] 205 | - name: req 206 | summary: Some required flag 207 | required: true 208 | type: flag 209 | - name: number 210 | summary: integer option 211 | type: integer 212 | - name: number2 213 | summary: integer option 214 | type: integer 215 | aliases: ["n"] 216 | - name: fnumber 217 | summary: float option 218 | type: float 219 | - name: fnumber2 220 | summary: float option 221 | type: float 222 | aliases: ["f"] 223 | - name: date 224 | type: string 225 | default: today 226 | aliases: ["d"] 227 | - name: items 228 | type: string 229 | multiple: true 230 | summary: multi option 231 | - name: set 232 | type: string 233 | multiple: true 234 | mapping: true 235 | summary: multiple key=value pairs 236 | 237 | 238 | 239 | =for comment 240 | STOP INLINE 241 | 242 | =head1 METHODS 243 | 244 | =over 4 245 | 246 | =item common 247 | 248 | Builds a hash with the given hashref and fills in some defaults. 249 | 250 | my %hash = $class->common($args); 251 | 252 | =item from_dsl 253 | 254 | Builds a hash from the dsl string 255 | 256 | %dsl = $class->from_dsl("verbose|v+ --Be verbose"); 257 | 258 | 259 | =item name, type, multiple, required, unique, summary, description, default, completion, enum, values, mapping 260 | 261 | Attributes which represent the ones from the spec. 262 | 263 | =back 264 | 265 | =cut 266 | -------------------------------------------------------------------------------- /lib/App/Spec/Completion.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: Shell Completion generator 2 | use strict; 3 | use warnings; 4 | package App::Spec::Completion; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use Moo; 9 | 10 | has spec => ( is => 'ro' ); 11 | 12 | 1; 13 | 14 | __DATA__ 15 | 16 | =pod 17 | 18 | =head1 NAME 19 | 20 | App::Spec::Completion - Shell Completion generator 21 | 22 | See L and L 23 | 24 | =head1 ATTRIBUTES 25 | 26 | =over 4 27 | 28 | =item spec 29 | 30 | Contains the L object 31 | 32 | =back 33 | 34 | =cut 35 | -------------------------------------------------------------------------------- /lib/App/Spec/Option.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: App::Spec objects representing command line option specs 2 | use strict; 3 | use warnings; 4 | package App::Spec::Option; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use base 'App::Spec::Argument'; 9 | use Moo; 10 | 11 | has aliases => ( is => 'ro' ); 12 | 13 | sub build { 14 | my ($class, %args) = @_; 15 | my %hash = $class->common(%args); 16 | my $self = $class->new({ 17 | aliases => $args{aliases} || [], 18 | %hash, 19 | }); 20 | return $self; 21 | } 22 | 23 | 1; 24 | 25 | =pod 26 | 27 | =head1 NAME 28 | 29 | App::Spec::Option - App::Spec objects representing command line option specs 30 | 31 | =head1 SYNOPSIS 32 | 33 | This class inherits from L 34 | 35 | =head1 METHODS 36 | 37 | =over 4 38 | 39 | =item build 40 | 41 | my $option = App::Spec::Option->build( 42 | name => 'verbose', 43 | summary => 'lala', 44 | aliases => ['v'], 45 | ); 46 | 47 | =item aliases 48 | 49 | Attribute which represents the one from the spec. 50 | 51 | =back 52 | 53 | =cut 54 | -------------------------------------------------------------------------------- /lib/App/Spec/Parameter.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: App::Spec objects representing command line parameters 2 | use strict; 3 | use warnings; 4 | package App::Spec::Parameter; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use base 'App::Spec::Argument'; 9 | use Moo; 10 | 11 | sub build { 12 | my ($class, %args) = @_; 13 | my %hash = $class->common(%args); 14 | my $self = $class->new({ 15 | %hash, 16 | }); 17 | return $self; 18 | } 19 | 20 | sub to_usage_header { 21 | my ($self) = @_; 22 | my $name = $self->name; 23 | my $usage = ''; 24 | if ($self->multiple and $self->required) { 25 | $usage = "<$name>+"; 26 | } 27 | elsif ($self->multiple) { 28 | $usage = "[<$name>+]"; 29 | } 30 | elsif ($self->required) { 31 | $usage = "<$name>"; 32 | } 33 | else { 34 | $usage = "[<$name>]"; 35 | } 36 | } 37 | 38 | 1; 39 | 40 | =pod 41 | 42 | =head1 NAME 43 | 44 | App::Spec::Parameter - App::Spec objects representing command line parameters 45 | 46 | =head1 SYNOPSIS 47 | 48 | This class inherits from L 49 | 50 | =head1 METHODS 51 | 52 | =over 4 53 | 54 | =item build 55 | 56 | my $param = App::Spec::Parameter->build( 57 | name => 'verbose', 58 | summary => 'lala', 59 | ); 60 | 61 | =item to_usage_header 62 | 63 | my $param_usage_header = $param->to_usage_header; 64 | # results 65 | # if multiple and required 66 | # <$name>+ 67 | # if multiple 68 | # [<$name>+] 69 | # if required 70 | # <$name> 71 | # else 72 | # [<$name>} 73 | 74 | =back 75 | 76 | =cut 77 | -------------------------------------------------------------------------------- /lib/App/Spec/Plugin/Format.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: App::Spec Plugin for formatting data structures 2 | use strict; 3 | use warnings; 4 | package App::Spec::Plugin::Format; 5 | our $VERSION = '0.000'; # VERSION 6 | 7 | use YAML::PP; 8 | use Ref::Util qw/ is_arrayref /; 9 | use Encode; 10 | 11 | use Moo; 12 | with 'App::Spec::Role::Plugin::GlobalOptions'; 13 | 14 | my $yaml; 15 | my $options; 16 | sub _read_data { 17 | unless ($yaml) { 18 | $yaml = do { local $/; }; 19 | ($options) = YAML::PP::Load($yaml); 20 | } 21 | } 22 | 23 | 24 | sub install_options { 25 | my ($class, %args) = @_; 26 | _read_data(); 27 | return $options; 28 | } 29 | 30 | sub init_run { 31 | my ($self, $run) = @_; 32 | $run->subscribe( 33 | print_output => { 34 | plugin => $self, 35 | method => "print_output", 36 | }, 37 | ); 38 | } 39 | 40 | sub print_output { 41 | my ($self, %args) = @_; 42 | my $run = $args{run}; 43 | my $opt = $run->options; 44 | my $format = $opt->{format} || ''; 45 | 46 | my $res = $run->response; 47 | my $outputs = $res->outputs; 48 | for my $out (@$outputs) { 49 | next unless $out->type eq 'data'; 50 | my $content = $out->content; 51 | if ($format eq 'YAML') { 52 | $content = encode_utf8 YAML::PP::Dump($content); 53 | } 54 | elsif ($format eq 'JSON') { 55 | require JSON::XS; 56 | my $coder = JSON::XS->new->ascii->pretty->allow_nonref; 57 | $content = encode_utf8 $coder->encode($content) . "\n"; 58 | } 59 | elsif ($format eq 'Table' and is_arrayref($content)) { 60 | require Text::Table; 61 | my $header = shift @$content; 62 | my $tb = Text::Table->new( @$header ); 63 | $tb->load(@$content); 64 | $content = encode_utf8 "$tb"; 65 | } 66 | elsif ($format eq 'Data::Dump') { 67 | require Data::Dump; 68 | $content = Data::Dump::dump($content) . "\n"; 69 | } 70 | else { 71 | $content = Data::Dumper->Dump([$content], ['output']); 72 | } 73 | $out->content( $content ); 74 | $out->type( "plain" ); 75 | } 76 | 77 | } 78 | 79 | 80 | 1; 81 | 82 | =pod 83 | 84 | =head1 NAME 85 | 86 | App::Spec::Plugin::Format - App::Spec Plugin for formatting data structures 87 | 88 | =head1 DESCRIPTION 89 | 90 | 91 | =head1 METHODS 92 | 93 | =over 4 94 | 95 | =item install_options 96 | 97 | This method is required by L. 98 | 99 | See L. 100 | 101 | =item init_run 102 | 103 | See L 104 | 105 | =item print_output 106 | 107 | This method is called by L right before output. 108 | 109 | =back 110 | 111 | =cut 112 | 113 | __DATA__ 114 | --- 115 | - name: format 116 | summary: Format output 117 | type: string 118 | enum: [JSON, YAML, Table, "Data::Dumper", "Data::Dump"] 119 | 120 | -------------------------------------------------------------------------------- /lib/App/Spec/Plugin/Help.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: App::Spec Plugin for help subcommand and options 2 | use strict; 3 | use warnings; 4 | package App::Spec::Plugin::Help; 5 | our $VERSION = '0.000'; # VERSION 6 | 7 | use Moo; 8 | with 'App::Spec::Role::Plugin::Subcommand'; 9 | with 'App::Spec::Role::Plugin::GlobalOptions'; 10 | 11 | my $yaml; 12 | my $cmd = { 13 | name => 'help', 14 | summary => 'Show command help', 15 | class => 'App::Spec::Plugin::Help', 16 | op => 'cmd_help', 17 | subcommand_required => 0, 18 | options => [ 19 | { spec => 'all' }, 20 | ], 21 | }; 22 | my $options = [ 23 | { 24 | name => 'help', 25 | summary => 'Show command help', 26 | type => 'flag', 27 | aliases => ['h'], 28 | }, 29 | ]; 30 | 31 | sub install_subcommands { 32 | my ($class, %args) = @_; 33 | my $parent = $args{spec}; 34 | my $appspec = App::Spec::Subcommand->read($cmd); 35 | 36 | my $help_subcmds = $appspec->subcommands || {}; 37 | 38 | my $parent_subcmds = $parent->subcommands || {}; 39 | $class->_add_subcommands($help_subcmds, $parent_subcmds, { subcommand_required => 0 }); 40 | $appspec->subcommands($help_subcmds); 41 | 42 | return $appspec; 43 | } 44 | 45 | sub cmd_help { 46 | my ($self, $run) = @_; 47 | my $spec = $run->spec; 48 | my $cmds = $run->commands; 49 | shift @$cmds; 50 | my $help = $spec->usage( 51 | commands => $cmds, 52 | colored => $run->colorize_code, 53 | ); 54 | $run->out($help); 55 | } 56 | 57 | sub _add_subcommands { 58 | my ($self, $commands1, $commands2, $ref) = @_; 59 | for my $name (keys %{ $commands2 || {} }) { 60 | next if $name eq "help"; 61 | my $cmd = $commands2->{ $name }; 62 | $commands1->{ $name } = App::Spec::Subcommand->new( 63 | name => $name, 64 | subcommands => {}, 65 | %$ref, 66 | ); 67 | my $subcmds = $cmd->{subcommands} || {}; 68 | $self->_add_subcommands($commands1->{ $name }->{subcommands}, $subcmds, $ref); 69 | } 70 | } 71 | 72 | sub install_options { 73 | my ($class, %args) = @_; 74 | return $options; 75 | } 76 | 77 | sub init_run { 78 | my ($self, $run) = @_; 79 | $run->subscribe( 80 | global_options => { 81 | plugin => $self, 82 | method => "global_options", 83 | }, 84 | ); 85 | } 86 | 87 | sub global_options { 88 | my ($self, %args) = @_; 89 | my $run = $args{run}; 90 | my $options = $run->options; 91 | my $op; 92 | 93 | if ($run->spec->has_subcommands) { 94 | if ($options->{help} and (not @{ $run->argv } or $run->argv->[0] ne "help")) { 95 | # call subcommand 'help' 96 | unshift @{ $run->argv }, "help"; 97 | } 98 | } 99 | else { 100 | if ($options->{help}) { 101 | $op = "::cmd_help"; 102 | } 103 | } 104 | 105 | $run->op("App::Spec::Plugin::Help$op") if $op; 106 | } 107 | 108 | 109 | 1; 110 | 111 | =pod 112 | 113 | =head1 NAME 114 | 115 | App::Spec::Plugin::Help - App::Spec Plugin for help subcommand and options 116 | 117 | =head1 DESCRIPTION 118 | 119 | This plugin is enabled in L by default. 120 | 121 | This is a plugin which adds C<-h|--help> options to your app. 122 | Also for apps with subcommands it adds a subcommand C. 123 | 124 | The help command can then be called with all existing subcommands, like this: 125 | 126 | % app cmd1 127 | % app cmd2 128 | % app cmd2 cmd2a 129 | % app help 130 | % app help cmd1 131 | % app help cmd2 132 | % app help cmd2 cmd2a 133 | 134 | =head1 METHODS 135 | 136 | =over 4 137 | 138 | =item cmd_help 139 | 140 | This is the code which is executed when using C<-h|--help> or the subcommand 141 | help. 142 | 143 | =item install_options 144 | 145 | This method is required by L. 146 | 147 | See L. 148 | 149 | =item install_subcommands 150 | 151 | This is required by L. 152 | 153 | See L. 154 | 155 | =item global_options 156 | 157 | This method is called by L after global options have been read. 158 | 159 | For apps without subcommands it just sets the method to execute to 160 | L. 161 | No further processing is done. 162 | 163 | For apps with subcommands it inserts C at the beginning of the 164 | commandline arguments and continues processing. 165 | 166 | =item init_run 167 | 168 | See L 169 | 170 | =back 171 | 172 | =cut 173 | 174 | -------------------------------------------------------------------------------- /lib/App/Spec/Plugin/Meta.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: App::Spec Plugin for meta functions 2 | use strict; 3 | use warnings; 4 | package App::Spec::Plugin::Meta; 5 | our $VERSION = '0.000'; # VERSION 6 | 7 | use List::Util qw/ any /; 8 | 9 | use Moo; 10 | with 'App::Spec::Role::Plugin::Subcommand'; 11 | 12 | my $yaml = do { local $/; }; 13 | 14 | sub install_subcommands { 15 | my ($class, %args) = @_; 16 | my $parent = $args{spec}; 17 | my $appspec = App::Spec::Subcommand->read(\$yaml); 18 | return $appspec; 19 | } 20 | 21 | sub cmd_self_completion { 22 | my ($self, $run) = @_; 23 | my $options = $run->options; 24 | my $shell = $options->{zsh} ? "zsh" : $options->{bash} ? "bash" : ''; 25 | unless ($shell) { 26 | my $ppid = getppid(); 27 | chomp($shell = `ps --no-headers -o cmd $ppid`); 28 | $shell =~ s/.*\W(\w*sh).*$/$1/; #handling case of '-zsh' or '/bin/bash' 29 | #or bash -i -rs 30 | } 31 | unless (any { $_ eq $shell } qw/ bash zsh / ) { 32 | die "Specify which shell, '$shell' not supported"; 33 | } 34 | my $spec = $run->spec; 35 | my $completion = $spec->generate_completion( 36 | shell => $shell, 37 | ); 38 | $run->out($completion); 39 | } 40 | 41 | sub cmd_self_pod { 42 | my ($self, $run) = @_; 43 | my $spec = $run->spec; 44 | 45 | require App::Spec::Pod; 46 | my $generator = App::Spec::Pod->new( 47 | spec => $self, 48 | ); 49 | my $pod = $generator->generate; 50 | 51 | $run->out($pod); 52 | } 53 | 54 | 1; 55 | 56 | =pod 57 | 58 | =head1 NAME 59 | 60 | App::Spec::Plugin::Meta - App::Spec Plugin for meta functions 61 | 62 | =head1 DESCRIPTION 63 | 64 | This plugin is enabled in L by default. 65 | 66 | It adds the following commands to your app: 67 | 68 | % app meta completion generate 69 | % app meta pod generate 70 | 71 | =head1 METHODS 72 | 73 | =over 4 74 | 75 | =item cmd_self_completion 76 | 77 | This is called by C 78 | 79 | =item cmd_self_pod 80 | 81 | This is called by C 82 | 83 | =item install_subcommands 84 | 85 | See L 86 | 87 | =back 88 | 89 | =cut 90 | 91 | __DATA__ 92 | --- 93 | name: _meta 94 | class: App::Spec::Plugin::Meta 95 | summary: Information and utilities for this app 96 | subcommands: 97 | completion: 98 | summary: Shell completion functions 99 | subcommands: 100 | generate: 101 | summary: Generate self completion 102 | op: cmd_self_completion 103 | options: 104 | - name: name 105 | summary: name of the program (optional, override name in spec) 106 | - name: zsh 107 | summary: for zsh 108 | type: flag 109 | - name: bash 110 | summary: for bash 111 | type: flag 112 | pod: 113 | summary: Pod documentation 114 | subcommands: 115 | generate: 116 | summary: Generate self pod 117 | op: cmd_self_pod 118 | -------------------------------------------------------------------------------- /lib/App/Spec/Pod.pm: -------------------------------------------------------------------------------- 1 | # ASTRACT: Generates Pod from App::Spec objects 2 | use strict; 3 | use warnings; 4 | package App::Spec::Pod; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use Moo; 9 | 10 | has spec => ( is => 'ro' ); 11 | 12 | sub generate { 13 | my ($self) = @_; 14 | my $spec = $self->spec; 15 | my $appname = $spec->name; 16 | my $title = $spec->title; 17 | my $abstract = $spec->abstract // ''; 18 | my $description = $spec->description // ''; 19 | my $subcmds = $spec->subcommands; 20 | my $global_options = $spec->options; 21 | 22 | $self->markup(text => \$abstract); 23 | $self->markup(text => \$description); 24 | 25 | my @subcmd_pod = $self->subcommand_pod( 26 | commands => $subcmds, 27 | ); 28 | my $option_string = ''; 29 | if (@$global_options) { 30 | $option_string = "=head2 GLOBAL OPTIONS\n\n" . $self->options2pod( 31 | options => $global_options, 32 | ); 33 | } 34 | 35 | my $pod = <<"EOM"; 36 | \=head1 NAME 37 | 38 | $appname - $title 39 | 40 | \=head1 ABSTRACT 41 | 42 | $abstract 43 | 44 | \=head1 DESCRIPTION 45 | 46 | $description 47 | 48 | $option_string 49 | 50 | \=head2 SUBCOMMANDS 51 | 52 | @{[ join '', @subcmd_pod ]} 53 | EOM 54 | 55 | } 56 | 57 | sub subcommand_pod { 58 | my ($self, %args) = @_; 59 | my $spec = $self->spec; 60 | my $appname = $spec->name; 61 | my $commands = $args{commands}; 62 | my $previous = $args{previous} || []; 63 | 64 | my @pod; 65 | my %keys; 66 | @keys{ keys %$commands } = (); 67 | my @keys; 68 | if (@$previous) { 69 | @keys = sort keys %keys; 70 | } 71 | else { 72 | for my $key (qw/ help _meta /) { 73 | if (exists $keys{ $key }) { 74 | push @keys, $key; 75 | delete $keys{ $key }; 76 | } 77 | } 78 | unshift @keys, sort keys %keys; 79 | } 80 | for my $name (@keys) { 81 | my $cmd_spec = $commands->{ $name }; 82 | my $name = $cmd_spec->name; 83 | my $summary = $cmd_spec->summary; 84 | my $description = $cmd_spec->description; 85 | my $subcmds = $cmd_spec->subcommands; 86 | my $parameters = $cmd_spec->parameters; 87 | my $options = $cmd_spec->options; 88 | 89 | $self->markup(text => \$summary); 90 | $self->markup(text => \$description); 91 | 92 | my $desc = ''; 93 | if (length $summary) { 94 | $desc .= "$summary\n\n"; 95 | } 96 | if (length $description) { 97 | $desc .= "$description\n\n"; 98 | } 99 | 100 | my $usage = "$appname @$previous $name"; 101 | if (keys %$subcmds) { 102 | $usage .= " "; 103 | } 104 | 105 | my $option_string = ''; 106 | if (@$options) { 107 | $usage .= " [options]"; 108 | $option_string = "Options:\n\n" . $self->options2pod( 109 | options => $options, 110 | ); 111 | } 112 | 113 | if (length $option_string) { 114 | $desc .= "$option_string\n"; 115 | } 116 | 117 | my $param_string = ''; 118 | if (@$parameters) { 119 | $param_string = "Parameters:\n\n" . $self->params2pod( 120 | parameters => $parameters, 121 | ); 122 | for my $param (@$parameters) { 123 | my $name = $param->name; 124 | my $required = $param->required; 125 | $usage .= " " . $param->to_usage_header; 126 | } 127 | } 128 | if (length $param_string) { 129 | $desc .= $param_string; 130 | } 131 | 132 | my $pod = <<"EOM"; 133 | \=head3 @$previous $name 134 | 135 | $usage 136 | 137 | $desc 138 | EOM 139 | if (keys %$subcmds and $name ne "help") { 140 | my @sub = $self->subcommand_pod( 141 | previous => [@$previous, $name], 142 | commands => $subcmds, 143 | ); 144 | $pod .= join '', @sub; 145 | } 146 | push @pod, $pod; 147 | } 148 | return @pod; 149 | } 150 | 151 | sub params2pod { 152 | my ($self, %args) = @_; 153 | my $params = $args{parameters}; 154 | my @rows; 155 | for my $param (@$params) { 156 | my $required = $param->required ? '*' : ''; 157 | my $summary = $param->summary; 158 | my $multi = ''; 159 | if ($param->mapping) { 160 | $multi = '{}'; 161 | } 162 | elsif ($param->multiple) { 163 | $multi = '[]'; 164 | } 165 | my $flags = $self->spec->_param_flags_string($param); 166 | my @lines = split m/\n/, $summary; 167 | push @rows, [" " . $param->name, " " . $required, $multi, ($lines[0] // '') . $flags]; 168 | push @rows, [" " , " ", '', $_] for map {s/^ +//; $_ } @lines[1 .. $#lines]; 169 | } 170 | my $test = $self->simple_table(\@rows); 171 | return $test; 172 | } 173 | 174 | sub simple_table { 175 | my ($self, $rows) = @_; 176 | my @widths; 177 | 178 | for my $row (@$rows) { 179 | for my $i (0 .. $#$row) { 180 | my $col = $row->[ $i ]; 181 | $widths[ $i ] ||= 0; 182 | if ( $widths[ $i ] < length $col) { 183 | $widths[ $i ] = length $col; 184 | } 185 | } 186 | } 187 | my $format = join ' ', map { "%-" . ($_ || 0) . "s" } @widths; 188 | my @lines; 189 | for my $row (@$rows) { 190 | my $string = sprintf "$format\n", map { $_ // '' } @$row; 191 | push @lines, $string; 192 | } 193 | return join '', @lines; 194 | 195 | } 196 | 197 | sub options2pod { 198 | my ($self, %args) = @_; 199 | my $options = $args{options}; 200 | my @rows; 201 | for my $opt (@$options) { 202 | my $name = $opt->name; 203 | my $aliases = $opt->aliases; 204 | my $summary = $opt->summary; 205 | my $required = $opt->required ? '*' : ''; 206 | my $multi = ''; 207 | if ($opt->mapping) { 208 | $multi = '{}'; 209 | } 210 | elsif ($opt->multiple) { 211 | $multi = '[]'; 212 | } 213 | my @names = map { 214 | length $_ > 1 ? "--$_" : "-$_" 215 | } ($name, @$aliases); 216 | my $flags = $self->spec->_param_flags_string($opt); 217 | my @lines = split m/\n/, $summary; 218 | push @rows, [" @names", " " . $required, $multi, ($lines[0] // '') . $flags]; 219 | push @rows, [" ", " " , '', $_ ] for map {s/^ +//; $_ } @lines[1 .. $#lines]; 220 | } 221 | my $test = $self->simple_table(\@rows); 222 | return $test; 223 | } 224 | 225 | sub markup { 226 | my ($self, %args) = @_; 227 | my $text = $args{text}; 228 | return unless defined $$text; 229 | my $markup = $self->spec->markup // ''; 230 | if ($markup eq "swim") { 231 | $$text = $self->swim2pod($$text); 232 | } 233 | } 234 | sub swim2pod { 235 | my ($self, $text) = @_; 236 | require Swim; 237 | my $swim = Swim->new(text => $text); 238 | my $pod = $swim->to_pod; 239 | } 240 | 241 | 1; 242 | 243 | __END__ 244 | 245 | =pod 246 | 247 | =head1 NAME 248 | 249 | App::Spec::Pod - Generates Pod from App::Spec objects 250 | 251 | =head1 SYNOPSIS 252 | 253 | my $generator = App::Spec::Pod->new( 254 | spec => $appspec, 255 | ); 256 | my $pod = $generator->generate; 257 | 258 | =head1 METHODS 259 | 260 | =over 4 261 | 262 | =item generate 263 | 264 | my $pod = $generator->generate; 265 | 266 | =item markup 267 | 268 | $pod->markup(text => \$abstract); 269 | 270 | Applies markup defined in the spec to the text argument. 271 | 272 | =item options2pod 273 | 274 | my $option_string = "Options:\n\n" . $self->options2pod( 275 | options => $options, 276 | ); 277 | 278 | =item params2pod 279 | 280 | my $param_string = "Parameters:\n\n" . $self->params2pod( 281 | parameters => $parameters, 282 | ); 283 | 284 | =item subcommand_pod 285 | 286 | Generates pod for subcommands recursively 287 | 288 | my @pod = $self->subcommand_pod( 289 | previous => [@previous_subcmds], 290 | commands => $subcmds, 291 | ); 292 | 293 | =item swim2pod 294 | 295 | my $pod = $self->swim2pod($swim); 296 | 297 | Converts Swim markup to Pod. 298 | See L. 299 | 300 | =item spec 301 | 302 | Accessor for L object 303 | 304 | =back 305 | 306 | =cut 307 | 308 | -------------------------------------------------------------------------------- /lib/App/Spec/Role/Command.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | package App::Spec::Role::Command; 4 | 5 | our $VERSION = '0.000'; # VERSION 6 | 7 | use YAML::PP; 8 | use List::Util qw/ any /; 9 | use App::Spec::Option; 10 | use Ref::Util qw/ is_arrayref /; 11 | 12 | use Moo::Role; 13 | 14 | has name => ( is => 'rw' ); 15 | has markup => ( is => 'rw', default => 'pod' ); 16 | has class => ( is => 'rw' ); 17 | has op => ( is => 'ro' ); 18 | has plugins => ( is => 'ro' ); 19 | has plugins_by_type => ( is => 'ro', default => sub { +{} } ); 20 | has options => ( is => 'rw', default => sub { +[] } ); 21 | has parameters => ( is => 'rw', default => sub { +[] } ); 22 | has subcommands => ( is => 'rw', default => sub { +{} } ); 23 | has description => ( is => 'rw' ); 24 | 25 | sub default_plugins { 26 | qw/ Meta Help / 27 | } 28 | 29 | sub has_subcommands { 30 | my ($self) = @_; 31 | return $self->subcommands ? 1 : 0; 32 | } 33 | 34 | sub build { 35 | my ($class, %spec) = @_; 36 | $spec{options} ||= []; 37 | $spec{parameters} ||= []; 38 | for (@{ $spec{options} }, @{ $spec{parameters} }) { 39 | $_ = { spec => $_ } unless ref $_; 40 | } 41 | $_ = App::Spec::Option->build(%$_) for @{ $spec{options} || [] }; 42 | $_ = App::Spec::Parameter->build(%$_) for @{ $spec{parameters} || [] }; 43 | 44 | my $commands; 45 | for my $name (keys %{ $spec{subcommands} || {} }) { 46 | my $cmd = $spec{subcommands}->{ $name }; 47 | $commands->{ $name } = App::Spec::Subcommand->build( 48 | name => $name, 49 | %$cmd, 50 | ); 51 | } 52 | $spec{subcommands} = $commands; 53 | 54 | if ( defined (my $op = $spec{op}) ) { 55 | die "Invalid op '$op'" unless $op =~ m/^\w+\z/; 56 | } 57 | if ( defined (my $class = $spec{class}) ) { 58 | die "Invalid class '$class'" unless $class =~ m/^ \w+ (?: ::\w+)* \z/x; 59 | } 60 | 61 | my $self = $class->new(%spec); 62 | } 63 | 64 | sub read { 65 | my ($class, $file) = @_; 66 | unless (defined $file) { 67 | die "No filename given"; 68 | } 69 | 70 | my $spec = $class->load_data($file); 71 | 72 | my %disable; 73 | my @plugins; 74 | 75 | my $spec_plugins = $spec->{plugins} || []; 76 | for my $plugin (@$spec_plugins) { 77 | if ($plugin =~ m/^-(.*)/) { 78 | $disable{ $1 } = 1; 79 | } 80 | } 81 | my @default_plugins = grep { not $disable{ $_ } } $class->default_plugins; 82 | 83 | push @plugins, @default_plugins; 84 | push @plugins, grep{ not m/^-/ } @$spec_plugins; 85 | for my $plugin (@plugins) { 86 | unless ($plugin =~ s/^=//) { 87 | $plugin = "App::Spec::Plugin::$plugin"; 88 | } 89 | } 90 | $spec->{plugins} = \@plugins; 91 | 92 | my $self = $class->build(%$spec); 93 | 94 | $self->load_plugins; 95 | $self->init_plugins; 96 | 97 | return $self; 98 | } 99 | 100 | sub load_data { 101 | my ($class, $file) = @_; 102 | my $spec; 103 | if (ref $file eq 'GLOB') { 104 | my $data = do { local $/; <$file> }; 105 | $spec = eval { YAML::PP::Load($data) }; 106 | } 107 | elsif (not ref $file) { 108 | $spec = eval { YAML::PP::LoadFile($file) }; 109 | } 110 | elsif (ref $file eq 'SCALAR') { 111 | my $data = $$file; 112 | $spec = eval { YAML::PP::Load($data) }; 113 | } 114 | elsif (ref $file eq 'HASH') { 115 | $spec = $file; 116 | } 117 | 118 | unless ($spec) { 119 | die "Error reading '$file': $@"; 120 | } 121 | return $spec; 122 | } 123 | 124 | sub load_plugins { 125 | my ($self) = @_; 126 | my $plugins = $self->plugins; 127 | if (@$plugins) { 128 | require Module::Runtime; 129 | for my $plugin (@$plugins) { 130 | my $loaded = Module::Runtime::require_module($plugin); 131 | } 132 | } 133 | } 134 | 135 | sub init_plugins { 136 | my ($self) = @_; 137 | my $plugins = $self->plugins; 138 | if (@$plugins) { 139 | my $subcommands = $self->subcommands; 140 | my $options = $self->options; 141 | for my $plugin (@$plugins) { 142 | if ($plugin->does('App::Spec::Role::Plugin::Subcommand')) { 143 | push @{ $self->plugins_by_type->{Subcommand} }, $plugin; 144 | my $subc = $plugin->install_subcommands( spec => $self ); 145 | $subc = [ $subc ] unless is_arrayref($subc); 146 | 147 | if ($subcommands) { 148 | for my $cmd (@$subc) { 149 | $subcommands->{ $cmd->name } ||= $cmd; 150 | } 151 | } 152 | } 153 | 154 | if ($plugin->does('App::Spec::Role::Plugin::GlobalOptions')) { 155 | push @{ $self->plugins_by_type->{GlobalOptions} }, $plugin; 156 | my $new_opts = $plugin->install_options( spec => $self ); 157 | if ($new_opts) { 158 | $options ||= []; 159 | 160 | for my $opt (@$new_opts) { 161 | $opt = App::Spec::Option->build(%$opt); 162 | unless (any { $_->name eq $opt->name } @$options) { 163 | push @$options, $opt; 164 | } 165 | } 166 | 167 | } 168 | } 169 | 170 | } 171 | } 172 | } 173 | 174 | 175 | 1; 176 | 177 | __END__ 178 | 179 | =pod 180 | 181 | =head1 NAME 182 | 183 | App::Spec::Role::Command - commands and subcommands both use this role 184 | 185 | =head1 METHODS 186 | 187 | =over 4 188 | 189 | =item read 190 | 191 | Calls load_data, build, load_plugins, init_plugins 192 | 193 | =item build 194 | 195 | This builds a tree of objects 196 | 197 | my $self = App::Spec->build(%$hashref); 198 | my $self = App::Spec::Subcommand->build(%$hashref); 199 | 200 | =item load_data 201 | 202 | my $spec = App::Spec->load_data($file); 203 | 204 | Takes a filename as a string, a filehandle, a ref to a YAML string or 205 | a hashref. 206 | 207 | =item default_plugins 208 | 209 | Returns ('Meta', 'Help') 210 | 211 | =item has_subcommands 212 | 213 | Returns 1 if there are any subcommands defined. 214 | 215 | =item init_plugins 216 | 217 | Initialize plugins 218 | 219 | =item load_plugins 220 | 221 | Loads the specified plugin modules. 222 | 223 | =item plugins_by_type 224 | 225 | my $p = $cmd->plugins_by_type->{Subcommand}; 226 | 227 | =back 228 | 229 | =head1 ATTRIBUTES 230 | 231 | =over 4 232 | 233 | =item class 234 | 235 | Specifies the class which implements the app. 236 | 237 | =item op, description, markup, name, options, parameters, plugins, subcommands 238 | 239 | Accessors for specification items 240 | 241 | =back 242 | 243 | 244 | =cut 245 | -------------------------------------------------------------------------------- /lib/App/Spec/Role/Plugin.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: Main role for App::Spec plugins 2 | use strict; 3 | use warnings; 4 | package App::Spec::Role::Plugin; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use Moo::Role; 9 | 10 | sub init_run { 11 | my ($self, $run) = @_; 12 | } 13 | 14 | 1; 15 | 16 | __END__ 17 | 18 | =pod 19 | 20 | =head1 NAME 21 | 22 | App::Spec::Role::Plugin - Main role for App::Spec plugins 23 | 24 | =head1 METHODS 25 | 26 | =over 4 27 | 28 | =item init_run 29 | 30 | Will be called with the plugin object/class and an L 31 | object as parameters. 32 | 33 | my ($self, $run) = @_; 34 | 35 | You can then use the C method of App::Spec::Run to subscribe 36 | to certain events. 37 | 38 | =back 39 | 40 | =cut 41 | -------------------------------------------------------------------------------- /lib/App/Spec/Role/Plugin/GlobalOptions.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: Plugins for adding options should use this role 2 | use strict; 3 | use warnings; 4 | package App::Spec::Role::Plugin::GlobalOptions; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use Moo::Role; 9 | 10 | requires 'install_options'; 11 | 12 | with 'App::Spec::Role::Plugin'; 13 | 14 | 1; 15 | 16 | __END__ 17 | 18 | =pod 19 | 20 | =head1 NAME 21 | 22 | App::Spec::Role::Plugin::GlobalOptions - Plugins for adding options should use this role 23 | 24 | =head1 DESCRIPTION 25 | 26 | See L for an example. 27 | 28 | =head1 REQUIRED METHODS 29 | 30 | =over 4 31 | 32 | =item install_options 33 | 34 | This should return an arrayref of options: 35 | 36 | [ 37 | { 38 | name => "help", 39 | summary: "Show command help", 40 | ..., 41 | }, 42 | ] 43 | 44 | 45 | 46 | =back 47 | -------------------------------------------------------------------------------- /lib/App/Spec/Role/Plugin/Subcommand.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: Plugins for subcommands should use this role 2 | use strict; 3 | use warnings; 4 | package App::Spec::Role::Plugin::Subcommand; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use Moo::Role; 9 | 10 | requires 'install_subcommands'; 11 | 12 | with 'App::Spec::Role::Plugin'; 13 | 14 | 1; 15 | 16 | __END__ 17 | 18 | =pod 19 | 20 | =head1 NAME 21 | 22 | App::Spec::Role::Plugin::Subcommand - Plugins for subcommands should use this role 23 | 24 | =head1 DESCRIPTION 25 | 26 | See L for an example. 27 | 28 | =head1 REQUIRED METHODS 29 | 30 | =over 4 31 | 32 | =item install_subcommands 33 | 34 | =back 35 | 36 | 37 | =cut 38 | -------------------------------------------------------------------------------- /lib/App/Spec/Run/Cmd.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: The App::Spec command which is run 2 | use strict; 3 | use warnings; 4 | package App::Spec::Run::Cmd; 5 | our $VERSION = '0.000'; # VERSION 6 | 7 | use App::Spec::Run; 8 | use Moo; 9 | 10 | 1; 11 | 12 | __END__ 13 | 14 | =pod 15 | 16 | =head1 NAME 17 | 18 | App::Spec::Run::Cmd - The App::Spec command which is run 19 | 20 | =cut 21 | -------------------------------------------------------------------------------- /lib/App/Spec/Run/Output.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: Output class for App::Spec::Run 2 | use strict; 3 | use warnings; 4 | package App::Spec::Run::Output; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use Moo; 9 | 10 | has type => ( is => 'rw', default => 'plain' ); 11 | has error => ( is => 'rw' ); 12 | has content => ( is => 'rw' ); 13 | 14 | 1; 15 | 16 | __END__ 17 | 18 | =pod 19 | 20 | =head1 NAME 21 | 22 | App::Spec::Run::Output - Output class for App::Spec::Run 23 | 24 | =head1 ATTRIBUTES 25 | 26 | =over 4 27 | 28 | =item type 29 | 30 | Currently two types ar esupported: C, C 31 | 32 | =item error 33 | 34 | If set to 1, output is supposed to go to stderr. 35 | 36 | =item content 37 | 38 | The text or data content. 39 | 40 | =back 41 | 42 | =cut 43 | -------------------------------------------------------------------------------- /lib/App/Spec/Run/Response.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: Response class for App::Spec::Run 2 | use strict; 3 | use warnings; 4 | package App::Spec::Run::Response; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use App::Spec::Run::Output; 9 | use Scalar::Util qw/ blessed /; 10 | 11 | use Moo; 12 | 13 | has exit => ( is => 'rw', default => 0 ); 14 | has outputs => ( is => 'rw', default => sub { [] } ); 15 | has finished => ( is => 'rw' ); 16 | has halted => ( is => 'rw' ); 17 | has buffered => ( is => 'rw', default => 0 ); 18 | has callbacks => ( is => 'rw', default => sub { +{} } ); 19 | 20 | sub add_output { 21 | my ($self, @out) = @_; 22 | 23 | for my $out (@out) { 24 | unless (blessed $out) { 25 | $out = App::Spec::Run::Output->new( 26 | content => $out, 27 | ref $out ? (type => 'data') : (), 28 | ); 29 | } 30 | } 31 | 32 | if ($self->buffered) { 33 | my $outputs = $self->outputs; 34 | push @$outputs, @out; 35 | } 36 | else { 37 | $self->print_output(@out); 38 | } 39 | } 40 | 41 | sub add_error { 42 | my ($self, @out) = @_; 43 | 44 | for my $out (@out) { 45 | unless (blessed $out) { 46 | $out = App::Spec::Run::Output->new( 47 | error => 1, 48 | content => $out, 49 | ); 50 | } 51 | } 52 | 53 | if ($self->buffered) { 54 | my $outputs = $self->outputs; 55 | push @$outputs, @out; 56 | } 57 | else { 58 | $self->print_output(@out); 59 | } 60 | } 61 | 62 | sub print_output { 63 | my ($self, @out) = @_; 64 | my $outputs = $self->outputs; 65 | push @$outputs, @out; 66 | 67 | my $callbacks = $self->callbacks->{print_output} || []; 68 | for my $cb (@$callbacks) { 69 | $cb->(); 70 | } 71 | 72 | while (my $out = shift @$outputs) { 73 | my $content = $out->content; 74 | if (ref $content) { 75 | require Data::Dumper; 76 | $content = Data::Dumper->Dump([$content], ['output']); 77 | } 78 | if ($out->error) { 79 | print STDERR $content; 80 | } 81 | else { 82 | print $content; 83 | } 84 | } 85 | } 86 | 87 | sub add_callbacks { 88 | my ($self, $event, $cb_add) = @_; 89 | my $callbacks = $self->callbacks; 90 | my $cb = $callbacks->{ $event } ||= []; 91 | push @$cb, @$cb_add; 92 | } 93 | 94 | 1; 95 | 96 | __END__ 97 | 98 | =pod 99 | 100 | =head1 NAME 101 | 102 | App::Spec::Run::Response - Response class for App::Spec::Run 103 | 104 | =head1 METHODS 105 | 106 | =over 4 107 | 108 | =item add_output 109 | 110 | If you pass it a string, it will create a L. 111 | 112 | $res->add_output("string\n", "string2\n"); 113 | my $output = App::Spec::Run::Output->new( 114 | content => "string\n", 115 | ); 116 | $res->add_output($output); 117 | 118 | This will call C if buffered is false, otherwise it will 119 | add the output to C 120 | 121 | =item add_error 122 | 123 | Like C, but the created Output object will have an attribute 124 | C set to 1. 125 | 126 | $res->add_error("string\n", "string2\n"); 127 | my $output = App::Spec::Run::Output->new( 128 | error => 1, 129 | content => "string\n", 130 | ); 131 | $res->add_error($output); 132 | 133 | =item print_output 134 | 135 | $res->print_output(@out); 136 | 137 | Prints the given output and all output in C. 138 | 139 | =item add_callbacks 140 | 141 | $response->add_callbacks(print_output => \@callbacks); 142 | 143 | Where C<@callbacks> are coderefs. 144 | 145 | =back 146 | 147 | =head1 ATTRIBUTES 148 | 149 | =over 4 150 | 151 | =item buffered 152 | 153 | If true, output should be buffered until print_output is called. 154 | 155 | Default: false 156 | 157 | =item exit 158 | 159 | The exit code 160 | 161 | =item outputs 162 | 163 | Holds an array of L objects. 164 | 165 | =item finished 166 | 167 | Set to 1 after print_output has been called. 168 | 169 | =item halted 170 | 171 | If set to 1, no further processing should be done. 172 | 173 | =item callbacks 174 | 175 | Contains a hashref of callbacks 176 | 177 | { 178 | print_output => $coderef, 179 | }, 180 | 181 | =back 182 | 183 | =cut 184 | -------------------------------------------------------------------------------- /lib/App/Spec/Run/Validator.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: Processes and validates options and parameters 2 | use strict; 3 | use warnings; 4 | package App::Spec::Run::Validator; 5 | 6 | our $VERSION = '0.000'; # VERSION; 7 | 8 | use List::Util qw/ any /; 9 | use List::MoreUtils qw/ uniq /; 10 | use Ref::Util qw/ is_arrayref is_hashref /; 11 | use Moo; 12 | 13 | has options => ( is => 'ro' ); 14 | has option_specs => ( is => 'ro' ); 15 | has parameters => ( is => 'ro' ); 16 | has param_specs => ( is => 'ro' ); 17 | 18 | my %validate = ( 19 | string => sub { length($_[0]) > 0 }, 20 | file => sub { $_[0] eq '-' or -f $_[0] }, 21 | filename => sub { 1 }, 22 | dir => sub { -d $_[0] }, 23 | dirname => sub { 1 }, 24 | integer => sub { $_[0] =~ m/^[+-]?\d+$/ }, 25 | float => sub { $_[0] =~ m/^[+-]?\d+(?:\.\d+)?$/ }, 26 | flag => sub { 1 }, 27 | enum => sub { 28 | my ($value, $list) = @_; 29 | any { $value eq $_ } @$list; 30 | }, 31 | ); 32 | 33 | sub process { 34 | my ($self, $run, $errs) = @_; 35 | my ($ok) = $self->_process( $errs, type => "parameters", app => $run ); 36 | $ok &&= $self->_process( $errs, type => "options", app => $run ); 37 | return $ok; 38 | } 39 | 40 | sub _process { 41 | my ($self, $errs, %args) = @_; 42 | my $run = $args{app}; 43 | my $type = $args{type}; 44 | my ($items, $specs); 45 | if ($args{type} eq "parameters") { 46 | $items = $self->parameters; 47 | $specs = $self->param_specs; 48 | } 49 | else { 50 | $items = $self->options; 51 | $specs = $self->option_specs; 52 | } 53 | 54 | # TODO: iterate over parameters in original cmdline order 55 | for my $name (sort keys %$specs) { 56 | my $spec = $specs->{ $name }; 57 | my $value = $items->{ $name }; 58 | my $param_type = $spec->type; 59 | my $enum = $spec->enum; 60 | 61 | if ($spec->type eq "flag") { 62 | if ($spec->multiple) { 63 | if (defined $value and $value !~ m/^\d+$/) { 64 | die "Value for '$name': '$value' shouldn't happen"; 65 | } 66 | } 67 | else { 68 | if (defined $value and $value != 1) { 69 | die "Value for '$name': '$value' shouldn't happen"; 70 | } 71 | } 72 | next; 73 | } 74 | 75 | my $values; 76 | if ($spec->multiple and $spec->mapping) { 77 | if (not defined $value) { 78 | $items->{ $name } = $value = {}; 79 | } 80 | $values = $value; 81 | 82 | if (not keys %$values) { 83 | if (defined (my $default = $spec->default)) { 84 | $values = { split m/=/, $default, 2 }; 85 | $items->{ $name } = $values; 86 | } 87 | } 88 | 89 | if (not keys %$values and $spec->required) { 90 | $errs->{ $type }->{ $name } = "missing"; 91 | next; 92 | } 93 | 94 | if (not keys %$values) { 95 | next; 96 | } 97 | 98 | } 99 | elsif ($spec->multiple) { 100 | if (not defined $value) { 101 | $items->{ $name } = $value = []; 102 | } 103 | $values = $value; 104 | 105 | if (not @$values) { 106 | if (defined (my $default = $spec->default)) { 107 | $values = [ $default ]; 108 | $items->{ $name } = $values; 109 | } 110 | } 111 | 112 | if ( not @$values and $spec->required) { 113 | $errs->{ $type }->{ $name } = "missing"; 114 | next; 115 | } 116 | 117 | if (not @$values) { 118 | next; 119 | } 120 | 121 | if ($spec->unique and (uniq @$values) != @$values) { 122 | $errs->{ $type }->{ $name } = "not_unique"; 123 | next; 124 | } 125 | 126 | } 127 | else { 128 | 129 | if (not defined $value) { 130 | if (defined (my $default = $spec->default)) { 131 | $value = $default; 132 | $items->{ $name } = $value; 133 | } 134 | } 135 | 136 | if ( not defined $value and $spec->required) { 137 | $errs->{ $type }->{ $name } = "missing"; 138 | next; 139 | } 140 | 141 | if (not defined $value) { 142 | next; 143 | } 144 | 145 | $values = [ $value ]; 146 | } 147 | 148 | my $def; 149 | if (ref $param_type eq 'HASH') { 150 | ($param_type, $def) = %$param_type; 151 | } 152 | my $code = $validate{ $param_type } 153 | or die "Missing method for validation type $param_type"; 154 | 155 | my $possible_values = $spec->mapping ? {} : []; 156 | if (my $spec_values = $spec->values) { 157 | if (my $op = $spec_values->{op}) { 158 | my $args = { 159 | runmode => "validation", 160 | parameter => $name, 161 | }; 162 | $possible_values = $run->cmd->$op($run, $args) || []; 163 | } 164 | elsif ($spec->mapping) { 165 | $possible_values = $spec_values->{mapping}; 166 | } 167 | else { 168 | $possible_values = $values->{enum}; 169 | } 170 | } 171 | 172 | my @to_check = $spec->mapping 173 | ? map { [ $_ => $values->{ $_ } ] } keys %$values 174 | : @$values; 175 | for my $item (@to_check) { 176 | my ($key, $v); 177 | if ($spec->mapping) { 178 | ($key, $v) = @$item; 179 | } 180 | else { 181 | $v = $item; 182 | } 183 | # check type validity 184 | my $ok = $code->($v, $def); 185 | unless ($ok) { 186 | $errs->{ $type }->{ $name } = "invalid $param_type"; 187 | } 188 | # check static enums 189 | if ($enum) { 190 | my $code = $validate{enum} 191 | or die "Missing method for validation type enum"; 192 | my $ok = $code->($v, $enum); 193 | unless ($ok) { 194 | $errs->{ $type }->{ $name } = "invalid enum"; 195 | } 196 | } 197 | if ($param_type eq 'file' and $v eq '-') { 198 | $v = do { local $/; my $t = ; \$t }; 199 | # TODO does not work for multiple 200 | $items->{ $name } = $v; 201 | } 202 | 203 | if ($spec->mapping and keys %$possible_values) { 204 | my $ok = 0; 205 | if (exists $possible_values->{ $key }) { 206 | if (my $list = $possible_values->{ $key }) { 207 | $ok = any { $_ eq $v } @$list; 208 | } 209 | else { 210 | # can have any value 211 | $ok = 1; 212 | } 213 | } 214 | unless ($ok) { 215 | $errs->{ $type }->{ $name } = "invalid value"; 216 | } 217 | } 218 | elsif (@$possible_values) { 219 | my $ok = any { 220 | is_hashref($_) ? $_->{name} eq $v : $_ eq $v 221 | } @$possible_values; 222 | unless ($ok) { 223 | $errs->{ $type }->{ $name } = "invalid value"; 224 | } 225 | } 226 | } 227 | } 228 | return (keys %$errs) ? 0 : 1; 229 | } 230 | 231 | 1; 232 | 233 | __END__ 234 | 235 | =pod 236 | 237 | =head1 NAME 238 | 239 | App::Spec::Run::Validator - Processes and validates options and parameters 240 | 241 | =head1 METHODS 242 | 243 | =over 4 244 | 245 | =item process 246 | 247 | my %errs; 248 | my $ok = $validator->process( $run, \%errs ); 249 | 250 | Returns 1 or 0. In case of validation errors, it fills C<%errs>. 251 | 252 | =back 253 | 254 | =head1 ATTRIBUTES 255 | 256 | =over 4 257 | 258 | =item options 259 | 260 | Holds the read commandline options 261 | 262 | =item parameters 263 | 264 | Holds the read commandline parameters 265 | 266 | =item option_specs 267 | 268 | Holds the items from App::Spec for options 269 | 270 | =item param_specs 271 | 272 | Holds the items from App::Spec for parameters 273 | 274 | =back 275 | 276 | =cut 277 | -------------------------------------------------------------------------------- /lib/App/Spec/Schema.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | package App::Spec::Schema; 4 | 5 | our $VERSION = '0.000'; # VERSION 6 | 7 | use base 'Exporter'; 8 | our @EXPORT_OK = qw/ $SCHEMA /; 9 | 10 | our $SCHEMA; 11 | 12 | # START INLINE 13 | $SCHEMA = { 14 | 'additionalProperties' => '', 15 | 'definitions' => { 16 | 'bool' => { 17 | 'anyOf' => [ 18 | { 19 | 'type' => 'boolean' 20 | }, 21 | { 22 | 'type' => 'integer' 23 | }, 24 | { 25 | 'maxLength' => 0, 26 | 'type' => 'string' 27 | } 28 | ] 29 | }, 30 | 'command' => { 31 | 'additionalProperties' => '', 32 | 'properties' => { 33 | 'description' => { 34 | 'type' => 'string' 35 | }, 36 | 'op' => { 37 | 'type' => 'string' 38 | }, 39 | 'options' => { 40 | '$ref' => '#/definitions/options' 41 | }, 42 | 'parameters' => { 43 | '$ref' => '#/definitions/options' 44 | }, 45 | 'subcommands' => { 46 | 'additionalProperties' => '', 47 | 'patternProperties' => { 48 | '^[a-zA-Z0-9_]+$' => { 49 | '$ref' => '#/definitions/command' 50 | } 51 | }, 52 | 'type' => 'object' 53 | }, 54 | 'summary' => { 55 | 'type' => 'string' 56 | } 57 | }, 58 | 'type' => 'object' 59 | }, 60 | 'option' => { 61 | 'additionalProperties' => '', 62 | 'anyOf' => [ 63 | { 64 | 'required' => [ 65 | 'name' 66 | ] 67 | }, 68 | { 69 | 'required' => [ 70 | 'spec' 71 | ] 72 | } 73 | ], 74 | 'properties' => { 75 | 'aliases' => { 76 | 'items' => { 77 | 'type' => 'string' 78 | }, 79 | 'type' => 'array' 80 | }, 81 | 'completion' => { 82 | 'oneOf' => [ 83 | { 84 | 'type' => 'object' 85 | }, 86 | { 87 | '$ref' => '#/definitions/bool' 88 | } 89 | ] 90 | }, 91 | 'default' => { 92 | 'type' => 'string' 93 | }, 94 | 'description' => { 95 | 'type' => 'string' 96 | }, 97 | 'enum' => { 98 | 'items' => { 99 | 'type' => 'string' 100 | }, 101 | 'type' => 'array' 102 | }, 103 | 'mapping' => { 104 | '$ref' => '#/definitions/bool' 105 | }, 106 | 'multiple' => { 107 | '$ref' => '#/definitions/bool' 108 | }, 109 | 'name' => { 110 | 'type' => 'string' 111 | }, 112 | 'required' => { 113 | '$ref' => '#/definitions/bool' 114 | }, 115 | 'spec' => { 116 | 'type' => 'string' 117 | }, 118 | 'summary' => { 119 | 'type' => 'string' 120 | }, 121 | 'type' => { 122 | 'oneOf' => [ 123 | { 124 | '$ref' => '#/definitions/optionTypeSimple' 125 | } 126 | ] 127 | }, 128 | 'unique' => { 129 | '$ref' => '#/definitions/bool' 130 | }, 131 | 'values' => { 132 | 'additionalProperties' => '', 133 | 'properties' => { 134 | 'enum' => { 135 | 'items' => { 136 | 'type' => 'string' 137 | }, 138 | 'type' => 'array' 139 | }, 140 | 'mapping' => { 141 | 'type' => 'object' 142 | }, 143 | 'op' => { 144 | 'type' => 'string' 145 | } 146 | }, 147 | 'type' => 'object' 148 | } 149 | }, 150 | 'type' => [ 151 | 'object', 152 | 'string' 153 | ] 154 | }, 155 | 'optionTypeSimple' => { 156 | 'enum' => [ 157 | 'flag', 158 | 'string', 159 | 'integer', 160 | 'float', 161 | 'file', 162 | 'filename', 163 | 'dir', 164 | 'dirname' 165 | ] 166 | }, 167 | 'options' => { 168 | 'items' => { 169 | '$ref' => '#/definitions/option' 170 | }, 171 | 'type' => 'array' 172 | } 173 | }, 174 | 'properties' => { 175 | 'abstract' => { 176 | 'type' => 'string' 177 | }, 178 | 'appspec' => { 179 | 'additionalProperties' => '', 180 | 'properties' => { 181 | 'version' => { 182 | 'type' => 'number' 183 | } 184 | }, 185 | 'required' => [ 186 | 'version' 187 | ], 188 | 'type' => 'object' 189 | }, 190 | 'class' => { 191 | 'type' => 'string' 192 | }, 193 | 'description' => { 194 | 'type' => 'string' 195 | }, 196 | 'markup' => { 197 | 'type' => 'string' 198 | }, 199 | 'name' => { 200 | 'type' => 'string' 201 | }, 202 | 'options' => { 203 | '$ref' => '#/definitions/options' 204 | }, 205 | 'parameters' => { 206 | '$ref' => '#/definitions/options' 207 | }, 208 | 'plugins' => { 209 | 'items' => { 210 | 'type' => 'string' 211 | }, 212 | 'type' => 'array' 213 | }, 214 | 'subcommands' => { 215 | 'additionalProperties' => '', 216 | 'patternProperties' => { 217 | '^[a-zA-Z0-9_]+$' => { 218 | '$ref' => '#/definitions/command' 219 | } 220 | }, 221 | 'type' => 'object' 222 | }, 223 | 'title' => { 224 | 'type' => 'string' 225 | } 226 | }, 227 | 'required' => [ 228 | 'name', 229 | 'appspec' 230 | ], 231 | 'type' => 'object' 232 | }; 233 | # END INLINE 234 | 235 | 1; 236 | -------------------------------------------------------------------------------- /lib/App/Spec/Subcommand.pm: -------------------------------------------------------------------------------- 1 | # ABSTRACT: Represents an App::Spec subcommand 2 | use strict; 3 | use warnings; 4 | package App::Spec::Subcommand; 5 | 6 | our $VERSION = '0.000'; # VERSION 7 | 8 | use App::Spec::Option; 9 | use App::Spec::Parameter; 10 | 11 | use Moo; 12 | 13 | with('App::Spec::Role::Command'); 14 | 15 | has summary => ( is => 'ro' ); 16 | has subcommand_required => ( is => 'ro' ); 17 | 18 | sub default_plugins { } 19 | 20 | 1; 21 | 22 | __END__ 23 | 24 | =pod 25 | 26 | =head1 NAME 27 | 28 | App::Spec::Subcommand - Represents an App::Spec subcommand 29 | 30 | =head1 METHODS 31 | 32 | =over 4 33 | 34 | =item default_plugins 35 | 36 | Returns an empty list 37 | 38 | =back 39 | 40 | =head1 ATTRIBUTES 41 | 42 | =over 4 43 | 44 | =item summary, subcommand_required 45 | 46 | Items from the specification. 47 | 48 | =back 49 | 50 | =cut 51 | -------------------------------------------------------------------------------- /lib/App/Spec/Tutorial.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | App::Spec::Tutorial - How to write an app with App::Spec::Run 4 | 5 | =head1 LINKS 6 | 7 | =over 4 8 | 9 | =item Options and parameters 10 | 11 | See L for documentation and examples on how to 12 | define options and parameters. 13 | 14 | =back 15 | 16 | =head1 GENERATOR 17 | 18 | You can generate a boilerplate with appspec: 19 | 20 | appspec new --class App::Birthdays --name birthdays.pl 21 | 22 | For documentation, look at L and L. 23 | 24 | =head1 EXAMPLES 25 | 26 | =head1 A minimal app called birthdays.pl 27 | 28 | The smallest example would be the following app. It doesn't 29 | use subcommands. 30 | 31 | =over 4 32 | 33 | =item birthdays.pl 34 | 35 | use strict; 36 | use warnings; 37 | package App::Birthdays; 38 | use base 'App::Spec::Run::Cmd'; 39 | 40 | sub execute { 41 | my ($self, $run) = @_; 42 | my $date = $run->options->{date}; 43 | my $output = <<"EOM"; 44 | Birthdays $date: 45 | 46 | EOM 47 | $output .= "Larry Wall"; 48 | if ($run->options->{age}) { 49 | $output .= " (Age: unknown)"; 50 | } 51 | $output .= "\n"; 52 | $run->out($output); 53 | } 54 | 55 | package main; 56 | use App::Spec; 57 | 58 | App::Spec->read("$Bin/birthdays.yaml")->runner->run; 59 | 60 | =item birthdays.yaml 61 | 62 | Short version: 63 | 64 | name: birthdays.pl 65 | title: Show birthdays 66 | appspec: { version: '0.001' } 67 | class: App::Birthdays 68 | options: 69 | - date=s =today --Date 70 | - age --Show age 71 | 72 | Long version: 73 | 74 | name: birthdays.pl 75 | title: Show birthdays 76 | appspec: { version: '0.001' } 77 | class: App::Birthdays 78 | options: 79 | - name: date 80 | type: string 81 | default: today 82 | summary: Date 83 | - name: age 84 | type: flag 85 | summary: Show age 86 | 87 | =back 88 | 89 | =cut 90 | -------------------------------------------------------------------------------- /share/schema.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | type: object 3 | additionalProperties: false 4 | required: [name, appspec] 5 | properties: 6 | name: { type: string } 7 | appspec: 8 | type: object 9 | required: [version] 10 | additionalProperties: false 11 | properties: 12 | version: { type: number } 13 | title: { type: string } 14 | abstract: { type: string } 15 | description: { type: string } 16 | markup: { type: string } 17 | class: { type: string } 18 | plugins: 19 | type: array 20 | items: { type: string } 21 | options: { '$ref': '#/definitions/options' } 22 | parameters: { '$ref': '#/definitions/options' } 23 | subcommands: 24 | type: object 25 | additionalProperties: false 26 | patternProperties: 27 | "^[a-zA-Z0-9_]+$": 28 | '$ref': '#/definitions/command' 29 | 30 | definitions: 31 | 32 | optionTypeSimple: 33 | enum: [flag, string, integer, float, file, filename, dir, dirname] 34 | 35 | options: 36 | type: array 37 | items: 38 | '$ref': '#/definitions/option' 39 | 40 | option: 41 | type: [object, string] 42 | additionalProperties: false 43 | anyOf: 44 | - required: [name] 45 | - required: [spec] 46 | properties: 47 | name: { type: string } 48 | spec: { type: string } 49 | summary: { type: string } 50 | description: { type: string } 51 | multiple: { '$ref': '#/definitions/bool' } 52 | mapping: { '$ref': '#/definitions/bool' } 53 | unique: { '$ref': '#/definitions/bool' } 54 | type: 55 | oneOf: 56 | - '$ref': '#/definitions/optionTypeSimple' 57 | enum: 58 | type: array 59 | items: { type: string } 60 | default: { type: string } 61 | aliases: 62 | type: array 63 | items: { type: string } 64 | required: { '$ref': '#/definitions/bool' } 65 | values: 66 | type: object 67 | additionalProperties: false 68 | properties: 69 | op: { type: string } 70 | mapping: 71 | type: object 72 | enum: 73 | type: array 74 | items: { type: string } 75 | completion: 76 | oneOf: 77 | - { type: object } 78 | - { '$ref': '#/definitions/bool' } 79 | 80 | command: 81 | type: object 82 | additionalProperties: false 83 | properties: 84 | summary: { type: string } 85 | description: { type: string } 86 | op: { type: string } 87 | options: { '$ref': '#/definitions/options' } 88 | parameters: { '$ref': '#/definitions/options' } 89 | subcommands: 90 | type: object 91 | additionalProperties: false 92 | patternProperties: 93 | "^[a-zA-Z0-9_]+$": 94 | '$ref': '#/definitions/command' 95 | 96 | bool: 97 | anyOf: 98 | - { type: boolean } 99 | - { type: integer } 100 | - { type: string, maxLength: 0 } 101 | -------------------------------------------------------------------------------- /t/00.compile.t: -------------------------------------------------------------------------------- 1 | use 5.006; 2 | use strict; 3 | use warnings; 4 | 5 | # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 6 | 7 | use Test::More; 8 | 9 | plan tests => 22 + ($ENV{AUTHOR_TESTING} ? 1 : 0); 10 | 11 | my @module_files = ( 12 | 'App/Spec.pm', 13 | 'App/Spec/Argument.pm', 14 | 'App/Spec/Completion.pm', 15 | 'App/Spec/Completion/Bash.pm', 16 | 'App/Spec/Completion/Zsh.pm', 17 | 'App/Spec/Option.pm', 18 | 'App/Spec/Parameter.pm', 19 | 'App/Spec/Plugin/Format.pm', 20 | 'App/Spec/Plugin/Help.pm', 21 | 'App/Spec/Plugin/Meta.pm', 22 | 'App/Spec/Pod.pm', 23 | 'App/Spec/Role/Command.pm', 24 | 'App/Spec/Role/Plugin.pm', 25 | 'App/Spec/Role/Plugin/GlobalOptions.pm', 26 | 'App/Spec/Role/Plugin/Subcommand.pm', 27 | 'App/Spec/Run.pm', 28 | 'App/Spec/Run/Cmd.pm', 29 | 'App/Spec/Run/Output.pm', 30 | 'App/Spec/Run/Response.pm', 31 | 'App/Spec/Run/Validator.pm', 32 | 'App/Spec/Schema.pm', 33 | 'App/Spec/Subcommand.pm' 34 | ); 35 | 36 | 37 | 38 | # no fake home requested 39 | 40 | my @switches = ( 41 | -d 'blib' ? '-Mblib' : '-Ilib', 42 | ); 43 | 44 | use File::Spec; 45 | use IPC::Open3; 46 | use IO::Handle; 47 | 48 | open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; 49 | 50 | my @warnings; 51 | for my $lib (@module_files) 52 | { 53 | # see L 54 | my $stderr = IO::Handle->new; 55 | 56 | diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } 57 | $^X, @switches, '-e', "require q[$lib]")) 58 | if $ENV{PERL_COMPILE_TEST_DEBUG}; 59 | 60 | my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); 61 | binmode $stderr, ':crlf' if $^O eq 'MSWin32'; 62 | my @_warnings = <$stderr>; 63 | waitpid($pid, 0); 64 | is($?, 0, "$lib loaded ok"); 65 | 66 | shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ 67 | and not eval { +require blib; blib->VERSION('1.01') }; 68 | 69 | if (@_warnings) 70 | { 71 | warn @_warnings; 72 | push @warnings, @_warnings; 73 | } 74 | } 75 | 76 | 77 | 78 | is(scalar(@warnings), 0, 'no warnings found') 79 | or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; 80 | 81 | 82 | -------------------------------------------------------------------------------- /t/00.load.t: -------------------------------------------------------------------------------- 1 | 2 | use Test::More tests => 11; 3 | 4 | use_ok( 'App::Spec' ); 5 | use_ok( 'App::Spec::Run' ); 6 | use_ok( 'App::Spec::Run::Cmd' ); 7 | use_ok( 'App::Spec::Option' ); 8 | use_ok( 'App::Spec::Parameter' ); 9 | use_ok( 'App::Spec::Argument' ); 10 | use_ok( 'App::Spec::Subcommand' ); 11 | use_ok( 'App::Spec::Run::Validator' ); 12 | use_ok( 'App::Spec::Completion' ); 13 | use_ok( 'App::Spec::Completion::Zsh' ); 14 | use_ok( 'App::Spec::Completion::Bash' ); 15 | -------------------------------------------------------------------------------- /t/11.appspecrun.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use FindBin '$Bin'; 5 | use lib "$Bin/lib"; 6 | use App::Spec::Example::MyApp; 7 | use App::Spec::Example::MySimpleApp; 8 | use App::Spec::Example::Nometa; 9 | use App::Spec; 10 | use YAML::PP; 11 | $ENV{PERL5_APPSPECRUN_COLOR} = 'never'; 12 | $ENV{PERL5_APPSPECRUN_TEST} = 1; 13 | 14 | my @datafiles = map { 15 | "$Bin/data/$_" 16 | } qw/ 11.completion.yaml 11.invalid.yaml 11.valid.yaml /; 17 | my @testdata = map { my $d = YAML::PP::LoadFile($_); @$d } @datafiles; 18 | 19 | for my $test (@testdata) { 20 | my $args = $test->{args}; 21 | my $app = shift @$args; 22 | my $spec = App::Spec->read("$Bin/../examples/$app-spec.yaml"); 23 | my $runner = $spec->runner; 24 | $runner->response->buffered(1); 25 | my $exit = $test->{exit} || 0; 26 | my $env = $test->{env}; 27 | my $name = "$app args: (@$args)"; 28 | $name .= ", $_=$env->{$_}" for sort keys %$env; 29 | 30 | subtest $name => sub { 31 | { 32 | local @ARGV = @$args; 33 | local %ENV = %ENV; 34 | if ($env) { 35 | @ENV{ keys %$env } = values %$env; 36 | } 37 | $runner->process; 38 | }; 39 | my $res = $runner->response; 40 | my $outputs = $res->outputs; 41 | my @stdout_output = map { $_->content } grep { not $_->error } @$outputs; 42 | my @stderr_output = map { $_->content } grep { $_->error } @$outputs; 43 | 44 | my $res_exit = $res->exit; 45 | cmp_ok ( $res_exit, '==', $exit, "Expecting to exit with $exit" ); 46 | 47 | my $stdout = $test->{stdout} || []; 48 | my $stderr = $test->{stderr} || []; 49 | $stdout = [$stdout] unless ref $stdout eq 'ARRAY'; 50 | $stderr = [$stderr] unless ref $stderr eq 'ARRAY'; 51 | 52 | for my $item (@$stdout) { 53 | my $regex = $item->{regex}; 54 | like ( "@stdout_output", qr{$regex}, "Expecting STDOUT: $regex" ); 55 | } 56 | for my $item (@$stderr) { 57 | my $regex = $item->{regex}; 58 | like ( "@stderr_output", qr{$regex}, "Expecting STDERR: $regex" ); 59 | } 60 | }; 61 | } 62 | 63 | done_testing; 64 | -------------------------------------------------------------------------------- /t/12.dsl.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use constant TESTS => 8; 5 | use Test::More tests => TESTS; 6 | 7 | use FindBin '$Bin'; 8 | use YAML::PP qw/ LoadFile /; 9 | use App::Spec; 10 | use Test::Deep; 11 | use Data::Dumper; 12 | 13 | my @docs = LoadFile("$Bin/data/12.dsl.yaml"); 14 | my $spec1 = App::Spec->read($docs[0]); 15 | my $spec2 = App::Spec->read($docs[1]); 16 | 17 | for my $i (0 .. TESTS - 1) { 18 | my $dsl = $spec1->options->[$i]; 19 | my $compare = $spec2->options->[$i]; 20 | # warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$dsl], ['dsl']); 21 | # warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$compare], ['compare']); 22 | 23 | cmp_deeply( 24 | $dsl, 25 | $compare, 26 | "dsl: option $i", 27 | ); 28 | } 29 | -------------------------------------------------------------------------------- /t/13.argv.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 3; 4 | use Test::Deep; 5 | use FindBin '$Bin'; 6 | use lib "$Bin/lib"; 7 | use App::Spec::Example::MyApp; 8 | use App::Spec; 9 | $ENV{PERL5_APPSPECRUN_COLOR} = 'never'; 10 | $ENV{PERL5_APPSPECRUN_TEST} = 1; 11 | 12 | { 13 | my $spec = App::Spec->read("$Bin/../examples/myapp-spec.yaml"); 14 | my @args = qw/ help convert /; 15 | 16 | my $runner1 = $spec->runner; 17 | { 18 | local @ARGV = @args; 19 | $runner1->process; 20 | }; 21 | 22 | my $runner2 = $spec->runner( 23 | argv => [@args], 24 | ); 25 | $runner2->process; 26 | 27 | my $res1 = $runner1->response; 28 | my $res2 = $runner2->response; 29 | # we don't care about the callbacks here 30 | $_->callbacks([]) for ($res1, $res2); 31 | cmp_deeply( 32 | $res1, 33 | $res2, 34 | "response is the same for default and custom \@ARGV", 35 | ); 36 | 37 | cmp_deeply( 38 | $runner1->argv_orig, 39 | [@args], 40 | "argv_orig() correct", 41 | ); 42 | cmp_deeply( 43 | $runner1->argv, 44 | [], 45 | "argv() empty", 46 | ); 47 | } 48 | 49 | done_testing; 50 | -------------------------------------------------------------------------------- /t/14.disable-plugins.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use FindBin '$Bin'; 5 | use lib "$Bin/lib"; 6 | 7 | use Test::More; 8 | use App::Spec; 9 | use App::Spec::Example::Nometa; 10 | use Data::Dumper; 11 | 12 | my $specfile = "$Bin/../examples/nometa-spec.yaml"; 13 | 14 | subtest nometa_valid => sub { 15 | my $spec = App::Spec->read($specfile); 16 | my $runner = $spec->runner; 17 | $runner->response->buffered(1); 18 | { 19 | local @ARGV = qw/ foo a /; 20 | $runner->process; 21 | }; 22 | my $res = $runner->response; 23 | my $outputs = $res->outputs; 24 | cmp_ok(scalar @$outputs, '==', 1, "Output number ok"); 25 | my $output = $outputs->[0]; 26 | cmp_ok($output->content, 'eq', "foo\n", "Output ok"); 27 | }; 28 | 29 | subtest nometa_invalid => sub { 30 | my $spec = App::Spec->read($specfile); 31 | my $runner = $spec->runner; 32 | $runner->response->buffered(1); 33 | { 34 | local @ARGV = qw/ _meta /; 35 | $runner->process; 36 | }; 37 | my $res = $runner->response; 38 | my $outputs = $res->outputs; 39 | my $output = $outputs->[1]; 40 | cmp_ok($output->content, '=~', qr{Unknown subcommand}, "Output error as expected"); 41 | }; 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /t/15.generate-pod.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use FindBin '$Bin'; 5 | use lib "$Bin/lib"; 6 | use App::Spec; 7 | use App::Spec::Pod; 8 | 9 | my @apps = qw(nometa mysimpleapp myapp pcorelist); 10 | for my $app (@apps) { 11 | my $spec = App::Spec->read("$Bin/../examples/$app-spec.yaml"); 12 | my $podfile = "$Bin/../examples/pod/$app.pod"; 13 | my $podexpected = do { open my $fh, '<', $podfile; local $/; <$fh> }; 14 | my $generator = App::Spec::Pod->new( 15 | spec => $spec, 16 | ); 17 | my $pod = $generator->generate; 18 | s/\s+\z// for $pod, $podexpected; 19 | cmp_ok $pod, 'eq', $podexpected, "Pod for $app like expected"; 20 | } 21 | 22 | done_testing; 23 | -------------------------------------------------------------------------------- /t/data/11.completion.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | - 3 | env: 4 | PERL5_APPSPECRUN_COMPLETION_PARAMETER: country 5 | PERL5_APPSPECRUN_SHELL: zsh 6 | args: [ myapp, weather, show ] 7 | stdout: 8 | regex: Austria\nGermany\nNetherlands 9 | exit: 0 10 | - 11 | env: 12 | PERL5_APPSPECRUN_COMPLETION_PARAMETER: city 13 | PERL5_APPSPECRUN_SHELL: bash 14 | args: [ myapp, weather, show, Netherlands ] 15 | stdout: 16 | - regex: Amsterdam\tAmsterdam 17 | - regex: Echt\tEcht 18 | exit: 0 19 | - 20 | env: 21 | PERL5_APPSPECRUN_COMPLETION_PARAMETER: city 22 | args: [ myapp, weather, show, Netherlands ] 23 | stdout: 24 | regex: '^$' 25 | exit: 0 26 | 27 | - 28 | env: 29 | PERL5_APPSPECRUN_COMPLETION_PARAMETER: target 30 | PERL5_APPSPECRUN_SHELL: zsh 31 | args: [ myapp, convert, distance, meter, 23 ] 32 | stdout: 33 | - regex: 'foot' 34 | - regex: 'inch' 35 | exit: 0 36 | - 37 | env: 38 | PERL5_APPSPECRUN_COMPLETION_PARAMETER: target 39 | PERL5_APPSPECRUN_SHELL: zsh 40 | args: [ myapp, convert, distance, meter, 23, foot, '' ] 41 | stdout: 42 | - regex: '^inch$' 43 | exit: 0 44 | 45 | # vim:et:sts=2:sws=2:sw=2:foldmethod=indent 46 | -------------------------------------------------------------------------------- /t/data/11.invalid.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | - 3 | # missing parameter 4 | args: [ myapp, cook ] 5 | stderr: 6 | - regex: 'Usage: myapp cook \[options\]' 7 | - regex: (?s:drink.*missing) 8 | exit: 1 9 | - 10 | # invalid subcommand 11 | args: [ myapp, foo ] 12 | stderr: 13 | - regex: 'Usage: myapp ' 14 | - regex: Unknown subcommand 'foo' 15 | exit: 1 16 | - 17 | args: [ myapp, cook, tea, --with, salt ] 18 | stderr: 19 | - regex: 'Usage: myapp cook \[options\]' 20 | - regex: 'with.*invalid' 21 | exit: 1 22 | - 23 | args: [ myapp ] 24 | stderr: 25 | - regex: 'Usage: myapp ' 26 | - regex: Missing subcommand 27 | exit: 1 28 | - 29 | args: [ myapp, weather, show, Netherlands ] 30 | stderr: 31 | - regex: 'Usage: myapp weather show \+' 32 | - regex: 'city.*missing' 33 | exit: 1 34 | - 35 | args: [ myapp, convert, nonsense ] 36 | stderr: 37 | - regex: 'Usage: myapp convert \+' 38 | - regex: 'type.*invalid' 39 | exit: 1 40 | - 41 | args: [ myapp, convert, distance, meter, 23, foot, foot ] 42 | stderr: 43 | - regex: 'Usage: myapp convert \+' 44 | - regex: 'target.*not_unique' 45 | exit: 1 46 | - 47 | args: [ myapp, convert, distance, meter, foobar, foot ] 48 | stderr: 49 | - regex: 'Usage: myapp convert \+' 50 | - regex: 'value.*invalid' 51 | exit: 1 52 | 53 | - 54 | args: [ myapp, config, --set, colour=auto ] 55 | stderr: 56 | - regex: 'set.*invalid' 57 | exit: 1 58 | 59 | - 60 | args: [ myapp, config, --set, colour= ] 61 | stderr: 62 | - regex: 'set.*invalid' 63 | exit: 1 64 | 65 | - 66 | args: [ myapp, config, --set, colour=nothanks ] 67 | stderr: 68 | - regex: 'set.*invalid' 69 | exit: 1 70 | 71 | # TODO 72 | #- 73 | # args: [ myapp, config, --set, colour ] 74 | # stderr: 75 | # - regex: 'set.*invalid' 76 | # exit: 1 77 | 78 | - 79 | args: [ myapp, palindrome, aha, heh ] 80 | stderr: 81 | - regex: 'Sorry, only one palindrome at a time' 82 | exit: 1 83 | # vim:et:sts=2:sws=2:sw=2:foldmethod=indent 84 | -------------------------------------------------------------------------------- /t/data/11.valid.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | - 3 | args: [ mysimpleapp, -h ] 4 | stdout: 5 | - regex: 'Usage: mysimpleapp \[options\]' 6 | - regex: '--longoption some long option' 7 | - regex: ' split over' 8 | - regex: '--longoption2 some other long option' 9 | - regex: ' description split' 10 | exit: 0 11 | - 12 | args: [ mysimpleapp, -vvv ] 13 | stdout: 14 | - regex: 'Options: verbose=3' 15 | exit: 0 16 | - 17 | args: [ myapp, cook, tea, --sugar, -vv, --verbose ] 18 | stdout: 19 | - regex: 'Options: sugar=1,verbose=3' 20 | - regex: 'Parameters: drink=tea' 21 | - regex: 'Subcommands: cook' 22 | exit: 0 23 | - 24 | args: [ myapp, cook, tea, --with, "almond milk" ] 25 | stdout: 26 | - regex: 'Options: with=almond milk' 27 | - regex: 'Parameters: drink=tea' 28 | - regex: 'Subcommands: cook' 29 | exit: 0 30 | - 31 | args: [ myapp, help ] 32 | stdout: 33 | regex: 'Usage: myapp \[options\]' 34 | exit: 0 35 | - 36 | args: [ myapp, help ] 37 | stdout: 38 | regex: 'Usage: myapp \[options\]' 39 | exit: 0 40 | - 41 | args: [ myapp, convert, temperature, celsius, 23, kelvin ] 42 | stdout: 43 | - regex: 296\.15K 44 | exit: 0 45 | 46 | - 47 | args: [ myapp, config, --set, color=auto, --set, push.default=current ] 48 | stdout: 49 | - regex: 'Options: set=\(color=auto\),set=\(push.default=current\)' 50 | exit: 0 51 | 52 | - 53 | args: [ myapp, config, --set, name=wall] 54 | stdout: 55 | - regex: 'Options: set=\(name=wall\)' 56 | exit: 0 57 | 58 | - 59 | args: [ myapp, data, --item, hash, --format YAML] 60 | stdout: 61 | - regex: "Data 'hash':" 62 | exit: 0 63 | - 64 | args: [ nometa, help ] 65 | stdout: 66 | - regex: 'Usage: nometa \[options\]' 67 | - regex: 'longsubcommand A subcommand with a' 68 | - regex: ' very long summary split' 69 | exit: 0 70 | - 71 | args: [ nometa, help, longsubcommand ] 72 | stdout: 73 | - regex: 'Usage: nometa longsubcommand \[\] \[options\]' 74 | - regex: 'longparam A parameter with a' 75 | - regex: ' very long summary split' 76 | exit: 0 77 | # vim:et:sts=2:sws=2:sw=2:foldmethod=indent 78 | -------------------------------------------------------------------------------- /t/data/12.dsl.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | # version with short dsl syntax 3 | name: myapp 4 | appspec: { version: 0.001 } 5 | class: App::Spec::Example::MyApp 6 | title: My Very Cool App 7 | options: 8 | - spec: foo --Foo 9 | - spec: verbose|v+ --be verbose 10 | - spec: +req --Some required flag 11 | - spec: number=i --integer option 12 | - spec: number2|n= +integer --integer option 13 | - spec: fnumber=f --float option 14 | - spec: fnumber2|f= +float --float option 15 | - spec: date|d=s =today 16 | - spec: items=s@ --multi option 17 | - spec: set=s% --multiple key=value pairs 18 | 19 | --- 20 | # version with verbose syntax 21 | name: myapp 22 | appspec: { version: 0.001 } 23 | class: App::Spec::Example::MyApp 24 | title: My Very Cool App 25 | options: 26 | - name: foo 27 | type: flag 28 | summary: Foo 29 | - name: verbose 30 | summary: be verbose 31 | type: flag 32 | multiple: true 33 | aliases: ["v"] 34 | - name: req 35 | summary: Some required flag 36 | required: true 37 | type: flag 38 | - name: number 39 | summary: integer option 40 | type: integer 41 | - name: number2 42 | summary: integer option 43 | type: integer 44 | aliases: ["n"] 45 | - name: fnumber 46 | summary: float option 47 | type: float 48 | - name: fnumber2 49 | summary: float option 50 | type: float 51 | aliases: ["f"] 52 | - name: date 53 | type: string 54 | default: today 55 | aliases: ["d"] 56 | - name: items 57 | type: string 58 | multiple: true 59 | summary: multi option 60 | - name: set 61 | type: string 62 | multiple: true 63 | mapping: true 64 | summary: multiple key=value pairs 65 | 66 | # vim:et:sts=2:sws=2:sw=2:foldmethod=indent 67 | -------------------------------------------------------------------------------- /t/lib/App/Spec/Example/MyApp.pm: -------------------------------------------------------------------------------- 1 | package App::Spec::Example::MyApp; 2 | use warnings; 3 | use strict; 4 | use 5.010; 5 | 6 | use Ref::Util qw/ is_arrayref is_hashref /; 7 | 8 | use base 'App::Spec::Run::Cmd'; 9 | 10 | sub _dump_hash { 11 | my ($self, $hash) = @_; 12 | my @strings; 13 | for my $key (sort keys %$hash) { 14 | next unless defined $hash->{ $key }; 15 | my $value = $hash->{ $key }; 16 | if (is_hashref($value)) { 17 | for my $key2 (sort keys %$value) { 18 | push @strings, "$key=($key2=$value->{ $key2 })"; 19 | } 20 | } 21 | else { 22 | push @strings, "$key=$value"; 23 | } 24 | } 25 | return join ",", @strings; 26 | } 27 | 28 | sub cook { 29 | my ($self, $run) = @_; 30 | my $param = $run->parameters; 31 | my $opt = $run->options; 32 | if ($ENV{PERL5_APPSPECRUN_TEST}) { 33 | $run->out("Subcommands: cook"); 34 | $run->out("Options: " . $self->_dump_hash($opt)); 35 | $run->out("Parameters: " . $self->_dump_hash($param)); 36 | return; 37 | } 38 | 39 | my @with; 40 | my $with = $opt->{with} // ''; 41 | if ($with eq "cow milk") { 42 | die "Sorry, no cow milk today. go vegan\n"; 43 | } 44 | push @with, $with if $with; 45 | push @with, "sugar" if $opt->{sugar}; 46 | 47 | $run->out("Starting to cook $param->{drink}" 48 | . (@with ? " with ". (join " and ", @with) : '')); 49 | } 50 | 51 | my %countries = ( 52 | Austria => { 53 | Vienna => { weather => "sunny =)", temperature => 23 }, 54 | Salzburg => { weather => "rainy =(", temperature => 13 }, 55 | }, 56 | Germany => { 57 | Berlin => { weather => "snow =)", temperature => -2 }, 58 | Hamburg => { weather => "sunny =)", temperature => 19 }, 59 | Frankfurt => { weather => "rainy =(", temperature => 23 }, 60 | }, 61 | Netherlands => { 62 | Amsterdam => { weather => "rainy =(", temperature => 17 }, 63 | Echt => { weather => "sunny =)", temperature => 37 }, 64 | }, 65 | ); 66 | 67 | sub weather { 68 | my ($self, $run) = @_; 69 | my $param = $run->parameters; 70 | my $cities = $param->{city}; 71 | for my $city (@$cities) { 72 | my $info = $countries{ $param->{country} }->{ $city }; 73 | my $output = sprintf "Weather in %s/%s: %s", $param->{country}, $city, $info->{weather}; 74 | if ($run->options->{temperature}) { 75 | my $temp = $info->{temperature}; 76 | my $label = "°C"; 77 | if ($run->options->{fahrenheit}) { 78 | $temp = int($temp * 9 / 5 + 32); 79 | $label = "F"; 80 | } 81 | $output .= " (Temperature: $temp$label)"; 82 | } 83 | say $output; 84 | } 85 | } 86 | 87 | sub countries { 88 | say for sort keys %countries; 89 | } 90 | 91 | sub cities { 92 | my ($self, $run) = @_; 93 | my $country = $run->options->{country}; 94 | my @countries = @$country ? @$country : sort keys %countries; 95 | say for map { sort keys %$_ } @countries{ @countries }; 96 | } 97 | 98 | sub weather_complete { 99 | my ($self, $run, $args) = @_; 100 | my $runmode = $args->{runmode}; 101 | return if $runmode ne "completion"; 102 | my $comp_param = $args->{parameter}; 103 | 104 | my $param = $run->parameters; 105 | if ($comp_param eq "city") { 106 | my $country = $param->{country}; 107 | my $cities = $countries{ $country } or return; 108 | return [map { +{ name => $_, description => "$_ ($country)" } } sort keys %$cities]; 109 | } 110 | elsif ($comp_param eq "country") { 111 | my @countries = sort keys %countries; 112 | return \@countries; 113 | } 114 | return; 115 | } 116 | 117 | sub palindrome{ 118 | my ($self, $run) = @_; 119 | my $string = $run->parameters->{string}; 120 | my $argv = $run->argv; 121 | if (@$argv) { 122 | $run->err("Sorry, only one palindrome at a time"); 123 | $run->halt(1); 124 | return; 125 | } 126 | $run->out( ($string eq reverse $string) ? "yes" : "nope" ); 127 | } 128 | 129 | my %units = ( 130 | temperature => { 131 | celsius => { label => "°C" }, 132 | kelvin => { label => "K" }, 133 | fahrenheit => { label => "°F" }, 134 | }, 135 | distance => { 136 | meter => { label => "m" }, 137 | inch => { label => "in" }, 138 | foot => { label => "ft" }, 139 | }, 140 | ); 141 | 142 | use constant KELVIN => 273.15; 143 | sub celsius_fahrenheit { $_[0] * 9 / 5 + 32 } 144 | sub fahrenheit_celsius { ($_[0] - 32) / (9 / 5) } 145 | sub meter_inch { $_[0] * 39.37 } 146 | sub inch_meter { $_[0] / 39.37 } 147 | sub meter_foot { $_[0] * 3.28083 } 148 | sub foot_meter { $_[0] / 3.28083 } 149 | sub inch_foot { $_[0] / 12 } 150 | sub foot_inch { $_[0] * 12 } 151 | my %conversions = ( 152 | temperature => { 153 | celsius_fahrenheit => sub { 154 | return sprintf "%.2f", celsius_fahrenheit($_[0]) 155 | }, 156 | celsius_kelvin => sub { 157 | return sprintf "%.2f", ($_[0] + KELVIN); 158 | }, 159 | fahrenheit_celsius => sub { 160 | return sprintf "%.2f", fahrenheit_celsius($_[0]) 161 | }, 162 | fahrenheit_kelvin => sub { 163 | return sprintf "%.2f", fahrenheit_celsius($_[0]) + KELVIN 164 | }, 165 | kelvin_celsius => sub { 166 | return sprintf "%.2f", $_[0] - KELVIN 167 | }, 168 | kelvin_fahrenheit => sub { 169 | return sprintf "%.2f", celsius_fahrenheit($_[0] - KELVIN) 170 | }, 171 | }, 172 | distance => { 173 | meter_inch => sub { sprintf "%.3f", meter_inch($_[0]) }, 174 | inch_meter => sub { sprintf "%.3f", inch_meter($_[0]) }, 175 | meter_foot => sub { sprintf "%.3f", meter_foot($_[0]) }, 176 | foot_meter => sub { sprintf "%.3f", foot_meter($_[0]) }, 177 | inch_foot => sub { sprintf "%.3f", inch_foot($_[0]) }, 178 | foot_inch => sub { sprintf "%.3f", foot_inch($_[0]) }, 179 | }, 180 | ); 181 | 182 | sub convert { 183 | my ($self, $run) = @_; 184 | my $param = $run->parameters; 185 | my $type = $param->{type}; 186 | my $source = $param->{source}; 187 | my $targets = $param->{target}; 188 | my $value = $param->{value}; 189 | for my $target (@$targets) { 190 | my $key = $source . '_' . $target; 191 | my $sub = $conversions{ $type }->{ $key }; 192 | my $result = $sub->($value); 193 | my $label = $units{ $type }->{ $target }->{label}; 194 | $run->out("$result$label"); 195 | } 196 | } 197 | 198 | sub config { 199 | my ($self, $run, $args) = @_; 200 | my $opt = $run->options; 201 | my $param = $run->parameters; 202 | if ($ENV{PERL5_APPSPECRUN_TEST}) { 203 | $run->out("Options: " . $self->_dump_hash($opt)); 204 | return; 205 | } 206 | warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$opt], ['opt']); 207 | } 208 | 209 | sub data { 210 | my ($self, $run) = @_; 211 | my $opt = $run->options; 212 | my $item = $opt->{item}; 213 | 214 | my $ref; 215 | if ($item eq 'hash') { 216 | $ref = { 217 | foo => 23, 218 | }; 219 | } 220 | elsif ($item eq 'table') { 221 | $ref = [ 222 | [qw/ FOO BAR /], 223 | [ qw/ a b /], 224 | [ qw/ c d /], 225 | ]; 226 | } 227 | 228 | # instead of print Data::Dumper->Dump($ref) or doing your own YAML or JSON 229 | # encoding simply pass it to App::Spec 230 | $run->out("Data '$item':"); 231 | $run->out($ref); 232 | } 233 | 234 | sub convert_complete { 235 | my ($self, $run, $args) = @_; 236 | my $errors = $run->validation_errors; 237 | my $runmode = $args->{runmode}; 238 | return if ($runmode ne "completion" and $runmode ne "validation"); 239 | my $comp_param = $args->{parameter}; 240 | my $param = $run->parameters; 241 | 242 | if ($comp_param eq 'type') { 243 | return [sort keys %units]; 244 | } 245 | if (delete $errors->{parameters}->{type}) { 246 | $run->err("Invalid type\n"); 247 | return; 248 | } 249 | if ($comp_param eq 'source') { 250 | my $type = $param->{type}; 251 | my $units = $units{ $type }; 252 | return [map { 253 | +{ name => $_, description => $units->{ $_ }->{label} } 254 | } keys %$units]; 255 | } 256 | if (delete $errors->{parameters}->{source}) { 257 | $run->err("Invalid source\n"); 258 | return; 259 | } 260 | delete $errors->{parameters}->{target}; 261 | if (delete $errors->{parameters}->{value}) { 262 | $run->err("Invalid value\n"); 263 | return; 264 | } 265 | if ($comp_param eq 'target') { 266 | my $type = $param->{type}; 267 | my $source = $param->{source}; 268 | my $value = $param->{value}; 269 | my $units = $units{ $type }; 270 | my @result; 271 | for my $unit (sort keys %$units) { 272 | next if $unit eq $source; 273 | my $label = $units->{ $unit }->{label}; 274 | my $key = $source . '_' . $unit; 275 | my $sub = $conversions{ $type }->{ $key }; 276 | my $result = $sub->($value); 277 | if ($ENV{PERL5_APPSPECRUN_TEST}) { 278 | push @result, $unit; 279 | } 280 | else { 281 | push @result, { 282 | name => $unit, 283 | description => "$result$label", 284 | }; 285 | } 286 | } 287 | return \@result; 288 | } 289 | } 290 | 291 | 1; 292 | -------------------------------------------------------------------------------- /t/lib/App/Spec/Example/MySimpleApp.pm: -------------------------------------------------------------------------------- 1 | package App::Spec::Example::MySimpleApp; 2 | use warnings; 3 | use strict; 4 | use 5.010; 5 | 6 | use base 'App::Spec::Run::Cmd'; 7 | 8 | sub execute { 9 | my ($self, $run) = @_; 10 | my $opt = $run->options; 11 | my $param = $run->parameters; 12 | if ($ENV{PERL5_APPSPECRUN_TEST}) { 13 | $run->out("Options: " . App::Spec::Example::MyApp->_dump_hash($opt)); 14 | $run->out("Parameters: " . App::Spec::Example::MyApp->_dump_hash($param)); 15 | return; 16 | } 17 | warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$opt], ['opt']); 18 | warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$param], ['param']); 19 | 20 | } 21 | 22 | 1; 23 | -------------------------------------------------------------------------------- /t/lib/App/Spec/Example/Nometa.pm: -------------------------------------------------------------------------------- 1 | package App::Spec::Example::Nometa; 2 | use strict; 3 | use warnings; 4 | use 5.010; 5 | 6 | use base 'App::Spec::Run::Cmd'; 7 | 8 | sub foo { 9 | my ($self, $run) = @_; 10 | $run->out("foo"); 11 | 12 | } 13 | 14 | 1; 15 | -------------------------------------------------------------------------------- /utils/generate-schema-pm.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use 5.010; 5 | use FindBin '$Bin'; 6 | 7 | use Data::Dumper; 8 | use YAML::PP; 9 | 10 | my $specfile = "$Bin/../share/schema.yaml"; 11 | my $pm = "$Bin/../lib/App/Spec/Schema.pm"; 12 | 13 | my $yp = YAML::PP->new( schema => [qw/ JSON /] ); 14 | 15 | my $SCHEMA = $yp->load_file($specfile); 16 | local $Data::Dumper::Sortkeys = 1; 17 | local $Data::Dumper::Indent = 1; 18 | my $dump = Data::Dumper->Dump([$SCHEMA], ['SCHEMA']); 19 | 20 | open my $fh, '<', $pm or die $!; 21 | my $module = do { local $/; <$fh> }; 22 | close $fh; 23 | 24 | $module =~ s/(# START INLINE\n).*(# END INLINE\n)/$1$dump$2/s; 25 | 26 | open $fh, '>', $pm or die $!; 27 | print $fh $module; 28 | close $fh; 29 | -------------------------------------------------------------------------------- /utils/process-pod.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use Data::Dumper; 5 | use 5.010; 6 | 7 | my $argument = "lib/App/Spec/Argument.pm"; 8 | 9 | my @processed; 10 | open my $fh, "<", $argument; 11 | my @content; 12 | while (my $line = <$fh>) { 13 | if (my $row = ($line =~ m/^START INLINE (\S+)/ ... $line =~ m/^STOP INLINE/)) { 14 | my $file = $1; 15 | warn "$row: $line"; 16 | if ($row =~ m/E0$/) { 17 | push @processed, "\n", "=for comment\n", $line; 18 | @content = (); 19 | } 20 | if ($row == 1) { 21 | open my $inline, "<", $file or die $!; 22 | @content = map { " $_" } grep { not m/^# vim/ } <$inline>; 23 | close $inline; 24 | push @processed, $line, "\n", @content; 25 | } 26 | elsif ($row == 2) { 27 | push @processed, $line; 28 | } 29 | } 30 | else { 31 | push @processed, $line; 32 | } 33 | } 34 | close $fh; 35 | 36 | open $fh, ">", $argument; 37 | print $fh @processed; 38 | close $fh; 39 | -------------------------------------------------------------------------------- /xt/02.pod-cover.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval "use Test::Pod::Coverage 1.00"; 3 | plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; 4 | my $xsaccessor = eval "use Class::XSAccessor; 1"; 5 | unless ($xsaccessor) { 6 | diag "\n----------------"; 7 | diag "Class::XSAccessor is not installed. Class attributes might not be checked"; 8 | diag "----------------"; 9 | } 10 | all_pod_coverage_ok(); 11 | -------------------------------------------------------------------------------- /xt/10.validate-spec.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 4; 4 | use FindBin '$Bin'; 5 | my $v = eval "use App::AppSpec::Schema::Validator; 1"; 6 | SKIP: { 7 | skip "App::AppSpec::Schema::Validator not installed", 4 unless $v; 8 | my $validator = App::AppSpec::Schema::Validator->new; 9 | my @files = qw/ myapp-spec.yaml mysimpleapp-spec.yaml subrepo-spec.yaml pcorelist-spec.yaml /; 10 | 11 | for my $file (@files) { 12 | my $path = "$Bin/../examples/$file"; 13 | my @errors = $validator->validate_spec_file($path); 14 | is(scalar @errors, 0, "spec $file is valid"); 15 | if (@errors) { 16 | diag $validator->format_errors(\@errors); 17 | } 18 | } 19 | } 20 | --------------------------------------------------------------------------------