view release on metacpan or  search on metacpan

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

		## Logging
		'logfile'		=> undef,
		'mode'			=> 'truncate',
		'to_stdout'		=> 0,
		
		'_started'		=> 0,
		
	) ;

my $POD_HEAD =	"=head" ;
my $POD_OVER =	"=over" ;

my @DEFAULT_OPTS = (
	['debug=i',			'Set debug level', 	'Set the debug level value', ],
	['v|"verbose"',		'Verbose output',	'Make script output more verbose', ],
	['dryrun|"norun"',	'Dry run', 			'Do not execute anything that would alter the file system, just show the commands that would have executed'],
	['h|"help"',		'Print help', 		'Show brief help message then exit'],
	['man',				'Full documentation', 'Show full man page then exit' ],
	['man-dev',			'Full developer\'s documentation', 'Show full man page for the application developer then exit' ],
	['log=s',			'Log file', 		'Specify a log file', ],
	['dev:pod',			'Output full pod', 	'Show full man page as pod then exit' ],
	['dev:dbg-data',		'Debug option: Show __DATA__', 				'Show __DATA__ definition in script then exit' ],
	['dev:dbg-data-array',	'Debug option: Show all __DATA__ items', 	'Show all processed __DATA__ items then exit' ],
	['dev:alf-info',	'Module information', 	'Display information about the App::Framework::Lite module then exit' ],
	['dev:alf-debug=i',	 'Debug App::Framework::Lite', 	'Set the debug level value of the App::Framework::Lite module', ],
#@NO-EMBED BEGIN
	['dev:alf-embed=s',		'Embed module', 	'Embed the App::Framework::Lite module into script then exit. Specify the filename of the new script.' ],
	['dev:alf-embed-lib=i',	'Embed libraries', 	'(Only used when embedding). Embed user modules as well as the App::Framework::Lite module.', 1 ],
	['dev:alf-compress=i',	'Compress embedded', 	'(Only used when embedding). Compress the embedded modules.', 1 ],
#@NO-EMBED END
	) ;

our @USED = (
	'Carp',
	'Cwd',
	'Getopt::Long qw(:config no_ignore_case)',
	'Pod::Usage',
	'File::Basename',
	'File::Path',
	'File::Temp',
	'File::Spec',
	'File::DosGlob qw(glob)',
) ;

our @OPT_MOD = (
	'File::Which',
) ;
our %AVAILABLE_MOD ;


#============================================================================================
BEGIN {

#@NO-EMBED BEGIN
	# Clear flag for non-embedded
	$EMBEDDED = 1 ;
#@NO-EMBED END

	## Get caller information
	my ($package, $filename, $line, $subr, $has_args, $wantarray) = caller(0) ;

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

		foreach my $fn (qw/go/)	
		{
			*{"${package}::$fn"} = sub {  
			    my @callinfo = caller(0);
				my $app = App::Framework::Lite->new(@_,
					'_caller_info' => \@callinfo) ;
				$app->$fn() ;
			};
		}	
	}
	
	## Optional modules
	foreach my $mod (@OPT_MOD)
	{
		# see if we can load up the package
		if (eval "require $mod") 
		{
			$mod->import() ;
			++$AVAILABLE_MOD{$mod} ;

		}
	}
}

#============================================================================================
# Set up module import
sub import 
{
    my $pkg     = shift;

	# save for later    
    $import_args = join ' ', @_ ;

	## Get caller information
	my ($package, $filename, $line, $subr, $has_args, $wantarray) = caller(0) ;

	## Set program info
	App::Framework::Lite->_set_paths($filename) ;
	

	## Import modules into caller space
	my $include = "package $package;\n" ;
	foreach my $use (@USED)
	{
		$include .= "use $use ;\n" ;
	}
	foreach my $use (keys %AVAILABLE_MOD)
	{
		if ($AVAILABLE_MOD{$use})
		{
			$include .= "use $use ;\n" ;
		}
	}
	eval $include ;
	die "Error: Unable to load modules into $package : $@" if $@ ;
}


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

=head2 METHODS

=over 4

=cut


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

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

Create a new object.

The %args passed down to the parent objects.


=cut


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

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

	# Create object
	my $this = {} ;
	bless ($this, $class) ;
	$this->{'app'} = $this ;

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

	## init
	foreach my $field (keys %FIELDS)
	{
		$this->{$field} = $FIELDS{$field} ;
	}
	$this->_setup_modules() ;
	
	## Get caller information
	my $callinfo_aref = delete $args{'_caller_info'} ;
	if (!$callinfo_aref)
	{
		$callinfo_aref = [ caller(0) ] ;	
	}
	my ($package, $filename, $line, $subr, $has_args, $wantarray) = @$callinfo_aref ;
	$this->set(
		'package'	=> $package,
		'filename'	=> $filename,
	) ;
	
	## Set program info
	$this->_set_paths($filename) ;
	
	## set up functions
	foreach my $fn_aref (
		# prefered
		['app_start',	'app_start'],
		['app',			'app'],
		['app_end',		'app_end'],
		['usage',		'usage'],

		# alternates
		['app_begin',	'app_start'],
		['app_enter',	'app_start'],
		['app_init',	'app_start'],
		['app_finish',	'app_end'],
		['app_exit',	'app_end'],
		['app_term',	'app_end'],
	)
	{
		my ($fn, $alias) = @$fn_aref ;
		
		# Only add function if it's not already been specified
		$this->_register_fn($fn, $alias) ;
	}


	## Get version
	$this->_register_scalar('VERSION', 'version') ;

	## Ensure name set
	if (!$this->{name})
	{
		$this->{name} = $this->{progname} ;		
	}
	
	# Process import args
	#
	my %feature_args ;

	my $personality ;
	my @features ;
	my @extensions ;
	my %extension_args ;
	
	# 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 ':')