CLI-Framework-0.05/0000755000076400007640000000000011536220123014207 5ustar kerismankerismanCLI-Framework-0.05/MANIFEST0000644000076400007640000000326111536220123015342 0ustar kerismankerismanMANIFEST README Changes Makefile.PL lib/CLI/Framework/Command/Alias.pm lib/CLI/Framework/Command/Meta.pm lib/CLI/Framework/Command/Menu.pm lib/CLI/Framework/Command/List.pm lib/CLI/Framework/Command/Console.pm lib/CLI/Framework/Command/Help.pm lib/CLI/Framework/Command/Dump.pm lib/CLI/Framework/Command/Tree.pm lib/CLI/Framework/Exceptions.pm lib/CLI/Framework/Tutorial.pod lib/CLI/Framework/Command.pm lib/CLI/Framework/Application.pm lib/CLI/Framework.pm t/00-load.t t/bin/perlfunc t/bin/myjournal t/config/myjournal.sql t/session-prod-cons.t t/db/myjournal.sqlite t/lib/My/Command/Shared/X.pm t/lib/My/Journal/Command/Publish.pm t/lib/My/Journal/Command/Dummy.pm t/lib/My/Journal/Command/Menu.pm t/lib/My/Journal/Command/Entry/dummy.txt t/lib/My/Journal/Command/Entry/Dummy.pm t/lib/My/Journal/Command/Entry/Modify.pm t/lib/My/Journal/Command/Entry/Add.pm t/lib/My/Journal/Command/Entry/Print.pm t/lib/My/Journal/Command/Entry/Remove.pm t/lib/My/Journal/Command/Entry.pm t/lib/My/Journal/Model.pm t/lib/My/PerlFunctions.pm t/lib/My/DemoNoUsage.pm t/lib/My/DemoNestedSubcommands.pm t/lib/My/DemoNestedSubcommands/Command0.pm t/lib/My/DemoNestedSubcommands/Command1/Command1_1/Command1_1_0.pm t/lib/My/DemoNestedSubcommands/Command1/Command1_1.pm t/lib/My/DemoNestedSubcommands/Command1/Command1_0.pm t/lib/My/DemoNestedSubcommands/Command1.pm t/lib/My/Journal.pm t/lib/My/DemoNoUsage/Command/A.pm t/lib/My/PerlFunctions/Command/Summary.pm t/no-defined-usage.t t/command_registration.t t/nested-subcommands.t t/basic.t t/define-classes-inline.t t/interactivity.t examples/queue examples/demo-simple.pl docs/images/cli-framework.jpg META.yml Module meta-data (added by MakeMaker) CLI-Framework-0.05/Changes0000644000076400007640000001073111536217674015525 0ustar kerismankerismanRevision history for CLI::Framework 0.01 2009-06-18 Initial release. 0.02 2009-06-18 Documentation corrections. 0.03 2009-09-20 * Corrected broken dependencies (Exception::Class) * Documentation improvements + refined existing documentation + added Tutorial * Concept of "session" replaced with the "cache" (which can hold data shared between separate components of a CLIF application) * Now supporting custom error handling capability (new handle_exception() hook) * Built-in command CLI::Framework::Command::Menu improved for better formatting * New features + inline declaration of CLIF subclasses (both Application and Command classes) is now supported (one file can contain everything) + new built-in command CLI::Framework::Command::Alias *** *** ATTENTION: interface has changed! Most noteworthy changes follow... *** * REPLACED CLI::Framework::Application::is_valid_command() WITH is_valid_command_pkg() AND is_valid_command_name() * REMOVED CLI::Framework::Application::command_search_path() (no longer needed with the new command registration strategy) * CHANGED CLI::Framework::Application::get_registered_command_names() TO registered_command_names() * REMOVED CLI::Framework::Command::get_registered_command_names() * CHANGED CLI::Framework::Command::get_registered_command() TO registered_command_object() * CHANGED CLI::Framework::Command::get_registered_subcommand() TO registered_subcommand_object() * REMOVED CLI::Framework::Command::register_command() * ADDED CLI::Framework::Command::package_is_registered() * CHANGED CLI::Framework::Application::is_interactive() TO get_interactivity_mode() * CHANGED CLI::Framework::Command::Meta::app() changed TO get_app() * REPLACED CLI::Framework::Application::valid_commands() WITH CLI::Framework::Application::command_map() (a hash mapping command names to package names) * CLI::Framework::Application::run() now accepts param 'initialize' 0.04 2010-03-31 * Fixed inconsistency in exception handling (http://cpanforum.com/posts/12419) * Fixed failing tests (some test scripts depended on DBI and DBD::SQLite, which are not (and should not be) dependencies of the distribution) * Added CLI::Framework package to satisfy CPAN's requirements for finding the ABSTRACT for a distribution + ***NOTE***: CLIF Application classes can now inherit from CLI::Framework instead of CLI::Framework::Application (both work equivalently) * documentation updates + link corrections, better explanation of some concepts + moved general framework documentation from CLI::Framework::Application POD to CLI::Framework POD + added class diagram *** *** ATTENTION: one (minor) interface change: *** * in CLI::Framework::Exceptions, changed throw_app_args_exception() to throw_invalid_cmd_exception() 0.05 2011-03-10 * RT #56882: Fixed to use autohistory if the system's local ReadLine supports it. * RT #56885: EOF now treated like a quit signal *** ATTENTION: updates that affect the interface... * RT #56887: The order of the commands shown in the built-in interactive menu is now determined by the order the commands are declared in command_map. The Application hook method "command_map" should now return a (hash-worthy) list, not a HASH ref. To upgrade a CLIF app to be compatible with this release, change the definition of command_map() to return a list (see documentation for CLI::Framework::Application::command_map) and remember to change calls to that method if necessary. Also see the new CLIF Application method, command_map_hashref(). * New method CLI::Framework::Application::command_map_hashref() returns a HASH ref constructed from the command_map() list. CLI-Framework-0.05/lib/0000755000076400007640000000000011536220123014755 5ustar kerismankerismanCLI-Framework-0.05/lib/CLI/0000755000076400007640000000000011536220123015364 5ustar kerismankerismanCLI-Framework-0.05/lib/CLI/Framework/0000755000076400007640000000000011536220123017321 5ustar kerismankerismanCLI-Framework-0.05/lib/CLI/Framework/Command/0000755000076400007640000000000011536220123020677 5ustar kerismankerismanCLI-Framework-0.05/lib/CLI/Framework/Command/Alias.pm0000644000076400007640000000645311536216716022313 0ustar kerismankerismanpackage CLI::Framework::Command::Alias; use base qw( CLI::Framework::Command::Meta ); use strict; use warnings; our $VERSION = 0.01; #------- sub usage_text { q{ alias []: show command aliases [and subcommand aliases for , if given] ARGUMENTS : if specified, show aliases for this command only and show its subcommand aliases } } sub run { my ($self, $opts, @args) = @_; my $app = $self->get_app(); my %cmd_alias_to_name = $app->command_alias(); my $cmd = shift @args; # Ignore non-interactive commands while in interactive mode... if( $app->get_interactivity_mode() ) { while( my ($k,$v) = each %cmd_alias_to_name ) { if( ! $app->is_interactive_command( $v ) ) { delete $cmd_alias_to_name{ $k }; } } } # Alias command only recognizes one argument: a top-level command... if( $cmd ) { # Recognize alias requests by alias... $cmd = $cmd_alias_to_name{$cmd} if exists $cmd_alias_to_name{$cmd}; # Silently pass if invalid command... return unless $app->is_valid_command_name( $cmd ); # Formatted display of aliases to specific command... my $summary = $self->_cmd_alias_hash_to_summary( \%cmd_alias_to_name, target => $cmd ); # Formatted display of aliases to subcommand... my $cmd_object = $app->registered_command_object( $cmd ) || $app->register_command( $cmd ); my %subcommand_alias = $cmd_object->subcommand_alias(); my $subcommand_summary = $self->_cmd_alias_hash_to_summary( \%subcommand_alias, ); if( $subcommand_summary ) { $summary .= sprintf( "\n%15s '%s':\n", 'SUBCOMMANDS of command', $cmd ); $summary .= sprintf( "\n%s", $subcommand_summary ); } return $summary; } else { # Formatted display of all aliases... my $summary = $self->_cmd_alias_hash_to_summary( \%cmd_alias_to_name, ); return $summary; } } sub _cmd_alias_hash_to_summary { my ($self, $aliases, %param) = @_; my $target = $param{target}; my %name_to_alias_set; while( my ($alias, $name) = each %$aliases ) { next if $alias =~ /^\d+$/; # ignore numerical aliases next if $target && $name ne $target; push @{ $name_to_alias_set{$name} }, $alias; } return $self->format_name_to_aliases_hash( \%name_to_alias_set ); } sub format_name_to_aliases_hash { my ($self, $h, $indent) = @_; $indent ||= 10; my $format = '%'.$indent."s: %s\n"; my @output; for my $command (keys %$h) { push @output, sprintf $format, $command, join( ', ', @{$h->{$command}} ); } my @output_sorted = sort { my $name_a = substr( $a, index($a, ':') ); my $name_b = substr( $b, index($b, ':') ); $name_a cmp $name_b; } @output; return join( '', @output ); } __END__ =pod =head1 NAME CLI::Framework::Command::Alias - CLIF built-in command to display the command aliases that are in effect for the running application and its commands =head1 SEE ALSO L L =cut CLI-Framework-0.05/lib/CLI/Framework/Command/Meta.pm0000644000076400007640000000310711536216716022141 0ustar kerismankerismanpackage CLI::Framework::Command::Meta; use base qw( CLI::Framework::Command ); our $VERSION = 0.01; sub new { my ($class, %args) = @_; my $app = $args{app}; bless { _app => $app }, $class; } # (metacommands know about their application (and thus, the other commands in # the app)) sub get_app { $_[0]->{_app} } sub set_app { $_[0]->{_app} = $_[1] } #------- 1; __END__ =pod =head1 NAME CLI::Framework::Command::Meta - Represent "metacommands" (app-aware commands) =head1 DESCRIPTION This class is a subclass of CLI::Framework::Command. It defines "metacommands", commands that are application-aware (and thus, implicitly aware of all other commands registered within the application). Metacommands have methods that set and retrieve a reference to the application within which they are running. This class exists as a separate class because, with few exceptions, commands should be independent of the application they are associated with and should not affect that application. Metacommands represent the exception to that rule. In the exceptional cases, your command will inherit from this one instead of C. =head1 WHEN TO BUILD METACOMMANDS VS REGULAR COMMANDS See L on this topic. =head1 METHODS =head2 get_app() / set_app( $app ) Retrieve or set the application object associated with a metacommand object. $app = $command->get_app(); $command->set_app( $app ); =head1 SEE ALSO L L =cut CLI-Framework-0.05/lib/CLI/Framework/Command/Menu.pm0000644000076400007640000000266311536216716022165 0ustar kerismankerismanpackage CLI::Framework::Command::Menu; use base qw( CLI::Framework::Command::Meta ); use strict; use warnings; our $VERSION = 0.01; #------- sub usage_text { q{ menu: menu of available commands } } sub run { my ($self, $opts, @args) = @_; return $self->menu_txt(); } sub menu_txt { my ($self) = @_; my $app = $self->get_app(); # Build a numbered list of visible commands... my @cmd = $app->get_interactive_commands(); my $txt; my %new_aliases = $app->command_alias(); for my $i (0..$#cmd) { my $alias = $i+1; $txt .= $alias . ') ' . $cmd[$i] . "\n"; $new_aliases{$alias} = $cmd[$i]; } # Add numerical aliases corresponding to menu options to the original # command aliases defined by the application... { no strict 'refs'; no warnings; *{ (ref $app).'::command_alias' } = sub { %new_aliases }; return "\n".$txt; } } sub line_count { my ($self) = @_; my $menu = $self->menu_txt(); my $line_count = 0; $line_count++ while $menu =~ /\n/g; return $line_count; } #------- 1; __END__ =pod =head1 NAME CLI::Framework::Command::Menu - CLIF built-in command to show a command menu including the commands that are available to the running application =head1 SEE ALSO L L L =cut CLI-Framework-0.05/lib/CLI/Framework/Command/List.pm0000644000076400007640000000167511536216716022176 0ustar kerismankerismanpackage CLI::Framework::Command::List; use base qw( CLI::Framework::Command::Meta ); use strict; use warnings; our $VERSION = 0.01; #------- sub usage_text { q{ list: print a concise list of the names of all commands available to the application } } sub run { my ($self, $opts, @args) = @_; my $app = $self->get_app(); # metacommand is app-aware # If interactive, exclude commands that do not apply in interactive mode... my @command_set = $app->get_interactivity_mode() ? $app->get_interactive_commands() : keys %{ $app->command_map_hashref() }; my $result = join(', ', map { lc $_ } @command_set ) . "\n"; return $result; } #------- 1; __END__ =pod =head1 NAME CLI::Framework::Command::List - CLIF built-in command to print a list of commands available to the running application =head1 SEE ALSO L L =cut CLI-Framework-0.05/lib/CLI/Framework/Command/Console.pm0000644000076400007640000000123411536216716022654 0ustar kerismankerismanpackage CLI::Framework::Command::Console; use base qw( CLI::Framework::Command::Meta ); use strict; use warnings; our $VERSION = 0.01; #------- sub usage_text { q{ console: invoke interactive command console } } sub run { my ($self, $opts, @args) = @_; my $app = $self->get_app(); # metacommand is app-aware $app->run_interactive(); return; } #------- 1; __END__ =pod =head1 NAME CLI::Framework::Command::Console - CLIF built-in command supporting interactive mode =head1 SEE ALSO L L L =cut CLI-Framework-0.05/lib/CLI/Framework/Command/Help.pm0000644000076400007640000000272711536216716022152 0ustar kerismankerismanpackage CLI::Framework::Command::Help; use base qw( CLI::Framework::Command::Meta ); use strict; use warnings; our $VERSION = 0.01; #------- sub usage_text { q{ help [command name]: usage information for an individual command or the application itself } } sub run { my ($self, $opts, @args) = @_; my $app = $self->get_app(); # metacommand is app-aware my $usage; my $command_name = shift @args; # Recognize help requests that refer to the target command by an alias... my %alias = $app->command_alias(); $command_name = $alias{$command_name} if $command_name && exists $alias{$command_name}; # First, attempt to get command-specific usage message... if( $command_name ) { # (do not show command-specific usage message for non-interactive # commands when in interactive mode) $usage = $app->usage( $command_name, @args ) unless( $app->get_interactivity_mode() && ! $app->is_interactive_command($command_name) ); } # Fall back to application usage message... $usage ||= $app->usage(); return $usage; } #------- 1; __END__ =pod =head1 NAME CLI::Framework::Command::Help - CLIF built-in command to print application or command-specific usage messages =head1 SEE ALSO L L L =cut CLI-Framework-0.05/lib/CLI/Framework/Command/Dump.pm0000644000076400007640000000110611217316645022153 0ustar kerismankerismanpackage CLI::Framework::Command::Dump; use base qw( CLI::Framework::Command::Meta ); use strict; use warnings; use Data::Dumper; our $VERSION = 0.01; #------- sub usage_text { q{ dump: print a dump of the application object using Data::Dumper } } sub run { my ($self, $opts, @args) = @_; my $result = Dumper($self->get_app()) . "\n"; return $result; } #------- 1; __END__ =pod =head1 NAME CLI::Framework::Command::Dump - CLIF built-in command to show the internal state of a running application =head1 SEE ALSO L =cut CLI-Framework-0.05/lib/CLI/Framework/Command/Tree.pm0000644000076400007640000000467611536216716022166 0ustar kerismankerismanpackage CLI::Framework::Command::Tree; use base qw( CLI::Framework::Command::Meta ); use strict; use warnings; our $VERSION = 0.01; #------- sub usage_text { q{ tree: tree view of the names of only those commands that are currently registered in the application } } sub run { my ($self, $opts, @args) = @_; my $app = $self->get_app(); # metacommand is app-aware my $tree = command_tree( $app ); $tree =~ s/^/\t/gm; return $tree; } #------- sub command_tree { my ($app, $root, $indent, $tree) = @_; $root ||= $app; $indent ||= 0; # (output object) $tree = { text => '' } unless ref $tree; $indent += 4 if( $root->isa( 'CLI::Framework::Command' ) ); # For every command registered into the root object (either a CLIF # Application or a CLIF Command), append its tree representation to the # output object... # Use proper accessors for object type... my $registered_command_names_accessor = 'registered_command_names'; my $registered_command_obj_accessor = 'registered_command_object'; if( $root->isa('CLI::Framework::Command') ) { $registered_command_names_accessor = 'registered_subcommand_names'; $registered_command_obj_accessor = 'registered_subcommand_object'; } my @command_names; { no strict 'refs'; @command_names = $root->$registered_command_names_accessor; } for my $command_name (@command_names) { #XXX-ALTERNATIVE: show a tree of command names # $tree->{text} .= ' 'x$indent . $command_name . "\n"; my $command_obj; { no strict 'refs'; $command_obj = $root->$registered_command_obj_accessor( $command_name ); } #XXX-ALTERNATIVE: show a tree of Perl package names defining the commands (including # source files they were defined in): my $source = Class::Inspector->loaded_filename( ref $command_obj ); $source ||= 'defined inline'; my $x = ref ($command_obj) . " ($source)"; $tree->{text} .= ' 'x$indent . $x . "\n"; # Recursive call (NOTE: passing output object reference which will act # as an accumulator)... command_tree( $app, $command_obj, $indent, $tree ); } return $tree->{text} . "\n"; } #------- 1; __END__ =pod =head1 NAME CLI::Framework::Command::Tree - CLIF built-in command to display a tree representation of the commands that are currently registered with the running application =head1 SEE ALSO L =cut CLI-Framework-0.05/lib/CLI/Framework/Exceptions.pm0000644000076400007640000001251111536216716022015 0ustar kerismankerismanpackage CLI::Framework::Exceptions; use strict; use warnings; our $VERSION = 0.02; # Make it possible to use aliases directly in client code... use Exporter qw( import ); our @EXPORT_OK = qw( throw_clif_exception throw_app_hook_exception throw_app_opts_parse_exception throw_app_opts_validation_exception throw_app_init_exception throw_invalid_cmd_exception throw_cmd_registration_exception throw_type_exception throw_cmd_opts_parse_exception throw_cmd_validation_exception throw_cmd_run_exception ); our %EXPORT_TAGS = ( all => \@EXPORT_OK ); # Create exception class hierarchy... use Exception::Class ( 'CLI::Framework::Exception' => { description => 'General CLIF error', alias => 'throw_clif_exception', }, 'CLI::Framework::Exception::AppHookException' => { isa => 'CLI::Framework::Exception', description => 'Application hook method failed preconditions', alias => 'throw_app_hook_exception', }, 'CLI::Framework::Exception::AppOptsParsingException' => { isa => 'CLI::Framework::Exception', description => 'Failed parsing of application options', alias => 'throw_app_opts_parse_exception' }, 'CLI::Framework::Exception::AppOptsValidationException' => { isa => 'CLI::Framework::Exception', description => 'Failed validation of application options', alias => 'throw_app_opts_validation_exception' }, 'CLI::Framework::Exception::AppInitException' => { isa => 'CLI::Framework::Exception', description => 'Failed application initialization', alias => 'throw_app_init_exception' }, 'CLI::Framework::Exception::InvalidCmdException' => { isa => 'CLI::Framework::Exception', description => 'Invalid command', alias => 'throw_invalid_cmd_exception' }, 'CLI::Framework::Exception::CmdRegistrationException' => { isa => 'CLI::Framework::Exception', description => 'Failed command registration', alias => 'throw_cmd_registration_exception', }, 'CLI::Framework::Exception::TypeException' => { isa => 'CLI::Framework::Exception', description => 'Object is not of the proper type', alias => 'throw_type_exception', }, 'CLI::Framework::Exception::CmdOptsParsingException' => { isa => 'CLI::Framework::Exception', description => 'Failed parsing of command options', alias => 'throw_cmd_opts_parse_exception' }, 'CLI::Framework::Exception::CmdValidationException' => { isa => 'CLI::Framework::Exception', description => 'Failed validation of command options/arguments', alias => 'throw_cmd_validation_exception' }, 'CLI::Framework::Exception::CmdRunException' => { isa => 'CLI::Framework::Exception', description => 'Failure to run command', alias => 'throw_cmd_run_exception' }, ); #------- 1; __END__ =pod =head1 NAME CLI::Framework::Exceptions - Exceptions used by CLIF =head1 EXCEPTION TYPES This package defines the following exception types. These exception objects are created using L and are subtypes of L. =head2 CLI::Framework::Exception =over =item description General CLIF error =item alias C =back =head2 CLI::Framework::Exception::AppHookException =over =item description Application hook method failed preconditions =item alias C =back =head2 CLI::Framework::Exception::AppOptsParsingException =over =item description Failed parsing of application options =item alias C =back =head2 CLI::Framework::Exception::AppOptsValidationException =over =item description Failed validation of application options =item alias C =back =head2 CLI::Framework::Exception::AppInitException =over =item description Failed application initialization =item alias C =back =head2 CLI::Framework::Exception::InvalidCmdException =over =item description C =item alias C =back =head2 CLI::Framework::Exception::CmdRegistrationException =over =item description Failed command registration =item alias C =back =head2 CLI::Framework::Exception::TypeException =over =item description Object is not of the proper type =item alias C =back =head2 CLI::Framework::Exception::CmdOptsParsingException =over =item description Failed parsing of command options =item alias C =back =head2 CLI::Framework::Exception::CmdValidationException =over =item description Failed validation of command options/arguments =item alias C =back =head2 CLI::Framework::Exception::CmdRunException =over =item description Failure to run command =item alias C =back =head1 EXPORTS All aliases are available for use by client code (but none are exported by default). The ':all' tag causes all of the Ces to be exported. =head1 SEE ALSO L L =cut CLI-Framework-0.05/lib/CLI/Framework/Tutorial.pod0000644000076400007640000004433111536216716021652 0ustar kerismankerisman =head1 NAME CLI::Framework::Tutorial - "HOWTO" develop CLIF applications using best practices =head1 CLIF DOCUMENTATION This is a guide to developing CLIF applications. It is a supplement to the documentation in L, L and L, which have more thorough coverage of some finer points. It is suggested that new users start by reading this document, then use the other documentation for reference as necessary. =head1 INTRODUCTION Developers have been reluctantly writing ad-hoc, disposable scripts for too long or struggling to decide how not to do so. There is a better alternative. The L documentation enumerates many advantages to using CLIF instead of writing yet-another-getopt-based-script. CLIF comes with a lot of documentation, but don't take that to mean that using CLIF is complicated. CLIF apps with simple needs are very easy to build. Apps with complex needs are a bit more work, but much easier to build (and far easier to test and maintain) than doing that work from scratch. This document will first demonstrate a very simple CLIF application. Next, a complete application will be shown to demonstrate more advanced CLIF features. Think of a typical command-line script. It needs to parse command-line options and arguments, check that any required external resources (files, databases, etc.) are available, fail nicely if something is missing or inconsistent, then do something application-specific that depends on the options, arguments, and external resources. What happens when new scripts are created to do something similar? All too often, they end up with different option names for conceptually the same purpose. It is common for functionality needed by several scripts to be duplicated in each similar script. This rapidly gets out of hand, becoming a maintenance frustration. Your team members are not "on the same page" and new people learning your tools must have lengthy, verbal, one-on-one code tours. Instead, a set of related scripts could be combined into a CLIF application. Consistent naming conventions and sharing of common code is naturally encouraged. The commands are easy to test. New commands can be added with ease. =head1 FROM P.O.S. TO CLIF IN A FEW EASY STEPS A "P.O.S." is a "Plain Old Script." This section shows you how to reform an old P.O.S., creating a shiny new CLIF application! Please see working code for this example included with the C distribution (F). This example demonstrates the following features: =over =item * inline application definition =item * basics (app, commands, command options and args) =item * the relationship between plain scripts and CLIF applications (including how to convert between them) =back To understand CLIF commands, imagine converting a legacy script to a CLIF application. First, create a Perl class that inherits from L. Place the main body of the script in a C method. Add the functions that the script defines, if any. # Your Command subclass... package Converted::Script::Command::LegacyScript; use base qw( CLI::Framework::Command ); # main body of former script goes inside run(): sub run { ... } Next, create a Perl class (creating a separate package file for the class is totally optional) that inherits from L (or you can use C as a shorthand) and define a method, C, that links command names with classes that implement the commands: # Your Application class... package Converted::Script; use base qw( CLI::Framework ); sub command_map { 'legacy-script' => 'Converted::Script::Command::LegacyScript', } The code that provides a friendly usage message (if the legacy script provided one) can be replaced by defining the C method: sub usage_text { qq{ $0 [--verbose|v] [--help|h]: how to use this application... } } Back in your Command subclass, the option/argument processing code will be replaced with a method defining what options will be recognized (the data structure to be returned is exactly as documented in L): sub option_spec { [ 'help|h' => 'show help' ], [ 'verbose|v' => 'be verbose' ], } ...and that's all it takes to convert a simple script to a CLIF app. This contrived example demonstrates the mechanics, but let me point out a few advantages (see L for the long list): =over =item Clear division of responsibilities Using packages, subroutines, and separate files (if desired), CLIF apps follow established convention and provide a new pattern for creating tools. =item Easy to test Now that functional units of code are subroutines in packages, you can unit test each component independently. =item Easy to maintain Instead of puzzling over a several-thousand-line script, maintaining a CLIF application is like maintaining any other well-engineered application code. =item Easy to extend Related tools frequently occur in groups. Instead of awkwardly forcing loosely-related behaviors into the same script, CLIF makes it easy to add additional commands in a modular way. =back =head1 WHEN B TO USE CLIF CLIF could be used for the simplest of needs, but it may be overkill in very simple situations. You may want to avoid CLIF for very basic scripts that have a single behavior and are completely independent from other such tools. However, if there's a chance that the scripts might grow to become more complex or if you would simply like a pattern to follow, it may still be worth considering. =head1 CONCEPTS AND DEFINITIONS See L. =head1 UNDERSTANDING THE APPLICATION RUN SEQUENCE See L. B. You need, at the least, to understand how CLIF differentiates between options and arguments that are meant for the application itself and those options and arguments that are meant for individual commands. The following examples demonstrate the alternative command request forms. Note that in all cases, any number of (sub)command options and arguments can be passed (these examples show only one of each for brevity). FORM #1 (without subcommands) -- command requests that involve NO subcommands take the following form: [--app-opt] [--cmd-opt] [cmd-arg] ... (notice how the position of options and arguments determines whether they are meant for the application as a whole or for the specific command). FORM #2 (with subcommands) -- Command requests that involve A SINGLE subcommand take this form: [--app-opt] [--cmd-opt] [--subcmd-opt] [subcmd-arg] ... Command requests that involve MULTIPLE subcommands follow the same form: [--app-opt] [--cmd-opt] [--subcmd1-opt] [--subcmd2-opt] [subcmd2-arg] ... (notice that the final arguments apply to the final subcommand. The only command that can receive arguments is the final subcommand). =head1 A MORE INVOLVED EXAMPLE Please see working code for this example included with the C distribution (F). The next example demonstrates the following features: =over =item * inline application definition =item * basics (app, commands, command options and args) =item * subcommands =item * validation of application and command arguments =item * interactive mode and non-interactive mode =back Suppose we need to write a command-line application that provides an interface to a queue. Strings can be added to or removed from the queue, queue contents can be displayed, and queue "properties" can be set to restrict the contents added to the queue. The interface should work interactively. The following usage demonstrates the desired behavior: [somebody@somewhere]$ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile console # ---- interactive mode ---- 1) dequeue 2) cmd-list 3) enqueue 4) print 5) alias 6) property > help enqueue enqueue [--tag= [--tag= [...] ] ] [ ... ]: add item(s) to queue > enqueue --tag=x "something" > property set --evens > e 1 21 514 937 18 The working example in F accomplishes this goal in a single inline application containing the Application class and multiple Command Classes. This application is created in fundamentally the same way as the simple one presented earlier. It uses more commands, more Application class/Command Class hooks, and subcommands. The code is much longer but almost all of it is for business logic -- very little additional CLIF-specific code is needed. The example code shows how various commands can be managed by an Application subclass. The code is commented thoroughly to explain the various hooks that are available for Application class and Command Classes. Of course, CLIF applications can always be used in non-interactive mode: # ---- non-interactive mode ---- $ examples/queue --qout=/tmp/qfile enqueue 'first' $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile enqueue --tag=x --tag=y 'second' $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile property list $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile property set --evens $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile property list $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile enqueue 17 $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile enqueue 4 $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile enqueue 2 $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile dequeue $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile dequeue $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile dequeue $ examples/queue --qin=/tmp/qfile --qout=/tmp/qfile enqueue 3 $ examples/queue --qin=/tmp/qfile print =head1 PLANNING A COMPLEX CLIF APPLICATION Little additional thought (beyond that needed for business logic) is required to create a basic CLIF app -- the strategy explained in L demonstrates how CLIF differs from a "Plain Old Script". A more sophisticated command line application will benefit from a wider variety of the features CLIF provides. The extra features are easy to use, but the additional complexity warrants careful planning. After the initial learning curve, applying interface design principles and implementing business rules will become the only challenging aspects to developing your CLIF applications. This is as it should be -- the framework handles application-independent aspects, leaving you to focus on the unique features of your application. Here are some considerations: =over =item Basic interface =over =item What commands and subcommands should be available? =item What options and arguments will they support? =item What kind of validation should be done on the provided command requests? =item Which built-in commands will be used? =item Will an interactive mode be provided? =item If so, will a custom menu be created? =item Do any commands need to directly access or modify the application itself or the other commands (these will be metacommands)? =back =item High-level code layout Which components of the application will be defined in their own package files? Which will be defined inline? =item Separation of concerns using MVC strategy How will the model be separated from the rest of the application? What about the view? =item Data sharing between application and commands What data will data be shared between the application and the commands? Will this be arranged by using the cache, using a Command superclass (a generic command class that all of your commands inherit from), or by some other means? =back Read on for possible answers to some of these questions. =head1 HOW CAN I ...? This section briefly highlights how CLIF could be used to support various common goals. Even if your particular situation does not appear here, reading this short section will give you an understanding of how CLIF could be set up to support novel cases. =head2 How can I quickly create a very simple application? For a demonstration of how to create a very simple CLIF app, see L. CLIF applications require, at the minimum: =over =item * An Application class that inherits from L (or C). For anything useful to happen, it should override the C hook and include a new command. =item * A Command Class that inherits from L. It should override the C hook (or have a subcommand that overrides C). =item * An Application Script that calls the C method in your application. =back These can all be defined in one file or each class can be placed in a separate file. Do whatever works best for your particular needs. =head2 How can I add an interactive mode to my application? The built-in console command can be used to enable your application to run interactively. To do this, simply add the built-in command L to the L in your Application class. =head2 How can I include logging in my application? In your Application class, define C to initialize your logging object and save the resulting object in the cache, where the object will be available to your application and command objects. =head2 How can I include database connectivity in my application? In your Application class, define C to connect to your database and save the resulting object or database handle in the cache, where the object/handle will be available to your application and command objects. Of course, for proper Separation of Concerns, you should not simply store a connected database handle in the cache and use it directly in your Command classes. You should instead store an object of another class that encapsulates your data model layer code. An example of this is the model class for the demo journal application included with CLIF tests: F. =head2 How can I support an application configuration file? In your Application class, define C to load your configuration file and save the resulting configuration object in the cache using the L, where the object will be available to your application and command objects. =head2 How can I use templates for more flexible output? In your Application class, override the C method. For instance, you could write an application where all commands return a data structure to be used in processing a template. Your C method could determine which template file to process (e.g. based on which command is being run) and then process it using the received data structure. =head2 How can I create an application-aware command? In exceptional cases, you may need to create a command that "knows about" the application and needs access to some of its data (which may include the data of other commands in the application). To create an application-aware command, inherit from L. The command will then have an accessor that will provide access to the application object. You should generally not need to do this -- your commands should usually be decoupled from your application. This will occur by default when you inherit from L. =head2 How can I use alternative CLI prompting techniques and terminal I/O convenience functions? You may, for example, want to present a menu of options from a variety of choices based on content from a database. Or perhaps you want to prompt the user for a list of numbers and you want to support a comma-separated list with ranges, etc. Create a CLI::Framework::Command subclass (say, C) that implements your convenience functions or uses a CPAN module such as L. Then all of your commands can inherit from C and will all have access to the functions. You may also want to override L. =head2 How can I create an app without a "help" command? The 'help' command is fundamental to most applications. If you really want to build an application without a 'help' command, simply create a custom Help command with an empty C method. =head2 How can I dynamically determine whether or not to run interactively based on command-line options? You may wish to provide an application option (C<--interactive>) to start interactive mode. One way to do this is to use your application's C method to determine whether or not to invoke the built-in console command. For example: sub init { my ($app, $opts) = @_; # imagine fancy logic to determine whether or not to run interactively... if( $opts->{interactive} ) { $app->set_current_command('console'); } return 1; } This will cause the interactive console to be launched during initialization. This technique could be used to launch the built-in console command or a custom interactive command. This was considered in greater detail on the discussion forum: L. =head1 TROUBLESHOOTING The following solutions may be helpful when working with CLIF. =over =item * Don't forget to inherit from CLI::Framework::Application in your Application class and CLI::Framework::Command in your command class =item * Don't forget to override command_map() in your Application class =item * Don't forget to override run() in your Command class =item * If in doubt, run "perl -wc " If a user-defined command class does not compile, your CLIF application will fail silently. Running C will report compilation problems for F. =back =head1 LICENSE AND COPYRIGHT Copyright (c) 2009 Karl Erisman (kerisman@cpan.org). All rights reserved. This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perlartistic. =head1 AUTHOR Karl Erisman (kerisman@cpan.org) =cut CLI-Framework-0.05/lib/CLI/Framework/Command.pm0000644000076400007640000005771411536217674021274 0ustar kerismankerismanpackage CLI::Framework::Command; use strict; use warnings; #use warnings::register; our $VERSION = 0.04; use Carp; use Getopt::Long::Descriptive; use Exception::Class::TryCatch; use Class::Inspector; use CLI::Framework::Exceptions qw( :all ); #FIXME-TODO-CLASS_GENERATION: #our %CLASSES; # remember which classes have been auto-generated # #sub import { # my ($class, %import_args) = @_; # # # If caller has supplied import args, CLIF's "inline form" is being used; # # we need to generate command classes dynamically... # while( my ($cmd_pkg, $cmd_def) = each %import_args ) { # ##FIXME-TODO-CLASS_GENERATION: Create the new classes named in $cmd_pkg, injecting the subs indicated ## (whether explicitly or implicitly) by the contents of $cmd_def... # ## $cmd_obj = __PACKAGE__->new(); # } #} ############################### # # OBJECT CONSTRUCTION # ############################### sub manufacture { my ($class, $target_pkg) = @_; # Manufacture base command... eval "require $target_pkg"; # (may or may not be pre-loaded) my $object = $target_pkg->new() or croak "Failed to instantiate command package '$target_pkg' via new(): $!"; # Recognize subcommands that were defined in their own package files... $object->_manufacture_subcommands_in_dir_tree(); # Recognize subcommands that have been loaded via an inline definition... $object->_register_preloaded_subcommands(); return $object; } sub _manufacture_subcommands_in_dir_tree { my ($parent_command_object) = @_; # Check for a subdirectory by the name of the current command containing .pm # files representing subcommands, then manufacture() any that are found... # Look for subdirectory with name of current command... my $subcommand_dir = Class::Inspector->resolved_filename( ref $parent_command_object ); substr( $subcommand_dir, -3, 3 ) = ''; # trim trailing '.pm' if( -d $subcommand_dir ) { # Directory with name of current command exists; look inside for .pm # files representing subcommands... my $dh; opendir( $dh, $subcommand_dir ) or die "cannot opendir '$dh': $!"; while( my $subcommand = readdir $dh ) { # Ignore non-module files... next unless substr( $subcommand, -3 ) =~ s/\.pm//; # trim trailing '.pm' my $subcommand_pkg = (ref $parent_command_object).'::'.$subcommand; eval "require $subcommand_pkg"; if( $subcommand_pkg->isa(ref $parent_command_object) ) { my $subcommand_obj = $subcommand_pkg->new() or croak 'Failed to instantiate subcommand', "'$subcommand_pkg' via method new(): $!"; $parent_command_object->register_subcommand( $subcommand_obj ); $subcommand_obj->_manufacture_subcommands_in_dir_tree(); $subcommand_obj->_register_preloaded_subcommands(); } # else { # warnings::warn "Found a non-subclass Perl package file in search path: '$subcommand_pkg' -- ignoring..." # if warnings::enabled; # } } } return 1; } sub _register_preloaded_subcommands { my ($parent_cmd_obj) = @_; # Find direct subclasses and register them beneath the given parent... # Class::Inspector::subclasses actually finds all *descendants* # (not just direct subclasses)... my $descendants = sub { Class::Inspector->subclasses(@_) }; my $descendant_names = $descendants->( ref $parent_cmd_obj ); return unless ref $descendant_names eq 'ARRAY'; for my $descendant_cmd ( @$descendant_names ) { # (skip if already registered) next if $parent_cmd_obj->package_is_registered( $descendant_cmd ); # Find the direct parent class(es) of the descendant... my @direct_parents; { no strict 'refs'; @direct_parents = @{ $descendant_cmd.'::ISA' }; } for my $direct_parent_of_descendant (@direct_parents) { # If the descendant is a *direct* subclass of the given parent... if( $direct_parent_of_descendant eq ref $parent_cmd_obj ) { # ...register child command as subcommand of parent... my $child_cmd = $descendant_cmd->new(); $parent_cmd_obj->register_subcommand( $child_cmd ); $child_cmd->_register_preloaded_subcommands(); } } } return 1; } sub new { bless { _cache => undef }, $_[0] } sub set_cache { $_[0]->{_cache} = $_[1] } sub cache { $_[0]->{_cache} } ############################### # # COMMAND DISPATCHING # ############################### sub get_default_usage { $_[0]->{_default_usage} } sub set_default_usage { $_[0]->{_default_usage} = $_[1] } sub usage { my ($cmd, $subcommand_name, @subcommand_args) = @_; # Allow subcommand aliases in place of subcommand name... $cmd->_canonicalize($subcommand_name); my $usage_text; if(my $subcommand = $cmd->registered_subcommand_object($subcommand_name)) { # Get usage from subcommand object... $usage_text = $subcommand->usage(@subcommand_args); } else { # Get usage from Command object... $usage_text = $cmd->usage_text(); } # Finally, fall back to default command usage message... $usage_text ||= $cmd->get_default_usage(); return $usage_text; } sub _canonicalize { my ($cmd, $input) = @_; # Translate shorthand aliases for subcommands to full names... return unless $input; my %aliases = $cmd->subcommand_alias(); return unless %aliases; my $command_name = $aliases{$input} || $input; $_[1] = $command_name; } # # ARGV_Format # # $ app [app-opts] [cmd-opts] # # params contain: $cmd = , $cmd_opts = [cmd-opts], @args = # # could, in turn, indicate nested subcommands: # { [subcmd-opts] {...} } [subcmd-args] # sub dispatch { my ($cmd, $cmd_opts, @args) = @_; # --- VALIDATE COMMAND OPTIONS AND ARGS --- eval { $cmd->validate($cmd_opts, @args) }; if( catch my $e ) { # (command failed validation) throw_cmd_validation_exception( error => $e ); } # Check if a subcommand is being requested... my $first_arg = shift @args; # consume potential subcommand name from input $cmd->_canonicalize( $first_arg ); my ($subcmd_opts, $subcmd_usage); if( my $subcommand = $cmd->registered_subcommand_object($first_arg) ) { # A subcommand is being requested; parse its options... @ARGV = @args; my $format = $cmd->name().' '.$subcommand->name().'%o ...'; eval { ($subcmd_opts, $subcmd_usage) = describe_options( $format, $subcommand->option_spec() ) }; if( catch my $e ) { # (subcommand failed options parsing) $e->isa( 'CLI::Framework::Exception' ) && do{ $e->rethrow }; throw_cmd_opts_parse_exception( error => $e ); } $subcommand->set_default_usage( $subcmd_usage->text() ); # Reset arg list to reflect only arguments ( options may have been # consumed by describe_options() )... @args = @ARGV; # Pass session data to subcommand... $subcommand->set_cache( $cmd->cache() ); # --- NOTIFY MASTER COMMAND OF SUBCOMMAND DISPATCH --- $cmd->notify_of_subcommand_dispatch( $subcommand, $cmd_opts, @args ); # Dispatch subcommand with its options and the remaining args... $subcommand->dispatch( $subcmd_opts, @args ); } else { # If first arg is not a subcommand then put it back in input... unshift @args, $first_arg if defined $first_arg; # ...and run the command itself... my $output; eval { $output = $cmd->run( $cmd_opts, @args ) }; if( catch my $e ) { # (error during command execution) $e->isa( 'CLI::Framework::Exception' ) && do{ $e->rethrow }; throw_cmd_run_exception( error => $e ); } return $output; } } ############################### # # COMMAND REGISTRATION # ############################### sub registered_subcommand_names { keys %{$_[0]->{_subcommands}} } sub registered_subcommand_object { my ($cmd, $subcommand_name) = @_; return unless $subcommand_name; return $cmd->{_subcommands}->{$subcommand_name}; } sub register_subcommand { my ($cmd, $subcommand_obj) = @_; return unless $subcommand_obj && $subcommand_obj->isa("CLI::Framework::Command"); my $subcommand_name = $subcommand_obj->name(); $cmd->{_subcommands}->{$subcommand_name} = $subcommand_obj; return $subcommand_obj; } sub package_is_registered { my ($cmd, $pkg) = @_; my @registered_pkgs = map { ref $_ } values %{ $cmd->{_subcommands} }; return grep { $pkg eq $_ } @registered_pkgs; } ############################### # # COMMAND SUBCLASS HOOKS # ############################### sub name { my ($cmd) = @_; # Use base name of package as command name... my $pkg = ref $cmd; my @pkg_parts = split /::/, $pkg; return lc $pkg_parts[-1]; } sub option_spec { ( ) } sub subcommand_alias { ( ) } sub validate { } sub notify_of_subcommand_dispatch { } sub usage_text { } sub run { $_[0]->usage() } #------- 1; __END__ =pod =head1 NAME CLI::Framework::Command - CLIF Command superclass =head1 SYNOPSIS # The code below shows a few of the methods your command classes are likely # to override... package My::Journal::Command::Search; use base qw( CLI::Framework::Command ); sub usage_text { q{ search [--titles-only] : search a journal } } sub option_spec { ( [ 'titles-only' => 'search only journal titles' ], ) } sub validate { my $self, $opts, @args) = @_; die "exactly one argument required (search regex)" unless @args == 1; } sub run { my ($self, $opts, @args) = @_; my $db = $self->cache->get( 'db' ) # perform search against $db... # $search_results = ... return $search_results; } =head1 DESCRIPTION CLI::Framework::Command (command class for use with L) is the base class for CLIF commands. All CLIF commands inherit from this class. =head1 CONCEPTS =over =item Subcommands Commands can have "subcommands," which are also objects of CLI::Framework::Command. Subcommands can, in turn, have their own subcommands, and this pattern may repeat indefinitely. B that in this documentation, the term "command" may be used to refer to both commands and subcommands. =item Registration of subcommands Subcommands are "registered" with their parent commands. The parent commands can then forward subcommand responsibilities as appropriate. =item File-based commands vs. inline commands Command classes (which inherit from CLI::Framework::Command) can be defined in their own package files or they may be declared inline in another package (e.g. a command package file could include the declaration of a subcommand package or command packages could be declared inline in the package file where the application is declared). As long as the classes have been loaded (making their way into the symbol table), CLIF can use the commands. =back =head1 OBJECT CONSTRUCTION =head2 manufacture( $command_package ) # (manufacture MyApp::Command::Go and any subcommand trees beneath it) my $go = CLI::Framework::Command->manufacture( 'MyApp::Command::Go' ); CLI::Framework::Command is an abstract factory; C is the factory method that constructs and returns an object of the specific command class that is requested. After instantiating an object of the requested command package, C attempts to load subcommands in the following 2 steps: =over =item 1 Attempt to find package B representing subcommands. For every subcommand S, S is registered as a child of the parent command. Next, steps 1 and 2 repeat, this time being invoked on S (i.e. with S as the parent in an attempt to find subcommands of S). =item 2 Attempt to find and register pre-compiled subcommands defined B. Only pre-compiled subcommands are considered for registration (i.e. package files are not considered in this step). For every subcommand S, any pre-compiled subcommands that inherit B from S are found and step 2 repeats for those classes. =back Note the following rules about command class definition: =over =item * If a command class is defined inline, its subcommand classes must be defined inline as well. =item * If a command class is file-based, each of its subcommand classes can be either file-based or inline. Furthermore, it is not necessary for all of these subcommand classes to be defined in the same way -- a mixture of file-based and inline styles can be used for the subcommands of a given command. =back =head2 new() $object = $cli_framework_command_subclass->new(); Basic constructor. =head1 SHARED CACHE DATA CLIF commands may need to share data with other commands and with their associated application. These methods support those needs. =head2 set_cache( $cache_object ) Set the internal cache object for this instance. See L. =head2 cache() Retrieve the internal cache object for this instance. See L for an explanation of how to use this simple cache object. =head1 COMMAND DISPATCHING =head2 get_default_usage() / set_default_usage( $default_usage_text ) Get or set the default usage message for the command. This message is used by L. B: C merely retrieves the usage data that has already been set. CLIF only sets the default usage message for a command when processing a run request for the command. Therefore, the default usage message for a command may be empty (if a run request for the command has not been given and you have not otherwise set the default usage message). $cmd->set_default_usage( ... ); $usage_msg = $cmd->get_default_usage(); =head2 usage( $subcommand_name, @subcommand_chain ) # Command usage... print $cmd->usage(); # Subcommand usage (to any level of depth)... $subcommand_name = 'list'; @subcommand_chain = qw( completed ); print $cmd->usage( $subcommand_name, @subcommand_chain ); Attempts to find and return a usage message for a command or subcommand. If a subcommand is given, returns a usage message for that subcommand. If no subcommand is given or if the subcommand cannot produce a usage message, returns a general usage message for the command. Logically, here is how the usage message is produced: =over =item * If registered subcommand(s) are given, attempt to get usage message from a subcommand (B that a sequence of subcommands could be given, e.g. C<< $cmd->usage('list' 'completed') >>, which would result in the usage message for the final subcommand, C<'completed'>). If no usage message is defined for the subcommand, the usage message for the command is used instead. =item * If the command has implemented L, its return value is used as the usage message. =item * Finally, if no usage message has been found, the default usage message produced by L is returned. =back =head2 dispatch( $cmd_opts, @args ) For the given command request, C performs any applicable validation and initialization with respect to supplied options C<$cmd_opts> and arguments C<@args>, then runs the command. C<@args> may indicate the request for a subcommand: { [subcmd-opts] {...} } [subcmd-args] ...as in the following command (where "usage" is the ): $ gen-report --html stats --role=admin usage --time='2d' '/tmp/stats.html' If a subcommand registered under the indicated command is requested, the subcommand is initialized and dispatched with its options C<[subcmd-opts]> and arguments. Otherwise, the command itself is run. This means that a request for a subcommand will result in the C method of only the deepest-nested subcommand (because C will keep forwarding to successive subcommands until the args no longer indicate that a subcommand is requested). Furthermore, the only command that can receive args is the final subcommand in the chain (but all commands in the chain can receive options). However, B that each command in the chain can affect the execution process through its L method. =head1 COMMAND REGISTRATION =head2 registered_subcommand_names() @registered_subcommands = $cmd->registered_subcommand_names(); Return a list of the currently-registered subcommands. =head2 registered_subcommand_object( $subcommand_name ) $subcmd_obj = $cmd->get_registered_subcommand( 'lock' ); Given the name of a registered subcommand, return a reference to the subcommand object. If the subcommand is not registered, returns undef. =head2 register_subcommand( $subcmd_obj ) $cmd->register_subcommand( $subcmd_obj ); Register C<$subcmd_obj> as a subcommand under master command C<$cmd>. If C<$subcmd_obj> is not a CLI::Framework::Command, returns undef. Otherwise, returns C<$subcmd_obj>. =head2 package_is_registered( $package_name ) Return a true value if the named class is registered as a subcommand. Returns a false value otherwise. =head2 name() $s = My::Command::Squeak->new(); $s->name(); # => 'squeak' C takes no arguments and returns the name of the command. This method uses the normalized base name of the package as the command name, e.g. the command defined by the package My::Application::Command::Xyz would be named 'xyz'. =head1 COMMAND SUBCLASS HOOKS Just as CLIF Applications have hooks that subclasses can use, CLIF Commands are able to influence the command dispatch process via several hooks. Except where noted, all hooks are optional -- subclasses may choose whether or not to override them. =head2 option_spec() This method should return an option specification as expected by L (see L). The option specification is a list of arrayrefs that defines recognized options, types, multiplicities, etc. and specifies textual strings that are used as descriptions of each option: sub option_spec { [ "verbose|v" => "be verbose" ], [ "logfile=s" => "path to log file" ], } Subclasses should override this method if commands accept options (otherwise, the command will not recognize any options). =head2 subcommand_alias() sub subcommand_alias { rm => 'remove', new => 'create', j => 'jump', r => 'run', } Subcommands can have aliases to support shorthand versions of subcommand names. Subclasses should override this method if subcommand aliases are desired. Otherwise, the subcommands will only be recognized by their full command names. =head2 validate( $cmd_opts, @args ) To provide strict validation of a command request, a subclass may override this method. Otherwise, validation is skipped. C<$cmd_opts> is an options hash with the received command options as keys and their values as hash values. C<@args> is a list of the received command arguments. C is called in void context. It is expected to throw an exception if validation fails. This allows your validation routine to provide a context-specific failure message. B that Getop::Long::Descriptive performs some validation of its own based on the L. However, C allows more flexibility in validating command options and also allows validation of arguments. =head2 notify_of_subcommand_dispatch( $subcommand, $cmd_opts, @args ) If a request for a subcommand is received, the master command itself does not C. Instead, its C method is called. This gives the master command a chance to act before the subcommand is run. For example, suppose some (admittedly contrived) application, 'queue', has a command hierarchy with multiple commands: enqueue dequeue print property constraint maxlen behavior ... In this case, C<$ queue property constraint maxlen> might set the max length property for a queue. If the command hierarchy was built this way, C would be the only command to C in response to that request. If C, the master command of C, needs to hook into this execution path, C could be overridden in the command class that implements C. C would then be called just before Cing C. The C method is called in void context. C<$subcommand> is the subcommand object. C<$cmd_opts> is the options hash for the subcommand. C<@args> is the argument list for the subcommand. =head2 usage_text() sub usage_text { q{ dequeue: remove item from queue } } If implemented, this method should simply return a string containing usage information for the command. It is used automatically to provide context-specific help. Implementing this method is optional. See L for details on how usage information is generated within the context of a CLIF application. Users are encouraged to override this method. =head2 run( $cmd_opts, @args ) This method is responsible for the main execution of a command. It is called with the following parameters: C<$cmd_opts> is a pre-validated options hash with command options as keys and their user-provided values as hash values. C<@args> is a list of the command arguments. The default implementation of this method simply calls L to show help information for the command. Therefore, subclasses will usually override C (Occasionally, it is useful to have a command that does little or nothing on its own but has subcommands that define the real behavior. In such occasional cases, it may not be necessary to override C). If an error occurs during the execution of a command via its C method, the C method code should throw an exception. The exception will be caught and handled appropriately by CLIF. The return value of C is treated as data to be processed by the L method in your CLIF Application class. B>. If no output is to be produced, your C method should return C or empty string. =head1 DIAGNOSTICS =over =item C<< Error: failed to instantiate command package '' via new() >> L was asked to manufacture an object of class , but failed while trying to invoke its constructor. =item C<< Error: failed to instantiate subcommand '' via method new() >> Object construction for the subcommand (whose package has already been C) was unsuccessful. =item C<< cannot opendir >> While trying to L subcommands in a directory tree, calling C on the subdirectory with the name of the parent command failed. =back =head1 CONFIGURATION & ENVIRONMENT No special configuration requirements. =head1 DEPENDENCIES Carp L L L L =head1 SEE ALSO L L L =head1 LICENSE AND COPYRIGHT Copyright (c) 2009 Karl Erisman (kerisman@cpan.org). All rights reserved. This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perlartistic. =head1 AUTHOR Karl Erisman (kerisman@cpan.org) =cut CLI-Framework-0.05/lib/CLI/Framework/Application.pm0000644000076400007640000013111011536216716022134 0ustar kerismankerismanpackage CLI::Framework::Application; use strict; use warnings; our $VERSION = '0.04'; use Getopt::Long::Descriptive; use Exception::Class::TryCatch; use CLI::Framework::Exceptions qw( :all ); use CLI::Framework::Command; # Certain built-in commands are required: use constant REQUIRED_BUILTINS_PKGS => qw( CLI::Framework::Command::Help ); use constant REQUIRED_BUILTINS_NAMES => qw( help ); # Certain built-in commands are required only in interactive mode: use constant REQUIRED_BUILTINS_PKGS_INTERACTIVE => qw( CLI::Framework::Command::Menu ); use constant REQUIRED_BUILTINS_NAMES_INTERACTIVE => qw( menu ); #FIXME-TODO-CLASS_GENERATION: #sub import { # my ($class, $app_pkg, $app_def) = @_; # # # If caller has supplied import args, CLIF's "inline form" is being used. # # The application class must be generated dynamically... # #} #------- sub new { my ($class, %args) = @_; my $interactive = $args{ interactive }; # boolean: interactive mode? my $cache = CLI::Framework::Cache->new(); my $app = { _registered_command_objects => undef, # (k,v)=(cmd pkg name,cmd obj) for all registered commands _default_command => 'help', # name of default command _current_command => undef, # name of current (or last) command to run _interactive => $interactive, # boolean: interactive state _cache => $cache, # storage for data shared between app and cmd _initialized => 0, # initialization status }; bless $app, $class; # Validate some hook methods so we can assume that they behave properly... $app->_validate_hooks(); return $app; } sub _validate_hooks { my ($app) = @_; # Ensure that hook methods return expected data structure types according # to their preconditions... my $class = ref $app; # Ensure that command_map() succeeds... eval { $app->command_map() }; if( catch my $e ) { throw_app_hook_exception( error => "method 'command_map' in class '$class' fails" ); } # Ensure that command_map() returns a "hash-worthy" list... else { eval { $app->_list_to_hashref( 'command_map' ) }; if( catch my $e ) { $e->isa( 'CLI::Framework::Exception' ) && do{ $e->rethrow() }; throw_app_hook_exception( error => $e ); } } # Ensure that command_alias() succeeds... eval { $app->command_alias() }; if( catch my $e ) { throw_app_hook_exception( error => "method 'command_alias' in class '$class' fails" ); } # Ensure that commandf_alias() returns a "hash-worthy" list... else { eval { $app->_list_to_hashref( 'command_alias' ) }; if( catch my $e ) { $e->isa( 'CLI::Framework::Exception' ) && do{ $e->rethrow() }; throw_app_hook_exception( error => $e ); } } } sub cache { $_[0]->{_cache} } ############################### # # COMMAND INTROSPECTION & REGISTRATION # ############################### # convert a list to a HASH ref if list is hash-worthy sub _list_to_hashref { my ($app, $method) = @_; my $class = ref $app; my @map = $app->$method; # throw exception if command_map list is of odd length if( scalar @map % 2 ) { throw_app_hook_exception( error => "odd-length list returned by application hook '$method' in class '$class' is not hash-worthy\n" ); } my %h; for my $i (0..$#map-1) { if($i % 2 == 0) { my ($k,$v) = ( $map[$i], $map[$i+1] ); # throw exception if command_map list-to-hash conversion would # lose data due to duplicate keys if( exists $h{$k} ) { throw_app_hook_exception( error => "list returned by application hook '$method' in class '$class' is not hash-worthy (duplicate keys for $i)\n" ); } $h{ $map[$i] } = $map[$i+1]; } } return \%h; } # Transform command map to hashref sub command_map_hashref { my ($app) = @_; return $app->_list_to_hashref('command_map'); } # Return names of all valid commands in same order as specified by # command_map() sub _valid_command_names { my ($app) = @_; # ordered pairs of (command name, command class) my @valid_command_name_class_pairs = $app->command_map(); # unordered command names my @command_names = keys %{ { @valid_command_name_class_pairs } }; my @ordered_command_names; for my $c (@valid_command_name_class_pairs) { push @ordered_command_names, $c if grep {$_ eq $c} @command_names; } return @ordered_command_names; } # Return package names for all valid commands sub _valid_command_pkgs { my ($app) = @_; my $valid_commands_hashref = $app->command_map_hashref; return values %$valid_commands_hashref; } ## Given a command name, return its package name #sub _find_command_pkg_named { # my ($app, $cmd_name) = @_; # # my $valid_commands_hashref = $app->command_map_hashref; # return $valid_commands_hashref->{$cmd_name}; #} sub is_valid_command_pkg { my ($app, $cmd_pkg) = @_; return unless $cmd_pkg; my @valid_pkgs = ( $app->_valid_command_pkgs(), REQUIRED_BUILTINS_PKGS ); push @valid_pkgs, REQUIRED_BUILTINS_PKGS_INTERACTIVE if $app->get_interactivity_mode(); return grep { $cmd_pkg eq $_ } @valid_pkgs; } sub is_valid_command_name { my ($app, $cmd_name) = @_; return unless $cmd_name; my @valid_aliases = ( $app->_valid_command_names() ); push @valid_aliases, REQUIRED_BUILTINS_NAMES; push @valid_aliases, REQUIRED_BUILTINS_NAMES_INTERACTIVE if $app->get_interactivity_mode(); return grep { $cmd_name eq $_ } @valid_aliases; } sub registered_command_names { my ($app) = @_; my @names; # For each registered command package (name)... for my $cmd_pkg_name (keys %{ $app->{_registered_command_objects} }) { # Find command names that this command package was registered under... push @names, grep { $_ } map { $_ if $app->command_map_hashref->{$_} eq $cmd_pkg_name } $app->_valid_command_names } return @names; } sub registered_command_object { my ($app, $cmd_name) = @_; return unless $cmd_name; my $cmd_pkg = $app->command_map_hashref->{$cmd_name}; return unless $cmd_pkg && exists $app->{_registered_command_objects} && exists $app->{_registered_command_objects}->{$cmd_pkg}; return $app->{_registered_command_objects}->{$cmd_pkg}; } sub register_command { my ($app, $cmd) = @_; return unless $cmd; if( ref $cmd && $app->is_valid_command_pkg(ref $cmd) ) { # Register by reference... return unless $cmd->isa( 'CLI::Framework::Command' ); $app->{_registered_command_objects}->{ref $cmd} = $cmd; } elsif( $app->is_valid_command_pkg($app->command_map_hashref->{$cmd}) ) { # Register by command name... my $pkg = $app->command_map_hashref->{$cmd}; $cmd = CLI::Framework::Command->manufacture( $pkg ); $app->{_registered_command_objects}->{ref $cmd} = $cmd; } #FIXME:use REQUIRED_BUILTINS_PKGS_INTERACTIVE & REQUIRED_BUILTINS_NAMES_INTERACTIVE elsif( $cmd eq 'help' ) { # Required built-in is always valid... $cmd = CLI::Framework::Command->manufacture( 'CLI::Framework::Command::Help' ); $app->{_registered_command_objects}->{'CLI::Framework::Command::Help'} = $cmd; } elsif( $app->get_interactivity_mode() && $cmd eq 'menu' ) { # Required built-in for interactive usage is always valid... $cmd = CLI::Framework::Command->manufacture( 'CLI::Framework::Command::Menu' ); $app->{_registered_command_objects}->{'CLI::Framework::Command::Menu'} = $cmd; } else { throw_cmd_registration_exception( error => "Error: failed attempt to register invalid command '$cmd'" ); } # Metacommands should be app-aware... $cmd->set_app( $app ) if $cmd->isa( 'CLI::Framework::Command::Meta' ); return $cmd; } sub get_default_command { $_[0]->{_default_command} } sub set_default_command { $_[0]->{_default_command} = $_[1] } sub get_current_command { $_[0]->{_current_command} } sub set_current_command { $_[0]->{_current_command} = $_[1] } sub get_default_usage { $_[0]->{_default_usage} } sub set_default_usage { $_[0]->{_default_usage} = $_[1] } ############################### # # PARSING & RUNNING COMMANDS # ############################### sub usage { my ($app, $command_name, @args) = @_; # Allow aliases in place of command name... $app->_canonicalize_cmd( $command_name ); my $usage_text; if( $command_name && $app->is_valid_command_name($command_name) ) { # Get usage from Command object... my $cmd = $app->registered_command_object( $command_name ) || $app->register_command( $command_name ); $usage_text = $cmd->usage(@args); } else { # Get usage from Application object... $usage_text = $app->usage_text(); } # Finally, fall back to default application usage message... $usage_text ||= $app->get_default_usage(); return $usage_text; } sub _canonicalize_cmd { my ($self, $input) = @_; # Translate shorthand aliases for commands to full names... return unless $input; my $command_name; my %aliases = $self->command_alias(); return unless %aliases; $command_name = $aliases{$input} || $input; $_[1] = $command_name; } sub _handle_global_app_options { my ($app) = @_; # Process the [app-opts] prefix of the command request... # preconditions: # - tail of @ARGV has been parsed and removed, leaving only the # [app-opts] portion of the request # postconditions: # - application options have been parsed and any application-specific # validation and initialization that is defined has been performed # - invalid tokens after [app-opts] and before are detected and # handled # Parse [app-opts], consuming them from @ARGV... my ($app_options, $app_usage); eval { ($app_options, $app_usage) = describe_options( '%c %o ...', $app->option_spec ) }; if( catch my $e ) { # (failed application options parsing) throw_app_opts_parse_exception( error => $e ); } $app->set_default_usage( $app_usage->text ); # Detect invalid tokens in the [app-opts] part of the request # (@ARGV should be empty unless such invalid tokens exist because has # been removed and any valid options have been processed)... if( @ARGV ) { my $err = @ARGV > 1 ? 'Unrecognized options: ' : 'Unrecognized option: '; $err .= join(' ', @ARGV ) . "\n"; throw_app_opts_parse_exception( error => $err ); } # --- VALIDATE APP OPTIONS --- eval { $app->validate_options($app_options) }; if( catch my $e ) { # (failed application options validation) $e->isa( 'CLI::Framework::Exception' ) && do{ $e->rethrow() }; throw_app_opts_validation_exception( error => $e . "\n" . $app->usage ); } # --- INITIALIZE APP --- eval{ $app->init($app_options) }; if( catch my $e ) { # (application failed initialization) $e->isa( 'CLI::Framework::Exception' ) && do{ $e->rethrow() }; throw_app_init_exception( error => $e ); } $app->{_initialized} = 1; return 1; } sub _parse_request { my ($app, %param) = @_; # Parse options/arguments from a command request and set the name of the # current command... # If requested, perform validation and initialization of the application. # NOTE: Application validation/initialization should NOT be performed here # in interactive mode for each command request because it should only be # done once for the application, not every time a command is run. #~~~~~~~~~~~~~~~~~~~~~~~ # ARGV_Format # # non-interactive case: @ARGV: [app-opts] [cmd-opts] [cmd-args] # interactive case: @ARGV: [cmd-opts] [cmd-args] #~~~~~~~~~~~~~~~~~~~~~~~ my $initialize_app = $param{initialize}; # Parse options/arguments for the application and the command from @ARGV... my ($command_name, @command_opts_and_args); for my $i ( 0..$#ARGV ) { # Find first valid command name in @ARGV... $app->_canonicalize_cmd( $ARGV[$i] ); if( $app->is_valid_command_name($ARGV[$i]) ) { # Extract and store ' [cmd-opts] [cmd-args]', leaving # preceding contents (potentially '[app-opts]') in @ARGV... ($command_name, @command_opts_and_args) = @ARGV[$i..@ARGV-1]; splice @ARGV, $i; last; } } unless( defined $command_name ) { # If no valid command, fall back to default, ignoring any args... $command_name = $app->get_default_command(); @command_opts_and_args = (); # If no valid command then any non-option tokens are invalid args... my @invalid_args = grep { substr($_, 0, 1) ne '-' } @ARGV; if( @invalid_args ) { my $err = @invalid_args > 1 ? 'Invalid arguments: ' : 'Invalid argument: '; $err .= join(' ', @invalid_args ); throw_invalid_cmd_exception( error => $err ); } } # Set internal current command name... $app->set_current_command( $command_name ); # If requested, parse [app-opts] and initialize application... # (this is an optional step because in interactive mode, it should not be # done for every request) $app->_handle_global_app_options() if $initialize_app; # Leave '[cmd-opts] [cmd-args]' in @ARGV... @ARGV = @command_opts_and_args; return 1; } sub run { my ($app, %param) = @_; # Auto-instantiate if necessary... unless( ref $app ) { my $class = $app; $app = $class->new(); } # Determine whether to do initialization -- if not explicitly indicated, # default to doing initialization only if it has not yet been done... my $initialize = $param{initialize}; $initialize = not $app->{_initialized} unless defined $initialize; # Parse request; perform initialization... eval { $app->_parse_request( initialize => $initialize ) }; if( catch my $e ) { $app->handle_exception($e); return } my $command_name = $app->get_current_command(); # Lazy registration of commands... my $command = $app->registered_command_object( $command_name ) || $app->register_command( $command_name ); # Parse command options and auto-generate minimal usage message... my ($cmd_options, $cmd_usage); my $currently_interactive = $app->get_interactivity_mode(); my $format = "$command_name %o ..."; # Getopt::Long::Descriptive format string $format = '%c '.$format unless $currently_interactive; # (%c is command name -- irrelevant in interactive mode) # (configure Getopt::Long to stop consuming tokens when first non-option is # encountered on input stream) my $getopt_configuration = { getopt_conf => [qw(require_order)] }; eval { ($cmd_options, $cmd_usage) = describe_options( $format, $command->option_spec, $getopt_configuration ) }; # (handle failed command options parsing) if( catch my $e ) { if( $e->isa('CLI::Framework::Exception') ) { $app->handle_exception($e); return; } eval{ throw_cmd_opts_parse_exception( error => $e ) }; if( catch my $e ) { $app->handle_exception( $e ); return } } $command->set_default_usage( $cmd_usage->text ); # Share session data with command... # (init() method may have populated shared session data in cache for use by all commands) $command->set_cache( $app->cache ); # --- APP HOOK: COMMAND PRE-DISPATCH --- $app->pre_dispatch( $command ); # --- RUN COMMAND --- my $output; eval { $output = $command->dispatch( $cmd_options, @ARGV ) }; if( catch my $e ) { $app->handle_exception($e); return } # Display output of command, if any... $app->render( $output ) if defined $output; return 1; } ############################### # # INTERACTIVITY # ############################### sub get_interactivity_mode { $_[0]->{_interactive} } sub set_interactivity_mode { $_[0]->{_interactive} = $_[1] } sub is_interactive_command { my ($app, $command_name) = @_; my @noninteractive_commands = $app->noninteractive_commands(); # Command must be valid... return 0 unless $app->is_valid_command_name( $command_name ); # Command must NOT be non-interactive... return 1 unless grep { $command_name eq $_ } @noninteractive_commands; return 0; } sub get_interactive_commands { my ($app) = @_; my @valid_commands = $app->_valid_command_names; # All valid commands are enabled in non-interactive mode... return @valid_commands unless( $app->get_interactivity_mode() ); # ...otherwise, in interactive mode, include only interactive commands... my @command_names; for my $c ( @valid_commands ) { push @command_names, $c if $app->is_interactive_command( $c ); } return @command_names; } sub run_interactive { my ($app, %param) = @_; # Auto-instantiate if necessary... unless( ref $app ) { my $class = $app; $app = $class->new(); } $app->set_interactivity_mode(1); # If default command is non-interactive, reset it, remembering default... my $orig_default_command = $app->get_default_command(); if( grep { $orig_default_command eq $_ } $app->noninteractive_commands() ) { $app->set_default_command( 'help' ); } # If initialization indicated, run init() and handle existing input... eval { $app->_parse_request( initialize => $param{initialize} ) if $param{initialize} }; if( catch my $e ) { $app->handle_exception($e); return } # Find how many prompts to display in sequence between displaying menu... my $menu_cmd = $app->registered_command_object('menu') || $app->register_command( 'menu' ); $menu_cmd->isa( 'CLI::Framework::Command::Menu' ) or throw_type_exception( error => "Menu command must be a subtype of " . "CLI::Framework::Command::Menu" ); my $invalid_request_threshold = $param{invalid_request_threshold} || $menu_cmd->line_count(); # num empty prompts b4 re-displaying menu $app->_run_cmd_processing_loop( menu_cmd => $menu_cmd, invalid_request_threshold => $invalid_request_threshold ); # Restore original default command... $app->set_default_command( $orig_default_command ); } sub _run_cmd_processing_loop { my ($app, %param) = @_; my $menu_cmd = $param{menu_cmd}; my $invalid_request_threshold = $param{invalid_request_threshold}; $app->render( $menu_cmd->run() ); my ($cmd_succeeded, $invalid_request_count, $done) = (0,0,0); until( $done ) { if( $invalid_request_count >= $invalid_request_threshold ) { # Reached threshold for invalid cmd requests => re-display menu... $invalid_request_count = 0; $app->render( $menu_cmd->run() ); } elsif( $cmd_succeeded ) { # Last command request was successful => re-display menu... $app->render( $menu_cmd->run() ); $cmd_succeeded = $invalid_request_count = 0; } # Read a command request... $app->read_cmd(); if( @ARGV ) { # Recognize quit requests... if( $app->is_quit_signal($ARGV[0]) ) { undef @ARGV; last; } $app->_canonicalize_cmd($ARGV[0]); # translate cmd aliases if( $app->is_interactive_command($ARGV[0]) ) { if( $app->run() ) { $cmd_succeeded = 1; } else { $invalid_request_count++ } } else { $app->render( 'unrecognized command request: ' . join(' ',@ARGV) . "\n"); $invalid_request_count++; } } else { $invalid_request_count++ } } } sub read_cmd { my ($app) = @_; require Text::ParseWords; # Retrieve or cache Term::ReadLine object (this is necessary to save # command-line history in persistent object)... my $term = $app->{_readline}; unless( $term ) { require Term::ReadLine; $term = Term::ReadLine->new('CLIF Application'); select $term->OUT; $app->{_readline} = $term; #FIXME-TODO-CMDLINE_COMPLETION: # # Arrange for command-line completion... # my $attribs = $term->Attribs; # $attribs->{completion_function} = $app->_cmd_request_completions(); } # Prompt for the name of a command and read input from STDIN. # Store the individual tokens that are read in @ARGV. my $command_request = $term->readline('> '); if(! defined $command_request ) { # Interpret CTRL-D (EOF) as a quit signal... @ARGV = $app->quit_signals(); print "\n"; # since EOF character is rendered as '' } else { # Prepare command for usual parsing... @ARGV = Text::ParseWords::shellwords( $command_request ); $term->addhistory($command_request) if $command_request =~ /\S/ and !$term->Features->{autohistory}; } return 1; } ##FIXME-TODO-CMDLINE_COMPLETION:this should only return interactive commands; it should pay attention ##to its text/line/start args, ...; also: make it work with subcommands ## --see Term::Readline::Gnu #sub _cmd_request_completions { # my ($app) = @_; # return sub { # my ($text, $line, $start) = @_; # return $app->_valid_command_names; # } #} sub is_quit_signal { my ($app, $command_name) = @_; my @quit_signals = $app->quit_signals(); return grep { $command_name eq $_ } @quit_signals; } ############################### # # APPLICATION SUBCLASS HOOKS # ############################### #XXX-CONSIDER: consider making default implementation of init(): # $app->set_current_command('help') if $opts->{help} sub init { 1 } sub pre_dispatch { } sub usage_text { } sub option_spec { } sub validate_options { 1 } sub command_map { help => 'CLI::Framework::Command::Help', console => 'CLI::Framework::Command::Console', menu => 'CLI::Framework::Command::Menu', list => 'CLI::Framework::Command::List', 'dump' => 'CLI::Framework::Command::Dump', tree => 'CLI::Framework::Command::Tree', alias => 'CLI::Framework::Command::Alias', } sub command_alias { } sub noninteractive_commands { qw( console menu ) } sub quit_signals { qw( q quit exit ) } sub handle_exception { my ($app, $e) = @_; $app->render( $e->description . "\n\n" . $e->error ); return; } sub render { my ($app, $output) = @_; #XXX-CONSIDER: consider built-in features to help simplify associating templates #with commands (each command would probably have its own template for its #output) print $output; } ############################### # # CACHING # ############################### package CLI::Framework::Cache; use strict; use warnings; sub new { my ($class) = @_; bless { _cache => { } }, $class; } sub get { my ($self, $k) = @_; my $v = $self->{_cache}->{$k}; return $v; } sub set { my ($self, $k, $v) = @_; $self->{_cache}->{$k} = $v; return $v; } #------- 1; __END__ =pod =head1 NAME CLI::Framework::Application - CLIF Application superclass =head1 SYNOPSIS # The code below shows a few of the methods your application class is likely # to override... package My::Journal; use base qw( CLI::Framework ); sub usage_text { q{ $0 [--verbose|v] OPTIONS --db [path] : path to SQLite database file -v --verbose : be verbose -h --help : show help COMMANDS help - show application or command-specific help menu - print command menu entry - work with journal entries publish - publish a journal console - start a command console for the application } } sub option_spec { [ 'help|h' => 'show help' ], [ 'verbose|v' => 'be verbose' ], [ 'db=s' => 'path to SQLite database file' ], } sub command_map { help => 'CLI::Framework::Command::Help', menu => 'My::Journal::Command::Menu', entry => 'My::Journal::Command::Entry', publish => 'My::Journal::Command::Publish', console => 'CLI::Framework::Command::Console', } sub command_alias { h => 'help', m => 'menu', e => 'entry', p => 'publish', sh => 'console', c => 'console', } sub init { my ($self, $opts) = @_; my $db = DBI->connect( ... ); $self->cache->set( db => $db ); return 1; } 1; =head1 OBJECT CONSTRUCTION =head2 new( [interactive => 1] ) $app = My::Application->new( interactive => 1 ); C: Optional parameter. Set this to a true value if the application is to be run interactively (or call C later) Constructs and returns a new CLIF Application object. As part of this process, some validation is performed on L defined in the application class. If validation fails, an exception is thrown. =head1 COMMAND INTROSPECTION & REGISTRATION The methods in this section are responsible for providing access to the commands in an application. =head2 command_map_hashref() $h = $app->command_map_hashref(); Returns a HASH ref built from the command_map for an Application (by direct conversion from the command map array). If the list returned by the definition of L in the application is not hash-worthy, an exception is thrown. =head2 is_valid_command_pkg( $package_name ) $app->is_valid_command_pkg( 'My::Command::Swim' ); Returns a true value if the specified command class (package name) is valid within the application. Returns a false value otherwise. A command class is "valid" if it is included in L or if it is a built-in command that was included automatically in the application. =head2 is_valid_command_name( $command_name ) $app->is_valid_command_name( 'swim' ); Returns a true value if the specified command name is valid within the application. Returns a false value otherwise. A command name is "valid" if it is included in L or if it is a built-in command that was included automatically in the application. =head2 registered_command_names() @registered_commands = $app->registered_command_names(); Returns a list of the names of all registered commands. These are the names that each command was given in L (plus any auto-registered built-ins). =head2 registered_command_object( $command_name ) $command_object = $app->registered_command_object( 'fly' ); Given the name of a registered command, returns the L object that is registered in the application under that name. If the command is not registered, returns C. =head2 register_command( $cmd ) # Register by name... $command_object = $app->register_command( $command_name ); # ...or register by object reference... $command_object = CLI::Framework::Command->new( ... ); $app->register_command( $command_object ); Register a command to be recognized by the application. This method accepts either the name of a command or a reference to a L object. If C<$cmd> is a L object and it is one of the command types specified in L to be valid, the command object is registered and returned. If C<$cmd> is the name of a valid command specified in L, an object of the corresponding command class is registered and returned. If C<$cmd> is not recognized, an exception is thrown. =head2 get_default_command() / set_default_command( $default_cmd ) C retrieves the name of the command that is currently set as the default command for the application. my $default_command = $app->get_default_command(); Given a command name, C makes it the default command for the application. $app->set_default_command( 'jump' ); =head2 get_current_command() / set_current_command( $current ) C returns the name of the current command (or the one that was most recently run). $status = $app->run(); print 'The command named: ', $app->get_current_command(), ' was just run'; Given a command name, C forwards execution to that command. This might be useful (for instance) to "redirect" to another command. $app->set_current_command( 'fly' ); =head2 get_default_usage() / set_default_usage( $default_usage ) The "default usage" message is used as a last resort when usage information is unavailable by other means. See L. C gets the default usage message for the application. $usage_msg = $app->get_default_usage(); C sets the default usage message for the application. $app->set_default_usage( $usage_message ); =head1 PARSING & RUNNING COMMANDS =head2 usage( $command_name, @subcommand_chain ) # Application usage... print $app->usage(); # Command-specific usage... $command_name = 'task'; @subcommand_chain = qw( list completed ); print $app->usage( $command_name, @subcommand_chain ); Returns a usage message for the application or a specific (sub)command. If a command name is given (optionally with subcommands), returns a usage message string for that (sub)command. If no command name is given or if no usage message is defined for the specified (sub)command, returns a general usage message for the application. Here is how the usage message is produced: =over =item * If a valid command name (or alias) is given, attempt to get a usage message from the command (this step takes into account C<@subcommand_chain> so that a subcommand usage message will be shown if applicable); if no usage message is defined for the command, use the application usage message instead. =item * If the application object has defined L, use its return value as the usage message. =item * Finally, fall back to using the default usage message returned by L. B: It is advisable to define usage_text because the default usage message, produced via Getopt::Long::Descriptive, is terse and is not context-specific to the command request. =back =head2 cache() CLIF Applications may have the need to share data between individual CLIF Commands and the Application object itself. C provides a way for this data to be stored, retrieved, and shared between components. $cache_object = $app->cache(); C returns a cache object. The following methods demonstrate usage of the resulting object: $cache_object->get( 'key' ); $cache_object->set( 'key' => $value ); B: The underlying cache class is currently limited to these rudimentary features. In the future, the object returned by C may be changed to an instance of a real caching class, such as L (which would maintain backwards compatibility but offer expiration, serialization, multiple caching backends, etc.). =head2 run() # as class method: My::App->run(); # as object method (when having an object reference to call other methods # is desirable): my $app = My::App->new(); $app->run(); ... # Explicitly specify whether or not initialization should be done: $app->run( initialize => 0 ); This method controls the request processing and dispatching of a single command. It takes its input from @ARGV (which may be populated by a script running non-interactively on the command line) and dispatches the indicated command, capturing its return value. The command's return value represents the output produced by the command. This value is passed to L for final display. If errors occur, they result in exceptions that are handled by L. The following parameters are accepted: C: This controls whether or not application initialization (via L) should be performed. If not specified, initialization is performed upon the first call to C. Should there be subsequent calls, initialization is not repeated. Passing C explicitly can modify this behavior. =head1 INTERACTIVITY =head2 get_interactivity_mode() / set_interactivity_mode( $is_interactive ) C returns a true value if the application is in an interactive state and a false value otherwise. print "running interactively" if $app->get_interactivity_mode(); C sets the interactivity state of the application. One parameter is recognized: a true or false value to indicate whether the application state should be interactive or non-interactive, respectively. $app->set_interactivity_mode(1); =head2 is_interactive_command( $command_name ) $help_command_is_interactive = $app->is_interactive_command( 'help' ); Returns a true value if there is a valid command with the specified name that is an interactive command (i.e. a command that is enabled for this application in interactive mode). Returns a false value otherwise. =head2 get_interactive_commands() my @interactive_commands = $app->get_interactive_commands(); Return a list of all commands that are to be available in interactive mode ("interactive commands"). =head2 run_interactive( [%param] ) MyApp->run_interactive(); # ...or as an object method: $app->run_interactive(); Start an event processing loop to prompt for and run commands in sequence. The C command is used to display available command selections (the built-in C command, L, will be used unless the application defines its own C command). Within this loop, valid input is the same as in non-interactive mode except that application options are not accepted (any application options should be handled upon application initialization and before the interactive B loop is entered -- see the description of the C parameter below). The following parameters are recognized: C: causes any application options that are present in C<@ARGV> to be procesed/validated and causes L to be invoked prior to entering the interactive event loop to recognize commands. If C is called after application options have already been handled, this parameter can be omitted. C: the number of unrecognized command requests the user can enter before the menu is re-displayed. =head2 read_cmd() $app->read_cmd(); This method is responsible for retrieving a command request and placing the user input into C<@ARGV>. It is called in void context. The default implementation uses L to prompt the user and read a command request, supporting command history. Subclasses are free to override this method if a different means of accepting user input is desired. This makes it possible to read command selections without assuming that the console is being used for I/O. =head2 is_quit_signal() until( $app->is_quit_signal(read_string_from_user()) ) { ... } Given a string, return a true value if it is a quit signal (indicating that the application should exit) and a false value otherwise. L is an application subclass hook that defines what strings signify that the interactive session should exit. =head1 SUBCLASS HOOKS There are several hooks that allow CLIF applications to influence the command execution process. This makes customizing the critical aspects of an application as easy as overriding methods. Except where noted, all hooks are optional -- subclasses may choose not to override them (in fact, runnable CLIF applications can be created with very minimal subclasses). =head2 init( $options_hash ) This hook is called in void context with one parameter: C<$options_hash> is a hash of pre-validated application options received and parsed from the command line. The options hash has already been checked against the options defined to be accepted by the application in L. This method allows CLIF applications to perform any common initialization tasks that are necessary regardless of which command is to be run. Some examples of this include connecting to a database and storing a connection handle in the shared L slot for use by individual commands, setting up a logging facility that can be used by each command by storing a logging object in the L, or initializing settings from a configuration file. =head2 pre_dispatch( $command_object ) This hook is called in void context. It allows applications to perform actions after each command object has been prepared for dispatch but before the command dispatch actually takes place. Its purpose is to allow applications to do whatever may be necessary to prepare for running the command. For example, a log entry could be inserted in a database to store a record of every command that is run. =head2 option_spec() An example definition of this hook is as follows: sub option_spec { [ 'verbose|v' => 'be verbose' ], [ 'logfile=s' => 'path to log file' ], } This method should return an option specification as expected by L. The option specification defines what options are allowed and recognized by the application. =head2 validate_options( $options_hash ) This hook is called in void context. It is provided so that applications can perform validation of received options. C<$options_hash> is an options hash parsed from the command-line. This method should throw an exception if the options are invalid (throwing the exception using C is sufficient). B that L, which is used internally for part of the options processing, will perform some validation of its own based on the L. However, the C hook allows for additional flexibility in validating application options. =head2 command_map() Return a mapping between command names and Command classes (classes that inherit from L). The mapping is a list of key-value pairs. The list should be "hash-worthy", meaning that it can be directly converted to a hash. Note that the order of the commands in this list determines the order that the commands are displayed in the built-in interactive menu. The keys are names that should be used to install the commands in the application. The values are the names of the packages that implement the corresponding commands, as in this example: sub command_map { # custom commands: fly => 'My::Command::Fly', run => 'My::Command::Run', # overridden built-in commands: menu => 'My::Command::Menu', # built-in commands: help => 'CLI::Framework::Command::Help', list => 'CLI::Framework::Command::List', tree => 'CLI::Framework::Command::Tree', 'dump' => 'CLI::Framework::Command::Dump', console => 'CLI::Framework::Command::Console', alias => 'CLI::Framework::Command::Alias', } =head2 command_alias() This hook allows aliases for commands to be specified. The aliases will be recognized in place of the actual command names. This is useful for setting up shortcuts to longer command names. C should return a "hash-worthy" list where the keys are aliases and the values are command names. An example of its definition: sub command_alias { h => 'help', l => 'list', ls => 'list', sh => 'console', c => 'console', } =head2 noninteractive_commands() sub noninteractive_commands { qw( console menu ) } Certain commands do not make sense to run interactively (e.g. the "console" command, which itself puts the application into interactive mode). This method should return a list of their names. These commands will be disabled during interactive mode. By default, all commands are interactive commands except for C and C. =head2 quit_signals() sub quit_signals { qw( q quit exit ) } An application can specify exactly what input represents a request to end an interactive session. By default, the example definition above is used. =head2 handle_exception( $e ) sub handle_exception { my ($app, $e) = @_; # Handle the exception represented by object $e... $app->my_error_logger( error => $e->error, pid => $e->pid, gid => $e->gid, ... ); warn "caught error ", $e->error, ", continuing..."; return; } Error conditions are caught by CLIF and forwarded to this exception handler. It receives an exception object (see L for methods that can be called on the object). If not overridden, the default implementation extracts the error message from the exception object and processes it through the L method. =head2 render( $output ) $app->render( $output ); This method is responsible for presentation of the result from a command. The default implementation simply attempts to print the C<$output> scalar, assuming that it is a string. Subclasses are free to override this method to provide more sophisticated behavior such as processing the C<$output> scalar through a templating system. =head2 usage_text() sub usage_text { q{ OPTIONS -v --verbose : be verbose -h --help : show help COMMANDS tree - print a tree of only those commands that are currently-registered in your application menu - print command menu help - show application or command-specific help console - start a command console for the application list - list all commands available to the application } } To provide application usage information, this method may be overridden. It accepts no parameters and should return a string containing a useful help message for the overall application. Overriding this method is encouraged in order to provide a better usage message than the default. See L. =head1 ERROR HANDLING IN CLIF Internally, CLIF handles errors by throwing exceptions. The L method provides an opportunity for customizing the way errors are treated in a CLIF application. Application and Command class hooks such as L and L are expected to indicate success or failure by throwing exceptions (via C or something more elaborate, such as exception objects). =head1 CONFIGURATION & ENVIRONMENT For interactive usage, L is used by default. Depending on which readline libraries are available on your system, your interactive experience will vary (for example, systems with GNU readline can benefit from a command history buffer). =head1 DEPENDENCIES L L L (only for interactive use) L (only for interactive use) L L =head1 DEFECTS AND LIMITATIONS No known bugs. =head1 PLANS FOR FUTURE VERSIONS =over =item * Command-line completion of commands in interactive mode =item * Features to make it simpler to use templates for output =item * Features to instantly web-enable your CLIF Applications, making them accessible via a "web console" =item * Better automatic usage message generation =item * An optional inline automatic class generation interface similar to that of L that will make the simple "inline" form of usage even more compact =back =head1 SEE ALSO L L L =head1 LICENSE AND COPYRIGHT Copyright (c) 2009 Karl Erisman (kerisman@cpan.org). All rights reserved. This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perlartistic. =head1 AUTHOR Karl Erisman (kerisman@cpan.org) =cut CLI-Framework-0.05/lib/CLI/Framework.pm0000644000076400007640000003265711536217674017715 0ustar kerismankerismanpackage CLI::Framework; use base qw( CLI::Framework::Application ); use strict; use warnings; our $VERSION = '0.05'; #------- 1; __END__ =pod =head1 NAME CLI::Framework - Build standardized, flexible, testable command-line applications =head1 OVERVIEW CLI::Framework ("CLIF") provides a framework and conceptual pattern for building full-featured command line applications. It intends to make this process simple and consistent. It assumes the responsibility of implementing details that are common to all command-line applications, making it possible for new applications adhering to well-defined conventions to be built without the need to repeatedly write the same command-line interface code. For instance, a complete application supporting commands and subcommands, with options and arguments for the application itself as well as its commands, can be built by writing concise, understandable code in packages that are easy to test and maintain. The classes can focus on implementation of unique aspects essential to the command's purpose without being concerned with the many details involved in building an interface around those commands. This methodology for building command-line applications also establishes a valuable standard for an organization (or an individual developer). =head1 LEARNING CLIF: RECOMMENDATIONS CLIF has a rich set of features and offers many alternative approaches to building applications, but if you are new to using it, you may want a succinct introduction. For this reason, the L is provided and is the recommended starting point. After you gain a basic understanding, the other documents can be used as references. =head1 MOTIVATION There are a few other distributions on CPAN intended to simplify building modular command line applications. I have not found any that meet my requirements, which are documented in L. =head1 DESIGN GOALS AND FEATURES CLIF was designed to offer the following features... =over =item * A clear conceptual pattern for creating command-line applications =item * Guiding documentation and examples =item * Convenience for simple cases, flexibility for complex cases =item * Support for both non-interactive and interactive modes (with almost no additional work -- define the necessary hooks and both modes will be supported) =item * A design that naturally encourages MVC applications: decouple data model, control flow, and presentation =item * Commands that can be shared between applications (and uploaded to CPAN) =item * The possibility to share some components with MVC web applications =item * Validation of application options =item * Validation of command options and arguments =item * A model that encourages easily-testable applications =item * A flexible means to provide usage/help information for the application as a whole and for individual commands =item * Support for subcommands that can be added as a natural extension to commands =item * Support for recursively-defined subcommands (sub-sub-...commands to any level of depth) =item * Support for aliases to commands and subcommands =item * Allow Application and [sub]commands to be defined inline (some or all packages involved may be defined in the same file) or split across multiple files =item * Support the concept of a default command for the application =item * Exception handling that allows individual applications to define custom exception handlers =item * Performance. Core framework code should load as quickly as a simple script; individual commands should be initialized only when invoked. =back =head1 CONCEPTS AND DEFINITIONS =over =item * Application Script - The wrapper program that invokes the CLIF Application's L method. The file it is defined in may or may not also contain the definition of Application or Command packages. =item * Metacommand - An application-aware command. Metacommands are subclasses of L. They are identical to regular commands except they hold a reference to the application within which they are running. This means they are able to "know about" and affect the application. For example, the built-in command "Menu" is a Metacommand because it needs to produce a list of the other commands in its application. In general, your commands should be designed to operate independently of the application, so they should simply inherit from L. This encourages looser coupling. However, in exceptional cases, the use of Metacommands is warranted (For an example, see the built-in "Menu" command). =item * Non-interactive Command - In interactive mode, some commands need to be disabled. For instance, the built-in "console" command (which is used to start interactive mode, presenting a command menu and responding to user selections) should not be presented as a menu option in interactive mode because it is already running. You can designate which commands are non-interactive by overriding the L method. =item * Registration of commands - Each CLIF application defines the commands it will support. These may be built-in CLIF commands or custom CLIF commands. These commands are lazily "registered" as they are called upon for use. =back =head1 APPLICATION RUN SEQUENCE When a command of the form: $ app [app-opts] [cmd-opts] { [cmd-opts] {...} } [cmd-args] examples: app | [app-opts] { | [cmd-opts] } [cmd-args] `````````````````|```````````````````````````````````|`````````````|`````````````````|`````````````` $ examples/queue |--qin=/tmp/qfile --qout=/tmp/qfile | enqueue | --tag=x --tag=y | 'item' `````````````````|```````````````````````````````````|`````````````|`````````````````|`````````````` $ gen-report | --html | stats | --role=admin | | | usage | --time='2d' | '/tmp/stats.html' ```````````````````````````````````````````````````````````````````````````````````````````````````` ...causes your application script, , to invoke the L method in your application class, CLI::Framework::Application performs the following actions: =over =item 1 Parse the command request =item 2 Validate application options =item 3 Initialize application =item 4 Prepare command =item 5 Invoke command pre-dispatch hook =item 6 Dispatch command =back These steps are explained in more detail below... =head2 Request parsing Parse the application options C<< [app-opts] >>, command name C<< >>, command options C<< [cmd-opts] >>, and the remaining part of the command line, which includes command arguments C<< [cmd-args] >> for the last command and may include multiple subcommands. Everything between the inner brackets (C<< { ... } >>) represents recursive subcommand processing -- the "C<...>" represents another string of "C<< [cmd-opts] {...} >>". The second example above shows a command request that requires recursive subcommand processing. The command might cause an HTML report to be generated with usage statistics for admin users (of some application) for the past two days, writing the report to a file. In one line, it would look like this: $ gen-report --html stats --role=admin usage --time='2d' '/tmp/stats.html' This fictional gen-report application could be designed with such an interface because it could offer various types of reports (as opposed to the statistics report). There might be other statistics reports (as opposed to 'usage'). The stats might be available for users with other roles. The usage report might need to accept custom time frames. CLIF allows you to choose whether various parts of your data should be supplied as options or as arguments -- these interface decisions are left to your discretion. CLIF also makes it easy to validate command requests and to provide usage information so users know what to change if a command request fails validation. In general, if a command request is not well-formed, it is replaced with the default command and any arguments present are ignored. The default command prints a help or usage message (you may change this behavior if desired). =head2 Validation of application options Your application class can optionally define the L method. If your application class does not override this method, validation is skipped -- any received options are considered to be valid. =head2 Application initialization Your application class can optionally override the L method. This is a hook that can be used to perform any application-wide initialization that needs to be done independent of individual commands. For example, your application may use the L method to connect to a database and store a connection handle which may be needed by some or all of the commands in your application. =head2 Preparing the command The requested command is now loaded (if not already done). The command's L is set (using a reference to the same L used by the application). =head2 Command pre-dispatch Your application class can optionally have a L method that is called with one parameter: the Command object that is about to be dispatched. =head2 Dispatching the command CLIF uses the L method to actually dispatch a specific command. That method is responsible for running the command or delegating responsibility to a subcommand, if applicable. =head1 INTERACTIVITY After building your CLIF application, in addition to basic non-interactive functionality, you will instantly benefit from the ability to (optionally) run your application in interactive mode. A readline-enabled application command console with an event loop, a command menu, and built-in debugging commands is provided by default. Inside interactive mode, only steps 4, 5, and 6 above (L) are performed for each command request. Supporting interactivity in your application is as simple as adding the built-in command L to your L. =head1 BUILT-IN COMMANDS INCLUDED IN THIS DISTRIBUTION This distribution comes with some default built-in commands, and more CLIF built-ins can be installed as they become available on CPAN. Use of the built-ins is optional in most cases, but certain features require specific built-in commands (e.g. the Help command is a fundamental feature of all applications and the Menu command is required in interactive mode). You can override any of the built-ins. A new application that does not override the L hook will include all of the built-ins listed below. The existing built-ins and their corresponding packages are as follows: =over =item help: Print application or command-specific usage messages L B: This command is registered automatically. All CLIF applications must have the "help" command defined (though this built-in can replaced by your subclass to change the "help" command behavior or to do nothing if you specifically do not want a help command). =item list: Print a list of commands available to the running application L =item dump: Show the internal state of a running application L =item tree: Display a tree representation of the commands that are currently registered with the running application L =item alias: Display the command aliases that are in effect for the running application and its commands L =item console: Invoke CLIF's interactive mode L =item menu: Show a command menu including the commands that are available to the running application L B: This command is registered automatically when an application runs in interactive mode. This built-in may be replaced by a user-defined "menu" command, but any command class to be used for the "menu" command MUST be a subclass of this one. =back =head1 CLIF ARCHITECTURE AT A GLANCE The class diagram below shows the relationships of the major classes of CLI Framework, including some of their methods. This is not intended to be a comprehensive diagram, only an aid to understanding CLIF at a glance. =begin html

class diagram from docs/images dir

=end html =head1 SEE ALSO L L L =head1 LICENSE AND COPYRIGHT Copyright (c) 2009 Karl Erisman (kerisman@cpan.org). All rights reserved. This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perlartistic. =head1 AUTHOR Karl Erisman (kerisman@cpan.org) =cut CLI-Framework-0.05/t/0000755000076400007640000000000011536220123014452 5ustar kerismankerismanCLI-Framework-0.05/t/00-load.t0000644000076400007640000000065611536216716016017 0ustar kerismankerismanuse Test::More tests => 6; use lib 'lib'; use lib 't/lib'; BEGIN { use_ok( 'CLI::Framework' ); use_ok( 'CLI::Framework::Application' ); use_ok( 'CLI::Framework::Command' ); use_ok( 'CLI::Framework::Command::Help' ); use_ok( 'CLI::Framework::Command::List' ); use_ok( 'CLI::Framework::Command::Menu' ); } diag( "Testing CLI::Framework::Application $CLI::Framework::Application::VERSION, Perl $], $^X" ); CLI-Framework-0.05/t/bin/0000755000076400007640000000000011536220123015222 5ustar kerismankerismanCLI-Framework-0.05/t/bin/perlfunc0000644000076400007640000000045611216525274017002 0ustar kerismankerisman#! /usr/bin/perl use strict; use warnings; use lib 'lib'; use lib 't/lib'; use My::PerlFunctions; My::PerlFunctions->run(); __END__ =pod =head1 PURPOSE Application Script executable for demo application supporting searching for single-line summary descriptions of built-in Perl functions. =cut CLI-Framework-0.05/t/bin/myjournal0000755000076400007640000000047111230155067017177 0ustar kerismankerisman#! /usr/bin/perl use strict; use warnings; use lib 'lib'; use lib 't/lib'; use My::Journal; my $journal = My::Journal->new(); $journal->set_default_command( 'console' ); $journal->run(); __END__ =pod =head1 PURPOSE Application Script executable for demo application implementing a personal journal. =cut CLI-Framework-0.05/t/config/0000755000076400007640000000000011536220123015717 5ustar kerismankerismanCLI-Framework-0.05/t/config/myjournal.sql0000644000076400007640000000115611216525267020477 0ustar kerismankerisman/* myjournal.sql: Example database for demo My::Journal CLIF application */ BEGIN TRANSACTION; DROP TABLE IF EXISTS journal; CREATE TABLE journal_entry ( id INTEGER PRIMARY KEY AUTOINCREMENT, entry_text TEXT NOT NULL ); CREATE TABLE entry2tag ( entry_id INTEGER NOT NULL, tag_id INTEGER NOT NULL, PRIMARY KEY (entry_id, tag_id), FOREIGN KEY (entry_id) REFERENCES journal_entry(id), FOREIGN KEY (tag_id) REFERENCES tag(id) ); CREATE TABLE tag ( id INTEGER PRIMARY KEY AUTOINCREMENT, tag_text TEXT NOT NULL UNIQUE ); COMMIT; CLI-Framework-0.05/t/session-prod-cons.t0000644000076400007640000000456111536216716020247 0ustar kerismankerismanuse strict; use warnings; use lib 'lib'; use lib 't/lib'; use Test::More tests => 2; use File::Spec; open( my $devnull, '>', File::Spec->devnull() ); select $devnull; my ($SHARED_KEY, $SHARED_VALUE) = ('shared-key', '* producer was here *'); my $SHARED_VALUE_CACHED_IN_INIT = '* shared value set in app init() method *'; my $app = Test::Of::Session::Persistence->new(); @ARGV = ( "--app_opt=$SHARED_VALUE_CACHED_IN_INIT", 'prod', 'a', 'b' ); $app->run(); is( $app->cache->get( 'app_opt' ), $SHARED_VALUE_CACHED_IN_INIT, 'init() method in application class correctly stores data in cache' ); @ARGV = qw( cons ); $app->run(); is( $app->cache->get( $SHARED_KEY ), $SHARED_VALUE, 'values stored in cache persist' ); close $devnull; ############################ # # APPLICATION CLASS # ############################ # application WRITES TO the cache package Test::Of::Session::Persistence; use base qw( CLI::Framework ); use strict; use warnings; sub option_spec { [ 'app_opt=s' => 'option to test setting a cache key in init() method of application class' ], } sub init { my ($self, $opts) = @_; for my $key (keys %$opts ) { $self->cache->set( $key => $opts->{$key} ); } } sub command_map { console => 'CLI::Framework::Command::Console', 'session-producer' => 'Producer', 'session-consumer' => 'Consumer', } sub command_alias { 'prod' => 'session-producer', 'cons' => 'session-consumer', } ############################ # # COMMAND CLASSES # ############################ # command that WRITES TO the cache package Producer; use base qw( CLI::Framework::Command ); use strict; use warnings; sub run { my ($self, $opts, @args) = @_; # If args provided, treat them as set of key-value pairs to be added to # the cache... die 'zero or even number of args required' if @args % 2; my %kv = @args; for my $key (keys %kv) { $self->cache->set( $key => $kv{$key} ); } $self->cache->set($SHARED_KEY => $SHARED_VALUE); return ''; } #------- # command that READS FROM the cache package Consumer; use base qw( CLI::Framework::Command ); use strict; use warnings; sub run { my ($self, $opts, @args) = @_; my $value_passed_by_producer = $self->cache->get( $SHARED_KEY ); return $value_passed_by_producer; } #------- __END__ =pod =head1 PURPOSE Test session persistence in CLIF =cut CLI-Framework-0.05/t/db/0000755000076400007640000000000011536220123015037 5ustar kerismankerismanCLI-Framework-0.05/t/db/myjournal.sqlite0000644000076400007640000001600011227440470020305 0ustar kerismankerismanSQLite format 3@ ( \  {tabletagtagCREATE TABLE tag ( id INTEGER PRIMARY KEY AUTOINCREMENT, tag_text TEXT NOT NULL UNIQUE )%9indexsqlite_autoindex_tag_1tagktableentry2tagentry2tagCREATE TABLE entry2tag ( entry_id INTEGER NOT NULL, tag_id INTEGER NOT NULL, PRIMARY KEY (entry_id, tag_id), FOREIGN KEY (entry_id) REFERENCES journal_entry(id), FOREIGN KEY (tag_id) REFERENCES tag(id) )1Eindexsqlite_autoindex_entry2tag_1entry2tagP++Ytablesqlite_sequencesqlite_sequenceCREATE TABLE sqlite_sequence(name,seq)!''tablejournal_entryjournal_entryCREATE TABLE journal_entry ( id INTEGER PRIMARY KEY AUTOINCREMENT, entry_text TEXT NOT NULL ) + ]a journal entry to remember or to forget]a journal entry to rememb !mulberries boohellotest boot $journal_entr'journal_entry tag                                 berriesdarkshiny silversunny outsidexoofoo  berries dark shiny silver sunny outsidexoofooCLI-Framework-0.05/t/lib/0000755000076400007640000000000011536220123015220 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/0000755000076400007640000000000011536220123015605 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/Command/0000755000076400007640000000000011536220123017163 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/Command/Shared/0000755000076400007640000000000011536220123020371 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/Command/Shared/X.pm0000644000076400007640000000054211217054723021146 0ustar kerismankerismanpackage My::Command::Shared::X; use base qw( CLI::Framework::Command ); use strict; use warnings; sub run { my ($self, $opts, @args) = @_; return 'running ' . $self->name() . ' from package ' . __PACKAGE__ . "\n"; } #------- 1; __END__ =pod =head1 PURPOSE Test/demonstrate a CLIF setup involving a non-standard command search path. =cut CLI-Framework-0.05/t/lib/My/Journal/0000755000076400007640000000000011536220123017217 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/Journal/Command/0000755000076400007640000000000011536220123020575 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/Journal/Command/Publish.pm0000644000076400007640000000220511536216716022555 0ustar kerismankerismanpackage My::Journal::Command::Publish; use base qw( CLI::Framework::Command ); use strict; use warnings; use Carp; #------- sub usage_text { q{ publish [--out= --format=]: publish a journal } } sub option_spec { ( [ 'format=s' => 'publish in specific format' ], [ 'template=s' => '' ], [ 'out=s' => 'output file' ], ) } sub run { my ($self, $opts, @args) = @_; my $db = $self->cache->get('db'); croak "DB not initialized in cache" unless $db; my @entries = $db->all_entries(); my @entries_output; for my $entry (@entries) { my $entry_output = $entry->{id}.':'.$entry->{entry_text}; my @tags = $db->tags_by_entry_id( $entry->{id} ); $entry_output .= ' [tags: ' . join(',', @tags) . ']' if @tags; push @entries_output, $entry_output; } print 'Pretend that this data gets published in the ', 'requested format, using a specified template, and sent to a named ', "output file\n\n"; return join("\n", @entries_output) . "\n"; } #------- 1; __END__ =pod =head1 PURPOSE Command to publish a journal =cut CLI-Framework-0.05/t/lib/My/Journal/Command/Dummy.pm0000644000076400007640000000102211216525272022231 0ustar kerismankerismanpackage My::Journal::Command::Dummy; use strict; use warnings; sub new { bless {}, $_[0] } 1; __END__ =pod =head1 DUMMY CLASS This is a dummy class that exists solely to demonstrate that (sub)command directory hierarchies can contain classes that do NOT represent subcommands. This class is ignored during construction of the command tree for the My::Journal application because it does not inherit from My::Journal::Command (even though it is in the expected directory location for My::Journal::Command subclasses). =cut CLI-Framework-0.05/t/lib/My/Journal/Command/Menu.pm0000644000076400007640000000215411227636656022064 0ustar kerismankerismanpackage My::Journal::Command::Menu; use base qw( CLI::Framework::Command::Menu ); use strict; use warnings; sub usage_text { q{ menu (My::Journal command overriding the built-in): test of overriding a built-in command...' } } sub menu_txt { my ($self) = @_; my $app = $self->get_app(); # metacommand is app-aware my $menu; $menu = "\n" . '-'x13 . "menu" . '-'x13 . "\n"; for my $c ( $app->get_interactive_commands() ) { $menu .= sprintf("\t%s\n", $c) } $menu .= '-'x30 . "\n"; return $menu; } #------- 1; __END__ =pod =head1 NAME My::Journal::Command::Menu =head1 PURPOSE A demonstration and test of overriding a built-in CLIF Menu command. =head1 NOTES This example replaces the built-in command menu. The particular replacement is not particularly useful, but shows how such a replacement could be done. Note that overriding the menu command is a special case of overriding a built-in command and it is necessary that the overriding command inherit from the built-in menu class, CLI::Framework::Command::Menu. This example merely changes the menu format. =cut CLI-Framework-0.05/t/lib/My/Journal/Command/Entry/0000755000076400007640000000000011536220123021676 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/Journal/Command/Entry/dummy.txt0000644000076400007640000000016411216525272023603 0ustar kerismankerisman This dummy file exists for testing purposes. It should be ignored by CLIF when loading commands and subcommands. CLI-Framework-0.05/t/lib/My/Journal/Command/Entry/Dummy.pm0000644000076400007640000000071211216525271023336 0ustar kerismankerismanpackage My::Journal::Command::Entry::Dummy; use strict; use warnings; sub new { bless {}, $_[0] } 1; __END__ =pod =head1 DUMMY CLASS This is a dummy class that exists solely to demonstrate that (sub)command directory hierarchies can contain classes that do NOT represent subcommands. This class is ignored during construction of the Entry command tree for the My::Journal application because it does not inherit from My::Journal::Command::Entry. =cut CLI-Framework-0.05/t/lib/My/Journal/Command/Entry/Modify.pm0000644000076400007640000000434411225520613023472 0ustar kerismankerismanpackage My::Journal::Command::Entry::Modify; use base qw( My::Journal::Command::Entry ); use strict; use warnings; sub usage_text { q{ entry modify tag (add|remove|reset) --id= [ ...] } } #------- package My::Journal::Command::Entry::Modify::Tag; use base qw( My::Journal::Command::Entry::Modify ); use strict; use warnings; sub option_spec { [ 'id=s' => 'id' ], } package My::Journal::Command::Entry::Modify::Tag::Add; use base qw( My::Journal::Command::Entry::Modify::Tag ); use strict; use warnings; sub validate { my ($self, $opts, @args) = @_; die $self->usage_text(), "\n" unless $opts->{id} && @args; } sub run { my ($self, $opts, @args) = @_; my $db = $self->cache->get( 'db' ); $db->add_tag_to_entry( $opts->{id}, $_ ) for @args; return ''; } package My::Journal::Command::Entry::Modify::Tag::Remove; use base qw( My::Journal::Command::Entry::Modify::Tag ); use strict; use warnings; sub validate { my ($self, $opts, @args) = @_; die $self->usage_text(), "\n" unless $opts->{id} && @args; } sub run { my ($self, $opts, @args) = @_; my $db = $self->cache->get( 'db' ); my @tag_ids; for my $tag_text (@args) { my $tag_id = $db->get_tag_id_by_name( $tag_text ); push @tag_ids, $tag_id if defined $tag_id; } $db->remove_tag_from_entry( $opts->{id}, $_ ) for @tag_ids; return ''; } package My::Journal::Command::Entry::Modify::Tag::Reset; use base qw( My::Journal::Command::Entry::Modify::Tag ); use strict; use warnings; sub validate { my ($self, $opts, @args) = @_; die $self->usage_text(), "\n" unless $opts->{id} && @args; } sub run { my ($self, $opts, @args) = @_; my $db = $self->cache->get( 'db' ); $db->clear_tags_from_entry( $opts->{id} ); $db->add_tag_to_entry( $opts->{id}, $_ ) for @args; return ''; } #------- 1; __END__ =pod =head1 NAME My::Journal::Command::Entry::Modify - Subcommands to modify journal entries =head2 My::Journal::Command::Entry::Modify::Tag Subcommands to modify journal entry tags =head2 My::Journal::Command::Entry::Modify::Tag::Add =head2 My::Journal::Command::Entry::Modify::Tag::Remove =head2 My::Journal::Command::Entry::Modify::Tag::Reset =cut CLI-Framework-0.05/t/lib/My/Journal/Command/Entry/Add.pm0000644000076400007640000000154411225520623022733 0ustar kerismankerismanpackage My::Journal::Command::Entry::Add; use base qw( My::Journal::Command::Entry ); use strict; use warnings; sub usage_text { q{ entry add [--tag= [--tag=...]] : add a new journal entry with optional tags } } sub option_spec { ( [ 'tag=s@' => 'tag text' ], ) } sub validate { my ($self, $opts, @args) = @_; die 'exactly one argument is required', "\n" unless @args == 1; } sub run { my ($self, $opts, @args) = @_; my $entry_text = shift @args; my $db = $self->cache->get( 'db' ); my $entry_id = $db->insert_entry( $entry_text ); my $tags = $opts->{tag}; for my $tag ( @$tags ) { $db->add_tag_to_entry( $entry_id, $tag ); } return ''; } #------- 1; __END__ =pod =head1 My::Journal::Command::Entry::Add =head2 PURPOSE Command to add a journal entry =cut CLI-Framework-0.05/t/lib/My/Journal/Command/Entry/Print.pm0000644000076400007640000000152211225520627023337 0ustar kerismankerismanpackage My::Journal::Command::Entry::Print; use base qw( My::Journal::Command::Entry ); use strict; use warnings; use Carp; sub usage_text { q{ entry print [ ...]: display a journal entry } } sub validate { my ($self, $opts, @args) = @_; # Require at least one arg... die "at least one argument required\n" unless @args; # Accept only digits as args... die "only numerical ids allowed\n" if grep /\D/, @args; } sub run { my ($self, $opts, @args) = @_; my $db = $self->cache->get('db'); my @entries; for my $id (@args) { my $entry = $db->entry_by_id( $id ); push @entries, $entry->{id}.': '.$entry->{entry_text} if $entry; } return join("\n", @entries) . "\n"; } #------- 1; __END__ =pod =head1 PURPOSE Command to display journal entries given their ids =cut CLI-Framework-0.05/t/lib/My/Journal/Command/Entry/Remove.pm0000644000076400007640000000123711225520632023477 0ustar kerismankerismanpackage My::Journal::Command::Entry::Remove; use base qw( My::Journal::Command::Entry ); use strict; use warnings; use Carp; #------- sub usage_text { q{ entry remove: remove journal entries } } sub validate { my ($self, $opts, @args) = @_; # Require at least one arg... die $self->usage_text(), "\n" unless @args; # Accept only digits as args... die 'arguments must be digits', "\n" if grep /\D/, @args; } sub run { my ($self, $opts, @args) = @_; my $db = $self->cache->get('db'); $db->delete_entry( $_ ) for (@args); return; } #------- 1; __END__ =pod =head1 PURPOSE Command to remove journal entries =cut CLI-Framework-0.05/t/lib/My/Journal/Command/Entry.pm0000644000076400007640000000606511227640136022252 0ustar kerismankerismanpackage My::Journal::Command::Entry; use base qw( CLI::Framework::Command ); use strict; use warnings; #------- sub usage_text { q{ entry [--date=yyyy-mm-dd] [subcommands...] OPTIONS --date=yyyy-mm-dd: set date that entry appiles to ARGUMENTS (subcommands) add: add an entry remove: remove an entry modify: modify an entry search: search for entries by regex; show summary print: display full text of entries } } sub option_spec { return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior ( [ 'date=s' => 'date that entry applies to' ], ) } sub subcommand_alias { return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior ( a => 'add', s => 'search', p => 'print', rm => 'remove', del => 'remove', rem => 'remove', m => 'modify', mod => 'modify', ) } sub validate { my ($self, $opts, @args) = @_; return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior # ... } sub notify_master { my ($self, $subcommand, $opts, @args ) = @_; return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior # ... } #------- # # Inline subcommand example... # # NOTE that the 'search' subcommand is defined inline in the same package # file as its master commnd, 'entry.' # # This is supported as an alternative to defining the subcommand in its # own separate package file. # package My::Journal::Command::Entry::Search; use base qw( My::Journal::Command::Entry ); use strict; use warnings; sub usage_text { q{ entry search --regex= [--tag=]: search for journal entries } } sub option_spec { [ 'regex=s' => 'regex' ], [ 'tag=s@' => 'tag' ], } sub validate { my ($self, $opts, @args) = @_; die "missing required option 'regex'\n" unless $opts->{regex}; } sub run { my ($self, $opts, @args) = @_; my $regex = $opts->{regex}; my $tags = $opts->{tag}; my $r = eval { qr/$regex/ }; $r ||= qr/.*/; warn "searching...\n" if $self->cache->get('verbose'); my $db = $self->cache->get('db'); # model class object # Show a brief summary of truncated entries with their ids... my @entries; if( defined $tags ) { for my $tag ( @$tags ) { push @entries, $db->entries_by_tag($tag); } } else { @entries = $db->all_entries(); } my $matching; for my $entry (@entries) { if( $entry->{entry_text} =~ /$r/m ) { my $id = $entry->{id}; my $entry_summary = sprintf "%10d: %s", $id, substr( $entry->{entry_text}, 0, 80 ); $matching->{$id} = $entry_summary; } } return join "\n", values %$matching; } #------- 1; __END__ =pod =head1 NAME My::Journal::Command::Entry - Command to work with journal entries =head2 My::Journal::Command::Entry::Search Subcommand to search for journal entries =cut CLI-Framework-0.05/t/lib/My/Journal/Model.pm0000644000076400007640000001123011536216716020627 0ustar kerismankerismanpackage My::Journal::Model; use strict; use warnings; use Carp; use DBI; #------- sub new { my ($class, %args) = @_; my $sqlite_db_path = $args{ dbpath } or croak 'path to SQLite DB file required'; # Connect to database... my $dbh = DBI->connect( "dbi:SQLite:dbname=$sqlite_db_path", { AutoCommit => 1, RaiseError => 1, ShowErrorStatement => 1 } ); bless { _dbh => $dbh }, $class; } sub dbh { $_[0]->{_dbh} } #------- sub insert_entry { my ($self, $entry_text) = @_; my $dbh = $self->dbh(); my $entry_id; $dbh->begin_work(); # transaction (to get id of last-inserted record) eval { $dbh->do( q{ INSERT INTO journal_entry (entry_text) VALUES (?) }, undef, $entry_text ); my $e = $dbh->selectrow_arrayref( 'SELECT MAX(id) FROM journal_entry' ); $entry_id = $e->[0]; $dbh->commit(); }; if( $@ ) { eval { $dbh->rollback() } } return $entry_id; } sub delete_entry { my ($self, $id) = @_; my $dbh = $self->dbh(); my $rows_affected = $dbh->do( q{ DELETE FROM journal_entry WHERE id = ? }, undef, $id ); return 1; } sub insert_tag { my ($self, $tag_text) = @_; my $dbh = $self->dbh(); $dbh->do( q{ INSERT INTO tag (tag_text) VALUES (?) }, undef, $tag_text ); return 1; } sub add_tag_to_entry { my ($self, $entry_id, $tag_text) = @_; my $dbh = $self->dbh(); $dbh->begin_work(); # transaction eval { my $tag_id; my $tag = $dbh->selectrow_arrayref( "SELECT id FROM tag WHERE tag_text = ?", undef, $tag_text ); unless( defined $tag ) { # Tag does not exist already... $self->insert_tag( $tag_text ); my $t = $dbh->selectrow_arrayref( 'SELECT MAX(id) FROM tag' ); $tag_id = $t->[0]; } $tag_id ||= $tag->[0]; # Add (pre-existing or new) tag to journal entry... $dbh->do( 'INSERT INTO entry2tag (entry_id, tag_id) VALUES (?, ?)', undef, $entry_id, $tag_id ); $dbh->commit; }; if( $@ ) { eval { $dbh->rollback() } } return 1; } sub remove_tag_from_entry { my ($self, $entry_id, $tag_id) = @_; my $dbh = $self->dbh(); my $sth = $dbh->prepare_cached( q{ DELETE FROM entry2tag WHERE entry_id = ? AND tag_id = ? } ); $sth->execute( $entry_id, $tag_id ); return 1; } sub clear_tags_from_entry { my ($self, $entry_id) = @_; my $dbh = $self->dbh(); $dbh->do( q{ DELETE FROM entry2tag WHERE entry_id = ? }, undef, $entry_id ); return 1; } #------- sub get_tag_id_by_name { my ($self, $tag_text) = @_; my $dbh = $self->dbh(); my $t = $dbh->selectrow_arrayref( 'SELECT id FROM tag WHERE tag_text = ?', undef, $tag_text ); my $tag_id; if( defined $t ) { $tag_id = $t->[0]; } return $tag_id; } sub entry_by_id { my ($self, $id) = @_; my $dbh = $self->dbh(); my $sth = $dbh->prepare_cached( q{ SELECT id, entry_text FROM journal_entry WHERE id = ? } ); $sth->execute( $id ); my $row = $sth->fetchrow_hashref(); $sth->finish(); return $row; } sub entries_by_tag { my ($self, $tag_text) = @_; my $dbh = $self->dbh(); my $sth = $dbh->prepare_cached( q{ SELECT e.id, e.entry_text FROM journal_entry e INNER JOIN entry2tag e2t ON (e2t.entry_id = e.id) INNER JOIN tag t ON (t.id = e2t.tag_id) WHERE t.tag_text = ? } ); $sth->execute( $tag_text ); my @entries; while( my $entry = $sth->fetchrow_hashref() ) { push @entries, $entry; } $sth->finish(); return @entries; } sub all_entries { my ($self) = @_; my $dbh = $self->dbh(); my $sth = $dbh->prepare_cached( q{ SELECT e.id, e.entry_text FROM journal_entry e } ); $sth->execute(); my @rows; while( my $row = $sth->fetchrow_hashref() ) { push @rows, $row; } return @rows; } sub tags_by_entry_id { my ($self, $entry_id) = @_; my $dbh = $self->dbh(); my $sth = $dbh->prepare_cached( q{ SELECT t.tag_text FROM tag t INNER JOIN entry2tag e2t ON (e2t.tag_id = t.id) WHERE e2t.entry_id = ? } ); $sth->execute( $entry_id ); my $tags = $sth->fetchall_arrayref(); return map { $_->[0] } @$tags; } #------- 1; __END__ =pod =head1 NAME My::Journal::Model - Example model class for My::Journal demo app. =head1 DEPENDENCIES DBI DBD::SQLite =cut CLI-Framework-0.05/t/lib/My/PerlFunctions.pm0000644000076400007640000000177511536216716020765 0ustar kerismankerismanpackage My::PerlFunctions; use base qw( CLI::Framework ); use strict; use warnings; sub option_spec { ( [ 'verbose|v' => 'be noisy' ], ) } sub init { my ($self, $opts) = @_; # Store App's verbose setting where it will be accessible to commands... $self->cache->set( 'verbose' => $opts->{verbose} ); } sub usage_text { q{ OPTIONS -v --verbose: running commentary about actions COMMANDS summary: show perl functions by name } } sub command_map { summary => 'My::PerlFunctions::Command::Summary', console => 'CLI::Framework::Command::Console', menu => 'CLI::Framework::Command::Menu', } #------- 1; __END__ =pod =head1 PURPOSE The Application class for a very simple CLIF app demo. This is a contrived example that has only one command to print a one-line summary of the purpose of the Perl built-in function by the given name. It is meant only as a demonstration of how to create a minimal CLI::Framework application. =cut CLI-Framework-0.05/t/lib/My/DemoNoUsage.pm0000644000076400007640000000075111536216716020331 0ustar kerismankerismanpackage My::DemoNoUsage; use base qw( CLI::Framework ); use lib 'lib'; use lib 't/lib'; use strict; use warnings; sub option_spec { ( [ "arg1|o=s" => "arg1" ], [ ], [ "arg2|t=s" => "arg2" ] ) } sub command_map { tree => 'CLI::Framework::Command::Tree', a => 'My::DemoNoUsage::Command::A', } #------- 1; __END__ =pod =head1 NAME My::DemoNoUsage - Test the case where no usage_text() is provided by the CLIF Application class. =cut CLI-Framework-0.05/t/lib/My/DemoNestedSubcommands.pm0000644000076400007640000000166411536216716022412 0ustar kerismankerismanpackage My::DemoNestedSubcommands; use base qw( CLI::Framework ); use strict; use warnings; sub usage_text { q{ Demo app to test nested subcommands... } } sub command_map { tree => 'CLI::Framework::Command::Tree', list => 'CLI::Framework::Command::List', command0 => 'My::DemoNestedSubcommands::Command0', command0_0 => 'My::DemoNestedSubcommands::Command0::Command0_0', command0_1 => 'My::DemoNestedSubcommands::Command0::Command0_1', command0_1_0 => 'My::DemoNestedSubcommands::Command0::Command0_1::Command0_1_0', command1 => 'My::DemoNestedSubcommands::Command1', command1_0 => 'My::DemoNestedSubcommands::Command1::Command1_0', command1_1 => 'My::DemoNestedSubcommands::Command1::Command1_1', command1_1_0 => 'My::DemoNestedSubcommands::Command1::Command1_1::Command1_1_0', } #------- 1; __END__ =pod =head1 PURPOSE =cut CLI-Framework-0.05/t/lib/My/DemoNestedSubcommands/0000755000076400007640000000000011536220123022030 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/DemoNestedSubcommands/Command0.pm0000644000076400007640000000223111216525270024030 0ustar kerismankerismanpackage My::DemoNestedSubcommands::Command0; use base qw( CLI::Framework::Command ); use strict; use warnings; sub usage_text { 'command0: first top-level command' } sub run { print "running command '" . $_[0]->name . "'"; } #------- package My::DemoNestedSubcommands::Command0::Command0_0; use base qw( My::DemoNestedSubcommands::Command0 ); use strict; use warnings; sub usage_text { 'command0_0: first subcommand of first top-level command' } #------- package My::DemoNestedSubcommands::Command0::Command0_1; use base qw( My::DemoNestedSubcommands::Command0 ); use strict; use warnings; sub usage_text { 'command0_1: second subcommand of first top-level command' } #------- package My::DemoNestedSubcommands::Command0::Command0_1::Command0_1_0; use base qw( My::DemoNestedSubcommands::Command0::Command0_1 ); use strict; use warnings; sub usage_text { 'command0_1_0: first subcommand of second subcommand of first top-level command (a sub-subcommand)' } #------- 1; __END__ =pod =head1 PURPOSE Test defining a tree of nested subcommands inline via a single package file. command0 command0_0 command0_1 command_0_1_0 =cut CLI-Framework-0.05/t/lib/My/DemoNestedSubcommands/Command1/0000755000076400007640000000000011536220123023467 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/DemoNestedSubcommands/Command1/Command1_1/0000755000076400007640000000000011536220123025346 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/DemoNestedSubcommands/Command1/Command1_1/Command1_1_0.pm0000644000076400007640000000061211216525270030007 0ustar kerismankerismanpackage My::DemoNestedSubcommands::Command1::Command1_1::Command1_1_0; use base qw( My::DemoNestedSubcommands::Command1::Command1_1 ); use strict; use warnings; sub usage_text { 'command1_1_0: first subcommand of second subcommand of second top-level command (a sub-subcommand)' } sub run { print "running command '" . $_[0]->name . "'"; } #------- 1; __END__ =pod =head1 PURPOSE =cut CLI-Framework-0.05/t/lib/My/DemoNestedSubcommands/Command1/Command1_1.pm0000644000076400007640000000050711216525270025714 0ustar kerismankerismanpackage My::DemoNestedSubcommands::Command1::Command1_1; use base qw( My::DemoNestedSubcommands::Command1 ); use strict; use warnings; sub usage_text { 'command1_1: second subcommand of second top-level command' } sub run { print "running command '" . $_[0]->name . "'"; } #------- 1; __END__ =pod =head1 PURPOSE =cut CLI-Framework-0.05/t/lib/My/DemoNestedSubcommands/Command1/Command1_0.pm0000644000076400007640000000047211216525270025714 0ustar kerismankerismanpackage My::DemoNestedSubcommands::Command1::Command1_0; use base qw( My::DemoNestedSubcommands::Command1 ); use strict; use warnings; sub usage_text { 'first subcommand of second top-level command' } sub run { print "running command '" . $_[0]->name . "'"; } #------- 1; __END__ =pod =head1 PURPOSE =cut CLI-Framework-0.05/t/lib/My/DemoNestedSubcommands/Command1.pm0000644000076400007640000000070711216525270024037 0ustar kerismankerismanpackage My::DemoNestedSubcommands::Command1; use base qw( CLI::Framework::Command ); use strict; use warnings; sub usage_text { 'command1: second top-level command' } sub run { print "running command '" . $_[0]->name . "'"; } #------- 1; __END__ =pod =head1 PURPOSE Test defining a tree of nested subcommands using classes that each have their own package file: command1 command1_0 command1_1 command_1_1_0 =cut CLI-Framework-0.05/t/lib/My/Journal.pm0000644000076400007640000000454511536216716017602 0ustar kerismankerismanpackage My::Journal; use base qw( CLI::Framework ); use strict; use warnings; use lib 't/lib'; use My::Journal::Model; #------- sub usage_text { q{ OPTIONS --db [path] : path to SQLite database file for your journal -v --verbose : be verbose -h --help : show help COMMANDS entry - work with journal entries publish - publish a journal tree - print a tree of only those commands that are currently-registered in your application dump - examine the internals of your application object using Data::Dumper menu - print command menu help - show application or command-specific help console - start a command console for the application list - list all commands available to the application } } #------- sub option_spec { [ 'help|h' => 'show help' ], [ 'verbose|v' => 'be verbose' ], [ 'db=s' => 'path to SQLite database file for your journal' ], } sub command_map { entry => 'My::Journal::Command::Entry', publish => 'My::Journal::Command::Publish', menu => 'My::Journal::Command::Menu', help => 'CLI::Framework::Command::Help', list => 'CLI::Framework::Command::List', tree => 'CLI::Framework::Command::Tree', alias => 'CLI::Framework::Command::Alias', 'dump' => 'CLI::Framework::Command::Dump', console => 'CLI::Framework::Command::Console', } sub command_alias { h => 'help', e => 'entry', p => 'publish', 'list-commands' => 'list', l => 'list', ls => 'list', t => 'tree', d => 'dump', a => 'alias', sh => 'console', c => 'console', m => 'menu', } #------- sub init { my ($app, $opts) = @_; # Command redirection for --help or -h options... $app->set_current_command('help') if $opts->{help}; # Store App's verbose setting where it will be accessible to commands... $app->cache->set( 'verbose' => $opts->{verbose} ); # Get object to work with database... my $db = My::Journal::Model->new( dbpath => 't/db/myjournal.sqlite' ); # ...store object in the application cache... $app->cache->set( 'db' => $db ); } #------- 1; __END__ =pod =head1 NAME My::Journal - Demo CLIF application used as a documentation example and for testing. =cut CLI-Framework-0.05/t/lib/My/DemoNoUsage/0000755000076400007640000000000011536220123017753 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/DemoNoUsage/Command/0000755000076400007640000000000011536220123021331 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/DemoNoUsage/Command/A.pm0000644000076400007640000000064711216525271022065 0ustar kerismankerismanpackage My::DemoNoUsage::Command::A; use base qw( CLI::Framework::Command ); use strict; use warnings; sub option_spec { ( [ "opt1=s" => "one" ], [ "opt2=s" => "two" ], ) } sub run { return "running command '" . $_[0]->name . "'\n"; } #------- 1; __END__ =pod =head1 NAME My::DemoNoUsage::Command::A - Test the case where no usage_text() is provided by the CLIF Command class. =cut CLI-Framework-0.05/t/lib/My/PerlFunctions/0000755000076400007640000000000011536220123020400 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/PerlFunctions/Command/0000755000076400007640000000000011536220123021756 5ustar kerismankerismanCLI-Framework-0.05/t/lib/My/PerlFunctions/Command/Summary.pm0000644000076400007640000002437211227372017023770 0ustar kerismankerismanpackage My::PerlFunctions::Command::Summary; use base qw( CLI::Framework::Command ); use strict; use warnings; sub option_spec { [ 'name=s' => 'name of perl function' ], } sub validate { my ($self, $opts, @args) = @_; die "name option required", $self->usage(), "\n" unless exists $opts->{name}; } sub run { my ($self, $opts, @args) = @_; print "[finding function...]\n" if $self->cache->get('verbose'); while() { my ($name) = (m/(.*?)\s+\- /); next unless $name; if( $name eq $opts->{name} ) { seek DATA, 0, 0; return $_; } } return "function '".$opts->{name}."' not found"; } sub usage_text { q{ summary --name=: print a one-line summary of the the named perl function } } #------- 1; =pod =head1 PURPOSE The Command class for a very simple CLIF app demo. =cut __DATA__ abs - absolute value function accept - accept an incoming socket connect alarm - schedule a SIGALRM atan2 - arctangent of Y/X in the range -PI to PI bind - binds an address to a socket binmode - prepare binary files for I/O bless - create an object break - exit a loop prematurely caller - get context of the current subroutine call chdir - change your current working directory chmod - changes the permissions on a list of files chomp - remove a trailing record separator from a string chop - remove the last character from a string chown - change the owership on a list of files chr - get character this number represents chroot - make directory new root for path lookups close - close file (or pipe or socket) handle closedir - close directory handle connect - connect to a remote socket continue - optional trailing block in a while or foreach cos - cosine function crypt - one-way passwd-style encryption dbmclose - breaks binding on a tied dbm file dbmopen - create binding on a tied dbm file defined - test whether a value, variable, or function is defined delete - deletes a value from a hash die - raise an exception or bail out do - turn a BLOCK into a TERM dump - create an immediate core dump each - retrieve the next key/value pair from a hash endgrent - be done using group file endhostent - be done using hosts file endnetent - be done using networks file endprotoent - be done using protocols file endpwent - be done using passwd file endservent - be done using services file eof - test a filehandle for its end eval - catch exceptions or compile and run code exec - abandon this program to run another exists - test whether a hash key is present exit - terminate this program exp - raise I to a power fcntl - file control system call fileno - return file descriptor from filehandle flock - lock an entire file with an advisory lock fork - create a new process just like this one format - declare a picture format with use by the write() function formline - internal function used for formats getc - get the next character from the filehandle getgrent - get next group record getgrgid - get group record given group user ID getgrnam - get group record given group name gethostbyaddr - get host record given its address gethostbyname - get host record given name gethostent - get next hosts record getlogin - return who logged in at this tty getnetbyaddr - get network record given its address getnetbyname - get networks record given name getnetent - get next networks record getpeername - find the other end of a socket connection getpgrp - get process group getppid - get parent process ID getpriority - get current nice value getprotobyname - get protocol record given name getprotobynumber - get protocol record numeric protocol getprotoent - get next protocols record getpwent - get next passwd record getpwnam - get passwd record given user login name getpwuid - get passwd record given user ID getservbyname - get services record given its name getservbyport - get services record given numeric port getservent - get next services record getsockname - retrieve the sockaddr for a given socket getsockopt - get socket options on a given socket glob - expand filenames using wildcards gmtime - convert UNIX time into record or string using Greenwich time goto - create spaghetti code grep - locate elements in a list test true against a given criterion hex - convert a string to a hexadecimal number import - patch a module's namespace into your own index - find a substring within a string int - get the integer portion of a number ioctl - system-dependent device control system call join - join a list into a string using a separator keys - retrieve list of indices from a hash kill - send a signal to a process or process group last - exit a block prematurely lc - return lower-case version of a string lcfirst - return a string with just the next letter in lower case length - return the number of bytes in a string link - create a hard link in the filesytem listen - register your socket as a server local - create a temporary value for a global variable (dynamic scoping) localtime - convert UNIX time into record or string using local time lock - get a thread lock on a variable, subroutine, or method log - retrieve the natural logarithm for a number lstat - stat a symbolic link m - match a string with a regular expression pattern map - apply a change to a list to get back a new list with the changes mkdir - create a directory msgctl - SysV IPC message control operations msgget - get SysV IPC message queue msgrcv - receive a SysV IPC message from a message queue msgsnd - send a SysV IPC message to a message queue my - declare and assign a local variable (lexical scoping) next - iterate a block prematurely no - unimport some module symbols or semantics at compile time oct - convert a string to an octal number open - open a file, pipe, or descriptor opendir - open a directory ord - find a character's numeric representation our - declare and assign a package variable (lexical scoping) pack - convert a list into a binary representation package - declare a separate global namespace pipe - open a pair of connected filehandles pop - remove the last element from an array and return it pos - find or set the offset for the last/next m//g search print - output a list to a filehandle printf - output a formatted list to a filehandle prototype - get the prototype (if any) of a subroutine push - append one or more elements to an array q - singly quote a string qq - doubly quote a string qr - Compile pattern quotemeta - quote regular expression magic characters qw - quote a list of words qx - backquote quote a string rand - retrieve the next pseudorandom number read - fixed-length buffered input from a filehandle readdir - get a directory from a directory handle readline - fetch a record from a file readlink - determine where a symbolic link is pointing readpipe - execute a system command and collect standard output recv - receive a message over a Socket redo - start this loop iteration over again ref - find out the type of thing being referenced rename - change a filename require - load in external functions from a library at runtime reset - clear all variables of a given name return - get out of a function early reverse - flip a string or a list rewinddir - reset directory handle rindex - right-to-left substring search rmdir - remove a directory s - replace a pattern with a string say - scalar - force a scalar context seek - reposition file pointer for random-access I/O seekdir - reposition directory pointer select - reset default output or do I/O multiplexing semctl - SysV semaphore control operations semget - get set of SysV semaphores semop - SysV semaphore operations send - send a message over a socket setgrent - prepare group file for use sethostent - prepare hosts file for use setnetent - prepare networks file for use setpgrp - set the process group of a process setpriority - set a process's nice value setprotoent - prepare protocols file for use setpwent - prepare passwd file for use setservent - prepare services file for use setsockopt - set some socket options shift - remove the first element of an array, and return it shmctl - SysV shared memory operations shmget - get SysV shared memory segment identifier shmread - read SysV shared memory shmwrite - write SysV shared memory shutdown - close down just half of a socket connection sin - return the sine of a number sleep - block for some number of seconds socket - create a socket socketpair - create a pair of sockets sort - sort a list of values splice - add or remove elements anywhere in an array split - split up a string using a regexp delimiter sprintf - formatted print into a string sqrt - square root function srand - seed the random number generator stat - get a file's status information state study - optimize input data for repeated searches sub - declare a subroutine, possibly anonymously substr - get or alter a portion of a stirng symlink - create a symbolic link to a file syscall - execute an arbitrary system call sysopen - open a file, pipe, or descriptor sysread - fixed-length unbuffered input from a filehandle sysseek - position I/O pointer on handle used with sysread and syswrite system - run a separate program syswrite - fixed-length unbuffered output to a filehandle tell - get current seekpointer on a filehandle telldir - get current seekpointer on a directory handle tie - bind a variable to an object class tied - get a reference to the object underlying a tied variable time - return number of seconds since 1970 times - return elapsed time for self and child processes tr - transliterate a string truncate - shorten a file uc - return upper-case version of a string ucfirst - return a string with just the next letter in upper case umask - set file creation mode mask undef - remove a variable or function definition unlink - remove one link to a file unpack - convert binary structure into normal perl variables unshift - prepend more elements to the beginning of a list untie - break a tie binding to a variable use - load in a module at compile time utime - set a file's last access and modify times values - return a list of the values in a hash vec - test or set particular bits in a string wait - wait for any child process to die waitpid - wait for a particular child process to die wantarray - get void vs scalar vs list context of current subroutine call warn - print debugging info write - print a picture record -X - a file test (-r, -x, etc) y - transliterate a string CLI-Framework-0.05/t/no-defined-usage.t0000644000076400007640000000106511536216716017770 0ustar kerismankerismanuse strict; use warnings; use lib 'lib'; use lib 't/lib'; use Test::More qw( no_plan ); use My::DemoNoUsage; @ARGV = qw( ); #@ARGV = qw( a ); my $app = My::DemoNoUsage->new(); ok( $app->run() ); #my $output_printed = ? #FIXME-TODO:need to capture the output printed to STDOUT into $output_printed) #is( $output_printed, $app->get_default_usage(), 'default usage message was printed' ); __END__ =pod =head1 PURPOSE To test that usage() falls back to Getopt::Long::Descriptive usage text when no usage_text() method is provided by the CLIF Application. =cut CLI-Framework-0.05/t/command_registration.t0000644000076400007640000000366111536216716021072 0ustar kerismankerismanuse strict; use warnings; use lib 'lib'; use lib 't/lib'; use Test::More; # These tests require DBI and DBD::SQLite (My::Journal dependencies)... my $prereqs_installed = eval 'use DBI; use DBD::SQLite'; if( $@ ) { plan skip_all => 'DBI and DBD::SQLite are required for tests that use demo app My::Journal' } else { plan 'no_plan' } use_ok( 'My::Journal' ); my $app = My::Journal->new(); # Register some commands... ok( my $cmd = $app->register_command( 'console' ), "register (built-in) 'console' command" ); ok( $cmd->isa( 'CLI::Framework::Command::Console' ), "built-in 'console' command object returned" ); is( $cmd->name(), 'console', 'command name is as expected' ); ok( $cmd = $app->register_command( 'menu' ), "register (overridden) 'menu' command" ); ok( $cmd->isa( 'My::Journal::Command::Menu' ), "application-specific, overridden command returned instead of the built-in 'menu' command" ); is( $cmd->name(), 'menu', 'command name is as expected' ); # Get and check list of all registered commands... ok( my @registered_cmd_names = $app->registered_command_names(), 'CLI::Framework::Application::registered_command_names()' ); my @got_cmd_names = sort @registered_cmd_names; my @expected_cmd_names = sort qw( console menu ); is_deeply( \@got_cmd_names, \@expected_cmd_names, 'registered_command_names() returned expected set of commands that were registered' ); # Check that we can get registered commands by name... ok( my $console_command = $app->registered_command_object('console'), 'retrieve console command by name' ); ok( $console_command->isa('CLI::Framework::Command::Console'), 'command object is ref to proper class' ); ok( my $menu_command = $app->registered_command_object('menu'), 'retrieve menu command by name' ); ok( $menu_command->isa('CLI::Framework::Command::Menu'), 'command object is a ref to proper class'); __END__ =pod =head1 PURPOSE To verify basic CLIF features related to registration of commands. =cut CLI-Framework-0.05/t/nested-subcommands.t0000644000076400007640000000375611536216716020462 0ustar kerismankerismanuse strict; use warnings; use lib 'lib'; use lib 't/lib'; use Test::More qw( no_plan ); use My::DemoNestedSubcommands; #~~~~~~ close STDOUT; open ( STDOUT, '>', File::Spec->devnull() ); #~~~~~~ @ARGV = qw( tree ); ok( my $app = My::DemoNestedSubcommands->new(), 'My::DemoNestedSubcommands->new()' ); ok( $app->register_command( 'command0' ), 'register command0' ); ok( $app->register_command( 'command1' ), 'register command1' ); # check the class hierarchy for registered commands, ensuring that parent-child # relationships are as expected: verify_expected_command_tree( $app ); ok( $app->run(), 'run()' ); #------- sub verify_expected_command_tree { my ($app) = @_; my $c0 = $app->registered_command_object( 'command0' ); is( $c0->name(), 'command0', 'command0 is child of app' ); my $c0_0 = $c0->registered_subcommand_object( 'command0_0' ); is( $c0_0->name(), 'command0_0' , 'command0_0 is child of command0' ); my $c0_1 = $c0->registered_subcommand_object( 'command0_1' ); is( $c0_1->name(), 'command0_1', 'command0_1 is child of command0' ); my $c0_1_0 = $c0_1->registered_subcommand_object( 'command0_1_0' ); is( $c0_1_0->name(), 'command0_1_0', 'command0_1_0 is child of command0_1' ); my $c1 = $app->registered_command_object( 'command1' ); is( $c1->name(), 'command1', 'command1 is child of app' ); my $c1_0 = $c1->registered_subcommand_object( 'command1_0' ); is( $c1_0->name(), 'command1_0', 'command1_0 is child of command1' ); my $c1_1 = $c1->registered_subcommand_object( 'command1_1' ); is( $c1_1->name(), 'command1_1', 'command1_1 is child of command1' ); my $c1_1_0 = $c1_1->registered_subcommand_object( 'command1_1_0' ); is( $c1_1_0->name(), 'command1_1_0', 'command1_1_0 is child of command1_1' ); } __END__ =pod =head1 PURPOSE Test to ensure that the proper class hierarchy for registered commands is established with the correct parent-child relationships as defined by CLIF Command subclasses. =cut CLI-Framework-0.05/t/basic.t0000644000076400007640000000564711536216716015751 0ustar kerismankerismanuse strict; use warnings; use lib 'lib'; use lib 't/lib'; use File::Spec; use Test::More; # These tests require DBI and DBD::SQLite (My::Journal dependencies)... my $prereqs_installed = eval 'use DBI; use DBD::SQLite'; if( $@ ) { plan skip_all => 'DBI and DBD::SQLite are required for tests that use demo app My::Journal' } else { plan 'no_plan' } use_ok( 'My::Journal' ); #~~~~~~ # Send STDOUT, STDERR to null device... close STDOUT; open( STDOUT, '>', File::Spec->devnull() ); close STDERR; open( STDERR, '>', File::Spec->devnull() ); #~~~~~~ @ARGV = qw( list ); ok( My::Journal->run(), 'call run() directly on CLIF-derived application class (without first '. 'constructing an object)' ); ok( my $app = My::Journal->new(), 'constructor' ); # These tests depend on 'help' being the default command... $app->set_default_command( 'help' ); # Test series of command requests... my $valid_command_requests = [ # [ => ] [ 'list' => 'list' ], [ 'menu' => 'menu' ], [ 'dump' => 'dump' ], [ 'tree' => 'tree' ], [ 'entry --date=20090530 list foo' => 'entry' ], [ '--verbose entry' => 'entry' ], [ '' => $app->get_default_command() ] ]; my $invalid_command_requests = [ [ '--foo entry' => 'entry' ], [ 'entry --foo' => 'entry' ], [ 'bogus' ], [ 'bogus --x' ], [ '--x bogus' ], [ 'foo1 entry list foo2' => 'entry' ], [ 'foo1 entry --date=20090530 list foo2' => 'entry' ], [ 'entry add one two' ], ]; test_command_requests( $valid_command_requests ); test_command_requests( $invalid_command_requests, invalid => 1 ); #------- sub test_command_requests { my ($requests, %param) = @_; my $invalid = $param{invalid}; for my $command_request ( @$requests ) { my ($request_string, $command_name) = @$command_request; @ARGV = split / /, $request_string; my $rv; if( $invalid ) { # run() with invalid command in @ARGV (expect false return value)... eval{ $rv = $app->run( initialize => 1 ) }; ok(! $rv, "invalid command '$request_string'" ); } else { # run() with valid command in @ARGV (expect true return value)... eval { $rv = $app->run( initialize => 1 ) }; ok( $rv, "valid command '$request_string'" ); } # (only check the last-run command if the expected value was passed) if( defined $command_name ) { is( $app->get_current_command(), $command_name, "last-run command was '$command_name'" ); } } } __END__ =pod =head1 PURPOSE To verify basic CLIF features. =cut CLI-Framework-0.05/t/define-classes-inline.t0000644000076400007640000000623011536216716021016 0ustar kerismankerismanuse strict; use warnings; use lib 'lib'; use lib 't/lib'; use Test::More tests => 1; use File::Spec; #~~~~~~ # Send STDOUT, STDERR to null device... close STDOUT; open ( STDOUT, '>', File::Spec->devnull() ); close STDERR; open( STDERR, '>', File::Spec->devnull() ); #~~~~~~ ok( My::App->run() ); ################################### # # INLINE APPLICATION DEFINITION... # ################################### package My::App; use base qw( CLI::Framework ); use strict; use warnings; #------- sub usage_text { q{ OPTIONS --db [path] : db -v --verbose : be verbose -h --help : show help COMMANDS x } } #------- sub option_spec { [ 'help|h' => 'show help' ], [ 'verbose|v' => 'be verbose' ], [ 'db=s' => 'db' ], } sub command_map { console => 'CLI::Framework::Command::Console', list => 'CLI::Framework::Command::List', menu => 'CLI::Framework::Command::Menu', 'dump' => 'CLI::Framework::Command::Dump', tree => 'CLI::Framework::Command::Tree', x => 'My::App::Command::X', # x => 'My::Command::Shared::X', } sub command_alias { h => 'help', t => 'tree', d => 'dump', sh => 'console', c => 'console', m => 'menu', } #------- sub init { my ($app, $opts) = @_; print __PACKAGE__.'::init()', "\n"; } ################################### # # INLINE COMMAND DEFINITIONS... # ################################### package My::App::Command::X; use base qw( CLI::Framework::Command ); use strict; use warnings; #------- sub usage_text { q{ x [--date=yyyy-mm-dd] [subcommands...] OPTIONS --date=yyyy-mm-dd: date ARGUMENTS (subcommands) search: ... } } sub option_spec { return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior ( [ 'date=s' => 'date that entry applies to' ], ) } sub subcommand_alias { return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior ( d => 'do', a => 'add', s => 'search', ) } sub validate { my ($self, $opts, @args) = @_; return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior # ... } sub notify_of_subcommand_dispatch { my ($self, $subcommand, $opts, @args ) = @_; return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior warn __PACKAGE__.'::notify_of_subcommand_dispatch', "\n"; #require Data::Dumper; warn Data::Dumper::Dumper( [ $subcommand, $opts, \@args ] ); # ... } #------- package My::App::Command::X::Search; use base qw( My::App::Command::X ); use strict; use warnings; sub usage_text { q{ x search --regex= [--tag=]: search } } sub option_spec { ( [ 'regex=s' => 'regex' ], [ 'tag=s@' => 'tag' ], ) } sub validate { my ($self, $opts, @args) = @_; die "missing required option 'regex'\n" unless $opts->{regex}; } sub run { my ($self, $opts, @args) = @_; my $regex = $opts->{regex}; my $tags = $opts->{tag}; warn __PACKAGE__.'::run()', "\n"; warn "searching...\n";# if $self->session('verbose'); return ''; } __END__ CLI-Framework-0.05/t/interactivity.t0000644000076400007640000000670711536216716017564 0ustar kerismankerismanuse strict; use warnings; use lib 'lib'; use lib 't/lib'; use File::Spec; use Test::More; # These tests require DBI and DBD::SQLite (My::Journal dependencies)... my $prereqs_installed = eval 'use DBI; use DBD::SQLite'; if( $@ ) { plan skip_all => 'DBI and DBD::SQLite are required for tests that use demo app My::Journal' } else { plan 'no_plan' } use_ok( 'My::Journal' ); #~~~~~~ # Prepare null device for supressing output... open ( my $devnull, '>', File::Spec->devnull() ); my $app = My::Journal->new(); # Build fake interactive request sequence... my @application_quit_signals = $app->quit_signals(); my $canned_request = [ [ 'list' ], [ 'publish' ], [ 'help', 'entry' ], [ 'entry', 'foo' ], [ 'tree' ], [ 'bogus' ], [ 'menu' ], [ 'dump' ], # (2nd-to-last canned request will be the last command run): [ 'entry' ], # (last canned request should be a 'quit signal') [ $application_quit_signals[0] ] ]; # Replace normal procedure to interactively read requests with a dummy # version that uses our fake request sequence... { no strict 'refs'; no warnings; *{My::Journal::read_cmd} = \&get_canned_request; } #~~~~~~ ok( ! $app->get_interactivity_mode(), 'just after construction, application is non-interactive' ); ok( $app->set_interactivity_mode(1), 'interactivity mode set' ); ok( $app->get_interactivity_mode(), 'after turning ON interactivity mode, application state is interactive' ); my @valid_commands = keys %{ $app->command_map_hashref() }; my @noninteractive_commands = $app->noninteractive_commands(); # We expect the interactive commands to be those which are valid but NOT non-interactive... my @expected_interactive; for my $valid (@valid_commands) { push(@expected_interactive, $valid) unless grep { $valid eq $_ } $app->noninteractive_commands(); } @expected_interactive = sort @expected_interactive; my @got_interactive = sort $app->get_interactive_commands(); is_deeply( \@got_interactive, \@expected_interactive, 'in interactive mode, non-interactive commands are not included in the set of commands returned by get_interactive_commands()' ); # Send output to null device... select $devnull; ok( $app->run_interactive( initialize => 1 ), 'run_interactive()' ); is( $app->get_current_command(), $canned_request->[-2]->[0], 'interactive session ended with expected command' ); # Make sure that non-interactive commands get forwarded to 'help' in # interactive mode: $canned_request = [ [ 'console' ], [ $application_quit_signals[0] ] ]; ok( $app->run_interactive( initialize => 1 ), 'run_interactive()' ); is( $app->get_current_command(), 'help', "attempt to run non-interactive command in interactive session forwards to 'help' command" ); # Make sure that requests for usage info for non-interactive commands get # forwarded to 'help' in interactive mode: $canned_request = [ [ 'help console' ], [ $application_quit_signals[0] ] ]; ok( $app->run_interactive( initialize => 1 ), 'run_interactive()' ); is( $app->get_current_command(), 'help', "attempt to show usage info for non-interactive command in interactive session forwards to 'help' command" ); #~~~~~~ close $devnull; #~~~~~~ # Command request reader that iterates over our fake request sequences: { my $i = 0; sub get_canned_request { my $j = $i++ % @$canned_request; @ARGV = @{ $canned_request->[$j] }; return 1; } } __END__ =pod =head1 PURPOSE To verify basic CLIF features related to interactivity. =cut CLI-Framework-0.05/examples/0000755000076400007640000000000011536220123016025 5ustar kerismankerismanCLI-Framework-0.05/examples/queue0000755000076400007640000002704511536216716017124 0ustar kerismankerisman#! /usr/bin/perl use strict; use warnings; use lib 'lib'; # ---- EXECUTION ---- My::Queue->run(); # Launch command #~~~~~~~~~~~~~~~~~~~~~~~ #my $app = My::Queue->new(); ## Set queue properties... #@ARGV = qw( property set --even ); $app->run(); # even numbers #my $regex = qr/\d{3,}/; #@ARGV = (qw( property set ), "--regex=$regex"); $app->run(); # 3 or more digits # ## List queue properties... #@ARGV = qw( property list ); $app->run(); # ## Enqueue items... #@ARGV = qw( e 1 ); $app->run(); #@ARGV = qw( e asfioj ); $app->run(); #@ARGV = qw( e 3 ); $app->run(); #@ARGV = qw( e four ); $app->run(); #@ARGV = qw( e 998 ); $app->run(); #@ARGV = qw( e x ); $app->run(); #@ARGV = qw( e 1001292 );$app->run(); #@ARGV = qw( e 1001293 );$app->run(); # ## Print queue contents... #@ARGV = qw( p ); $app->run(); ################################### # ---- APPLICATION CLASS ---- package My::Queue; use base qw( CLI::Framework ); use strict; use warnings; use Storable 2.05 qw( store retrieve ); my $model; # Model class for queue my $serialize; my $storable_file; # File for serializing queue # NOTE: In this example, My::Queue::Model is defined inline. In the "real # world", it should be in separate package file. In that case, the following # 'use' line would be needed: # # use My::Queue::Model; sub usage_text { # The usage_text() hook in the Application Class is meant to return a # usage string describing the whole application. qq{ $0 [--verbose|v]: OPTIONS: --verbose -v: be vebose ARGUMENTS (subcommands): console: run interactively cmd-list: list available commands enqueue: add item to queue dequeue: remove item from queue print: print contents of queue property: work with queue properties } } sub option_spec { # The option_spec() hook in the Application class provides the option # specification for the whole application. [ 'verbose|v' => 'be verbose' ], [ 'qin|i=s' => 'start by loading a saved queue stored from a previous session' ], [ 'qout|o=s' => 'optional file to use for serializing the queue' ], } sub validate_options { # The validate_options() hook can be used to ensure that the application # options are valid. my ($self, $opts) = @_; # ...nothing to check for this application } sub command_map { # In this *list*, the command names given as keys will be bound to the # command classes given as values. This will be used by CLIF as a hash # initializer and the command_map_hashref() method will be provided to # return a hash created from this list for convenience. console => 'CLI::Framework::Command::Console', alias => 'CLI::Framework::Command::Alias', 'cmd-list' => 'CLI::Framework::Command::List', enqueue => 'My::Queue::Command::Enqueue', dequeue => 'My::Queue::Command::Dequeue', print => 'My::Queue::Command::Print', property => 'My::Queue::Command::Property', } sub command_alias { # In this list, the keys are aliases to the command names given as values # (the values should be found as "keys" in command_map()). sh => 'console', e => 'enqueue', add => 'enqueue', d => 'dequeue', prop=> 'property', p => 'print', } sub init { # This initialization is performed once for the application (default # behavior). my ($self, $opts) = @_; # Get (new or saved) model object... if( $opts->{'qin'} ) { { no warnings; local $Storable::Eval = 1; # (support coderefs for deserialization) $model = retrieve( $opts->{'qin'} ); } } else { $model = My::Queue::Model->new(); } # Store model object in shared cache... $self->cache->set( 'model' => $model ); # Set file for storage of serialized queue... if( $opts->{'qout'} ) { $serialize = 1; $storable_file = $opts->{'qout'}; } return 1; } END { # Check if we should serialize queue before exiting... if( $serialize ) { { no warnings; $Storable::Deparse = 1; # (support coderefs for serialization) } eval { my $result = store( $model, $storable_file ) }; if( $@ ) { warn 'Storable error while trying to serialize model '. "object: $!"; } } } # ---- COMMAND: Enqueue ---- package My::Queue::Command::Enqueue; use base qw( CLI::Framework::Command ); use strict; use warnings; sub usage_text { # The usage_text() hook in a Command Class is meant to return a usage # string describing only a particular command. q{ enqueue [--tag= [--tag= [...] ] ] [ ... ]: add item(s) to queue } } sub validate { # The Command Class can override the validate() hook to catch invalid # command requests prior to run(). If the command request is invalid, the # hook should throw an exception with a descriptive error message. my ($self, $cmd_opts, @args) = @_; die "No arguments given. Usage:" . $self->usage_text() . "\n" unless @args; } sub option_spec { # The option_spec() hook in the Command Class provides the option # specification for a particular command. [ 'tag=s@' => 'item tag' ], } sub run { # This is usually where the "real" work is done. my ($self, $opts, @args) = @_; my $model = $self->cache->get( 'model' ); for my $item (@args) { my $item_id = $model->enqueue( $item ); my $tags = $opts->{tag}; for my $tag ( @$tags ) { $model->add_tag_to_item( $item_id, $tag ) } } return ''; } # ---- COMMAND: Dequeue ---- package My::Queue::Command::Dequeue; use base qw( CLI::Framework::Command ); use strict; use warnings; sub usage_text { q{ dequeue: remove item from queue } } sub run { my ($self, $opts, @args) = @_; my $model = $self->cache->get( 'model' ); my $item = $model->dequeue(); return $item->{data}; } # ---- COMMAND: Print ---- package My::Queue::Command::Print; use base qw( CLI::Framework::Command ); use strict; use warnings; sub usage_text { q{ print [--ids|i] [--tags|t] [--all|a]: print contents of queue OPTIONS --ids: print ids of each item --tags: print tags of each item --all: print both ids and tags of each item } } sub option_spec { [ 'ids|i' => 'print item ids' ], [ 'tags|t' => 'print item tags' ], [ 'all|a' => 'print all data about items' ], } sub run { my ($self, $opts, @args) = @_; my $model = $self->cache->get( 'model' ); my @items = $model->items(); $opts->{all} && do{ $opts->{ids} = $opts->{tags} = 1 }; my $format = "%10s"; # show data $format .= " (id=%s)" if $opts->{ids}; # show ids? $format .= " tags:%s" if $opts->{tags}; # show tags? $format .= "\n"; my $output; for my $item (@items) { my @parts = $item->{data}; # show data push @parts, $item->{id} # show ids? if defined $opts->{ids}; push @parts, join( ',', @{$item->{tags}} ) # show tags? if defined $opts->{tags}; $output .= sprintf $format, @parts; } return $output; } # ---- COMMAND: Property ---- package My::Queue::Command::Property; use base qw( CLI::Framework::Command ); use strict; use warnings; sub subcommand_alias { # "Master commands" can set aliases for subcommands. The list returned # by subcommand_alias() will be used as a hash initializer. Keys are the # aliases and values are the full subcommand names. l => 'list', s => 'set', } # This command is a "master command" to subcommands (defined below). As such, # its run() method is not called upon dispatch of a subcommand. The # notify_of_subcommand_dispatch() method gives the master command an # opportunity to hook into the dispatch process and do something before its # subcommand is dispatched. sub notify_of_subcommand_dispatch { my ($self, $subcommand, $cmd_opts, @args) = @_; print __PACKAGE__.'::notify...()'.' about to run '.ref $subcommand, "\n"; # For demonstration, the following causes the currenly-active queue # properties to be printed prior to each request to set a queue property: if( (ref $subcommand) eq 'My::Queue::Command::Property::Set' ) { my $list = $self->manufacture( 'My::Queue::Command::Property::List' ); $list->set_cache( $self->cache() ); my $out = $list->run(); chomp $out; print '(before setting new property, the following queue properties '. "are in effect: $out)\n\n"; } } sub usage_text { q{ property: work with queue properties ARGUMENTS (subcommands) list: list queue properties set: set queue properties } } # ---- SUBCOMMAND: Property List ---- package My::Queue::Command::Property::List; use base qw( My::Queue::Command::Property ); use strict; use warnings; sub usage_text { q{ property list: list queue properties } } sub run { my ($self, $opts, @args) = @_; my $model = $self->cache->get( 'model' ); my $output = 'properties: {' . join(',', $model->get_properties) . "}\n"; return $output; } # ---- SUBCOMMAND: Property Set ---- package My::Queue::Command::Property::Set; use base qw( My::Queue::Command::Property ); use strict; use warnings; sub usage_text { q{ property set: set queue properties OPTIONS --regex= --evens: only allow even integers in queue from now on } } sub option_spec { [ 'regex=s' => 'require regex validation of items in queue' ], [ 'evens' => 'only allow even integers in queue' ], } sub run { my ($self, $opts, @args) = @_; my $model = $self->cache->get( 'model' ); $model->set_property( regex => sub { $_[0] =~ /$opts->{regex}/ } ) if $opts->{regex}; $model->set_property( even => sub { $_[0] =~ /^\d+$/ && $_[0] % 2 == 0 } ) if $opts->{'evens'}; return; } ################################### # # MODEL CLASS # ################################### # This is used for demonstration purposes; in reality, something more useful # such as a SQLite database might be used. package My::Queue::Model; use strict; use warnings; use Carp; sub new { my ($class) = @_; bless { _items => [], _properties => {} }, $class; } sub add_tag_to_item { my ($self, $id, $tag) = @_; return unless defined $id && defined $tag; my @a = @{ $self->{_items} }; my ($entry) = (grep { $_->{id} == $id } @a); push @{ $entry->{tags} }, $tag; return 1; } sub enqueue { my ($self, $item) = @_; return unless $item; my $id = _id($item); # Ensure item satisfies all queue properties... for my $p ( values %{ $self->{_properties} } ) { $p->($item) || return; } push @{ $self->{_items} }, { id => $id, data => $item, tags => [] }; return $id; } sub _id { my $str = shift; my @s = split //, $str; return join( '', map { ord $_ } @s ); } sub dequeue { shift @{ $_[0]->{_items} } } sub items { @{$_[0]->{_items}} } sub get_properties { keys %{$_[0]->{_properties}} } sub set_property { my ($self, $name, $code) = @_; croak "queue property must be a CODE ref" unless ref $code eq 'CODE'; $self->{_properties}->{$name} = $code; return 1; } __END__ =pod =head1 PURPOSE Demonstration of a CLIF application that utilizes some of CLIF's more advanced features. =cut CLI-Framework-0.05/examples/demo-simple.pl0000644000076400007640000000237011536216716020614 0ustar kerismankerismanuse strict; use warnings; use lib 'lib'; # ---- EXECUTION ---- # Here, we set the default command to the only command in our simple # application. If this is not done, 'help' will be the default. my $app = Converted::Script->new(); $app->set_default_command( 'legacy-script' ); $app->run(); ################################### # ---- APPLICATION ---- package Converted::Script; use base qw( CLI::Framework ); use strict; use warnings; sub usage_text { qq{ $0 [--verbose|v] [--help|h]: work all manner of mischief devised by long-departed miscreants } } sub option_spec { [ 'help|h' => 'show help' ], [ 'verbose|v' => 'be verbose' ], } sub command_map { 'legacy-script' => 'Converted::Script::Command::LegacyScript', } # ---- COMMAND ---- package Converted::Script::Command::LegacyScript; use base qw( CLI::Framework::Command ); use strict; use warnings; sub run { # Now that the extraneous details have been separated into their own # subroutines, run() contains just the "real" program logic. my ($self, $opts, @args) = @_; return 'running '.__PACKAGE__. "... ()\n"; } __END__ =pod =head1 PURPOSE Demonstration of a very simple CLIF application. =cut CLI-Framework-0.05/Makefile.PL0000644000076400007640000000173011536216716016177 0ustar kerismankerismanuse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'CLI::Framework', AUTHOR => 'Karl Erisman ', VERSION_FROM => 'lib/CLI/Framework.pm', ABSTRACT => 'Build standardized, flexible, testable command-line applications', ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'perl') : ()), PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'File::Spec' => 0, 'Carp' => 0, 'Getopt::Long::Descriptive' => 0, 'Class::Inspector' => 0, 'Term::ReadLine' => 0, 'Text::ParseWords' => 0, 'Exception::Class' => 0, 'Exception::Class::TryCatch' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'CLI::Framework-*' }, ); CLI-Framework-0.05/README0000644000076400007640000000000111536216716015073 0ustar kerismankerisman CLI-Framework-0.05/docs/0000755000076400007640000000000011536220123015137 5ustar kerismankerismanCLI-Framework-0.05/docs/images/0000755000076400007640000000000011536220123016404 5ustar kerismankerismanCLI-Framework-0.05/docs/images/cli-framework.jpg0000644000076400007640000012345111536216716021673 0ustar kerismankerismanJFIFHHC    $.' ",#(7),01444'9=82<.342C  2!!22222222222222222222222222222222222222222222222222>"\ !1AV"QUa#27qBSTu'3Rrt$6ev%5Cb&4cEFdsf Q!1qaA ?њ3FUultRK%7=UYRN\I9skmMI8&9 OfJVN;IGWm{4TŲ5ilcA;bUsԖ+Ʈ Hu Osyk\= n?zɦy)SǦim75!8w8%fݙGm6;-MHǝ!n+4V-Kru]E۟) 95q'ԃ|Vh^PS ٪~嗨u6sR.RT-#!H ;kvCvWC9i,`|߻Gќ[nt *AG d :r}ւ*M9H%a #$u#XQچӨtu}d3b8^zRCKݬVͪ_1UFMAoBjꟽ`Brl-[{36 dyj6][Cf)ॢ|4H] p iH:#a쒡sw_u@uw54zv<v=| Y{5CO޼[ˣ.eI_KDǙP칢@ͻKjh=eEMmIkM<`|TNp=XPn@IZ45ξb1Ɯn^mY[ U3{;j(憌;~7e^|:ޠEzkQ{w,G;mEAާZ^ QkQ{wzZ^|;mEAޠEzkQ{w,G;mEAާZ^ QkQ{wzZ^|;mEAޠEzkQ{w,G;mEAާZ^ ʏ \vڋ܃Om;](&OAdKx`# ǁ "b^UEx#e)rZǙ.@/).Ϫ*yAeh3nYIy KhA|Z ۲8 Nszf%:vXZmO(!d2K!}qNrQ=E.h 2'"uMr |q6#cG2/Zi+YJͳ<э8;O3XЋLN(/;LNFì ٪~:Vrzԕ6{*f6IKӘ;nKQ2{TU,@du [ j}VS"8*$ q ?SиσT?T?IZSIUxv[Njd9zik kWc/K%p^K$5l7wҫtݾ/tި Q1/J۞A%ulI XV=/nt͵)%t 8xZ-zC%}PIv7d7*Y\oWl&j>dTq]xA[{5COޞ+t.ݺ~V;lkUsq#nJZrX<]qǠQ_eAn>cKJy;K+um +qZ#Z^rsm Èz=:! ⦣}EKKl9 9KCF PVc:O5;&HةqqĻޔzPh=P]<58$wOai]sJv= eâ/aK;rRc8 ihk^ǓI9h8⃏+;<7>;Տm*ʸꥷд.R6Hkq7-%]{5ƒLiE֘X9㓴/DQO}<7>;a*b~;TfCZxkzꏱO+;j5vM,GYdh;1iHF1ǎo5շCG-]y tnحqG^o(;8>;⳰ VX)\co1Rs6Gqh-ֶ[ZsNsMyu쏣z czVvT}AK(AK3cct8KMpݼ.|SS;)T\nhjG0yG `;v:~vSxoY}Q0wRWs9PTѺf4#DF wz$NۉxaazVvSDvT}xoY>X+;><7>;b#8>;⳰`U ޳`SÊꏰV(;ÊꏰO+;>X+;>kK)m m#yֵ8|8cz _T2d;u5.W(w%{ %ovsLsIA/Wcr$3a夃wV ^' fg9f9p-cpW&d4VJ)*G7ny.F_Yp*)e0Ƿn/#KX ;K*%]#j66#C1akuk5iќ >dUY& iȹNs"lykpAJ;tz]7:^jG@ᵼ 2Nޡa[CӥdW٫%,cz&ȃG kpIƞlzMk W8 8MQKIGQXMUzOSyhy HHŽ)!)H:6l7:MJO%ydXÉ{Am-4ҶúWZSWR7{xMpshv]CK$3OZXuKa`}|&hO3ick',L4N.M[%a{<۝ xsCAR E*"{Zbx 餶 fUTcuK7\" hwgzšAK,;h0Y胨SDG67x#ym0F؈: qƴ;# Gkyj ?/[#cU@DDD@DDD@DDD@DDD@DDD@DD>xGm5ɴ?q?)kh n+*sCs>A_tM2>g`K. c>sqX G6 5:}޾8ޜg>z4[A6!}c>Nv?39dn]㝏}`;sqX E}`gA㝏~h98Ϭ/v?3c>A㝏98Ϭ}M&Ug F滕i|G&Ab#,*[-y`2?܁Jw|Vtp>^4e88 9hpTCS4-< ǝ*Pw+ժ.d2N9-`cdkkGݜܜdXӎ 6ZeDV <7e/˰vvvGUNU]-\ƺ70c{;m:,n`0Gkyj ?/[#cU@DDD@DDD@DDD@DDD@DDD@DD痝?i\t{ أ1dk ؽ G9?r [riI)fiNM_X_+[ѽpZF:WgH۳FwVIe}TJl[X͟-s| F t.MiFj{e+X cZ)ӴOtCWۻ8/q[Cɐp36VLG7nݿvn[(4Tm-FLIa%Cp󠇚E<"Ylti3C&Kv\lg q|>|('(tn}JAVAgr~²h41%4ǞAKV䧓1Rt74l{~l:y^IWRf;< kZ?sB ' ٛw' ٛw*A%DvfIDvfJIx}x}D^,4Gfmd^lr~CGLmn|?(M&A`"-&cå`"n.r:D?-)s[]`j`% \㓼Kzytu+9)Y (/:D?z?VX;>='G Oiy%d ?4-iz .H; Α:D?bɫ9.`S|Ҹ/hqj\lz t}5\tf)$όdΑ:D? 1͠pT04Hhc18дvںM)l4.v Ahvビt= !X/?- lPɣuc45* I*t8cNq8+D?z? W)]/NuŬ?8'cmDP1!X'H`ގ}{m9M#s`[#6wX/g7``# ;[8=CNyt'piz)+g;ш`1(`8;vͰIxN1V2c0 A="Gt= \rgOmbŖŷB :D?/Db!g{M;f~ OOn^i-9i#8>q25Ghc'}h>0 >}SGɕ_T2d?ϛ =>Z$s]1kZAv'vqOĮ3_)gōh.|B 4} ={|R6IE Q8918@t03vvZjm;%8з 7xaW6םlUY42-gdVlZZ˕ՕSHZX174WM^*ojw69$!ܑaej)a4JxK[#Jʛ)/}uGIy{&kXZZCz]SGYyl4|k78a3\\:#]HE&y[7 l|E%na{d@sd.#݂q(.jt󪣧2]+:T F ggR62a=.ycD˞A?“v6N-23+,9_YEU_lӆ1i /#yR FUqaɅn r7V>-JX 1Hp@Ǜ缹j zM16my yi+f6 Ird?>w m/5U948c$rwFN쯇X%v3~A\85@8& DD@DDDAʗͭ1(Tmo?܏Vx_g+>x77=O|}#x+$|sx8x$C[ S++hl`ccg#ό=Kkt"SQSFpx88Q )皰IM<16-ߍ˚0(mJ9̒624<~KFhYvGn['>ls ÆVn6=WUUS~uSlLELofnhᖌ ] Ue[) &;eV8%Fїg9H w&8$OKp-5[W &3[ĸoY\)4I;* wLg$av@#%SjW]|[t&%3]&xh !hum {c$4idp]7>N)`pPjD7* k)<dCZC\u#x[>JQnxs}A΂Gvh2Q?LGYaVޫT[(笊W͚6T9=͌lo crX3~?[?KS.blNۆwz ;M\$0 y:<TW H6*ohǬ.t4R _YU4%Eet\1;if4ҝlF7Xזƒ6pmlIK9'=@Ag-u:<:Jt454- :w+CxÚzĢQ[RӶ' jb#k4.n޳R[ETBN\" ;{ݽj!Mw}1l.mk[C}|PsipyIфuâkq8 dM4qzv̔5n@p-[:xV@?h/~˶}m:}P1'w:U1 ~N<\iY䪴UHvv0d C1z-iڬLิawe̼s%]ym?GYJ%[3#}-gCkm367Y̲i5)%Cɤm5A#Ga[y5ڛNgsa{AFmHťYT=DkcɶCN>sq~[,T] x{)'7dǎIzj5FHqn7ǯi.2-u;*u-]GG U1״`d`o;M֚[O-E3)e`pkImcQit{^h*E39y].h.fQ=Y][AQ4!4*wggiHZI-Q>v7վGDvp!ĎoXݍY}m}f6,oYvn S~Ack&ϒ;{X<\n̽ۺc#1bYateØÿՋEgߧ'Ipl1Yzj˰Z#٩y !9ߵĔ4D@DDD@DDoھdGvh2 D@DDD@DDD@DDD@DDD@DDD@DDD@DDDAg~?_W/ E5Uc]N#/<'n]%i~Ϙy$#΍Np .ֿl8B) dqTj,3V̪77d堸տ;L:aL2ZZ랕쭩#GJ^톹 o6Q$O4Klq9 0\t[&%6C[h+5F͢&7-N" ;k<^`n T>inU7 BgŹvZ3$Z"KEPw7*f<7.2H&{@Fa $Yzyh.ډU2?;a.f1C'wZ .wz]-KUKM_4M,SӾ&pcKpK cSǩGSFŒ͌t[!y+tA+NcŨ]^9'6s1>2Yh_X6jOc-_畒#pxtl!/-W] Gkyj ?/[#cU@DDD@DDD@DDD@DDD@DDD@DD>xG9?r mpZjzco;M{n;i' Rf[E,q>L6 w7/@_h,4\٥#sA OV_i8)_!!~/k5 A;iVs(.ԵW[8 ~Igkv@ާ*zE%%֔Kndrm6<ٛh.;rխG[6׹\@6w_;huJګM +d sNH%Ź@6s5OU@K&nnoSzDvnloxpn$n_dcnS\-JS ˒!#q$*_T2e]8HH4h;WT̙" """ """ """ """ """ """ """ g>? %mv7sHrm#P;OAJ욶e割Jzx>*F06'9Am}+uMKEKd;.pin 90VD>*X-fe)(f{`c$/ӾIoXw-E#$mS.p æda\||FOV9fjφQ-4bh6 Ӝ;$9Ê vhءRS.ppa2K asד`A("F++*WQX4{qA-|3)u>r F 2Đ<Jj55t-cFӾGi;74̙X`(M&A`#,8O %g5<z9ZʷHǂ#n0X@;ᅁ`%{ %v:kʾu&ԒD`ĝ^@zq>;OܮϘ-w;q Dں؝+!n ^ㆀ|Z-Ci#ܔkF솓--Xh+.TQԶeK@s['2G^γLDȫF l!v()tPژ)5265Ż`2Ӽ.;:--|ͧ@K u7ugeW'T=]IpRð` 伓l}Me:qͳ}@`yϩtVM^+kjC|8[0{_56ֶ2F]N?YY$K:D!ԃ;NF ZjQPX+nNtm4Yn]d̶]eU\R cIw \z+9̩̍i47{Zђ_4+}-*f-'ȏq9-UQk;%mL$\qI7yckv巳_(ԒTкB|FX潧<\41CELOk"ژ9d^0&P8[I F7$_lآ{*UIŭ.`<imDkE};seA,vjo:hEI1P[m $Ԗ־DR#o7Xdu[\₝5e-9Ywv^+!ArvpIA#P)]=`ʒyϨ5zj4|-%|tM<q[*_6GƫRr?5XD@DDD@DDD@DDD@DDD@DDD@]rS+ c.h+tt:_ѡsF܈::/@h~]胧 F܈:z/@h~]ȃ tI%,<1lHDZ!Px:T3]:iꚳjV천c<@wzfcPh/')w'kRȍ3KZ>PHp?rbd16(ƀִpp>:/@h~]ȃ F܈:z/@h~]ȃ F܈:z/@h~]ȃ C&8x @DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDܖoOĬ=O:k5iox hhq#ROĭ]ڿVCn̦MAIW095/ilj–u馌buvY>)%Ygln; i[SA{#dns' oS]4펻|43Y E2-s ho ]A=ͳϊ$\F ݜgry0Ol4V'FgdF<|^cl5lC$Md3.pf6 Qk*VXڙ(&,nP JuEUe,P4Mk7~q]vjl7GQ0'sr:ZHgkI-9B{ ,w14sm9;Sۯ=҈lt{de ;XfC(Qm|}kfRAKxG٨H.oZ7cϿd54ܟ^ C*!h8S~zq8\m/5j:-#5':Jq9len+oymek0K#d]Ah@+@DDD@DDDAʗͭ1(Tmo?܏Vi>n%&hd0=xk@. q#x[vn( u`nM'7ojX"QvTx[vn( u`nM'7ojX"QvTx[vn( u`nM'7ojX"QvTx[vn( u`nM'Woj-;7T_̬\u=>^·lbh!$f0v[ u`nM En کQvT Q.ݽO u`nM En کQvT Q.ݽO u`nM ESԵt3蛫*kv<}&7i0<3E+Sw,G[vn<-]{U7x7ojESw,G[vn<-]{U7x7ojESw,G[vn<-]{U7xÔ 87XY,jid{ZuQv T Q.ݽO u`nM En کQvT Q.ݽO u`nM En کQvT R4ʶmCChic[+y{O6ݧ!ޫ%/+gW4UbiX_S+!slyo 8е| _VmVt{k[ ѤUS2P#sCv`n^QNZ!tnxͰKq71mJͰ3v0Cɽ.yyrIeҜ0 ' `h ĮutiggdgyMyc1(6n7(V/8h]LC27OaPrUȥx\#l9p97NplE3Z[3y8}Cw;=F6tRI'angrX/Bj* [5m^Z0岹S\%| =} nXSecXflw:3#J҆\%cq7  5č2w"D[ : >;+44QS*]0O$j;-U hclOa<Ӝƍ؃3O]|CplFpkeqi_gS4m %r}d՝!F6H49 ȅ xe؈Gkyj ?/[#cUy89EO[OUsQo,vC\8,DAByTv!d慬g3' Hvʂ7Pzb(nnm ]wSHaGx;Z~3[tV$껅Lq$#!(z-rUr&#!?{']dn 椖O Q-4W]xӟ_{Uw,QGxӟ_{Ty4ӿ_{Uw,QGxӟ_{UwNc}U EN}U,JMjFCx&7q R7Oִ?Tܗiy4W*\ p}5lJ3'^Z]q"JUK-h%htr2RCAo]9Oxw]8=+j9w!#КEк*a{!74q s].6Gӟ_{UwFۢSlԑSо8穒m6 ;?r W*7Y٠5wh)/p~@8>`,&<:='\ϳ$:wK,PkE,H\#s}`3r\rn^WluG']Uzܼwn:,nӡ< mgSMzܼ mgO*c=^ԇDޭBܼγD&[ d1O-lcv f˾M:.v\j96㯍)&!UQ WluG3+cay]UvT{c?uXנ&UvT{c?x!UQ ca6T9MǴG v!UQ uנn\d/:vJsP]p=~62x.-nPvHg1쑆&Z?]=*;M֋G|r-[),Tw YwYi_ Բ-yǃ4]j#Rч :*e*}ue7 íoS^!UQ WluG3']zn^r9U>Q:.\#/h󑱐펨~^!UQ WluG+c[ A]+ 4L f kZ70wU%h_ SW^7/?B:Y mgN&rn^WluG']Uzܼ mgO*c=:l=rn^tt˅H:Qݱl863OluG)&q+=4PoMsl] ba4l7z*-N$@&OAJj1_]N.'d0 4Ûd9$yǒܘi[l6H\Y$'smpF p"&2s4r[!ON0hpxZdy##8aXrDyh&`NFr#`<71S0¡xn~|ܽDbxi4`dKmJ&&Svm|s7xƫZh1z}s`Z 2xUeJaU)uAo0ya-W[+5]/e)~Cec6P˧tLS5FWuLwkuv[GMS| 'g ZUDu new דp+cIO[+Slt n2AUJj4=-sagh89u*z.T} c%ٛll40g'o*hc-7)r 09h$<<+":v:D,tq$8#Ot547_ (&^䴴8n(am٥s<3 kkֻ.MKpB^_#ZvG^OV=KwoCp{OSflcidf"fz$edƙ3;dʖR 3#\PTDQ\sIW$)~˶|nr!g|%$aǎ0PoMTlWB65yLcËF87wVʍr?<65y_+S4&Av9-Pꜩ|^ HAz2Vä-S͸;#yv>(i_jImHI dCeG$ĕ?c4T~4+X",G,a>ꗆt0ѣvrwtSeږ\i2նZy$$ ӪiZXA=R.mxub!Zwo&,7&:ݥ.0ʶ^竸Idv kg:VLudjJʺn;kAٜd7uBjorS-КܳqWɵ{T׊."Z 1cpoMGo:cN7PTJښgΆr NA̫|b ?OBjorPyPW-r^ ve}ETT%.Y_RٮWXiMCK+7';oW1m[57g(<9J*ۭu{t٫9eq7 G7P֋G5u,6yu-"b7eS0xŷS{ž1mZK9.l}Z{(P3y\w-άE{ڥqQdo9vŷS{ž1m𠖶Z\Oy\Z)m,N|G̦ts>]S[g=3]\7p+b ?OBjorPivhj6l7"h'?U6OJ(8|%̫b ?OBjorPDJj:|CmOkdX:7u=Luզ=Wv.xŷS{ž1m ^WqzuG:7S|ԹmAv4윕{MMY xŷS{ƒI.6Ӯnt材3O0<-$痍yhjA iHF7{xŷS{ž1mMRuƂ¢k#㊠a\˺llrj Z`u;t3874a-8;עŷS{ž1m3wԗnPU- ډSLԹsG#vBΆ n|b ?X2[Y =]; =tMop/_(BU WP #N@~NkN~;R^8455t5}m7HGjژdsOCj C)εj!eSl04o_wmW{ӵ ukEOQkpvHk7 rñ:3|9CтWH.Їaɓ-r7Pr_di\BIs0VVۜ2Si' g-Hpך77>+1C\c"ҍDFΘYw9'r)*kuE~-񲚢(`G I^*"'KUB覶VH#o(:)[tsvǶj EU6x*91lu4dDQGur?*}XVAAI+*_O$~!˼ryW/7[Nm841١wwk+oN+gFsX60]?$yV?.GV^nϼ1$N 27k/u*z MUE__Ev [7loo`3?5ݳh \G;v|z E]%qCC1kݴi9w/ڏRRǬntڈgG=6 epw^uUNWj eEڶCM,SF߲C[Lj8ܭ]KND/Q'yGr^^_sqxӼ1w?G qF6MEWH*#ev̄ և vBmUnr)bݠǴw4C\;z`F  B8@X?] \+:qϚsp3O=JrFkjzG?M!oX_}r˕3N6rwor9@- Nyg8w~Č-O4TmPu \%|f^}ly'8ۅ(~s)|%k$C褵U Cllp&Xq1Yo%<]-DNK47Hw hykϚ=W7RQsԴ̌sR>Afi8>V'CZ)lU־H52T3vhy,;/E]1o2if#9NzaKk%Fm MCり69c`{ݓ kyM]DB^G1hL=>FZN nAvz:HRcmlCk8 n$|l6lѲY#6HgZ-=Zh$F=O qݐѼC\/3hU=ES5,4栘p Z2@;ǙvəNy6ݐ={֦jZyXgN$hD04 ĩ}G r 엗cn]ֶ̩5lsGxGǴ7s{R0D7p<MAYQiJ[ lړh:Xph8㞹\=<9CA``u)xnjvӗ]~RSUX"I)D|d䖱-@u\V{K[B:)^] 'ԶμS:;dvJQla[sCpvgueNOuT'Ο{/Jk47jVcQG0A+[32;5YOW.sizW?$O8FvblyñޯL)fԐ%@ĵBoWbQ% u 8/,qpKq̴WG&9n kX45`0 D &0D@a D &0D@a D &0D@Ž򣫿ۿGtu[wQ&G1h~{~:ԇ(Eجq Oįu[UU ](%љ$fϑ䱧ۗg%0+TWe咆R00~JqZʖRM3#\+5;#gzULYil`{C6CɵbJPK۞pcsIǬ%{%c)Ne 9o?]bzd6PiL?w4F oޫlw h1d-s8ZtC5Ekn@DR3ݿnWiHmdo{䩪3cݎA-JZs,M-D4;ok N8g̲)5*M0WnqsGh+}}K梊RmTk:|^G[119FӷuCB7P=2cK1Ö ncji${B'mmpN5NG] <4#xih}AJWI#6]0l@ռA)k*!x⤧R>havJQIIf\jhMBd4r>h sl7;u(;B63w~;LލE/Ht!Js>n0ѿ+@DDD@DDDAʗͭ1(Tmo?܏V~?I?Z3~N]OB(<͂1֫.yv1Qox`4&N^u.Gߣ=U'-=޵] Q,tzwK~pWx-=޵]xߣ=U EK~pWx,tzw,Gߣ=U'-=޵] Q,tzwK~pWx-=޵]xߣ=U EK~pWx,tzw,Gߣ=U'-=޵] Q,tzwK~pWxGX:[{jŁ,V.Pum%l%6|" """ """ )M$-uҺ8a%.?)pQ(eXh?V#g>\~xur=S>4:ުuDfA#VÁpܪ/:҆_+0D$-~Y^<;v{֧VNT\ Wk:4`ӞZOOLwHzj$َ@sGяZ*ku˰Oާw.߾?zsk|F*btfX;Z9%.?N ̥ZhFی@Aԣkozu5˱߭Oާw._~?za>TW[-9ʈɝNn.NTItzQ uf87qwSMVxur=S˰OެMmR Z4<XX$uè_QA L|!ė GWuM} y\):  yq n[]j~ii9SuP #sZ"{+h}%-|ܦ킚M0}450aGvSU^ܻ~xwrESVIWZn cctw%޷Uŧl f ʊ9$֑~zkm˱߭Oޮ|;vխ:u{tOHm0qqݍ;NIMrtF 9p9p ']Mn;v{֧VUYEP\#mtOi` ]9XYk#evئ&u8,nr֧ {֧SûaZZrkN:%{eI 6XCэ}kra}5򶦷8#kr+ׇw.߾?z 'E_Ym/{2O\9I<_.t#c?`ZUf֑TABGč72wW2peB2*xc_ŭ{C>5hOVS)z;Ϛ=+ԵUF1F\\22Zy,8OĭNWKI,"Ӽ#)`A@k-upt戙2'sO;U\WI-#jG9qC@ݎ+vk hi GXIGR *(ڎfr($,YosTF.k@A$n*CSGkVUqE d\ q`n?;6,25ό0;d_RMQmE|U,8npId׎Sڒsv$ҪMzek$,k!>DnZǞKc}MYY |"d AcMqڔ+L;+.R㤛szn 7fQ8#6ȈdDD@DDD@DDDAʗͭ1(Tmo?܏V6}fʪxn!֒:<[ :jҺZ7QLЖ5$;w֩􆚸UU[55i{xo$del~Y+E|o2$K=NFB} wPitڸnl1oXC8GYOel~𠝬W|)%q sN͝R͓pOpmm@(C 9Co#3Xx;+ct?<ƒW۠tw|P׸5dly_q@4QCEK3͢Iy˳=![)쭏}c5}Ҵ>ϽkžAvZhgޟ=+C ֿ=![)쭏m}Ҵ>ϽkžAvZhgޟ=+C י򃥭1Nt_ {|OnϩPi;&v)ʈ]miAnF χm}Ҵ>ϽkžAvZhgޟ=+C ֿ=![)쭏m}Ҵ>ϽkžAvZhgޟ=+C ֿ=![)쭏m}Ҵ>ϽkžAvZhgޟ=+C ֿ=![)쭏m}kMUfxoam|³EU9i3쁜db #Y/eOiTj9mUoC50ap.ii@_R芽J*/6PԆ-71{sһ.z vhOkFCX# uۋSk:4VLlOG[(;S`$=2ߗ]rWGUj[IN"&'F7qT]{q{*~<Tڜ^ОVG?Oc'wehqгt [TRZTJ5M'!߸5׷kn/eOݫSkVnwUYLio' Hk3sqLD;;#~Vkn/eOݧ^^ʟS|1=0w>VӶi&,.^?x[Ky+9}76g=x|Tx u_ Oy1\%={ 'bt8Kž_*Ej}M-#nr[7g*_?v]{q{*~9UV l@02~Gt]j{;=<dl9Vg^^ʟO?veLj*4-l]`ԕPLY ;FccpNyeEg]oHK39w -^^ʟO?v:Rrs,f!r2<::\[9Gr{iZL8`qZx uۋSiξyU%юu;\6Hpܔ<ЊV#=]:;[nT]{q{*~<Ts45\AS9 f Fp0O72nӖUW-ZQ>i$A81}Ks-׷\j)]mz|R1`ӝFDZwe7򚷫 nfD>::xc1uY^ p8ݜ.I-^r==){ܡzO{^MM_)(ME=`mHsd?gc9ݟR<\Y76-%CF"f<'cރyӹBtP/tTܥUWQYI`tKJJGTayo3*U΢kƾJ#ICCp~07yo:w(^\Z n媎JJ1jJ+) LTt&c썩KF`>Tʭ1*mrp2=h-GD@DDzX]Ff>j6F=7l3+/r==){˧46j[{a]`g ['k> }*k D"Y Q|` 7ӹBtP/tozj;TS 5&*k"3/&]ZURKEHҶ1&e~-GAkӹBjm C6[Y26+v3kz$4WY ҦyDtqt7N ǑU~`g8Xd8۸A`!ea7Fp1ӹBin6(]dk>8n7eCj]g׍,e]s*"15pg~IStP/t;/AyK) g)sǭo6WIKCY TtSͰ@a߼tUh]G5,˕ QI=;%n#h-zw(^X][jYwcn9rr\؅JK3.sLd+*vhZfީek]7udmttUwJJcc~- nHu] tP/t;/AyK-]uHiK֊e,Riw32:(m[ 36AYstZ2̰|AӹBtP/t֧Ԕ~4Ֆ:i%쨕Aq8P.Wzk4T7\S|.R DyRh݁2r==){֚c'h+$HBѽ0z[MIYXoU+9bI pd1};/AyK'N z{RIwKn,X)AqN3xnS|n_OmM`ܭ. #m u;/AyK'N z{RKAV̮xlNΖ%`$[f7 MepgVv\̼ywЃg/շ}d Hi+e^ͨ@?T'Ot3dYiJqkCv|'rӾ{g|o{w3j4MFť\'m6-x!8DZ/.'Nb%qi#,?zwvWx,ze+$P 3咔>LR\]y_4ܜةޔP־0Aۙ~/t{n!quHn jiopG7M:G{֞OZTTܙ rh[;pXui:n͗4p;=;{ޫOzwvWx*,wPHzMi梜FF 2:AYg|_FұAnvwqg|o{wN}\y9+n 镳Pgd/<VݎVl.Ŗd?NeC,WarՈ]YH8R""4M,OIU%k{$!/ az*ˡ bZǾ;,>xy7ӳTS3痙\ 2ŞݽU ȥЖJ;U,uWeI˦,3\vUov~1qg|o{wNdUhKee֖JYs3TZsBng][5ut z BZ8ccxӾ{g|o{w6iz{ 9*1E9s [Z}f kdZ aG uxӾ{g|o{w2%6_Q 2+fkon8wj]kUZG#k#ָ8pRŞݽU'=;{ޫAd۾WU$vڙ@ST:9kv0Z[Ffkm.EMO|6HY==OR2:&E\'xv\?j֍r?2Z}A x.qJSDb9nCAaUr+(,g7j gIBIPCYhmEq}63XL8ݽS'=;{ޫA9>t+}+孑rOtIۿ^ة#1KTʦ$%~,zEmTwThsQ`gKŞݽU'=;{ޫAF6~??`xq{&#󜹃rg|o{wNq_ɞj*mcYU0*2 q+MlVK`Uʀ@ݸn,z,z8gB .RMfָb(7/zwvWx,jS_ʖ*ej \ly{ˎI>pFA(j4 :m(u-.Sj_tC/Xћ}Tck9/~2x?P>`QZzeO򜷫E=ENA݋O8 ^xXY4s4"<>gxp88#sxū?RRt4~zUP\bG 6@ vdD1RTS=̉1a/㑱Nrf^wʣX)#mC2@yp>47mUSJʜwnX-%m%? l؉홌lr92cܻhFGrkV5 Z*q6I#=cpӳ+*k4$>>gqĐFgv54r檑Mf =[ 6}G[G$m H?Xۃxg k+]kj[U ;@xvdžҰ;+{qsPK[Tۗ?"5 L{5qFz~}ywnItu/I)yhtm3i@cW%hچNڂwM1{36 ÜWfYqd:VKR9ė7q҃t#?R`?R`OVj+g٨*. ٫ѵ0ŭ6G.l#~P==n>:sۦFf\IgS\Ȁ`qnOTk+ca DPF&$fB20r:Ej>d^;U4xIb.6s||~P==nwV-:So Wɐqᓞ Ϲ97zN[{j#:0yǻx;#;J.Zsۦ}9wJ^ʅUtjm^mmNۄ|>i)m]k p~(Ӻ[꬗%m}89n[b8(k_*ʮW+FNB""" """ """ """ """ """ """ """ -nv7km;٪2=8앲D KFn{`! UY='OEioV?3KܡT_lk PZ*]}@^, =\}Q,WZ\mzd2OnJJrNNKS]V9+#11)d u c]V-74PN]8!8\|-IZgu\lnNU :-L.İd |û~Խu7yKiwI%58.j 6'eI'IV?3IyEV`&tMg>=cJ=8TȈ"5W&E_dkKZ[N%}uHM Z݌v}M-4Zye}.2$kvG]F{ҫ[#oұW;4q:kO q1ɀ8ZĴAEitL9M,Q#=ϑ̺4;l4U4/JV67;v01JpWx+<112K=CSYMU%DMgZ;MrgMnIjj#IY "'Á퓽N(OvvާdS5v@݇ݲw zn;cWh?M}'z>퓽N(LrdVx6 i\4,|QZqé8Xצ"er" """ """ """ """ """ """ """ """ """ """ """ """ """ """ """ """ """ """ """ v?^7z^UG8n"]yཆhr# fۭ+MP\b\]_w+/&VTSE5COP\#iwoZP_)-EjF\LYoy<1n]3m#Lm="lIq ˆ qw̶BϧTom3 &\sd3ַhOrXu5]TCbtw.>0cRz VOnZvmڢ)gS ye'9v3BMZꧦ|ʉI0OXnRME-jX6F|@wL|蓵}_RKn6ctl.wՏ6OsJkw1zH.n$dh;f: )>rW pHn9)4tn<˫Fvz#}WoZT~[ן9ǯQC&֚u3at3`߻zsK|m=>qg;Y-{WZ9D#KH$}*'IyY[U5Ms d'Vj Am k0"B) 8L;`Elcvyʗz6N(d!cc̈́D}7(=3h}k l2NqՎ+ۯ5u}MQYY%?E$~ެΟSf Sѩ]G" 7X8{.41S2Kloay[Q/6;lr]hfspCy<=|U)Ѻ,fBYm>VOQܲtE->'NDly%ed>tJ=λI::87L9f2Nݽc뾠ѨeJj"=:wYA!W5 )6_E ;99$im%JRR6JV(+4yLI=<17JPܑow7/55@џ٘ʉ+X"@{U-5T6 7;cՅ_m\XihKX dI/Pu6(Xs sˆqY.zQm=TV^˘pԪwJުSpv40I츴p2=G+4ۦTQHPc}KQ_W\X)"vfqp8'kQzV=KDh=&>VIcFB &?>vnq:xglQ2M|QDEhDDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@DDD@C>nWx段UJ pN87ާӝ{r"#g^ܞ ڽ? ڽ?<ӝ{r"|ӝ{r'3ڽ? ڽ?<ӝ{r")=9W" x';?j8ONv~qȈ ڽ?<ӝ{r"zscOg^܈=9W" x';?j8ONv~qȈ ڽ?wSim=T/e5(RDECLI-Framework-0.05/META.yml0000644000076400007640000000147311536220123015465 0ustar kerismankerisman--- #YAML:1.0 name: CLI-Framework version: 0.05 abstract: Build standardized, flexible, testable command-line applications author: - Karl Erisman license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Carp: 0 Class::Inspector: 0 Exception::Class: 0 Exception::Class::TryCatch: 0 File::Spec: 0 Getopt::Long::Descriptive: 0 Term::ReadLine: 0 Test::More: 0 Text::ParseWords: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.50 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4