App-Framework

 view release on metacpan or  search on metacpan

examples/app_doxy.pl  view on Meta::CPAN

					$arg =~ s/^\s+// ;
					$arg =~ s/\s+$// ;
					$arg =~ s/^[\\\$\@\%]+// ;
				}
print " + + args (@args)\n" if $opts{debug} ;
				$info{'fn_details'}{$fn}{'args'} = \@args ;
			}
						
			# method call
			# $this->access($options_aref) ;
			# $this->SUPER::access($options_aref) ;
			# App::Framework->access($options_aref) ;
			if ($line =~ /^[^#]*(?:\$\w+|[\w_:]+)\->(SUPER::){0,1}([^\s\(]+)\(([^\)]*)/)
			{
				($super, $call, $args) = ($1, $2, $3) ;
print " + fn call <$super>: $call($args)\n" if $opts{debug} ;

				# see if call complete
				if ($line =~ /\)\s*;/)
				{
					my @args = split ',', $args ;
					foreach my $arg (@args)
					{

examples/app_doxy.pl  view on Meta::CPAN

				foreach my $arg (@args)
				{
					$arg =~ s/^\s+// ;
					$arg =~ s/\s+$// ;
					$arg =~ s/^[\\\$\@\%]+// ;
				}
print " + + args (@args)\n" if $opts{debug} ;
				$info{'fn_details'}{$fn}{'args'} = \@args ;
			}

'fn:/^[^#]*(?:\$\w+|[\w_:]+)\->(SUPER::){0,1}([^\s\(]+)\(([^\)]*)/', 'super=$1;call=$2;args=$3;', FILTER_START_IF, CALL
'/\)\s*;/', 'args=args(args);' FILTER_IF, CALL
'super:/\)\s*;/', '$call = "$isa".":$call" ;' FILTER_IF, CALL
'/\)\s*;/', '$call = "$isa".":$call" ;' FILTER_IF, CALL
						
			# method call
			# $this->access($options_aref) ;
			# $this->SUPER::access($options_aref) ;
			# App::Framework->access($options_aref) ;
			if ($line =~ /^[^#]*(?:\$\w+|[\w_:]+)\->(SUPER::){0,1}([^\s\(]+)\(([^\)]*)/)
			{
				($super, $call, $args) = ($1, $2, $3) ;
print " + fn call <$super>: $call($args)\n" if $opts{debug} ;

				# see if call complete
				if ($line =~ /\)\s*;/)
				{
					my @args = split ',', $args ;
					foreach my $arg (@args)
					{

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


	print "Framework Inheritence Modules:\n\t". join("\n\t",@modules)."\n" if $class_debug ;


	$module = shift @modules ;
	
	my $loaded = App::Framework::Core->dynamic_isa($module, __PACKAGE__) ;
	croak "Sorry, App::Framework does not support \"$module\"" unless $loaded ;

	# Create object
	my $this = $class->SUPER::new(
		%args, 
		'_caller_info'	=> $args{'_caller_info'},
		'_inheritence'	=> \@modules,
		
		## Pass down extra information
		'personality'	=> $personality,
		'extensions'	=> \@extensions,
	) ;
	$this->set(
		'usage_fn' 		=> sub {$this->script_usage(@_);}, 

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


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

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

print "App::Framework::Base->new() class=$class\n" if $class_debug ;

	# Create object
	my $this = $class->SUPER::new(%args) ;

	## Check for any required modules
	my $ok = 1 ;
	my %loaded ;
	foreach my $module (@{$this->requires})
	{
		eval "package $class; use $module;" ;
		if ($@)
		{
			$loaded{$module} = 0 ;

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=item B<expand_keys($hash_ref, $vars_aref)>

Processes all of the HASH values, replacing any variables with their contents. The variable
values are taken from the ARRAY ref I<$vars_aref>, which is an array of hashes. Each hash
containing variable name / variable value pairs.

lib/App/Framework/Base/Object/ErrorHandle.pm  view on Meta::CPAN


=cut

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

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

	# Create object
	my $this = $class->SUPER::new(%args) ;
	
	
	return($this) ;
}



#============================================================================================
# CLASS METHODS 
#============================================================================================

lib/App/Framework/Base/Object/ErrorHandle.pm  view on Meta::CPAN

	if (! keys %args)
	{
		%args = () ;
	}
	
	# Add extra fields
	foreach (keys %FIELDS)
	{
		$args{'fields'}{$_} = $FIELDS{$_} ;
	}
	$class->SUPER::init_class(%args) ;

	# Create a class instance object - allows these methods to be called via class
	$class->class_instance(%args) ;

}


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

=item B<add_global_error($error)>

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


=cut

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

	# Create object
	my $this = $class->SUPER::new(%args) ;

#$this->debug(2) ;
$this->_dbg_prt(["new this=", $this], 10) ;

	return($this) ;
}



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

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT METHODS

=over 4

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

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

	## stop 'app' entry from being displayed in Features 
	App::Framework::Base::Object::DumpObj::exclude('app') ;
	
print "App::Framework::Core->new() class=$class\n" if $class_debug ;
	
	my $caller_info_aref = delete $args{'_caller_info'} || croak "$class must be called via App::Framework" ;

	# Create object
	my $this = $class->SUPER::new(%args) ;
	
	# Set up error handler
	$this->set('catch_fn' => sub {$this->catch_error(@_);} ) ;

	## Get caller information
	my ($package, $filename, $line, $subr, $has_args, $wantarray) = @$caller_info_aref ;
	$this->set(
		'package'	=> $package,
		'filename'	=> $filename,
	) ;

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=item B<allowed_class_instance()>

Class instance object is not allowed
 
=cut

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

=cut

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

	my $class = ref($obj) || $obj ;
print "App::Framework::Core::Script->new() class=$class\n" if $class_debug;
	
	# Create object
	my $this = $class->SUPER::new(
		%args, 
	) ;
	$this->set(
		'usage_fn' 	=> sub { $this->script_usage(@_); }, 
	) ;

	## Set options
	$this->feature('Options')->append_options(\@SCRIPT_OPTIONS) ;

print "App::Framework::Core::Script->new() - END\n" if $class_debug;

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


=cut

sub catch_error
{
	my $this = shift ;
	my ($error) = @_ ;

$this->_dbg_prt(["catch_error()\n"]) ;

	$this->SUPER::catch_error($error) ;

#TODO: This is just the App::Framework::Base::Object::ErrorHandle default_error_handler() code - could just use that (return handled=0)
	my $handled = 0 ;

	# If it's an error, stop
	if ($this->is_error($error))
	{
		my ($msg, $exitcode) = $this->error_split($error) ;
		die "Error: $msg\n" ;
		$handled = 1 ;

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

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

#print "App::Framework::Extension->new() class=$class\n" ;

	## Inherit from specified list
	my $this = App::Framework::Core->inherit($class, %args) ;

$this->_dbg_prt(["Extension - $class ISA=@ISA\n"]) ;

	# Create object
#	my $this = $class->SUPER::new(%args) ;

#$this->debug(1) ;
#print "App::Framework::Extension->new() - END\n" ;
	
	return($this) ;
}



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

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}


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

=back

=head2 OBJECT METHODS

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}


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

=back

=head2 OBJECT METHODS

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}


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

=back

=head2 OBJECT METHODS

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


=cut

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

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

	# Create object
	my $this = $class->SUPER::new(
		'priority'	=> $App::Framework::Base::PRIORITY_DEFAULT,	# will be overridden by derived object
		%args,
	) ;

	## do application-specific bits
	$this->register_app() ;
	
	return($this) ;
}

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=item B<allowed_class_instance()>

Returns 0 since this class can not have a class instance object
 
=cut

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

#			}
#			
#			$arg = \@list ;	
#		}
#		else
#		{
#			$arg = undef ;
#		}
#	}
#	
#	return $this->SUPER::feature_args($arg) ;
#}


##-----------------------------------------------------------------------------
#
#=item B< feature_args([$args]) >
#
#Get/set the feature's arguments. If specified, I<$args> may be either an ARRAY ref (which is saved as-is),
#or a SCALAR. In the case of the SCALAR, it is expected to be a space/comma separated list of argument
#strings which are parsed and converted into an ARRAY ref

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

#=cut
#
#sub feature_args
#{
#	my $this = shift ;
#	my ($arg) = @_ ;
#
#print "feature_args($arg) [$this]\n" ;
#$this->dump_callstack() ;	
#
#	return $this->SUPER::feature_args($arg) ;
#}

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

=back

=head2 OBJECT METHODS

=over 4

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


=cut

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

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

	# Create object
	my $this = $class->SUPER::new(%args,
	) ;


my $args = $this->feature_args() ;
$this->_dbg_prt(["NEW: feature args=", $args]) ;
$this->_dbg_prt(["OBJ=", $this]) ;
	
	return($this) ;
}

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT METHODS

=over 4

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

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

	# create search path object
	my $search_obj = App::Framework::Base::SearchPath->new(%args) ;
	
	# Create object
	my $this = $class->SUPER::new(%args,
		'priority'		=> $App::Framework::Base::PRIORITY_SYSTEM + 15,		# needs to be after options, but before data
		'registered'	=> [qw/go_entry getopts_entry application_entry/],
		'_search_path'	=> $search_obj,
	) ;
	
	## Map the search path object's methods into this object
	foreach my $method (qw/path write_path read_filepath write_filepath/)
	{
		no warnings 'redefine';
		no strict 'refs';

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT DATA METHODS

=over 4

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

	{

$this->_dbg_prt( ["settings args = ", \%args] ) ;

		# send to search path obj (if created yet)
		my $search_obj = $this->_search_path ;
$this->_dbg_prt( ["settings args on search_obj\n"] ) if $search_obj ;
		$search_obj->set(%args) if $search_obj ;
				
		# handle the args
		$this->SUPER::set(%args) ;
	}

}

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

=back

=head2 OBJECT METHODS

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


=cut

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

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

	# Create object
	my $this = $class->SUPER::new(%args,
		'priority' 			=> $App::Framework::Base::PRIORITY_SYSTEM + 20,		# needs to be after options
		'registered'		=> [qw/app_start_exit application_entry/],
		'feature_options'	=> \@OPTIONS,
	) ;

#$this->debug(2);

	
	return($this) ;
}

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT METHODS

=over 4

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


=cut

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

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

	# Create object
	my $this = $class->SUPER::new(%args,
		'feature_options'		=> \@OPTIONS,
		'registered'			=> [qw/application_entry/],
	) ;

#$this->debug(2);

	
	return($this) ;
}

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT METHODS

=over 4

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


=cut

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

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

	# Create object
	my $this = $class->SUPER::new(%args,
		'requires' 				=> [qw/Net::SMTP/],
		'registered'			=> [qw/application_entry catch_error_entry/],
		'feature_options'		=> \@OPTIONS,
	) ;
	

	## If associated with an app, set options
	my $app = $this->app ;
	if ($app)
	{

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT METHODS

=over 4

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


=cut

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

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

	# Create object
	my $this = $class->SUPER::new(%args,
		'priority' 		=> $App::Framework::Base::PRIORITY_SYSTEM + 10,		# needs to be before data
#		'registered'	=> [qw/getopts_entry/],
	) ;

	
	return($this) ;
}



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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT METHODS

=over 4

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


=cut

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

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

	# Create object
	my $this = $class->SUPER::new(%args,
		'feature_options'		=> \@OPTIONS,
		'registered'			=> [qw/application_entry/],
	) ;

#$this->debug(2);

	
	return($this) ;
}

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT METHODS

