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
# 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
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
}
# Simple throw/catch error handling.
sub throw {
$@ = join '', @_;
$@ .= sprintf " at %s line %d\n", (caller)[1..2] unless $@ =~ /\n\z/;
goto CATCH;
}
# Prints a prompt message and returns response.
sub prompt {
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:
view release on metacpan or search on metacpan
cpansmokebox/inc/bundle/Sort/Versions.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
lib/strictures.pm view on Meta::CPAN
if (!exists $opts{version}) {
$opts{version}
= exists $^H{strictures_enable} ? delete $^H{strictures_enable}
: int $VERSION;
}
$opts{file} = (caller)[1];
$class->_enable(\%opts);
}
sub _enable {
my ($class, $opts) = @_;
lib/strictures.pm view on Meta::CPAN
);
no warnings 'once';
except when called from a file which matches:
(caller)[1] =~ /^(?:t|xt|lib|blib)[\\\/]/
and when either C<.git>, C<.svn>, C<.hg>, or C<.bzr> is present in the current
directory (with the intention of only forcing extra tests on the author side)
-- or when C<.git>, C<.svn>, C<.hg>, or C<.bzr> is present two directories up
along with C<dist.ini> (which would indicate we are in a C<dzil test> operation,
view release on metacpan or search on metacpan
# 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
# 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
typesafety.pm view on Meta::CPAN
#
use Carp 'confess', 'cluck';
use B::Concise 'concise_cv';
sub debug { my @args = @_; my $line = (caller)[2]; print "debug: $line: ", @args, "\n" if $debug; }
sub nastily () { " in package $lastpack, file $lastfile, line $lastline"; }
# $SIG{__DIE__} = $SIG{INT} = sub {
# # when someone does kill -INT <our pid> from the command line, dump our stack and exit
typesafety.pm view on Meta::CPAN
my $self = bless ['none', typesafety::source_status(), (undef) x 4, [], [], undef], shift();
while(@_) {
my $f = shift; $self->$f = shift;
}
# ignore the output string, just make sure that the fields required for diagnostics are defined
$self->created = (caller)[2];
$self->diagnostics();
typesafety::debug("typesafety::typeob: new: created ", $self->diagnostics());
return $self;
}
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
sub import {
my $class = shift;
($pkg) = (caller)[0];
$current = __PACKAGE__;
$mods = "";
&rerun unless (@_);
view release on metacpan or search on metacpan
inc/Sort/Versions.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);
}