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+)/
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 {