=over 4

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


=cut

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

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

	# Create object
	my $this = $class->SUPER::new(%args) ;
	
	
	return($this) ;
}


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

=back

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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT DATA METHODS

=over 4

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

or fatal error if one or more required programs are not found. Sets the message string to indicate 
which programs were not found. 

=cut

sub required
{
	my $this = shift ;
	my ($new_required_href) = @_ ;
	
##	my $required_href = $this->SUPER::required($new_required_href) ;
	my $required_href = $this->field_access('required', $new_required_href) ;
	if ($new_required_href)
	{
		## Test for available executables
		foreach my $exe (keys %$new_required_href)
		{
			$required_href->{$exe} = which($exe) ;
		}
		
		## check for errors

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


=cut

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

	# Create object
	my $this = $class->SUPER::new(%args,
		'requires' => [qw/DBI DBD::mysql/],
	) ;

	## Postpone connection until we actually need it

	return($this) ;
}



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


sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT DATA METHODS

=over 4

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


	# ensure priority args are handled first
	my %priority ;
	foreach my $arg (@PRIORITY_FIELDS)
	{
		my $val = delete $args{$arg} ;
		$priority{$arg} = $val if $val ; 
	}
	if (keys %priority)
	{
		$this->SUPER::set(%priority) ;

		# Connect if we can
		if ($this->database && $this->host)
		{
			$this->connect() ;		
		}
	}
	
	# handle the rest
	$this->SUPER::set(%args) if keys %args ;

}

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

