view release on metacpan or search on metacpan
lib/POE/Component/Client/TCPMulti.pm view on Meta::CPAN
sub connect {
my %Options = @_[1..$#_];
$Options{Heap} ||= {};
printf STDERR "!!! -> connect method called from %s:%d\n",
(caller)[1,2] if DEBUG;
my $server = POE::Wheel::SocketFactory->new
( RemoteAddress => $Options{RemoteAddress},
RemotePort => $Options{RemotePort},
lib/POE/Component/Client/TCPMulti.pm view on Meta::CPAN
my $id = $server->ID;
printf TRACE "->connect(count %d, id %d, host (%s:%d) %s:%d);\n",
scalar keys %heap, $id, @Options{qw( RemoteAddress RemotePort )},
(caller)[1,2] if TRACE_CONNECT;
$heap{$id} = bless {
%{ $Options{Heap} },
-ID => $server->ID,
-ADDR => $Options{RemoteAddress},
view release on metacpan or search on metacpan
lib/POE/Component/Lightspeed/Hack/Kernel.pm view on Meta::CPAN
} else {
# Enqueue the event for "now", which simulates FIFO in our
# time-ordered queue.
$self->_data_ev_enqueue(
$session, ${ $self->[ KR_ACTIVE_SESSION ] }, $event_name, ET_POST, \@etc,
(caller)[1,2], ${ $self->[ KR_ACTIVE_EVENT ] }, time(),
);
}
# All done!
return 1;
lib/POE/Component/Lightspeed/Hack/Kernel.pm view on Meta::CPAN
# What should we return?
if (wantarray) {
my @return_value = (
($session == ${ $self->[ KR_ACTIVE_SESSION ] })
? $session->_invoke_state(
$session, $event_name, \@etc, (caller)[1,2],
${ $self->[ KR_ACTIVE_EVENT ] }
)
: $self->_dispatch_event(
$session, ${ $self->[ KR_ACTIVE_SESSION ] },
$event_name, ET_CALL, \@etc,
(caller)[1,2], ${ $self->[ KR_ACTIVE_EVENT ] }, time(), -__LINE__
)
);
$! = 0;
return @return_value;
lib/POE/Component/Lightspeed/Hack/Kernel.pm view on Meta::CPAN
if (defined wantarray) {
my $return_value = (
$session == ${ $self->[ KR_ACTIVE_SESSION ] }
? $session->_invoke_state(
$session, $event_name, \@etc, (caller)[1,2],
${ $self->[ KR_ACTIVE_EVENT ] }
)
: $self->_dispatch_event(
$session, ${ $self->[ KR_ACTIVE_SESSION ] },
$event_name, ET_CALL, \@etc,
(caller)[1,2], ${ $self->[ KR_ACTIVE_EVENT ] }, time(), -__LINE__
)
);
$! = 0;
return $return_value;
}
if ($session == ${ $self->[ KR_ACTIVE_SESSION ] }) {
$session->_invoke_state(
$session, $event_name, \@etc, (caller)[1,2],
${ $self->[ KR_ACTIVE_EVENT ] }
);
}
else {
$self->_dispatch_event(
$session, ${ $self->[ KR_ACTIVE_SESSION ] },
$event_name, ET_CALL, \@etc,
(caller)[1,2], ${ $self->[ KR_ACTIVE_EVENT ] }, time(), -__LINE__
);
}
$! = 0;
return;
view release on metacpan or search on metacpan
lib/POE/Kernel.pm view on Meta::CPAN
}
$self->_data_ev_enqueue(
$session, $kr_active_session,
EN_SIGNAL, ET_SIGNAL, [ $signal, @etc ],
(caller)[1,2], $kr_active_event
);
return 1;
}
# Public interface for flagging signals as handled. This will replace
lib/POE/Kernel.pm view on Meta::CPAN
# But not if the active event is ET_START, since that would generate
# a CHILD_LOSE without a CHILD_CREATE.
$self->_dispatch_event(
$old_parent, $self,
EN_CHILD, ET_CHILD, [ CHILD_LOSE, $kr_active_session, undef ],
(caller)[1,2], undef, monotime(), -__LINE__
)
unless $kr_active_event_type & ET_START;
# Tell the new parent (kernel) that it's gaining a child.
# (Actually it doesn't care, so we don't do that here, but this is
lib/POE/Kernel.pm view on Meta::CPAN
# Tell the current session that its parentage is changing.
$self->_dispatch_event(
$kr_active_session, $self,
EN_PARENT, ET_PARENT, [ $old_parent, $self ],
(caller)[1,2], undef, monotime(), -__LINE__
);
$self->_data_ses_move_child($kr_active_session->ID, $self->ID);
# Success!
lib/POE/Kernel.pm view on Meta::CPAN
# Tell the current session that the child is departing.
$self->_dispatch_event(
$kr_active_session, $self,
EN_CHILD, ET_CHILD, [ CHILD_LOSE, $child_session, undef ],
(caller)[1,2], undef, monotime(), -__LINE__
);
# Tell the new parent (kernel) that it's gaining a child.
# (Actually it doesn't care, so we don't do that here, but this is
# where the code would go if it ever does in the future.)
# Tell the child session that its parentage is changing.
$self->_dispatch_event(
$child_session, $self,
EN_PARENT, ET_PARENT, [ $kr_active_session, $self ],
(caller)[1,2], undef, monotime(), -__LINE__
);
$self->_data_ses_move_child($child_session->ID, $self->ID);
# Success!
lib/POE/Kernel.pm view on Meta::CPAN
# Enqueue the event for "now", which simulates FIFO in our
# time-ordered queue.
$self->_data_ev_enqueue(
$session, $kr_active_session, $event_name, ET_POST, \@etc,
(caller)[1,2], $kr_active_event
);
return 1;
}
#------------------------------------------------------------------------------
lib/POE/Kernel.pm view on Meta::CPAN
) if exists $poes_own_events{$event_name};
};
$self->_data_ev_enqueue(
$kr_active_session, $kr_active_session, $event_name, ET_POST, \@etc,
(caller)[1,2], $kr_active_event
);
undef;
}
lib/POE/Kernel.pm view on Meta::CPAN
if (wantarray) {
my @return_value = (
($session == $kr_active_session)
? $session->_invoke_state(
$session, $event_name, \@etc, (caller)[1,2],
$kr_active_event
)
: $self->_dispatch_event(
$session, $kr_active_session,
$event_name, ET_CALL, \@etc,
(caller)[1,2], $kr_active_event, monotime(), -__LINE__
)
);
$kr_exception and $self->_rethrow_kr_exception();
lib/POE/Kernel.pm view on Meta::CPAN
if (defined wantarray) {
my $return_value = (
$session == $kr_active_session
? $session->_invoke_state(
$session, $event_name, \@etc, (caller)[1,2],
$kr_active_event
)
: $self->_dispatch_event(
$session, $kr_active_session,
$event_name, ET_CALL, \@etc,
(caller)[1,2], $kr_active_event, monotime(), -__LINE__
)
);
$kr_exception and $self->_rethrow_kr_exception();
lib/POE/Kernel.pm view on Meta::CPAN
return $return_value;
}
if ($session == $kr_active_session) {
$session->_invoke_state(
$session, $event_name, \@etc, (caller)[1,2],
$kr_active_event
);
}
else {
$self->_dispatch_event(
$session, $kr_active_session,
$event_name, ET_CALL, \@etc,
(caller)[1,2], $kr_active_event, monotime(), -__LINE__
);
}
$kr_exception and $self->_rethrow_kr_exception();
lib/POE/Kernel.pm view on Meta::CPAN
# directly is faster than calling alarm_set to enqueue it.
if (defined $time) {
$self->_data_ev_enqueue
( $kr_active_session, $kr_active_session,
$event_name, ET_ALARM, [ @etc ],
(caller)[1,2], $kr_active_event, $time,
);
}
else {
# The event queue has become empty? Stop the time watcher.
$self->loop_pause_time_watcher() unless $kr_queue->get_item_count();
lib/POE/Kernel.pm view on Meta::CPAN
}
$self->_data_ev_enqueue
( $kr_active_session, $kr_active_session,
$event_name, ET_ALARM, [ @etc ],
(caller)[1,2], $kr_active_event, $time,
);
return 0;
}
lib/POE/Kernel.pm view on Meta::CPAN
# Add the new alarm if it includes a time. Calling _data_ev_enqueue
# directly is faster than calling alarm_set to enqueue it.
$self->_data_ev_enqueue
( $kr_active_session, $kr_active_session,
$event_name, ET_ALARM, [ @etc ],
(caller)[1,2], $kr_active_event, undef, $delay, $pri+$delay
);
}
else {
$self->alarm($event_name);
}
lib/POE/Kernel.pm view on Meta::CPAN
}
$self->_data_ev_enqueue
( $kr_active_session, $kr_active_session,
$event_name, ET_ALARM, [ @etc ],
(caller)[1,2], $kr_active_event, undef, $delay, $pri+$delay
);
return 0;
}
lib/POE/Kernel.pm view on Meta::CPAN
) if exists $poes_own_events{$event_name};
}
return $self->_data_ev_enqueue
( $kr_active_session, $kr_active_session, $event_name, ET_ALARM, [ @etc ],
(caller)[1,2], $kr_active_event, $time,
);
}
# Remove an alarm by its ID. TODO Now that alarms and events have
# been recombined, this will remove an event by its ID. However,
lib/POE/Kernel.pm view on Meta::CPAN
return;
}
return $self->_data_ev_enqueue
( $kr_active_session, $kr_active_session, $event_name, ET_ALARM, [ @etc ],
(caller)[1,2], $kr_active_event, $t, $seconds, $pri+$seconds
);
}
# Move a delay to a new offset from time(). As with alarm_adjust(),
# this is optimized internally for this sort of activity.
view release on metacpan or search on metacpan
21783 stat("/usr/share/perl5/strict.pmc", 0x7ffffff2c8d0) = -1 ENOENT (No such file or directory)
21783 stat("/usr/share/perl5/strict.pm", {st_mode=S_IFREG|0444, st_size=4783, ...}) = 0
21783 open("/usr/share/perl5/strict.pm", O_RDONLY|O_CLOEXEC) = 5
21783 ioctl(5, TCGETS, 0x7ffffff2c690) = -1 ENOTTY (Inappropriate ioctl for device)
21783 lseek(5, 0, SEEK_CUR) = 0
21783 read(5, "package strict;\n\n$strict::VERSION = \"1.12\";\n\nmy ( %bitmask, %explicit_bitmask );\n\nBEGIN {\n # Verify that we're called correctly so that strictures will work.\n # Can't use Carp, since Carp uses us!\n # see also warnin...
21783 lseek(5, 1605, SEEK_SET) = 1605
21783 lseek(5, 0, SEEK_CUR) = 1605
21783 close(5) = 0
21783 stat("/home/gray/src/posixruncapture/lib/warnings.pmc", 0x7ffffff2c8d0) = -1 ENOENT (No such file or directory)
21783 stat("/home/gray/src/posixruncapture/lib/warnings.pm", 0x7ffffff2c8d0) = -1 ENOENT (No such file or directory)
21783 stat("/usr/share/perl5/warnings.pmc", 0x7ffffff2c8d0) = -1 ENOENT (No such file or directory)
21783 stat("/usr/share/perl5/warnings.pm", {st_mode=S_IFREG|0444, st_size=53221, ...}) = 0
21783 open("/usr/share/perl5/warnings.pm", O_RDONLY|O_CLOEXEC) = 5
21783 ioctl(5, TCGETS, 0x7ffffff2c690) = -1 ENOTTY (Inappropriate ioctl for device)
21783 lseek(5, 0, SEEK_CUR) = 0
21783 read(5, "# -*- buffer-read-only: t -*-\n# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!\n# This file is built by regen/warnings.pl.\n# Any changes made here will be lost!\n\npackage warnings;\n\nour $VERSION = \"1.51\";\n\n# Verify that we're calle...
21783 read(5, "0\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\", # [13]\n 'once'\t\t\t\t=> \"\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\", # [14]\n 'overflow'\t\t\t\t=> \"...
21783 brk(0x1fcf000) = 0x1fcf000
21783 read(5, "8]\n 'nonchar'\t\t\t\t=> \"\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x08\\x00\\x00\\x00\\x00\\x00\\x00\", # [49]\n 'numeric'\t\t\t\t=> \"\\x00\\x00\\x00\\x08\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\...
21783 brk(0x1ff2000) = 0x1ff2000
21783 read(5, " && $DB::args[0] =~ /^$category=/ ;\n }\n $i -= 2 ;\n }\n elsif ($has_level) {\n $i = 2 + shift;\n }\n else {\n $i = _error_loc(); # see where Carp will allocate the error\n }\n\n # Default...
view release on metacpan or search on metacpan
pperl.h.header view on Meta::CPAN
my $exit_code = 0;
BEGIN {
*CORE::GLOBAL::exit = sub {
my $retval = shift || 0;
my $package = (caller)[0];
log_error("exit $package $retval $should_exit\n");
if ($package eq 'PPerlServer' || $should_exit) {
exit($retval);
}
$exit_code = $retval;
goto __PPerl_exit;
};
*CORE::GLOBAL::fork = sub {
my $package = (caller)[0];
my $ret = fork();
if (defined $ret && !$ret && $package ne 'PPerlServer') {
# forked children should just exit
$should_exit = 1;
}
pperl.h.header view on Meta::CPAN
*CORE::GLOBAL::exec = sub {
# This is so horribly wrong, overloading exec() to be
# system();exit() - but there's no other way to make this
# work. See the documentation in t/19invoke_djbish.t for
# further info on this issue.
my $package = (caller)[0];
log_error("exec $package $should_exit\n");
if ($package eq 'PPerlServer' || $should_exit) {
exec(@_);
}
my $code = system(@_);
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/Params/Clean.pm view on Meta::CPAN
{
my $me=shift; # our package name
my @opts, my $i; push @opts, [$_[$i++]=>$_[$i++]] while $i<@_; # pair up the options (we would use a hash, but we want to preserve order, and anyway we could have the same key repeated)
my %EXPORT=map {$_=>$_} @KEYWORDS; # keywords to be exported (normally all @KEYWORDS) in convenient hash format
my $keys=join "|", @KEYWORDS; # for regex to test for any of our keywords
my $caller=(caller)[0]; # caller's package
# Set up warning/fatal/ignoral categories
$Warn{$caller}={%{$Warn{undef}}}; # start by setting up default warning levels
for (grep $opts[$_][0]=~/^(warn|die|fatal|ignore)$/, 0..$#opts) # grep through the key-halves of each opt for exception-levels
view release on metacpan or search on metacpan
my $warn;
$SIG{__WARN__} = sub {$warn = shift};
sub t_error {
my($args, $expected_message) = @_;
my $test_name = "[line ".((caller)[2])."]";
(my $expected_error = $expected_message) =~ s/XXX/Error/;
(my $expected_warning = $expected_message) =~ s/XXX/Warning/;
eval { error(@$args) };
view release on metacpan or search on metacpan
lib/Path/This.pm view on Meta::CPAN
use File::Basename ();
use Sub::Util ();
our $VERSION = '0.005';
sub THISFILE () { Cwd::abs_path((caller)[1]) }
sub THISDIR () {
my $file = (caller)[1];
return -e $file ? File::Basename::dirname(Cwd::abs_path $file) : Cwd::getcwd;
}
sub import {
my $class = shift;
view release on metacpan or search on metacpan
share/utils/cpanm 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/scan/utf8.t view on Meta::CPAN
delete $p->{__P_seen} if exists $p->{__P_seen};
$_[0] };
my $v = $_[0];
my $rv = ref $v;
$dflts = $p->get_dflts((caller)[0]);
my ($depth, $noquote) = (sw(depth), sw(noquote));
if (HASH eq $rv) {
my $params = $v; $v = shift; $rv = ref $v;
$depth = $params->{depth} if exists $params->{depth};
}
t/scan/utf8.t view on Meta::CPAN
sub import {
my ($modname, @args) = @_;
if (@args) {
my @others;
my $caller = (caller)[0];
if (exists $mod_dflts{$caller}) {
$dflts = $mod_dflts{$caller};
} else {
$dflts = undef; # indicate no customization to dflts
}
t/scan/utf8.t view on Meta::CPAN
sub ops($) {
my $p = shift; my $c=ref $p || $p;
bless $p = {}, $c unless ref $p;
my $args = $_[0];
my $ldflts = $p->get_dflts((caller)[0]);
%{$p->{dflts}} = %$dflts unless ref $p->{dflts};
die "ops takes a hash to pass arguments" unless HASH $args;
$ldflts = $p->{dflts};
foreach (sort keys %$args) {
if (exists $ldflts->{$_}) { $ldflts->{$_} = $args->{$_} }
view release on metacpan or search on metacpan
lib/Perl/Tidy/Formatter.pm view on Meta::CPAN
}
}
}
}
# enter a list slice, such as '(caller)[1,2]'
my $Kn = $self->K_next_code($Kc);
if ( $Kn && $rLL->[$Kn]->[_TOKEN_] eq '[' ) {
my $seqno_next = $rLL->[$Kn]->[_TYPE_SEQUENCE_];
if ( $seqno_next
&& $self->is_list_by_seqno($seqno_next) )
view release on metacpan or search on metacpan
lib/chat2.pl view on Meta::CPAN
# returns undef if can't find a pty.
# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik.
sub _getpty { ## private
local($_PTY,$_TTY) = @_;
$_PTY =~ s/^([^':]+)$/(caller)[$[]."::".$1/e;
$_TTY =~ s/^([^':]+)$/(caller)[$[]."::".$1/e;
local($pty, $tty, $kind);
if( -e "/dev/pts000" ){ ## mods by Joe Doupnik Dec 1992
$kind = "pts"; ## SVR4 Streams
} else {
$kind = "pty"; ## BSD Clist stuff
view release on metacpan or search on metacpan
lib/Perl6/Binding.pm view on Meta::CPAN
##==============================================================================
## import - install the filter
##==============================================================================
sub import {
my $caller = (caller)[1];
unless ($INSTALLED{$caller}) {
shift;
filter_add({ @_ });
$INSTALLED{$caller} = 1;
}
lib/Perl6/Binding.pm view on Meta::CPAN
##==============================================================================
## unimport - uninstall the filter
##==============================================================================
sub unimport {
my $caller = (caller)[1];
if ($INSTALLED{$caller}) {
filter_del();
delete $INSTALLED{$caller};
}
}
view release on metacpan or search on metacpan
lib/Perl6/Builtins.pm view on Meta::CPAN
with each of the values for these keys being the equivalent item from
the list returned by C<caller> in list context. This is useful because
it means that, instead of:
$subname = (caller)[3];
you can write the much more readable:
$subname = caller->{sub};
view release on metacpan or search on metacpan
misc/old_pugs_perl5_backend/pilrun2-leftovers/api.pl view on Meta::CPAN
"(do{no strict;defined(\$$mn)?\$$mn:p6__lookup('$mn','$name')})";
}
sub p6_var { # XXX - not quite the right thing
my($name)=@_;
my $mn = p6_mangle($name);
my $pkg = (caller)[0];
#my $ret = eval "package $pkg;".<<' END';
# no strict;defined($$mn)?$$mn:p6__lookup('$mn','$name')
#END
#die "p6_var: bug: $@" if $@;
#$ret;
view release on metacpan or search on metacpan
lib/PerlIO/via/SeqIO.pm view on Meta::CPAN
if ($file or $mode !~ /:via\(SeqIO(?:::[a-zA-Z_]+)?\)/) {
#passthru
# if !defined $file, parse $mode according to presence of &...
if ($fh) {
if ( $fh =~ /^[A-Z]+$/ ) {
$fh = *{(caller)[0]."::$fh"};
}
}
if ($file) {
if ( $file =~ /^[A-Z]+$/) {
$file = *{(caller)[0]."::$file"};
}
return CORE::open($fh || $_[0],$_[1],$file);
}
else {
$_[0] ?
lib/PerlIO/via/SeqIO.pm view on Meta::CPAN
no strict qw(refs);
my $dup = gensym;
my $bareword = $1;
my $redirect = ($bareword =~ /OUT/ ? ">&" : "<&");
# get a pristine copy of DATA/STDIN/STDOUT
$fh = *{(caller)[0]."::$bareword"};
CORE::open($dup, $redirect, $fh) or croak($!);
if ($bareword =~ /OUT/) {
$| && $dup->autoflush(1);
}
# now, need to make everything output to the duplicated
lib/PerlIO/via/SeqIO.pm view on Meta::CPAN
}
else { # passthru
$DB::single=1;
($mode, $file) = $mode =~ /(\+?(?:<|>)?>?&?)(.*)/;
$file =~ /^[A-Z]+$/ and $file = *{(caller)[0]."::$file"};
$_[0] = PerlIO::Util->open($mode,$file);
}
1;
}
lib/PerlIO/via/SeqIO.pm view on Meta::CPAN
};
m/via/ && do {
return (tied $sym)->via_o; last;
};
m/^[A-Z]+$/ && do {
$sym = (caller)[0]."::$sym";
return (tied *$sym)->via_o if (tied *$sym);
return;
last;
};
}
view release on metacpan or search on metacpan
# Simple throw/catch error handling.
sub throw {
my $self = shift;
$@ = join '', @_;
$@ .= sprintf " at %s line %d\n", (caller)[1..2] unless $@ =~ /\n\z/;
goto CATCH;
}
# Prints a prompt message and returns response.
{
view release on metacpan or search on metacpan
PerlQt/lib/Qt/attributes.pm view on Meta::CPAN
# Attributes override any method with the same name, so you may want
# to prefix them with _ to prevent conflicts.
#
sub import {
my $class = shift;
my $caller = (caller)[0];
for my $attribute (@_) {
exists ${ ${$caller . '::META'}{'attributes'} }{$attribute} and next;
Qt::_internal::installattribute($caller, $attribute);
${ ${$caller . '::META'}{'attributes'} }{$attribute} = 1;
view release on metacpan or search on metacpan
lib/PerlX/ScopeFunction.pm view on Meta::CPAN
return \%import_as;
}
sub import ($class, @args) {
my $caller = (caller)[0];
my %handler = (
'let' =>[
sub { __define_keyword( \&__rewrite_let, $_[0] ) },
sub { __undefine_keyword( $_[0] ) },
],
lib/PerlX/ScopeFunction.pm view on Meta::CPAN
push @{ $STASH{$caller} }, sub { $unimporter->($as, $caller) };
}
}
sub unimport ($class) {
my $caller = (caller)[0];
for my $unimporter (@{ $STASH{$caller} // []}) {
$unimporter->();
}
}
view release on metacpan or search on metacpan
lib/Perlito5X/Exporter.pm view on Meta::CPAN
my $pkg = ref $self || $self;
return ${pkg}->VERSION($wanted);
}
sub export_tags {
_push_tags( (caller)[0], "EXPORT", \@_ );
}
sub export_ok_tags {
_push_tags( (caller)[0], "EXPORT_OK", \@_ );
}
1;
view release on metacpan or search on metacpan
lib/Pinto/Util.pm view on Meta::CPAN
# TODO: Use Carp instead?
return 1 if not $ENV{PINTO_DEBUG};
$it = $it->() if ref $it eq 'CODE';
my ( $file, $line ) = (caller)[ 1, 2 ];
print {*STDERR} "$it in $file at line $line\n";
return 1;
}
view release on metacpan or search on metacpan
lib/Pinwheel/Helpers/Text.pm view on Meta::CPAN
*p = *simple_format;
sub cycle
{
my ($ctx, $key, $i);
$key = (caller)[2] . "\t" . CORE::join("\t", @_);
$ctx = Pinwheel::Context::get('render');
$i = $ctx->{cycle}{$key}++;
return $_[$i % scalar(@_)];
}
view release on metacpan or search on metacpan
local/lib/perl5/IO/Compress/Base.pm view on Meta::CPAN
sub _def
{
my $obj = shift ;
my $class= (caller)[0] ;
my $name = (caller(1))[3] ;
$obj->croakError("$name: expected at least 1 parameters\n")
unless @_ >= 1 ;
view release on metacpan or search on metacpan
lib/Plagger.pm view on Meta::CPAN
}
sub template {
my $self = shift;
$self->log(error => "\$context->template is DEPRECATED NOW. use \$plugin->templatize()");
my $plugin = shift || (caller)[0];
Plagger::Template->new($self, $plugin);
}
sub templatize {
my($self, $plugin, $file, $vars) = @_;
view release on metacpan or search on metacpan
lib/Plugin/Simple.pm view on Meta::CPAN
{
no warnings 'redefine';
no strict 'refs';
my $pkg = (caller)[0];
*{"$pkg\::$sub_name"} = \&_plugins;
}
}
sub _new {
my ($class, %args) = @_;
lib/Plugin/Simple.pm view on Meta::CPAN
if (@_){
croak "usage: plugins(['Load::From'], [can => 'sub']), " .
"in that order\n";
}
my $pkg = (caller)[0];
my @plugins;
if ($item){
if ($item =~ /(?:\.pm|\.pl)/){
my $abs_path;
view release on metacpan or search on metacpan
t/pod/testcmp.pl view on Meta::CPAN
use File::Spec;
use FileHandle;
@ISA = qw(Exporter);
@EXPORT = qw(&testcmp);
$MYPKG = eval { (caller)[0] };
##--------------------------------------------------------------------------
=head1 NAME
view release on metacpan or search on metacpan
t/pod/testcmp.pl view on Meta::CPAN
use File::Spec;
use FileHandle;
@ISA = qw(Exporter);
@EXPORT = qw(&testcmp);
$MYPKG = eval { (caller)[0] };
##--------------------------------------------------------------------------
=head1 NAME
view release on metacpan or search on metacpan
t/cpan/Mojo/File.pm view on Meta::CPAN
my ($self, $to) = @_;
copy($$self, $to) or croak qq{Can't copy file "$$self" to "$to": $!};
return $self->new(-d $to ? ($to, File::Basename::basename $self) : $to);
}
sub curfile { __PACKAGE__->new(Cwd::realpath((caller)[1])) }
sub dirname { $_[0]->new(scalar File::Basename::dirname ${$_[0]}) }
sub extname { shift->basename =~ /.+\.([^.]+)$/ ? $1 : '' }
view release on metacpan or search on metacpan
t/pod/testcmp.pl view on Meta::CPAN
use File::Spec;
use FileHandle;
@ISA = qw(Exporter);
@EXPORT = qw(&testcmp);
$MYPKG = eval { (caller)[0] };
##--------------------------------------------------------------------------
=head1 NAME