view release on metacpan or search on metacpan
lib/CGI/FormBuilder/Source/YAML.pm view on Meta::CPAN
else {
my $l = $stacklevel;
my $subref = undef;
LEVELUP:
while (my $pkg = caller($l++)) {
debug 1, "looking up at lev $l for ref '$refstr' in '$pkg'";
my $evalstr = "\$subref = \\$reftype$pkg\::$refstr";
debug 1, "eval '$evalstr'";
eval $evalstr;
if (!$@) {
view release on metacpan or search on metacpan
lib/CGI/FormBuilder/Field.pm view on Meta::CPAN
# trying to inflate?
return unless exists $self->{inflate};
debug 2, "$self->{name}: inflate routine exists";
# must return real values to the validate() routine:
return if grep { ((caller($_))[3] eq 'CGI::FormBuilder::Field::validate') }
1..2;
debug 2, "$self->{name}: made sure inflate not called via validate";
# must be valid:
#return unless exists $self->{invalid} && ! $self->{invalid};
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
chdir $cwd;
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {
view release on metacpan or search on metacpan
lib/CGI/FormMagick/Utils.pm view on Meta::CPAN
=cut
sub debug_msg {
my $self = shift;
my $msg = shift;
my ($sub, $line) = (caller(1))[3,2];
print qq(<p class="debug">$sub $line: $msg</p>) if $self->{debug};
}
=head2 $fm->get_page_by_name($name)
view release on metacpan or search on metacpan
lib/CGI/Framework.pm view on Meta::CPAN
}
#
# Append stack to error message:
#
for ($index = 0 ; @callerparts = caller($index) ; $index++) {
push(@stack, "$callerparts[1]:$callerparts[2] ($callerparts[3])");
}
@stack = reverse @stack;
$error .= "\n\nStack trace appended by CGI::Framework fatal error handler:\n";
foreach (0 .. $#stack) {
view release on metacpan or search on metacpan
GuruMeditation.pm view on Meta::CPAN
if ($option->{-debug}) {
for (my $i = 0; $i < 100; $i++) {
my $caller = {}; @${caller}{qw(
-package -filename -line -subroutine -hasargs
-wantarray -evaltext -is_require -hints -bitmask
)} = caller($i) or last;
push(@{$bt}, $caller);
}
}
# fetch options from external variable
view release on metacpan or search on metacpan
HTMLError.pm view on Meta::CPAN
#
my $i;
my ($filename_from_stack,$number_from_stack);
while (1) {
my @caller = caller($i++);
if (defined $caller[3]) {
$filename_from_stack ||= $caller[1];
$number_from_stack ||= $caller[2];
return if $caller[3] eq '(eval)';
}
HTMLError.pm view on Meta::CPAN
if ($CONF{trace}) {
print '<hr><em>Stacktrace:</em><pre><code>';
my $i;
while (1) {
my ($pack,$file,$number,$sub) = caller($i) or last;
printf "%02d| \&$sub called at $file line $number\n",$i++;
}
print '</code></pre>';
}
HTMLError.pm view on Meta::CPAN
=over 4
=item Finding the right filename and line number
By default, C<CGI::HTMLError> expects the filename and line number to be in the error message handed to the handler (normally this is $@). This gives application writers the chance to point to another file as the actual cause of the problem (for inst...
If no filename can be found, only the error message and the optional stacktrace will be shown.
=item Security
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
# Done in evals to avoid confusing Perl::MinimumVersion
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
# Done in evals to avoid confusing Perl::MinimumVersion
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
*{caller(0) . "::AUTOLOAD"} = $self->autoload;
}
#line 147
sub autoload {
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
*{caller(0) . "::AUTOLOAD"} = $self->autoload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
}
view release on metacpan or search on metacpan
my($self) = @_;
## CGI::Log->_find_self(\$self); ## we have "found outselves" (what object
## reference we are, by the time we get here.)
my @call = caller(1);
my $line = $call[2];
my $cnt = 2;
my @stack;
while (defined($call[0]))
{
my $caller = $call[0];
@call = caller($cnt);
$call[3] = $caller if (!defined($call[3]));
unshift(@stack, $call[3] . ":" . $line);
$line = $call[2];
$cnt++;
}
view release on metacpan or search on metacpan
MxScreen/Tie/Stdout.pm view on Meta::CPAN
#
my ($pkg, $filename, $line);
my $i = 0;
do {
($pkg, $filename, $line) = caller($i++)
} while ($pkg eq __PACKAGE__ || $pkg eq 'Tie::Handle');
#
# Strip all trailing "\n" before logging.
#
view release on metacpan or search on metacpan
lib/CGI/Out.pm view on Meta::CPAN
# idiom.com specific feature:
$pwd = "$Chroot::has_chrooted$pwd"
if defined $Chroot::has_chrooted;
$usedby = join(':',(caller(2))[1,2]);
&error("Cannot combine CGI::Out ($usedby) and CGI::Wrap ($CGI::Wrap::usedby)")
if defined @CGI::Wrap::EXPORT;
}
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
# Done in evals to avoid confusing Perl::MinimumVersion
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
@found;
}
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
1;
view release on metacpan or search on metacpan
lib/CGI/ProgressBar.pm view on Meta::CPAN
=cut
no strict 'refs';
foreach (qw/ progress_bar update_progress_bar hide_progress_bar/){
*{caller(0).'::'.$_} = \&{__PACKAGE__.'::'.$_};
}
use strict 'refs';
}
=head1 USE
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
view release on metacpan or search on metacpan
our $DEBUG = 0;
sub import {
my($class,%args) = @_;
return unless exists $args{'autotie'};
$args{'filehandle'} = $args{'autotie'} =~ /::/ ? $args{'autotie'} : caller().'::'.$args{'autotie'};
no strict 'refs';
my $self = tie(*{$args{'filehandle'}},$class,%args);
return $self;
}
my($class,%args) = @_;
my $self = $class->new(%args);
$self->{'_handle'} = do { local *STDOUT };
my $handle_to_tie = '';
if($args{'filehandle'} !~ /::/) {
$handle_to_tie = caller().'::'.$args{'filehandle'};
} else {
$handle_to_tie = $args{'filehandle'};
}
open($self->{'_handle'},'>&'.$handle_to_tie) or die "Failed to copy the filehandle ($handle_to_tie): $!";
return $self;
view release on metacpan or search on metacpan
lib/CGI/Safe.pm view on Meta::CPAN
$CGI::POST_MAX = 512 * 1024; # limit posts to 512K max
}
sub import {
if ( grep { /:(?:standard|cgi)/ } @_ ) {
my $set_sub = caller(0) . '::set';
my $shell_sub = caller(0) . '::get_shell';
my $path_sub = caller(0) . '::get_path';
{
no strict 'refs';
*{$set_sub} = \&set;
*{$shell_sub} = \&get_shell;
*{$path_sub} = \&get_path;
view release on metacpan or search on metacpan
lib/CGI/Scriptpaths.pm view on Meta::CPAN
$rel=~s/^\/+//;
return "/$rel";
}
sub _script_rel_path_last_resort {
# my @caller = caller(1);
#@caller
# debug("caller @caller \n");
my $rel = $ENV{SCRIPT_NAME};
$rel ||= $0;
defined $rel or return;
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
chdir $cwd;
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}
sub _running_under {
my $thing = shift;
print <<"END_MESSAGE";
view release on metacpan or search on metacpan
memcache.pm view on Meta::CPAN
# Combine Session space and ID for truly unique ID
# TODO: Add self to have session instance specific $sess_space
sub _useid {
if ($trace) {
require Data::Dumper;
my @ci = caller(1);
#print(Data::Dumper::Dumper(\@ci));
print("$ci[3] : useid: $sess_space:$_[0]\n");}
# Allow instace specific ID-space prefix ???
# my $use_space = $_[1] && $_[1]->{'space'} ? $_[1]->{'space'} : $sess_space;
"$sess_space:$_[0]";
view release on metacpan or search on metacpan
lib/CGI/Simple.pm view on Meta::CPAN
sub _shift_if_ref { shift if ref $_[0] eq 'CGI::Simple' }
sub ReadParse {
my $q = &_shift_if_ref || CGI::Simple->new;
my $pkg = caller();
no strict 'refs';
*in
= @_
? $_[0]
: *{"${pkg}::in"}; # set *in to passed glob or export *in
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
@found;
}
sub _caller {
my $depth = 0;
my $caller = caller($depth);
while ($caller eq __PACKAGE__) {
$depth++;
$caller = caller($depth);
}
$caller;
}
view release on metacpan or search on metacpan
# void import(...)
# Called on 'use'.
sub import
{ my ($pkg, $opt)=@_;
my $caller = caller();
export_vars($opt, $caller) if $opt;
no strict;
foreach (@EXPORT) {
my ($type, $name) = /^([%@\$]?)(.*)$/s;
if ($type eq '%') {
view release on metacpan or search on metacpan
lib/CGI/Widget/DBI/Search/Base.pm view on Meta::CPAN
return $self;
}
sub caller_function {
my ($self, $stacklvl) = @_;
my ($func) = ( (caller($stacklvl || 1))[3] =~ m/::([^:]+)\z/ );
return $func || '';
}
sub log_error {
my ($self, $msg) = @_;
view release on metacpan or search on metacpan
lib/CGI/Wiki/Search/Base.pm view on Meta::CPAN
use Carp "croak";
use vars qw( @ISA $VERSION );
sub _abstract {
my $who = (caller(1))[3];
croak "$who is an abstract method which the ".(ref shift).
" class has not provided";
}
$VERSION = 0.01;
view release on metacpan or search on metacpan
XMLApplication.pm view on Meta::CPAN
# application related ############################################
# both functions are only for backward compatibilty with older scripts
sub debug_msg {
my $level = shift;
if ( $level <= $CGI::XMLApplication::DEBUG && scalar @_ ) {
my ($module, undef, $line) = caller(1);
warn "[$module; line: $line] ", join(' ', @_) , "\n";
}
}
##