=back

=head2 OBJECT METHODS

=over 4

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

Change trace level

=cut

sub trace
{
	my $this = shift ;
	my (@args) = @_ ;

	# Update value
##	my $trace = $this->SUPER::trace(@args) ;
	my $trace = $this->field_access('trace', @args) ;

	if (@args)
	{
		my $dbh = $this->dbh() ;
		my $trace_file = $this->trace_file() ;
		
		# Update trace level
		$this->_set_trace($dbh, $trace, $trace_file) ;
	}

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

Change trace file

=cut

sub trace_file
{
	my $this = shift ;
	my (@args) = @_ ;
	
	# Update value
##	my $trace_file = $this->SUPER::trace_file(@args) ;
	my $trace_file = $this->field_access('trace_file', @args) ;
	
	if (@args)
	{
		my $dbh = $this->dbh() ;
		my $trace = $this->trace() ;
		
		# Update trace level
		$this->_set_trace($dbh, $trace, $trace_file) ;	
	}

t/lib/ObjTest.pm  view on Meta::CPAN

) ;

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

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

	# Create object
	my $this = $class->SUPER::new(%args) ;
	
	return($this) ;
}

#-----------------------------------------------------------------------------
sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

#	# Add extra fields
#	$class->add_fields(\%FIELDS, \%args) ;
#
#	# init class
#	$class->SUPER::init_class(%args) ;

	if (! keys %args)
	{
		%args = () ;
	}
	
	# Add extra fields
	foreach (keys %FIELDS)
	{
		$args{'fields'}{$_} = $FIELDS{$_} ;
	}
	$class->SUPER::init_class(%args) ;

	# Create a class instance object - allows these methods to be called via class
	$class->class_instance(%args) ;


}

1;

__END__



( run in 1.477 second using v1.01-cache-2.11-cpan-49f99fa48dc )