view release on metacpan or search on metacpan
lib/Docbook/Table.pm view on Meta::CPAN
=cut
sub new {
my $self = {};
$self->{calling_package} = (caller)[0];
bless $self;
return $self;
}
=head2 Specifying the title
view release on metacpan or search on metacpan
lib/Drogo/LoadModules.pm view on Meta::CPAN
{
$caller_dir = $path;
}
else
{
my @caller_dir = split('/', (caller)[1]);
pop @caller_dir; # trash file name
$caller_dir = join('/', @caller_dir) . '/' . $path;
}
view release on metacpan or search on metacpan
lib/Email/Send.pm view on Meta::CPAN
# Classic Interface.
sub import {
no strict 'refs';
*{(caller)[0] . '::send'} = __PACKAGE__->can('_send_function');
}
sub _send_function {
my ($mailer, $message, @args) = @_;
__PACKAGE__->new({
view release on metacpan or search on metacpan
lib/EntityModel/Resolver.pm view on Meta::CPAN
sub import {
my $class = shift;
my %args = @_;
my $model = $args{model} || EntityModel->default_model;
my $pkg = (caller)[0];
# Now we have a better idea of what we're doing, call through
# to the various import helpers to do the real work
$class->import_resolve(package => $pkg, model => $model);
}
view release on metacpan or search on metacpan
lib/EnvDir.pm view on Meta::CPAN
push @_, $dir;
$dir = $DEFAULT_ENVDIR;
}
}
elsif ( $arg eq 'envdir' ) {
my $package = (caller)[0];
no strict 'refs';
*{"$package\::envdir"} = \&envdir;
}
elsif ( $arg eq '-clean' ) {
$self = $class->_instance;
view release on metacpan or search on metacpan
lib/Error/Hierarchy/Mixin.pm view on Meta::CPAN
BEGIN {
*CORE::GLOBAL::die = sub (@) {
# Error.pm die()s as well, but we don't want an endless recursion.
CORE::die(@_) if (caller)[0] eq 'Error' || ref $_[0];
local $Error::Depth = $Error::Depth + 1; # skip this level
throw Error::Hierarchy::Internal::CustomMessage(
custom_message => join(' ', @_),);
};
}
view release on metacpan or search on metacpan
lib/Evented/Object/Hax.pm view on Meta::CPAN
our $VERSION = '5.68';
# exported import subroutine.
sub import {
my ($export_pkg, $import_pkg, @import) = (shift, (caller)[0], @_);
# import each item.
foreach my $item (@import) {
my $code = $export_pkg->can($item) or next;
export_code($import_pkg, $item, $code);
view release on metacpan or search on metacpan
lib/ExportTo.pm view on Meta::CPAN
use Carp();
use strict;
sub import{
my $pkg = (caller)[0];
{
no strict 'refs';
*{$pkg . '::export_to'} = \&export_to
if not defined &{$pkg . '::export_to'};
}
lib/ExportTo.pm view on Meta::CPAN
}
sub export_to {
shift if $_[0] eq __PACKAGE__;
my %hash = @_;
my $pkg = (caller)[0];
while(my($class, $subs) = each %hash){
if(ref $subs eq 'HASH'){
# {subname => \&coderef/subname}
while (my($sub, $cr_or_name) = each %{$subs}) {
my($cr, $subname) = ref $cr_or_name eq 'CODE' ? ($cr_or_name, undef) : (undef, $cr_or_name);
view release on metacpan or search on metacpan
lib/Exporter/Dispatch.pm view on Meta::CPAN
package Exporter::Dispatch;
use Carp qw(croak);
our $VERSION = 2.10;
sub import {
my $pkg = (caller)[0];
if (@_ > 2) {
croak 'Incorrect import list for Exporter::Dispatch';
}
elsif ($_[-1] eq 'create_dptable') {
*{"${pkg}::create_dptable"} = \&create_dptable;
view release on metacpan or search on metacpan
lib/Exporter/Heavy.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;
view release on metacpan or search on metacpan
lib/ExtUtils/MM.pm view on Meta::CPAN
unshift @ISA, $class;
sub _assert {
my $sanity = shift;
die sprintf "Assert failed at %s line %d\n", (caller)[1,2] unless $sanity;
return;
}
view release on metacpan or search on metacpan
t/ExtUtils/SVDmaker/Test.pm view on Meta::CPAN
local($\, $,); # guard against -l and other things that screw with
# print
_reset_globals();
_read_program( (caller)[1] );
my $max=0;
while (@_) {
my ($k,$v) = splice(@_, 0, 2);
if ($k =~ /^test(s)?$/) { $max = $v; }
view release on metacpan or search on metacpan
lib/FAST/Bio/MySeqI.pm view on Meta::CPAN
@ISA = qw(FAST::Bio::MyPrimarySeqI);
sub _abstractDeath {
my $self = shift;
my $package = ref $self;
my $caller = (caller)[1];
confess "Abstract method '$caller' defined in interface FAST::Bio::SeqI not implemented by pacakge $package. Not your fault - author of $package should be blamed!";
}
=head2 top_SeqFeatures
view release on metacpan or search on metacpan
t/validate.t view on Meta::CPAN
},
);
sub t($schema, $input, $output) {
my $line = (caller)[2];
my $schema_copy = dclone([$schema])->[0];
my $input_copy = dclone([$input])->[0];
#diag explain FU::Validate->compile($schema, \%validations) if $line == 95;
t/validate.t view on Meta::CPAN
is_deeply $input, $input_copy, "input modification $line";
is_deeply $res, $output, "data ok $line";
}
sub f($schema, $input, $error, @msg) {
my $line = (caller)[2];
my $schema_copy = dclone([$schema])->[0];
my $input_copy = dclone([$input])->[0];
#diag explain FU::Validate->compile($schema, \%validations) if $line == 176;
view release on metacpan or search on metacpan
lib/File/Fu.pm view on Meta::CPAN
=cut
sub THIS_FILE {
my $package = shift;
my $name = (caller)[1];
return $package->file($name);
} # end subroutine THIS_FILE definition
########################################################################
=head2 cwd
view release on metacpan or search on metacpan
lib/File/HomeDir/Tiny.pm view on Meta::CPAN
package File::HomeDir::Tiny;
$VERSION='0.01';
sub import{
shift;
"home"ne$_
&&die __PACKAGE__." does not export $_ at ".join(' line ',(caller)[1,2])
.".\n"
for@_;
*{caller()."'home"}=\&home;_:
}
eval'sub home(){'
view release on metacpan or search on metacpan
lib/File/KDBX/IO.pm view on Meta::CPAN
*$self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
};
}
sub new {
my $class = shift || (caller)[0];
my $self = bless gensym, ref($class) || $class;
tie *$self, $self if 5.005 <= $];
return $self;
}
view release on metacpan or search on metacpan
($constname = $AUTOLOAD) =~ s/.*:://;
my $val;
$val = constant($constname, @_ ? ($_[0] =~ /^\d+/ ? $_[0] : 0) : 0);
if ($!) {
if ($! =~ /Invalid/) {
my ($file, $line) = (caller)[1,2];
die "$file:$line: $constname is not a valid $SELF macro.\n";
}
}
eval "sub $AUTOLOAD { $val }";
goto &$AUTOLOAD;
view release on metacpan or search on metacpan
lib/File/ProjectHome.pm view on Meta::CPAN
Makefile.PL
Build.PL
);
sub project_home {
my $dir = dir((caller)[1]);
while (my $parent = _parent($dir)) {
for my $project_root_files (@PROJECT_ROOT_FILES) {
if (-e File::Spec->catfile($dir, $project_root_files)) {
return "$dir";
}
view release on metacpan or search on metacpan
lib/File/TreeBuilder.pm view on Meta::CPAN
our @EXPORT_OK = qw(build_tree);
# --------------------------------------------------------------------
sub build_tree {
my ($dir, $str) = @_;
my $caller_pkg = (caller)[0];
$str = q[] unless defined $str;
my @lines = split /\n/, $str;
# Remove blank lines and comments.
@lines = grep ! /^\s*(?:#|$)/, @lines;
my $err_str = q[];
view release on metacpan or search on metacpan
lib/Filter/Template.pm view on Meta::CPAN
# Outer closure to define a unique scope.
{
my $template_name = '';
my ($template_line, $enum_index);
my ($package_name, $file_name, $line_number) = (caller)[0,1,2];
my $const_regexp_dirty = 0;
my $state = STATE_PLAIN;
# The following block processes inheritance requests for
# templates/constants and enums. added by sungo 09/2001
view release on metacpan or search on metacpan
lib/Filter/signatures.pm view on Meta::CPAN
# Make sure we return undef as the last statement of our initialization
# See t/07*
push @defaults, "();" if @args;
$res = sprintf 'sub %s { my (%s)=@_;%s%s', $name, join(",", @args), join( "" , @defaults), "\n" x $padding;
# die sprintf("Too many arguments for subroutine at %s line %d.\n", (caller)[1, 2]) unless @_ <= 2
# die sprintf("Too few arguments for subroutine at %s line %d.\n", (caller)[1, 2]) unless @_ >= 2
} else {
$res = sprintf 'sub %s { @_==0 or warn "Subroutine %s called with parameters.";();', $name, $name;
};
return $res
view release on metacpan or search on metacpan
Call/Call.pm view on Meta::CPAN
# Did we get a code reference?
my $coderef = (ref $obj eq 'CODE');
# If the parameter isn't already a reference, make it one.
if (!$coderef and (!ref($obj) or ref($obj) =~ /^ARRAY|HASH$/)) {
$obj = bless (\$obj, (caller)[0]);
}
# finish off the installation of the filter in C.
Filter::Util::Call::real_import($obj, (caller)[0], $coderef) ;
}
XSLoader::load('Filter::Util::Call');
1;
view release on metacpan or search on metacpan
t/lib/Test/Util.pm view on Meta::CPAN
$file =~ s@/$@/index.html@;
# figure out which bank test is calling us and use that to find the files
if ( !$context ) {
( $context ) = (caller)[1];
$context =~ s@t/(.*)\.t$@$1@;
$context =~ s@\.pm$@@;
}
$file =~ s@^\w+?://[^/]+@@;
t/lib/Test/Util.pm view on Meta::CPAN
}
}
sub setup {
my ( $MODULE_UNDER_TEST ) = (caller)[1] =~ m@/?(\w+)\.t$@;
eval "use Test::MockBank::$MODULE_UNDER_TEST\n";
$MODULE_UNDER_TEST;
}
view release on metacpan or search on metacpan
inc/Class/MOP/Class.pm view on Meta::CPAN
sub make_immutable {
my ( $self, @args ) = @_;
return unless $self->is_mutable;
my ($file, $line) = (caller)[1..2];
$self->_initialize_immutable(
file => $file,
line => $line,
$self->_immutable_options(@args),
view release on metacpan or search on metacpan
t/lineno-torture.t view on Meta::CPAN
}
fun test_loc($marker) {
my $expected = actual_location_of_line_with $marker;
defined $expected or die "$marker: something done fucked up";
my $got = (caller)[2];
is $got, $expected, "location of '$marker'";
}
sub {
test_loc 'LT torture begin.';
view release on metacpan or search on metacpan
lib/Function/Runner.pm view on Meta::CPAN
# Clear the LOG
$LOG = [];
my $fn_map = {}; # initial function map
my $defn = $_[1]; # user-provided function definition
my $pkg = (caller)[0]; # calling package
_die("missing defn or pkg") unless defined $defn && defined $pkg;
# See: https://perldoc.perl.org/perlmod#Symbol-Tables
my $tab = eval '\%'.$pkg.'::'; # symbol table of calling package
peek 3, ['Symbol Table: ','\%'.$pkg.'::',"has ref: \"".ref($tab).'"'];
view release on metacpan or search on metacpan
lib/Future.pm view on Meta::CPAN
{
my $self = shift;
my ( $exception, @more ) = @_;
if( !ref $exception and $exception !~ m/\n$/ ) {
$exception .= sprintf " at %s line %d\n", (caller)[1,2];
}
$self->fail( $exception, @more );
}
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/Gearman/WorkerSpawner.pm view on Meta::CPAN
$_ ne 'kids' # so DESTROY doesn't kill them
}
keys %$self
}, __PACKAGE__;
$params{source} = (caller)[1] if $params{caller_source};
# first command is startup parameters
$cmd = _serialize({
spawner => $storable_self,
class => $class,