view release on metacpan or search on metacpan
lib/Bread/Board/Service/Deferred.pm view on Meta::CPAN
}
return overload::StrVal($_[0]);
},
# cover your basic dereferncers
'%{}' => sub {
return $_[0] if (caller)[0] eq 'Bread::Board::Service::Deferred';
$_[0] = $_[0]->{service}->get;
$_[0]
},
'@{}' => sub { $_[0] = $_[0]->{service}->get; $_[0] },
'${}' => sub { $_[0] = $_[0]->{service}->get; $_[0] },
view release on metacpan or search on metacpan
t/data-test1.t view on Meta::CPAN
sub compare {
my $num = shift;
my $value = shift;
my $should_be = shift;
my ($filename, $line) = (caller)[1,2];
if ($value eq $should_be) {
print "'$value'\n" if $V > 1;
print "ok $num Line: " . $line . "\n";
} else {
view release on metacpan or search on metacpan
lib/CGI/Application/URIMapping.pm view on Meta::CPAN
foreach my $entry (@entries) {
$entry = {
path => $entry,
} unless ref $entry;
my $app = $entry->{app} || (caller)[0];
my $host = $entry->{host} || '*';
my $proto = $entry->{protocol} || 'http';
my $uri_table_entry;
my $rm;
unless ($rm = $entry->{rm}) {
view release on metacpan or search on metacpan
lib/CGI/Compile.pm view on Meta::CPAN
my($code, $path, $dir, $subname);
if (ref $script eq 'SCALAR') {
$code = $$script;
$package ||= (caller)[0];
$subname = '__CGI' . $anon{$package}++ . '__';
} else {
$code = $self->_read_source($script);
view release on metacpan or search on metacpan
t/7_template_00_base.t view on Meta::CPAN
my $test = shift;
my $vars = shift || {};
my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
my $obj = shift || $module->new(@$conf); # new object each time
my $out = '';
my $line = (caller)[2];
delete $vars->{'tt_config'};
$obj->process(\$str, $vars, \$out);
my $ok = ref($test) ? $out =~ $test : $out eq $test;
if ($ok) {
view release on metacpan or search on metacpan
lib/CGI/Ex.pm view on Meta::CPAN
} else {
if (! $ENV{'CONTENT_TYPED'}) {
print "Content-Type: $type\r\n\r\n";
$ENV{'CONTENT_TYPED'} = '';
}
$ENV{'CONTENT_TYPED'} .= sprintf("%s, %d\n", (caller)[1,2]);
}
}
### Boolean check if content has been typed
# $cgix->content_typed;
view release on metacpan or search on metacpan
lib/CGI/FormMagick.pm view on Meta::CPAN
$self->{lc($_)} = 1;
}
}
#$self->{sessiondir} = initialise_sessiondir($args{SESSIONDIR});
$self->{calling_package} = (caller)[0];
$self->{fallback_language} = undef;
return $self;
}
view release on metacpan or search on metacpan
lib/CGI/Framework.pm view on Meta::CPAN
#
# An alias to new(), to be used in nooop mode
#
sub initialize_cgi_framework {
my %para = ref($_[0]) eq "HASH" ? %{ $_[0] } : @_;
$para{callbacks_namespace} ||= (caller)[0] || "main";
return new("CGI::Framework", \%para);
}
#
# The constructor. Initializes pretty much everything, returns a new bless()ed instance
lib/CGI/Framework.pm view on Meta::CPAN
#
# We set some defaults if unsupplied
#
$para{valid_languages} ||= [];
$para{callbacks_namespace} ||= (caller)[0] || "main";
if (!$para{cookie_name}) {
$para{cookie_name} = "sessionid_$ENV{SCRIPT_NAME}";
$para{cookie_name} =~ s/[^0-9a-z]//gi;
}
if (!$para{sessions_mysql_dbh} && !$para{sessions_dir}) {
view release on metacpan or search on metacpan
lib/CGI/Info.pm view on Meta::CPAN
}
sub _find_paths {
my $self = shift;
if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
Carp::croak('Illegal Operation: This method can only be called by a subclass or ourself');
}
$self->_trace(__PACKAGE__ . ': entering _find_paths');
lib/CGI/Info.pm view on Meta::CPAN
# Allow the AUTOLOAD feature to be disabled
Carp::croak(__PACKAGE__, ": Unknown method $method") if(exists($self->{'auto_load'}) && boolean($self->{'auto_load'})->isFalse());
# Ensure the method is called on the correct package object or a subclass
return unless((ref($self) eq __PACKAGE__) || (UNIVERSAL::isa((caller)[0], __PACKAGE__)));
# Delegate to the param method
return $self->param($method);
}
view release on metacpan or search on metacpan
SecureState.pm view on Meta::CPAN
if (defined $args{'-mindSet'}) {
$cgi->{'.isforgetful'} = 0 if ($args{'-mindSet'} =~ /unforgetful/i);
} elsif ($NASTY_WARNINGS) {
warn "Programmer did not set mindset when declaring new CGI::SecureState object at ",
(caller)[1], " line ", (caller)[2], ". Please tell him/her to read the new CGI::SecureState ",
"documentation.\n";
}
#Set up long-term memory
$args{'-memory'} ||= $args{'-longTerm'} || $args{'-longterm'} || [];
view release on metacpan or search on metacpan
return $self;
}
sub import {
my $exportset = $_[1];
my $to_package = ((caller)[0]);
my $code = '';
return unless $exportset;
if ($exportset eq ':html' or $exportset eq ':standard') {
view release on metacpan or search on metacpan
lib/CLI/Helpers.pm view on Meta::CPAN
# Smarter handling of debug output
return unless $DEF{DEBUG};
# Check against caller class
my $package = exists $opts->{_caller_package} ? $opts->{_caller_package} : (caller)[0];
return unless lc $DEF{DEBUG_CLASS} eq 'all' || $package eq $DEF{DEBUG_CLASS};
# Check if we really want to debug syslog data
$opts->{syslog_level} = 'debug';
$opts->{no_syslog} //= !$DEF{SYSLOG_DEBUG};
lib/CLI/Helpers.pm view on Meta::CPAN
sub debug_var {
my $opts = {
clear => 1, # Meant for the screen
no_syslog => 1, # Meant for the screen
_caller_package => (caller)[0], # Make sure this is set on entry
};
# Merge with options
if( is_hashref($_[0]) && defined $_[1] && is_ref($_[1]) ) {
my $ref = shift;
foreach my $k (keys %{ $ref } ) {
view release on metacpan or search on metacpan
omnithreads/shared/t/av_refs.t view on Meta::CPAN
$name = '' unless defined $name;
# You have to do it this way or VMS will get confused.
print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
return $ok;
}
use ExtUtils::testlib;
view release on metacpan or search on metacpan
lib/CPANPLUS/YACSmoke/SortVers.pm view on Meta::CPAN
}
@A <=> @B;
}
sub versions() {
my $callerpkg = (caller)[0];
my $caller_a = "${callerpkg}::a";
my $caller_b = "${callerpkg}::b";
no strict 'refs';
return versioncmp($$caller_a, $$caller_b);
}
view release on metacpan or search on metacpan
t/test_utils.pl view on Meta::CPAN
sub opcodes {
my($start, $line_nr) = @_;
my @opcodes;
my $caller_line = (caller)[2];
ok $caller_line, "[line $caller_line] opcodes";
for (0..2) {
isa_ok my $line = Asm::Preproc::Line->new("line ".($line_nr+$_)."\n",
t/test_utils.pl view on Meta::CPAN
sub test_line { my($text, $line_nr, $file) = @_;
our $stream;
my $caller_line = (caller)[2];
my $token = $stream->next;
isa_ok $token, 'Asm::Preproc::Line';
is $text, $token->text, "[line $caller_line] text";
is $line_nr, $token->line_nr, "[line $caller_line] line_nr";
is $file, $token->file, "[line $caller_line] file";
t/test_utils.pl view on Meta::CPAN
sub test_token_line { my($text, $line_nr, $file) = @_;
our $stream;
our $line;
my $caller_line = (caller)[2];
ok my $token = $stream->peek, "[line $caller_line] peek";
isa_ok $line = $token->line, 'Asm::Preproc::Line';
is $line->text, $text, "[line $caller_line] text";
is $line->line_nr, $line_nr, "[line $caller_line] line_nr";
t/test_utils.pl view on Meta::CPAN
sub test_token { my($type, $value) = @_;
our $stream;
our $line;
my $caller_line = (caller)[2];
ok my $token = $stream->next, "[line $caller_line] drop";
is $token->type, $type, "[line $caller_line] type";
is $token->value, $value, "[line $caller_line] value";
is $token->line->text, $line->text, "[line $caller_line] text";
t/test_utils.pl view on Meta::CPAN
sub test_eof {
our $stream;
my $caller_line = (caller)[2];
is $stream->next, undef, "[line $caller_line] eof 1";
is $stream->next, undef, "[line $caller_line] eof 2";
}
1;
view release on metacpan or search on metacpan
t/Instruction.t view on Meta::CPAN
sub t_instr (@) {
my($factory, $addr, $limit, $size, $opcode, $args,
$is_call, $is_branch, $is_break_flow,
$string, $dump) = @_;
my $caller_line = (caller)[2];
ok 1, "[line $caller_line]";
isa_ok $instr = CPU::Z80::Disassembler::Instruction->$factory(
$mem, $addr, $limit),
'CPU::Z80::Disassembler::Instruction';
view release on metacpan or search on metacpan
lib/CSS/DOM/Style.pm view on Meta::CPAN
and $val = $self->getPropertyValue($prop);
@_ and $self->setProperty($prop, shift);
return $val;
} else {
die "Undefined subroutine $AUTOLOAD called at ",
join(" line ", (caller)[1,2]), ".\n";
}
}
sub DESTROY{}
}
*cssFloat = \&float;
view release on metacpan or search on metacpan
# default error handler.
package CSS::SAC::DefaultErrorHandler;
sub new { return bless [], __PACKAGE__; }
sub warning { warn "[warning] $_[1] (line " . (caller)[2] . ")"; }
sub error { warn "[error] $_[1] (line " . (caller)[2] . ")"; }
sub fatal_error { die "[fatal] $_[1] (line " . (caller)[2] . ")"; }
# #
# #
### Default Error Handler #############################################
view release on metacpan or search on metacpan
lib/Carp/Notify.pm view on Meta::CPAN
$init{'death_function'}->(%init, 'errors' => $errors);
}
else {
# this wants rework, badly
no strict 'vars';
my ($calling_package) = (caller)[0];
my $package = $calling_package . "::";
$package = $1 if $init{'death_function'} =~ s/(.+::)//;
$init{'death_function'} =~ s/^&//;
&{$package . $init{'death_function'}}(%init, 'errors' => $errors);
exit;
lib/Carp/Notify.pm view on Meta::CPAN
$func->($error);
}
elsif ($func){
# this wants reworked
no strict 'refs';
my ($calling_package) = (caller)[0];
my $package = $calling_package . "::";
$package = $1 if $$func =~ s/(.+::)//;
&{$package . $func}($error);
}
else {
view release on metacpan or search on metacpan
lib/Carrot.pm view on Meta::CPAN
# /type function
# /effect "Issues a warning only."
# //parameters
# //returns
{
# return if((caller)[RDX_CALLER_LINE] == 0); # perl -MCarrot
warn($translated_errors->message_text('require_preferred', []));
}
# =--------------------------------------------------------------------------= #
view release on metacpan or search on metacpan
lib/Earabic.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock
view release on metacpan or search on metacpan
lib/Ebig5hkscs.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock
view release on metacpan or search on metacpan
lib/Ebig5plus.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock
view release on metacpan or search on metacpan
lib/Ecyrillic.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock
view release on metacpan or search on metacpan
lib/Eeucjp.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock
view release on metacpan or search on metacpan
lib/Eeuctw.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock
view release on metacpan or search on metacpan
lib/Egb18030.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock
view release on metacpan or search on metacpan
lib/Egbk.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock
view release on metacpan or search on metacpan
lib/Egreek.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock
view release on metacpan or search on metacpan
lib/Ehp15.pm view on Meta::CPAN
elsif (defined $_[1]) {
return $_[1] . '::' . $name;
}
else {
return (caller)[0] . '::' . $name;
}
}
sub qualify_to_ref ($;$) {
if (defined $_[1]) {
no strict qw(refs);
return \*{ qualify $_[0], $_[1] };
}
else {
no strict qw(refs);
return \*{ qualify $_[0], (caller)[0] };
}
}
}
# P.714 29.2.39. flock