view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# 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
lib/CGI/Alert.pm view on Meta::CPAN
Otherwise, don't panic: I have sent a notification to the
[MAINTAINER], providing details of the error.
</p>
-
# For stack trace: names of the fields returned by caller(), in order.
our @Caller_Fields =
qw(
package
filename
line
lib/CGI/Alert.pm view on Meta::CPAN
# Get a full callback history, first-is-first (that is, the
# main script is first, instead of the usual most-recent-first).
# @levels will be a LoH, an array containing hashrefs.
#
# See perlfunc(1) for details on caller() and the 'DB' hack.
my $i = 0;
my @call_info;
while (do { { package DB; @call_info = caller($i++) } } ) {
unshift @levels, {
(map { $_ => shift @call_info } @Caller_Fields),
args => [ @DB::args ],
};
}
view release on metacpan or search on metacpan
$tx1 = "# File Name: $dtl\n# Start at $stm\n";
print $fh_dtl $tx1;
return $ar if ! $brf;
my ($pkg, $fn, $line, $subroutine, $hasargs, $wantarray,
$evaltext, $is_require, $hints, $bitmask) = caller(3);
$subroutine = 'start_log' if ! $subroutine;
$tx1 = "# File Name: $brf\n# Generated By: $subroutine\n";
$tx1 .= "# Fields: (elapsed times are in seconds)\n";
$cn1 = $cns; $cn1 =~ s/,/\|/g;
$tx1 .= "# $cn1\n";
view release on metacpan or search on metacpan
MapDisp2.pm view on Meta::CPAN
=cut
sub upload_sas_script {
my ($s, $q, $ar) = @_;
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
$s->disp_header($q,$ar,1);
MapDisp2.pm view on Meta::CPAN
sub get_scrnames {
my ($s, $ar) = @_;
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
my $ds = (exists $ar->{dir_sep}) ? $ar->{dir_sep} : '';
$ds = ($^O =~ /MSWin/i)? '\\': '/' if ! $ds;
MapDisp2.pm view on Meta::CPAN
my ($s, $dir) = @_;
# $dir - directory
# $package, $filename, $line, $subroutine, $hasargs,
# $wantarray, $evaltext, $is_require, $hints, $bitmask
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
if (! -d $dir) {
eval { mkpath($dir,0,0777) };
MapDisp2.pm view on Meta::CPAN
my ($s, $ffn, $ar) = @_;
# $ffn - file name
# $ar - parameter array
# $bdr - backup dir
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
my $ds = ($^O =~ /MSWin/i)? '\\': '/';
my ($bcp) = $s->get_params('bak_copies',$ar);
view release on metacpan or search on metacpan
my ($s, $q, $ar) = @_;
# print $s->disp_form($q, $ar);
print $s->disp_header($q, $ar);
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
# 1. check required parameters
$s->echo_msg("1. checking required parameters...", 2);
}
sub call_plsql {
my ($s, $rr, $ar) = @_;
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
my $vs = 'dir_sep,sql_cfn,sql_cs';
my ($ds,$cfn,$cs) = $s->get_params($vs, $ar);
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
lib/CGI/Application/Framework.pm view on Meta::CPAN
# -------------------------------------------------------
return $self->log_confess
(
__PACKAGE__
. " only implements a virtual interface method for ["
. (caller(1))[3]
. "] -- implement this yourself in a subclass! "
);
# -------------------------------------------------------
}
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;
}
# Done in evals to avoid confusing Perl::MinimumVersion
view release on metacpan or search on metacpan
lib/CGI/Application/Pluggable.pm view on Meta::CPAN
use UNIVERSAL::require '0.10';
our $VERSION = '0.03';
sub import {
my ( $self, @options ) = @_;
my $caller = caller(0);
{
no strict 'refs';
push @{"$caller\::ISA"}, $self;
}
view release on metacpan or search on metacpan
lib/CGI/Application/Plugin/AnyCGI.pm view on Meta::CPAN
else {
$dump = \@_;
}
}
my ( $package, $line, $sub ) = (caller())[0,2,3];
my ( $callerpackage, $callerline, $callersub )
= (caller(1))[0,2,3];
$sub ||= '-';
print "\n",
join( ' | ', $package, $line, $sub ),
view release on metacpan or search on metacpan
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
sub log_warn {
# Try to make our call stack invisible
shift;
if (@_ and $_[-1] !~ /\n$/) {
my (undef, $file, $line) = caller();
warn @_, " at $file line $line.\n";
} else {
warn @_;
}
}
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/Application/Plugin/Config/Any.pm view on Meta::CPAN
else {
$dump = \@_;
}
}
my ( $package, $line, $sub ) = (caller())[0,2,3];
my ( $callerpackage, $callerline, $callersub )
= (caller(1))[0,2,3];
$sub ||= '-';
print "\n",
join( ' | ', $package, $line, $sub ),
view release on metacpan or search on metacpan
lib/CGI/Application/Plugin/DebugMessage.pm view on Meta::CPAN
sub debug {
my $self = shift;
my @added = @_;
if (@added) {
my $footer = $self->param("${prefix}_footer") || [];
my $caller = bless([caller(0)], "${prefix}::Caller");
@added = map { [$caller, $_] } @added;
push(@{$footer}, @added);
$self->param("${prefix}_footer" => $footer)
}
}
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
lib/CGI/Application/Plugin/DeclareREST.pm view on Meta::CPAN
sub get {
my $sub = pop;
my ($path, %args) = @_;
my $caller = caller();
my $router = $routes{ $caller } ||= Routes::Tiny->new( strict_trailing_slash => 0 );
return $router->add_route($path, method => 'get', name => $sub, %args);
}
sub post {
my $sub = pop;
my ($path, %args) = @_;
my $caller = caller();
my $router = $routes{ $caller } ||= Routes::Tiny->new( strict_trailing_slash => 0 );
return $router->add_route($path, method => 'post', name => $sub, %args );
}
sub del {
my $sub = pop;
my ($path, %args) = @_;
my $caller = caller();
my $router = $routes{ $caller } ||= Routes::Tiny->new( strict_trailing_slash => 0 );
return $router->add_route($path, method => 'delete', name => $sub, %args );
}
sub put {
my $sub = pop;
my ($path, %args) = @_;
my $caller = caller();
my $router = $routes{ $caller } ||= Routes::Tiny->new( strict_trailing_slash => 0 );
return $router->add_route($path, method => 'put', name => $sub, %args );
}
sub patch {
my $sub = pop;
my ($path, %args) = @_;
my $caller = caller();
my $router = $routes{ $caller } ||= Routes::Tiny->new( strict_trailing_slash => 0 );
return $router->add_route($path, method => 'patch', name => $sub, %args );
}
sub any {
my $sub = pop;
my ($methods, $path, %args) = @_;
my $caller = caller();
my $router = $routes{ $caller } ||= Routes::Tiny->new( strict_trailing_slash => 0 );
return $router->add_route($path, method => $methods, name => $sub, %args);
}
sub import {
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
lib/CGI/Application/Plugin/HelpMan.pm view on Meta::CPAN
# first try from query
my $term = $self->query->param('query');
# then from caller
$term ||= caller; # was using caller(1), wrong.
$self->{_hm_data_}->{_man_searchterm} = $term;
debug(" term is [$term]\n");
}
return $self->{_hm_data_}->{_man_searchterm};
}
lib/CGI/Application/Plugin/HelpMan.pm view on Meta::CPAN
}
sub _set_term_as_caller {
my $self = shift;
my $caller = caller(1);
$caller or confess('caller should return');
unless( $self->hm_term_get eq $caller ){
$self->_hm_reset_data;
$self->hm_set_term($caller);
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
lib/CGI/Application/Plugin/TT.pm view on Meta::CPAN
# the directory is based on the object's package name
my $dir = File::Spec->catdir(split(/::/, ref($self)));
# the filename is the method name of the caller plus
# whatever offset the user asked for
(caller(2+$uplevel))[3] =~ /([^:]+)$/;
my $name = $1;
return File::Spec->catfile($dir, $name.'.tmpl');
}
view release on metacpan or search on metacpan
lib/CGI/Application/Plus.pm view on Meta::CPAN
, { name => 'runmode'
, default => 'start'
, validation => sub
{ croak qq(Too late to set the run mode)
if ( $_[0]->__STEP >= 2 # after prerun
&& (caller(2))[3] !~ /::_run_runmode$/
)
; 1
}
}
, { name => 'tmpl_path'
view release on metacpan or search on metacpan
lib/CGI/Buffer.pm view on Meta::CPAN
$widemess = "@_";
if($logger) {
$logger->fatal($widemess);
my $i = 1;
$logger->trace('Stack Trace');
while((my @call_details = (caller($i++)))) {
$logger->trace($call_details[1] . ':' . $call_details[2] . ' in function ' . $call_details[3]);
}
}
CORE::warn(@_); # call the builtin warn as usual
};
lib/CGI/Buffer.pm view on Meta::CPAN
# Unsafe options - must be called before output has been started
my $pos = $CGI::Buffer::buf->getpos;
if($pos > 0) {
if(defined($logger)) {
my @call_details = caller(0);
$logger->warn("Too late to call init, $pos characters have been printed, caller line $call_details[2] of $call_details[1]");
} else {
# Must do Carp::carp instead of carp for Test::Carp
Carp::carp "Too late to call init, $pos characters have been printed";
}
view release on metacpan or search on metacpan
t/01_base.t view on Meta::CPAN
$app->tt_vars(
test_sub => sub {
my $app = shift;
my $param = shift;
is( caller(), 'Template::Document', "The goto &func trick" );
isa_ok( $app, 'CGI::Builder' );
isa_ok( $app, 'TestApp6' );
is( $param, 'foobar', 'Parameter passed to sub' );
view release on metacpan or search on metacpan
lib/CGI/Builder.pm view on Meta::CPAN
}
; sub die_handler
{ my ( $s, $msg ) = @_
; for ( my $i = 1
; my $sub = (caller($i))[3]
; $i++
)
{ die $msg if $sub eq '(eval)' && (caller($i+1))[3]
}
; die sprintf 'Fatal error in phase %s for page "%s": %s'
, $s->phase
, $s->page_name
, $msg
view release on metacpan or search on metacpan
lib/CGI/Bus/fut.pm view on Meta::CPAN
my ($s,$file,$sub)=@_;
my $hdl =select();
my $ret;
if (ref($file) || ref(\$file) eq 'GLOB') {select(*$file); $ret =&$sub($hdl); select($hdl)}
else {
my $c =(caller(1) ? caller(1) .'::' : '');
local *{"${c}HANDLE"}; open("${c}HANDLE", $file) || die("open '$file': $!\n");
select ("${c}HANDLE"); $ret =&$sub($hdl); select($hdl);
close ("${c}HANDLE") || die("close '$file': $!\n");
}
$ret;
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';
return (@Existing, @Missing);
}
sub _running_under {
view release on metacpan or search on metacpan
lib/CGI/Carp/StackTrace.pm view on Meta::CPAN
=cut
BEGIN {
CGI::Carp::set_message(sub {
my $stack_trace = Devel::StackTrace::WithLexicals->new(
message => munge_error(decode_entities(shift), [ caller(3) ]),
ignore_package => [__PACKAGE__, 'CGI::Carp'],
);
print $stack_trace->as_html;
});
}
view release on metacpan or search on metacpan
# fixes GH #11 (and GH #12 in CGI::Fast since
# sub import was added to CGI::Fast in 9537f90
# so we need to move up a level to export the
# routines to the namespace of whatever is using
# CGI::Fast
($callpack, $callfile, $callline) = caller(1);
}
# To allow overriding, search through the packages
# Till we find one in which the correct subroutine is defined.
my @packages = ($self,@{"$self\:\:ISA"});
return undef unless $thingy;
return $thingy if UNIVERSAL::isa($thingy,'GLOB');
return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
if (!ref($thingy)) {
my $caller = 1;
while (my $package = caller($caller++)) {
my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy";
return $tmp if defined(fileno($tmp));
}
}
return undef;
sub ReadParse {
local(*in);
if (@_) {
*in = $_[0];
} else {
my $pkg = caller();
*in=*{"${pkg}::in"};
}
tie(%in,CGI);
return scalar(keys %in);
}