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__