view release on metacpan or  search on metacpan

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

 * app_start_fn = Function called before app() function (default is application-defined 'app_start' subroutine if available)
 * app_fn = Function called to execute program (default is application-defined 'app' subroutine if available)
 * app_end_fn = Function called after app() function (default is application-defined 'app_end' subroutine if available)
 * usage_fn = Function called to display usage information (default is application-defined 'usage' subroutine if available)

During program execution, the following values can be accessed:

 * package = Name of the application package (usually main::)
 * filename = Full filename path to the application (after following any links)
 * progname = Name of the program (without path or extension)
 * progpath = Pathname to program
 * progext = Extension of program

=cut

use 5.008004;

use strict ;
use Carp ;

use App::Framework::Core ;


our $VERSION = "1.07" ;


#============================================================================================
# OBJECT HIERARCHY
#============================================================================================
our @ISA ; 

#============================================================================================
# GLOBALS
#============================================================================================

our $class_debug = 0 ;

# Keep track of import info
my $import_args ;


#============================================================================================

=head2 METHODS

=over 4

=cut


#============================================================================================

# Set up module import
sub import 
{
    my $pkg     = shift;
    
    $import_args = join ' ', @_ ;
    
	## Set library paths
	my ($package, $filename, $line, $subr, $has_args, $wantarray) = caller(0) ;
	App::Framework::Core->set_paths($filename) ;

	## Add a couple of useful function calls into the caller namespace
	{
		no warnings 'redefine';
		no strict 'refs';

		foreach my $fn (qw/go modpod/)	
		{
			*{"${package}::$fn"} = sub {  
			    my @callinfo = caller(0);
				my $app = App::Framework->new(@_,
					'_caller_info' => \@callinfo) ;
				$app->$fn() ;
			};
		}	
	}
    
}

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

=item B< new([%args]) >

Create a new object.

The %args passed down to the parent objects.

The parameters are specific to App::Framework:

=over 4

=item B<specification> - Application definition

Instead of specifying the application in the 'use App::Framework' line, you can just specify them in this
argument when creating the object. If this is specified it will overwrite any specification in the 'use' pragma.

=back


=cut

sub new
{
	my ($obj, %args) = @_ ;

	my $class = ref($obj) || $obj ;

    my @callinfo = caller(0);
	$args{'_caller_info'} ||= \@callinfo ;

	print __PACKAGE__."->new() : caller=$args{'_caller_info'}->[0]\n" if $class_debug ;

	if (exists($args{'specification'}))
	{
		$import_args = delete $args{'specification'} ;
	}



	## Process the import command args
	my $personality ;
	my @features ;
	my @extensions ;
	my %extension_args ;
	my %feature_args ;
	$import_args ||= ':Script +run' ;
	
	# Expect something of the form:
	# :Personality ::Extension ::Ext(option1 option2) +Feature +Feat(opt1, opt2)
	#
	#                           type        name       args 
	while ($import_args =~ /\s*([\:\+]{1,2})([\w_]+)\s*(?:\(([^\)]+)\)){0,1}/g)
	{
		my ($type, $name, $args) = ($1, $2, $3) ;
		if ($type eq ':')
		{
			if ($personality)
			{
				croak "Sorry, App::Framework does not support multiple personalities (please see a psychiatrist!)" ;
			}
			if ($args)
			{
				warn "Sorry, personalities do not support arguments" ;
			}
			$personality = $name ;
		}
		elsif ($type eq '::')
		{
			push @extensions, $name ;
			$extension_args{$name} = $args || "" ;
		}
		elsif ($type eq '+')
		{
			push @features, $name ;
			$feature_args{$name} = $args || "" ;
		}
		else
		{
			croak "App::Framework does not understand the import string \"$import_args\" at \"$type\" " ;
		}
	}

	## sort extension list
	my @extension_modules ;
	my %extensions ;
	foreach my $extension (@extensions)
	{
		my $module = "App::Framework::Extension::$extension" ;