view release on metacpan or  search on metacpan

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

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}" ;

$self->{INTERACTION}{INFO} ||= sub {print @_} ;
$self->{INTERACTION}{WARN} ||= \&Carp::carp ;
$self->{INTERACTION}{DIE}  ||= \&Carp::confess ;

if($self->{VERBOSE})
	{
	$self->{INTERACTION}{INFO}('Creating ' . ref($self) . " '$self->{NAME}' at $location.\n") ;
	}

return 1 ;
}

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

sub CheckOptionNames
{

=head2 [P]CheckOptionNames