view release on metacpan or search on metacpan
lib/Ewindows1258.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/Workflow/Exception.pm view on Meta::CPAN
my ( $type, @items ) = @_;
my ( $msg, %params ) = _massage(@items);
my $caller = caller;
my $log = Log::Any->get_logger( category => $caller ); # log as if part of the package of the caller
my ( $pkg, $line ) = (caller)[ 0, 2 ];
my ( $prev_pkg, $prev_line ) = ( caller 1 )[ 0, 2 ];
# Do not log condition errors
my $method = $TYPE_LOGGING{$type};
$log->$method(
view release on metacpan or search on metacpan
lib/XML/API.pm view on Meta::CPAN
$rootattrs->{$key} = $val;
}
$attrs = $rootattrs;
}
my ( $file, $line ) = (caller)[ 1, 2 ] if ( $self->{debug} );
if ( $self->{langnext} ) {
$attrs->{'xml:lang'} = delete $self->{langnext};
}
if ( $self->{dirnext} ) {
lib/XML/API.pm view on Meta::CPAN
sub _close {
my $self = shift;
my $element = shift || croak '_close($element)';
my ( $file, $line ) = (caller)[ 1, 2 ] if ( $self->{debug} );
if ( !$self->{current} ) {
carp 'attempt to close non-existent element "' . $element . '"';
return;
}
view release on metacpan or search on metacpan
t/05-wrongs.t view on Meta::CPAN
use XML::Fast 'xml2hash';
sub dies_ok(&;@) {
my $code = shift;
my $name = pop || 'line '.(caller)[2];
my $qr = shift;
local $@;
if( eval { $code->(); 1} ) {
fail $name;
} else {
view release on metacpan or search on metacpan
lib/XML/Filter/Dispatcher/Parser.pm view on Meta::CPAN
: $_
: "<undef>" ,
@_
),
" (grammar rule at ",
(caller)[1],
", line ",
(caller)[2],
")"
);
return ();
}
view release on metacpan or search on metacpan
lib/XML/Hash/LX.pm view on Meta::CPAN
#warn "@rv";
return wantarray ? @rv : $rv[0];
}
sub hash2xml($;%) {
#warn "hash2xml(@_) from @{[ (caller)[1,2] ]}";
my $hash = shift;
my %opts = @_;
my $str = delete $opts{doc} ? 0 : 1;
my $encoding = delete $opts{encoding} || delete $opts{enc} || 'utf-8';
my $doc = XML::LibXML::Document->new('1.0', $encoding);
view release on metacpan or search on metacpan
hax/make_argcheck_ops.c.inc view on Meta::CPAN
#define make_croak_op(message) S_make_croak_op(aTHX_ message)
static OP *S_make_croak_op(pTHX_ SV *message)
{
#if HAVE_PERL_VERSION(5, 22, 0)
sv_catpvs(message, " at %s line %d.\n");
/* die sprintf($message, (caller)[1,2]) */
return op_convert_list(OP_DIE, 0,
op_convert_list(OP_SPRINTF, 0,
op_append_list(OP_LIST,
newSVOP(OP_CONST, 0, message),
newSLICEOP(0,
view release on metacpan or search on metacpan
xsc_test.pl view on Meta::CPAN
# The tests in lib run in a temporary subdirectory of t, and always
# pass in a list of "programs" to run
@prgs = @_;
} else {
# The tests below t run in t and pass in a file handle. In theory we
# can pass (caller)[1] as the second argument to report errors with
# the filename of our caller, as the handle is always DATA. However,
# line numbers in DATA count from the __END__ token, so will be wrong.
# Which is more confusing than not providing line numbers. So, for now,
# don't provide line numbers. No obvious clean solution - one hack
# would be to seek DATA back to the start and read to the __END__ token,
view release on metacpan or search on metacpan
t/XSLoader.t view on Meta::CPAN
package Foo::Bar;
XSLoader::load("Foo::Bar");
END
the_test:
ok $fell_back,
'XSLoader will not load relative paths based on (caller)[1]';
File::Path::rmtree($name);
}
view release on metacpan or search on metacpan
lib/YAML/Active.pm view on Meta::CPAN
node_activate(YAML::XS::LoadFile($node), $phase);
}
sub assert_arrayref {
return if UNIVERSAL::isa($_[0], 'ARRAY');
die sprintf "%s expects an array ref", (caller)[0];
}
sub assert_hashref {
return if UNIVERSAL::isa($_[0], 'HASH');
die sprintf "%s expects a hash ref", (caller)[0];
}
sub yaml_NULL { bless {}, NULL }
# end of activation-related code
# start of dump-related code
view release on metacpan or search on metacpan
lib/Youri/Config.pm view on Meta::CPAN
GetOptions(@args);
if ($args->{help}) {
if (!@ARGV) {
# standard help, available immediatly
my $filename = (caller)[1];
pod2usage(
-input => $filename,
-verbose => 0
);
}
view release on metacpan or search on metacpan
lib/Zoidberg/Utils/GetOpt.pm view on Meta::CPAN
if (! $type) { # no arg
error "option '$opt' doesn't take an argument" if defined $arg;
$opts{$opt} = ($pre eq '+') ? 0 : 1;
}
elsif (ref $type) { # CODE ... for default opts
output $type->( (caller(1))[3], (caller)[0] ); # subroutine, package
error {silent => 1, exit_status => 0}, 'getopt needed to pop stack';
}
else {
$arg = defined($arg) ? $arg : shift(@args);
error "option '$opt' requires an argument" unless defined $arg;
view release on metacpan or search on metacpan
local/lib/perl5/LWP/UserAgent.pm view on Meta::CPAN
}
sub add_handler {
my($self, $phase, $cb, %spec) = @_;
$spec{line} ||= join(":", (caller)[1,2]);
my $conf = $self->{handlers}{$phase} ||= do {
require HTTP::Config;
HTTP::Config->new;
};
$conf->add(%spec, callback => $cb);
local/lib/perl5/LWP/UserAgent.pm view on Meta::CPAN
sub set_my_handler {
my($self, $phase, $cb, %spec) = @_;
$spec{owner} = (caller(1))[3] unless exists $spec{owner};
$self->remove_handler($phase, %spec);
$spec{line} ||= join(":", (caller)[1,2]);
$self->add_handler($phase, $cb, %spec) if $cb;
}
sub get_my_handler {
my $self = shift;
local/lib/perl5/LWP/UserAgent.pm view on Meta::CPAN
elsif (ref($init) eq "HASH") {
$spec{$_}= $init->{$_}
for keys %$init;
}
$spec{callback} ||= sub {};
$spec{line} ||= join(":", (caller)[1,2]);
$conf->add(\%spec);
return \%spec;
}
return wantarray ? @h : $h[0];
}
view release on metacpan or search on metacpan
-e $so or die;
}
sub bootstrap {
my $p = shift;
my ($q, $qpm) = (caller)[0, 1];
my ($qc, $qso);
local *XSUB = \@{$XSUB{$qpm}};
defined @XSUB or return;
view release on metacpan or search on metacpan
lib/Fatal.pm view on Meta::CPAN
croak(sprintf(ERROR_NO_LEX,$class));
}
shift @_; # Remove :lexical
my $pkg = (caller)[0];
# If we've been called with arguments, then the developer
# has explicitly stated 'no autodie qw(blah)',
# in which case, we disable Fatalistic behaviour for 'blah'.
view release on metacpan or search on metacpan
bitflags.pm view on Meta::CPAN
my $i = .5;
sub import {
my $self = shift;
my $caller = (caller)[0];
if ($_[0] =~ /^:start=(\^?)(\d+)$/) {
if ($1) { $i = 2 ** ($2-1) }
elsif ($2 & ($2 - 1)) {
require Carp;
view release on metacpan or search on metacpan
lib/criticism.pm view on Meta::CPAN
#-----------------------------------------------------------------------------
sub import {
my ($pkg, @args) = @_;
my $file = (caller)[1];
return 1 if not -f $file;
my %pc_args = _make_pc_args( @args );
return _critique( $file, %pc_args );
}
view release on metacpan or search on metacpan
lib/deferred.pm view on Meta::CPAN
return;
}
for my $enabled(@enabled) {
if($module =~ $enabled) {
$half_loaded{$module} = join ":", (caller)[1,2];
open my $fh, "<", \"1";
return $fh;
}
}
view release on metacpan or search on metacpan
lib/define.pm view on Meta::CPAN
STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG
};
sub import {
my $class = shift;
my $pkg = (caller)[0];
if( @_ ) {
if( ref $_[0] eq 'HASH' ) {
while( my( $name, $val ) = each %{$_[0]} ) {
do_import( $pkg, $name, $val );
}
lib/define.pm view on Meta::CPAN
}
}
sub unimport {
my $class = shift;
my $pkg = (caller)[0];
if( @_ ) {
check_name( my $name = shift );
$DefPkgs{$name}{$pkg} = 1;
if( $Vals{$name} ) {
makedef( $pkg, $name, @{$Vals{$name}} );
view release on metacpan or search on metacpan
delay_use.pm view on Meta::CPAN
our $DEBUG = 0;
our $ABORT = 0;
our %INC = ();
sub delay_use {
my $pkg = shift;
my $caller = (caller)[0] || 'main';
my $func = $INC{$pkg} ||= eval qq{
sub {
package $caller;
eval qq{require $pkg};
if(\$@){
view release on metacpan or search on metacpan
lib/gerr.pm view on Meta::CPAN
################################################################################
sub Warn {
my ($message) = @_;
my $file = (caller)[1];
my $line = (caller)[2];
my $formatted_message = error("$message at $file line $line.", "return=1", "type=Warning", "trace=3");
if (ref($SIG{__WARN__}) eq 'CODE') {
$SIG{__WARN__}->($formatted_message);
} else {
binmode STDERR, ":encoding(UTF-8)"; # Set UTF-8 encoding for STDERR
lib/gerr.pm view on Meta::CPAN
################################################################################
sub Die {
my ($message) = @_;
my $file = (caller)[1];
my $line = (caller)[2];
my $formatted_message = error("$message at $file line $line.", "return=1", "type=Fatal", "trace=3");
if (ref($SIG{__DIE__}) eq 'CODE') {
$SIG{__DIE__}->($formatted_message);
} else {
binmode STDERR, ":encoding(UTF-8)"; # Set UTF-8 encoding for STDERR
view release on metacpan or search on metacpan
HTPL-modules/lib/HTML/HTPL/Munge.pm view on Meta::CPAN
use strict;
use vars qw(%variables);
use Carp;
sub import {
my $pkg = (caller)[0];
my $class = shift;
$variables{$pkg} = [ @_ ];
filter_add(bless {'pkg' => $pkg});
Exporter::export('HTML::HTPL::Munge::Stub', $pkg, 'AUTOLOAD');
view release on metacpan or search on metacpan
lib/i18n.pm view on Meta::CPAN
my $pkg = $_[0][PACKAGE];
@_ = reverse(@_) if pop;
return join( '', @_ ) unless warnings::enabled($class);
my $line = (caller)[2];
my ( $seen, @data );
foreach (@_) {
( push( @data, bless( \\$_, "$class\::var" ) ), next )
unless ref($_)
view release on metacpan or search on metacpan
lib/ifdef.pm view on Meta::CPAN
# being called from source (unless it's from the test-suite)
warn "The '".
__PACKAGE__.
"' pragma is not supposed to be called from source\n"
if ( (caller)[2] ) and ( $_[0] ne '_testing_' and !shift );
# lose the class
shift;
# check all parameters
view release on metacpan or search on metacpan
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD;
}
else
{
my ($file,$line) = (caller)[1,2];
die "Your vendor has not defined $Package macro $constname, used in $file at line $line.";
}
}
eval "sub $AUTOLOAD { $val }";
view release on metacpan or search on metacpan
lib/lib/abs.pm view on Meta::CPAN
BEGIN { *DEBUG = sub () { 0 } unless defined &DEBUG } # use constants is heavy
sub _carp { require Carp; goto &Carp::carp }
sub _croak { require Carp; goto &Carp::croak }
sub _debug ($@) { printf STDERR shift()." at @{[ (caller)[1,2] ]}\n",@_ }
sub mkapath($) {
my $depth = shift;
# Prepare absolute base bath
view release on metacpan or search on metacpan
lib/lib/archive.pm view on Meta::CPAN
sub import {
my ( $class, @entries ) = @_;
my %cache;
my $caller_file = (caller)[1];
my $under_debugger = defined($DB::single);
my $extract_dir = $ENV{PERL_LIB_ARCHIVE_EXTRACT} // "$home/.lib_archive_extract";
for my $entry (@entries) {
my $is_url = $entry =~ /$rx_url/;
view release on metacpan or search on metacpan
lib/lib/relative.pm view on Meta::CPAN
our $VERSION = '1.002';
sub import {
my ($class, @paths) = @_;
my $file = (caller)[1];
my $dir = -e $file ? File::Basename::dirname(Cwd::abs_path $file) : Cwd::getcwd;
lib->import(map { File::Spec->file_name_is_absolute($_) ? $_ : File::Spec->catdir($dir, $_) } @paths);
}
1;
view release on metacpan or search on metacpan
lib/LWP/UserAgent.pm view on Meta::CPAN
}
sub add_handler {
my($self, $phase, $cb, %spec) = @_;
$spec{line} ||= join(":", (caller)[1,2]);
my $conf = $self->{handlers}{$phase} ||= do {
require HTTP::Config;
HTTP::Config->new;
};
$conf->add(%spec, callback => $cb);
lib/LWP/UserAgent.pm view on Meta::CPAN
sub set_my_handler {
my($self, $phase, $cb, %spec) = @_;
$spec{owner} = (caller(1))[3] unless exists $spec{owner};
$self->remove_handler($phase, %spec);
$spec{line} ||= join(":", (caller)[1,2]);
$self->add_handler($phase, $cb, %spec) if $cb;
}
sub get_my_handler {
my $self = shift;
lib/LWP/UserAgent.pm view on Meta::CPAN
elsif (ref($init) eq "HASH") {
$spec{$_}= $init->{$_}
for keys %$init;
}
$spec{callback} ||= sub {};
$spec{line} ||= join(":", (caller)[1,2]);
$conf->add(\%spec);
return \%spec;
}
return wantarray ? @h : $h[0];
}
view release on metacpan or search on metacpan
$INC{$file} = $prefix_file_oo;
# run as Perl script
# must use CORE::do to use <DATA>, because CORE::eval cannot do it
# moreover "goto &CORE::do" doesn't work
return CORE::eval sprintf(<<'END', (caller)[0,2,1]);
package %s;
#line %s "%s"
CORE::do "$prefix_file_oo";
END
}
# eval STRING for MBCS encoding
sub mb::eval (;$) {
local $_ = @_ ? $_[0] : $_;
# run as Perl script in caller package
return CORE::eval sprintf(<<'END', (caller)[0,2,1], mb::parse());
package %s;
#line %s "%s"
%s
END
}
$INC{$_} = $prefix_file_oo;
# run as Perl script
# must use CORE::do to use <DATA>, because CORE::eval cannot do it.
local $@;
my $result = CORE::eval sprintf(<<'END', (caller)[0,2,1]);
package %s;
#line %s "%s"
CORE::do "$prefix_file_oo";
END