view release on metacpan or search on metacpan
lib/IO/Event.pm view on Meta::CPAN
$sock{PeerAddr} = $a;
} else {
$sock{$a} = $b;
}
my $handler = $sock{Handler} || (caller)[0];
delete $sock{Handler};
my $timeout;
if ($sock{Timeout}) {
$timeout = $sock{Timeout};
lib/IO/Event.pm view on Meta::CPAN
$sock{Peer} = $a;
} else {
$sock{$a} = $b;
}
my $handler = $sock{Handler} || (caller)[0];
delete $sock{Handler};
my $desc = $sock{Description}
|| join(" ", map { "$_=$sock{$_}" } sort keys %sock);
delete $sock{Description};
view release on metacpan or search on metacpan
lib/IO/Lambda.pm view on Meta::CPAN
if ( $DEBUG_CALLER > 1) {
$l-> {caller} = Carp::longmess;
chomp $l-> {caller};
$l-> {caller} =~ s/^ at //;
} else {
$l-> {caller} = join(':', (caller)[1,2]);
}
}
$l;
}
view release on metacpan or search on metacpan
$opts->{input} = $in;
$opts->{output} = $out;
}
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $line = (caller)[2];
no warnings 'redefine';
local *IO::Prompt::Simple::_isa_tty = sub { $isa_tty };
note "$desc at line $line"; do {
view release on metacpan or search on metacpan
t/session_cache.t view on Meta::CPAN
ok("0 entries in cache, room for 3");
&$dump_cache;
sub ok {
my $line = (caller)[2];
print "ok # $_[0]\n";
}
sub diag {
my $msg = shift;
$msg =~s{^}{ # }mg;
view release on metacpan or search on metacpan
lib/IOC/Service.pm view on Meta::CPAN
use warnings;
our $VERSION = '0.02';
use overload '%{}' => sub {
return $_[0] if (caller)[0] eq 'IOC::Service::Deferred';
$_[0] = $_[0]->{service}->instance();
$_[0]
},
'@{}' => sub { $_[0] = $_[0]->{service}->instance(); $_[0] },
'${}' => sub { $_[0] = $_[0]->{service}->instance(); $_[0] },
view release on metacpan or search on metacpan
lib/IPC/PerlSSH.pm view on Meta::CPAN
my $self = shift;
my ( $name, $code ) = @_;
$self->store( $name, $code );
my $caller = (caller)[0];
{
no strict 'refs';
*{$caller."::$name"} = sub { $self->call( $name, @_ ) };
}
}
view release on metacpan or search on metacpan
if ( $^O =~ /Win32/ && ++$tries <= 10 ) {
print STDOUT "# Waiting for Win32 to allow $f to be unlinked ($!)\n";
select undef, undef, undef, 0.1;
next;
}
die "$! unlinking $f at ", join( ", line ", (caller)[ 1, 2 ] ), "\n";
}
}
my $text = "Hello World\n";
my @perl = ($perl);
view release on metacpan or search on metacpan
lib/IPTables/IPv4/DBTarpit/Inst.pm view on Meta::CPAN
my $W = local *W;
return "could not open $file for write"
unless open($W,'>'.$file);
$file =~ m|([^/]+)$|;
my $whoami = (caller)[1];
print $W qq|# $1 |, scalar localtime(), q|
#
# This configuration file was automatically generated by '|. $whoami .q|'
#
# Don't edit this file, edit '|. $whoami .q|' instead.
view release on metacpan or search on metacpan
}
my $tmp = join ':1:', @arguments,':1';
@arguments = split ':', $tmp;
$offset = (caller)[2]+1;
filter_add({@arguments}) ;
}
#---------------------------------------------------------------------------
#---------------------------------------------------------------------------
view release on metacpan or search on metacpan
lib/Inline/Files/Virtual.pm view on Meta::CPAN
# Create a new Inline file (for Inline::Files only)
if (not $file and defined $Inline::Files::{get_filename}) {
(my $marker = *{$glob}{NAME}) =~ s|.*::(.*)|$1|;
if ($marker =~ /^[A-Z](?:_*[A-Z0-9]+)*$/) {
if ($file = Inline::Files::get_filename((caller)[0])) {
$marker = "__${marker}__\n";
my $vfile = sprintf "$file(NEW%-0.8d)", ++$new_counter;
$vfs{$vfile} =
{ data => '',
marker => $marker,
view release on metacpan or search on metacpan
lib/Installer/cpanm.pm view on Meta::CPAN
$fatpacked{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER';
package Exporter;require 5.006;our$Debug=0;our$ExportLevel=0;our$Verbose ||= 0;our$VERSION='5.70';our (%Cache);sub as_heavy {require Exporter::Heavy;my$c=(caller(1))[3];$c =~ s/.*:://;\&{"Exporter::Heavy::heavy_$c"}}sub export {goto &{as_heavy()}}s...
EXPORTER
$fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY';
package Exporter::Heavy;use strict;no strict 'refs';require Exporter;our$VERSION=$Exporter::VERSION;sub _rebuild_cache {my ($pkg,$exports,$cache)=@_;s/^&// foreach @$exports;@{$cache}{@$exports}=(1)x @$exports;my$ok=\@{"${pkg}::EXPORT_OK"};if (@$ok...
EXPORTER_HEAVY
$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD';
use strict;use warnings;package File::pushd;our$VERSION='1.009';our@EXPORT=qw(pushd tempd);our@ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub {...
FILE_PUSHD
view release on metacpan or search on metacpan
t/Iterator-Simple-Lookahead.t view on Meta::CPAN
my $s;
#------------------------------------------------------------------------------
sub t_get (@) {
my $where = "[line ".(caller)[2]."]";
for (@_) {
is $s->peek, $_, "$where peek is ".($_||"undef");
is $s->next, $_, "$where next is ".($_||"undef");
$s->unget($_);
is $s->(), $_, "$where () is ".($_||"undef");
view release on metacpan or search on metacpan
lib/JBD/Core/Exporter.pm view on Meta::CPAN
# Modally, applies the requested import sub to calling package.
sub import {
shift if (ref $_[0] || $_[0] || '') eq __PACKAGE__;
my $m = shift || ':default';
my $s = (map {s/^:/_/; $_} grep $m eq $_, MODES)[0];
*{"${\(caller)[0]}::import"} = *{__PACKAGE__ . "::$s"};
}
#///////////////////////////////////////////////////////////////
#/ Utilties ////////////////////////////////////////////////////
lib/JBD/Core/Exporter.pm view on Meta::CPAN
# @param string $p Exporting package.
# @param array Symbols caller will import from $p.
sub _omni($;@) {
my $p = shift;
bind_to_caller((caller)[0], $p, @_);
}
# @param string $p Exporting package.
# @param array Symbols caller will import from $p.
sub _default($;@) {
my $p = shift;
if (!@_ && defined *{"${p}::EXPORT"}{ARRAY}) {
my $ref = *{"${p}::EXPORT"};
bind_to_caller((caller)[0], $p, @$ref);
}
if (@_ && defined *{"${p}::EXPORT_OK"}{ARRAY}) {
my $ref = *{"${p}::EXPORT_OK"};
my @ok = grep index("@$ref", $_) >= 0, @_;
bind_to_caller((caller)[0], $p, @ok);
}
}
1;
view release on metacpan or search on metacpan
lib/JSTAPd/Suite.pm view on Meta::CPAN
warnings->import;
if ($in_the_parse) {
return;
}
my $suite_file = Path::Class::File->new((caller)[1]);
my $base_dir = detect_root($suite_file->dir);
run_server($suite_file, $base_dir);
}
sub detect_root {
view release on metacpan or search on metacpan
lib/Jifty/DBI/Collection.pm view on Meta::CPAN
# Ensure that the column has nothing fishy going on. We can't
# simply check $column_obj's truth because joins mostly join by
# table name, not class, and we don't track table_name -> class.
if ($args{column} =~ /\W/) {
warn "Possible SQL injection on column '$args{column}' in limit at @{[join(',',(caller)[1,2])]}\n";
%args = (
%args,
column => 'id',
operator => '<',
value => 0,
lib/Jifty/DBI/Collection.pm view on Meta::CPAN
|(NOT\s*)?LIKE
|(NOT\s*)?(STARTS|ENDS)_?WITH
|(NOT\s*)?MATCHES
|IS(\s*NOT)?
|IN)$/ix) {
warn "Unknown operator '$args{operator}' in limit at @{[join(',',(caller)[1,2])]}\n";
%args = (
%args,
column => 'id',
operator => '<',
value => 0,
view release on metacpan or search on metacpan
lib/Jifty/Upgrade.pm view on Meta::CPAN
=cut
sub since {
my ( $version, $sub ) = @_;
my $package = (caller)[0];
if ( exists $UPGRADES{$package}{$version} ) {
$UPGRADES{$package}{$version} =
sub { $UPGRADES{$package}{$version}->(); $sub->(); }
}
else {
lib/Jifty/Upgrade.pm view on Meta::CPAN
die "Must provide a table to rename" unless $args{table};
Jifty::Util->require( $args{table} );
my $table_name = $args{table}->table;
my $package = (caller)[0];
my $renamed = $package->just_renamed || {};
if ( $args{column} ) {
Jifty->handle->rename_column( %args, table => $table_name );
view release on metacpan or search on metacpan
lib/Ekoi8r.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/Ekoi8u.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/Ekps9566.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/Eksc5601.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/Keyword/Declare.pm view on Meta::CPAN
Keyword::Simple::define 'keytype', sub {
# Unpack trailing code...
my ($src_ref) = @_;
# Where was this keyword declared???
my ($file, $line) = (caller)[1,2];
# These track error messages and help decompose the parameter list...
# (they have to be package vars, so they're visible to in-regex code blocks in older Perls)
our ($expected, $failed_at, $block_start, @params) = ('new type name', 0, 0);
lib/Keyword/Declare.pm view on Meta::CPAN
Keyword::Simple::define 'keyword', sub {
# Unpack trailing code...
my ($src_ref) = @_;
# Where was this keyword declared???
my ($file, $line) = (caller)[1,2];
# Which keywords are allowed in nested code at this point...
my @active_IDs = @^H{ grep { m{^ Keyword::Declare \s+ active:}xms } keys %^H };
my $lexical_keywords
= @active_IDs ? join '|', reverse sort map { $keyword_impls[$_]{skip_matcher} } @active_IDs
lib/Keyword/Declare.pm view on Meta::CPAN
Keyword::Simple::define 'unkeyword', sub {
# Unpack trailing code...
my ($src_ref) = @_;
# Where was this keyword declared???
my ($file, $line) = (caller)[1,2];
# Match and extract the keyword definition...
use re 'eval';
$$src_ref =~ s{
\A
view release on metacpan or search on metacpan
IANA/build_codes.pl view on Meta::CPAN
# DO NOT RUN THIS SCRIPT IN THIS DIRECTORY
# IT IS RUN AUTOMATICALLY BY Makefile.PL
die q|DO NOT RUN THIS SCRIPT MANUALLY, IT
IS RUN AUTOMATICALLY BY 'make'
| unless &{$_=sub{(caller)[1]}} eq 'IANA/build_codes.pl';
die "Could not find IANA/protocols"
unless open(P,'IANA/protocols');
unless (open(I,'IANA/icmp')) {
view release on metacpan or search on metacpan
lib/LaTeX/TOM/Parser.pm view on Meta::CPAN
my $DEBUG = $LaTeX::TOM::DEBUG;
return unless $DEBUG >= 1 && $DEBUG <= 2;
my ($filename, $line) = (caller)[1,2];
my $caller = join ':', (fileparse($filename))[0], $line;
warn "$caller: $message\n" if $DEBUG >= 1 && defined $message;
$code->() if $DEBUG == 2 && defined $code;
}
view release on metacpan or search on metacpan
lib/Elatin1.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/Elatin10.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/Elatin2.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/Elatin3.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/Elatin4.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/Elatin5.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/Elatin6.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