view release on metacpan or  search on metacpan

lib/App/Chained.pm  view on Meta::CPAN

 }
 
 #--------------------------------------------------------------------------------- 
 
 package main ;
 
 App::Chained::Test->run(command_line_arguments => \@ARGV) ;

=head1 DESCRIPTION

This module implements  an application front end to other applications. As the B<git> command is a front end 
to many B<git-*> sub commands

=head1 DOCUMENTATION

This module tries to provide the git like front end with the minimum work from you. Your sub commands can be implemented in 
perl scripts, modules or even applications written in other languages. You will not have to derive your sub commands from a class I define
nor will you have to  define specific soubrourines/methods in your sub commands. In a word I tried to keep this module as non-intruisive as 
possible.

Putting a front end to height sub applications took a total of 15 minutes plus another 15 minutes when I decided to have a more advanced command
completion. More on completion later.

=head2 What you gain

The Wrapper will handle the following options

=over 2

=item * --help

=item * --apropos

=item * --faq

=item * --version

=item * --generate_bash_completion

=back

=head3 Defining sub commands/applications

 sub_apps =>
  {
  check => # the name of the sub command, it can be an alias
	{
	description => 'does a check', # description
	run => 
  	  sub
	  {
	  # a subroutine reference called to run the sub command
	  # This is a simple wrapper. You don't have to change your modules or scripts
	  # or inherite from any class
			
	  my ($self, $command, $arguments) =  @_ ;
	  system 'your_executable ' . join(' ', @{$arguments}) ;
	  },
			
	help => sub {system "your_executable --help"}, # a sub to be run when help required
	apropos => [qw(verify check error test)], # a list of words to match a user apropos query
	
	options => sub{ ...}, # See generate_bash_completion below
	},
  ...
  }
			
=head1 EXAMPLE

L<App::Requirement::Arch> (from version 0.02) defines a front end application B<ra> to quite a few sub commands. Check the source
of the B<ra> script for a real life example with sub command completion script.

=head1 THIS CLASS USES EXIT!

Some of the default handling will result in this module using B<exit> to return from the application wrapper. I may remove the B<exit> in future
versions as I rather dislike the usage of B<exit> in module.

=head1 SUBROUTINES/METHODS

=cut


#-------------------------------------------------------------------------------

Readonly my $NEW_ARGUMENTS => [qw(NAME INTERACTION help getopt_data sub_apps command_line_arguments version apropos faq usage)] ;

sub new
{

=head2 new(NAMED_ARGUMENT_LIST)

Create a App::Chained object, refer to the synopsis for a complete example.

I<Arguments>

=over 2 

=item *  INTERACTION -  Lets you redefine how B<App::Chained> displays information to thhe user

=item * command_line_arguments - Array reference- 

=item * help - A sub reference -

you can also \&App::Chained::get_help_from_pod if you want your help to be extracted from the pod  present in your app. The pod will be displayed
by I<perldoc> if present in your system or converted by B<App::Chained>.

=item * version - A scalar or a Sub reference -

=item * apropos - A sub reference - 

if it is not defined, The apropos fields in the sub commands entries are searched for a match

=item *  faq - A sub reference - called when the user 

=item * getopt_data - Ans array reference containing 

=over 2

=item * A string - a Getopt specification

=item * A scalar/array/hash/sub reference according to Getop

=item * A string - short description 

=item * A string - long description 

=back

	['an_option|o=s' => \my $option, 'description', 'long description'],

=item * sub_apps - A Hash reference - contains a sub command/application definition

	{
	check =>
		{
		description => 'does a check',
		run =>
			sub
			{
			my ($self, $command, $arguments) =  @_ ;
			system 'ra_check.pl ' . join(' ', @{$arguments}) ;
			},
			
		help => sub {system "ra_check.pl --help"},
		apropos => [qw(verify check error test)],
		options => sub{ ...},
		},
	},

=back

I<Returns> - An App::Chained object

I<Exceptions> - Dies if an invalid argument is passed

=cut

my ($invocant, @setup_data) = @_ ;

my $class = ref($invocant) || $invocant ;
confess 'Error: Invalid constructor call!' unless defined $class ;

my $object = {} ;

my ($package, $file_name, $line) = caller() ;
bless $object, $class ;

$object->Setup($package, $file_name, $line, @setup_data) ;

return($object) ;
}

#-------------------------------------------------------------------------------

sub Setup
{

=head2 [P]Setup

Helper sub called by new.

=cut

my ($self, $package, $file_name, $line, @setup_data) = @_ ;

croak "Error: Invalid number of argument '$file_name, $line'."  if (@setup_data % 2) ;

$self->{INTERACTION}{INFO} ||= sub {print @_} ;
$self->{INTERACTION}{WARN} ||= \&Carp::carp ;
$self->{INTERACTION}{DIE}  ||= \&Carp::croak ;
$self->{NAME} = 'Anonymous';
$self->{FILE} = $file_name ;
$self->{LINE} = $line ;

$self->CheckOptionNames($NEW_ARGUMENTS, @setup_data) ;

%{$self} = 
	(
	NAME                   => 'Anonymous',
	FILE                   => $file_name,
	LINE                   => $line,
	@setup_data,
	) ;

my $location = "$self->{FILE}:$self->{LINE}" ;