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
lib/CGI/Carp/Throw.pm view on Meta::CPAN
# unless the exception came from one of our throw_browser routines.
#####################################################################
*CGI::Carp::fatalsToBrowser = sub {
my $msg = shift;
my($pack,undef,undef,$sub) = caller(2);
if (($sub || '') =~ /::_throw_browser$/) {
die_msg_io($msg);
}
else {
$old_fatals_to_browser->($msg)
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
{
my $modfile = $Module;
$modfile =~ s/::/\//g;
my($i,$p,$filename)=0;
while( ($p,$filename) = caller(++$i) )
{
last unless $filename =~ /\/$modfile\.pm$/;
}
warn "$filename: $Module can't be used under mod_perl\n";
view release on metacpan or search on metacpan
lib/CGI/Ex/Conf.pm view on Meta::CPAN
my $args = shift;
if (! eval { require YAML }) {
my $err = $@;
my $found = 0;
my $i = 0;
while (my($pkg, $file, $line, $sub) = caller($i++)) {
return undef if $sub =~ /\bpreload_files$/;
}
die $err;
}
view release on metacpan or search on metacpan
lib/CGI/ExceptionManager/StackTrace.pm view on Meta::CPAN
sub new {
my ($klass, $message) = @_;
my @trace;
for (my $i = 1; my ($package, $file, $line) = caller($i); $i++) {
push @trace, {
file => $file,
line => $line,
func => undef,
};
if (my @c = caller($i + 1)) {
$trace[-1]->{func} = $c[3]
if $c[3];
}
}
if ($message =~ / at ([^ ]+) line (\d+)/