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
view release on metacpan or search on metacpan
Apache-Reload/lib/Apache/Reload.pm view on Meta::CPAN
$TouchTime = time;
sub import {
my $class = shift;
my ($package,$file) = (caller)[0,1];
$class->register_module($package, $file);
}
sub unimport {
my $class = shift;
my ($package,$file) = (caller)[0,1];
$class->unregister_module($package, $file);
}
sub package_to_module {
view release on metacpan or search on metacpan
lib/namespace/alias.pm view on Meta::CPAN
Class::MOP::load_class($package);
($alias) = $package =~ /(?:::|')(\w+)$/
unless defined $alias;
my $file = (caller)[1];
my $hook = $class->setup($file => sub {
my ($str) = @_;
if ($str =~ s/^$alias\b/$package/) {
view release on metacpan or search on metacpan
namespace.pm view on Meta::CPAN
$namespace::VERSION = '0.05';
sub import{
my ($slf, $als, $pkg) = (shift, shift, shift);
my $clr = (caller)[0];
$als = $clr.$als if substr($als, 0, 2) eq '::';
die "Package '$als' already defined!" if defined %{$als.'::'};
namespace.pm view on Meta::CPAN
else{ die "Undefined behavior!\n" }
}
}
sub unimport{
undef %{(substr($_[1], 0, 2) eq '::' ? (caller)[0] : '' ).$_[1].'::'};
}
1;
view release on metacpan or search on metacpan
lib/nextgen/blacklist.pm view on Meta::CPAN
my %prohibited;
my $NEXT_REQUIRE;
sub require {
my $file = shift;
my $callers_pkg = (caller)[0];
my $pkg_bl_db = $prohibited{ $callers_pkg };
my $class = _pmfile_to_class( $file );
if ( exists $pkg_bl_db->{$file} ) {
view release on metacpan or search on metacpan
lib/optimize.pm view on Meta::CPAN
sub register {
my $class = shift;
my $callback = shift;
my $package = shift;
my ($name) = (caller)[0];
#$DB::single = 1 if defined &DB::DB; # magic to allow debugging into CHECK blocks
$register{$package}->{$name} = $callback;
}
sub unregister {
my $class = shift;
my $package = shift;
my ($name) = (caller)[0];
$register{$package}->{$name} = 0;
}
sub UNIVERSAL::optimize : ATTR {
;
view release on metacpan or search on metacpan
cpan/ExtUtils-MakeMaker/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
lib/perl5i/0.pm view on Meta::CPAN
local $! = 255;
return CORE::die(@_) if @_ == 1 and ref $_[0];
my $error = join '', @_;
unless ($error =~ /\n$/) {
my ($file, $line) = (caller)[1,2];
$error .= " at $file line $line.\n";
}
local $! = 255;
return CORE::die($error);
view release on metacpan or search on metacpan
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/POEST/Plugin.pm view on Meta::CPAN
use POE qw[Component::Server::SMTP];
use Carp;
sub import {
my ($class) = @_;
my ($caller) = (caller)[0];
{
eval qq[
package $caller;
use POE qw[Component::Server::SMTP];
view release on metacpan or search on metacpan
t/perl/pat.t view on Meta::CPAN
# Force scalar context on the patern match
sub ok ($;$) {
my($ok, $name) = @_;
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
$test++;
return $ok;
}
t/perl/pat.t view on Meta::CPAN
for $got, $expect;
my $ok= $got eq $expect;
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n".
"# expected: %s\n".
"# result: %s\n",
(caller)[2], $expect, $got
unless $ok;
$test++;
return $ok;
}
view release on metacpan or search on metacpan
t/perl/pat.t view on Meta::CPAN
# Force scalar context on the patern match
sub ok ($;$) {
my($ok, $name) = @_;
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
$test++;
return $ok;
}
t/perl/pat.t view on Meta::CPAN
for $got, $expect;
my $ok= $got eq $expect;
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n".
"# expected: %s\n".
"# result: %s\n",
(caller)[2], $expect, $got
unless $ok;
$test++;
return $ok;
}
view release on metacpan or search on metacpan
t/perl/pat.t view on Meta::CPAN
# Force scalar context on the patern match
sub ok ($;$) {
my($ok, $name) = @_;
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
$test++;
return $ok;
}
t/perl/pat.t view on Meta::CPAN
for $got, $expect;
my $ok= $got eq $expect;
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n".
"# expected: %s\n".
"# result: %s\n",
(caller)[2], $expect, $got
unless $ok;
$test++;
return $ok;
}
view release on metacpan or search on metacpan
t/perl/pat.t view on Meta::CPAN
# Force scalar context on the patern match
sub ok ($;$) {
my($ok, $name) = @_;
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
$test++;
return $ok;
}
t/perl/pat.t view on Meta::CPAN
for $got, $expect;
my $ok= $got eq $expect;
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n".
"# expected: %s\n".
"# result: %s\n",
(caller)[2], $expect, $got
unless $ok;
$test++;
return $ok;
}
view release on metacpan or search on metacpan
lib/require/relative.pm view on Meta::CPAN
$require::relative::VERSION = '1.0.0';
use Path::Tiny ();
sub import {
my ($class, @paths) = @_;
my ($package, $file) = (caller)[0, 1];
my $dir = -e $file
? Path::Tiny->new ($file)->absolute->parent
: Path::Tiny->cwd
;
view release on metacpan or search on metacpan
lib/sanity.pm view on Meta::CPAN
exit;
}
# Look for every indicator that proves that the user is in the distro directory
# and appears to be one of the coders
my $author_mode = !!((caller)[1] =~ /^(?:x?t|b?lib)[\/\\]/ && (-d '.git' or -d '.svn'));
$author_mode = 0 if (grep {
$ENV{"PERL5_${_}_IS_RUNNING"} || $ENV{"PERL5_${_}_IS_RUNNING_IN_RECURSION"}
} (qw/CPANM CPANP CPANPLUS CPAN/) );
# Process order: