view release on metacpan or search on metacpan
lib/App/Packager.pm view on Meta::CPAN
}
push( @syms, $_ );
}
if ( $rsc ) {
my $pkg = (caller)[0];
no strict 'refs';
*{ $pkg . "::" . $rsc } = \&getresource;
}
# Dispatch to super.
view release on metacpan or search on metacpan
lib/App/RPi/EnvUI/API.pm view on Meta::CPAN
return $api if defined $api;
}
my $self = bless {}, shift;
my $caller = (caller)[0];
$self->_args(@_, caller => $caller);
warn "API in test mode\n" if $self->testing;
$self->_init;
view release on metacpan or search on metacpan
local/lib/perl5/Net/SFTP/Foreign/Compat.pm view on Meta::CPAN
for my $method (@forbidden) {
my $super = "SUPER::$method";
no strict 'refs';
*{$method} = sub {
unless (index((caller)[0], "Net::SFTP::Foreign") == 0) {
croak "Method '$method' is not available from " . __PACKAGE__
. ", use the real Net::SFTP::Foreign if you want it!";
}
shift->$super(@_);
};
view release on metacpan or search on metacpan
lib/App/Stash.pm view on Meta::CPAN
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
unless ( $self->application ) {
my $caller = (caller)[0];
$self->application($caller);
}
unless ( $self->directory ) {
my $dir = dir( home(), "." . $self->_clean( $self->application ));
view release on metacpan or search on metacpan
lib/App/Wallflower.pm view on Meta::CPAN
],
);
sub new_with_options {
my ( $class, $args ) = @_;
my $input = (caller)[1];
$args ||= [];
# save previous configuration
my $save = Getopt::Long::Configure();
view release on metacpan or search on metacpan
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
my $pkg = ref $self || $self;
return ${pkg}->VERSION($wanted);
}
sub heavy_export_tags {
_push_tags((caller)[0], "EXPORT", \@_);
}
sub heavy_export_ok_tags {
_push_tags((caller)[0], "EXPORT_OK", \@_);
}
1;
EXPORTER_HEAVY
view release on metacpan or search on metacpan
t/t_TestCommon.pm view on Meta::CPAN
# This is only visible with using "perl -Ilib t/xxx.t"
# not with 'prove -l' and so mostly pointless!
sub t_ok($;$) {
my ($isok, $test_label) = @_;
my $lno = (caller)[2];
$test_label = ($test_label//"") . " (line $lno)";
@_ = ( $isok, $test_label );
goto &Test2::V0::ok; # show caller's line number
}
sub ok_with_lineno($;$) { goto &t_ok };
sub t_is($$;$) {
my ($got, $exp, $test_label) = @_;
my $lno = (caller)[2];
$test_label = ($test_label//$exp//"undef") . " (line $lno)";
@_ = ( $got, $exp, $test_label );
goto &Test2::V0::is; # show caller's line number
}
sub is_with_lineno($$;$) { goto &t_is }
sub t_like($$;$) {
my ($got, $exp, $test_label) = @_;
my $lno = (caller)[2];
$test_label = ($test_label//$exp) . " (line $lno)";
@_ = ( $got, $exp, $test_label );
goto &Test2::V0::like; # show caller's line number
}
sub like_with_lineno($$;$) { goto &t_like }
sub _mycheck_end($$$) {
my ($errmsg, $test_label, $ok_only_if_failed) = @_;
return
if $ok_only_if_failed && !$errmsg;
my $lno = (caller)[2];
&Test2::V0::diag("**********\n${errmsg}***********\n") if $errmsg;
@_ = ( !$errmsg, $test_label );
goto &ok_with_lineno;
}
view release on metacpan or search on metacpan
lib/AppleII/Disk.pm view on Meta::CPAN
$data .= $pad x ($length - length($data))
if (length($pad) and length($data) < $length);
unless (length($data) == $length) {
local $Carp::CarpLevel = $Carp::CarpLevel;
++$Carp::CarpLevel if (caller)[0] =~ /^AppleII::Disk::/;
croak(sprintf("Data block is %d bytes",length($data)));
}
$data;
} # end AppleII::Disk::pad_block
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/Archive/Zip/Parser/Exception.pm view on Meta::CPAN
use strict;
use Carp;
sub _croak {
my ( $self, $error_message ) = @_;
my $caller_package = (caller)[0];
croak "[$caller_package] $error_message";
}
1;
view release on metacpan or search on metacpan
lib/Array/Iterator.pm view on Meta::CPAN
=cut
# We need to alter this so it's an lvalue
sub _current_index : lvalue {
(UNIVERSAL::isa((caller)[0], __PACKAGE__))
|| die 'Illegal Operation: This method can only be called by a subclass';
$_[0]->{_current_index}
}
=head2 _iteratee
lib/Array/Iterator.pm view on Meta::CPAN
=cut
# This we should never need to alter so we don't make it a lvalue
sub _iteratee {
(UNIVERSAL::isa((caller)[0], __PACKAGE__))
|| die 'Illegal Operation: This method can only be called by a subclass';
$_[0]->{_iteratee}
}
# we move this from a private method
# to a protected one, and check our access
# as well
sub _getItem {
(UNIVERSAL::isa((caller)[0], __PACKAGE__)) || die 'Illegal Operation: This method can only be called by a subclass';
my ($self, $iteratee, $index) = @_;
return $iteratee->[$index];
}
lib/Array/Iterator.pm view on Meta::CPAN
sub _get_item { my $self = shift; $self->_getItem(@_) }
# we need to alter this so it's an lvalue
sub _iterated : lvalue {
(UNIVERSAL::isa((caller)[0], __PACKAGE__))
|| die 'Illegal Operation: This method can only be called by a subclass';
$_[0]->{_iterated}
}
=head2 iterated
view release on metacpan or search on metacpan
#------------------------------------------------------------------------------
# TEST
sub t_get {
my($type, $value, $text, $file, $line_nr) = @_;
my $id = "[line ".(caller)[2]."]";
if (defined $type) {
isa_ok $token = $lex->(), 'Asm::Preproc::Token';
is $token->type, $type, "$id type $type";
is $token->value, $value, "$id value $value";
view release on metacpan or search on metacpan
lib/AtExit.pm view on Meta::CPAN
unless (ref $exit_sub) {
## Caller gave us a sub name instead of a sub reference.
## Need to make sure we have the callers package prefix
## prepended if one wasn't given.
my $pkg = '';
$pkg = (caller)[0] . "::" unless $exit_sub =~ /::/o;
## Now turn the sub name into a hard sub reference.
$exit_sub = eval "\\&$pkg$exit_sub";
undef $exit_sub if ($@);
}
view release on metacpan or search on metacpan
lib/Attribute/Abstract.pm view on Meta::CPAN
sub UNIVERSAL::Abstract :ATTR(CODE) {
my ($pkg, $symbol) = @_;
no strict 'refs';
my $sub = $pkg . '::' . *{$symbol}{NAME};
*{$sub} = sub {
my ($file, $line) = (caller)[1,2];
die "call to abstract method $sub at $file line $line.\n";
};
}
"Rosebud"; # for MARCEL's sake, not 1 -- dankogai
view release on metacpan or search on metacpan
@ISA = qw(DynaLoader);
__PACKAGE__->bootstrap($VERSION);
if ((caller)[0] eq 'Xmms') {
eval join '', <DATA>;
print $@ if $@;
unless (defined &Xmms::is_cpl) {
*Xmms::is_cpl = sub {0};
}
view release on metacpan or search on metacpan
return $msg;
}
sub d {
warn format_msg( (caller)[1,2], @_ );
}
sub d_to {
my $fh = shift;
print $fh format_msg( (caller)[1,2], @_ );
}
sub d_to_string {
format_msg( (caller)[1,2], @_ );
}
=head1 LIMITATIONS
view release on metacpan or search on metacpan
lib/Backup/EZ.pm view on Meta::CPAN
sub _debug {
my $self = shift;
my $msg = shift;
my $line = (caller)[2];
openlog "ezbackup", $self->{syslog_option}, LOG_SYSLOG;
syslog LOG_DEBUG, "($line) $msg";
closelog;
}
view release on metacpan or search on metacpan
lib/Beekeeper/Client.pm view on Meta::CPAN
sub accept_notifications {
my ($self, %args) = @_;
my ($file, $line) = (caller)[1,2];
my $at = "at $file line $line\n";
my $callbacks = $self->{_CLIENT}->{callbacks};
foreach my $fq_meth (keys %args) {
lib/Beekeeper/Client.pm view on Meta::CPAN
sub stop_accepting_notifications {
my ($self, @methods) = @_;
my ($file, $line) = (caller)[1,2];
my $at = "at $file line $line\n";
croak "No method specified" unless @methods;
foreach my $fq_meth (@methods) {
view release on metacpan or search on metacpan
lib/BerkeleyDB/Easy/Common.pm view on Meta::CPAN
# specification, generate a BerkeleyDB.pm wrapper function. Otherwise, make
# a simple object accessor.
#
sub _install {
my ($self, $name, $spec) = @_;
my ($pack, $file, $line) = (caller)[0..2];
DEBUG and $self->_debug(qq(Installing method stub: $name));
my $stub = sub {
my $code = $spec
lib/BerkeleyDB/Easy/Common.pm view on Meta::CPAN
# file and line number of our caller, the site of the template definition.
# (Internal method, used by _generate and _accessor)
#
sub _lines {
my $self = shift;
my ($file, $line) = (caller)[1..2];
join qq(# line $line $file(EVAL)\n),
map { (my $ln = $_) =~ s/\s*$/\n/; $ln }
grep $_, @_;
}
view release on metacpan or search on metacpan
lib/Ebig5.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/BingoX/Carbon.pm view on Meta::CPAN
=cut
sub import {
my $self = shift;
my $myclass = ref($self) || $self;
my $class = (caller)[0];
my @args = @_;
warn "BingoX::Carbon: import: class=$class: @args myclass=$myclass" if ($debug);
## Initialize special content and date field methods
no strict 'refs';
view release on metacpan or search on metacpan
lib/Bitcoin/Crypto/Helpers.pm view on Meta::CPAN
{
my ($msg) = @_;
return if $warned{$msg};
$warned{$msg} = 1;
local @CARP_NOT = ((caller)[0]);
carp($msg);
}
sub pad_hex
{
view release on metacpan or search on metacpan
lib/Bot/BasicBot/CommandBot.pm view on Meta::CPAN
my %command;
my %autocommand;
sub command {
(caller)[0]->declare_command(@_);
}
sub autocommand {
(caller)[0]->declare_autocommand(@_);
}
sub declare_autocommand {
my ($package, $sub) = @_;
$autocommand{$package} = $sub;
lib/Bot/BasicBot/CommandBot.pm view on Meta::CPAN
This can be helpful if you don't want to put all your commands in the same
module - you can declare them all on the same package.
sub import {
my $caller = (caller)[0];
$caller->declare_command(...);
}
=head2 autocommand
view release on metacpan or search on metacpan
lib/Bot/Cobalt/Core/ContextMeta/Ignore.pm view on Meta::CPAN
around add => sub {
my $orig = shift;
my ($self, $context, $mask, $reason, $addedby) = @_;
my ($pkg, $line) = (caller)[0,2];
confess "Missing arguments in ignore add()"
unless defined $context and defined $mask;
$mask = normalize_mask($mask);
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
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;