view release on metacpan or search on metacpan
lib/AI/TensorFlow/Libtensorflow/Lib.pm view on Meta::CPAN
$ffi;
};
}
sub mangler_default {
my $target = (caller)[0];
my $prefix = 'TF';
if( $target =~ /::Eager::/ ) {
$prefix = 'TFE';
}
sub {
view release on metacpan or search on metacpan
lib/Acme/Bleach.pm view on Meta::CPAN
sub dirty { $_[0] =~ /\S/ }
sub dress { $_[0] =~ /^$tie/ }
open 0 or print "Can't rebleach '$0'\n" and exit;
(my $shirt = join "", <0>) =~ s/(.*)^\s*use\s+Acme::Bleach\s*;\n//sm;
my $coat = $1;
my $pressed = '#line ' . ("$coat\n" =~ tr/\n/\n/) . ' ' . (caller)[1] . "\n";
local $SIG{__WARN__} = \&dirty;
do {eval $coat . brighten $shirt; print STDERR $@ if $@; exit}
unless dirty $shirt && not dress $shirt;
open 0, ">$0" or print "Cannot bleach '$0'\n" and exit;
print {0} "${coat}use Acme::Bleach;\n", whiten $pressed.$shirt and exit;
view release on metacpan or search on metacpan
lib/Acme/Code/Police.pm view on Meta::CPAN
package Acme::Code::Police;
INIT{unless(exists$INC{'strict.pm'}){unlink((caller)[1])}}
$trick_that_naughty_cpants_thingy_into_thinking_I_use_strict = <<'Ha, ha!';
use strict;
Ha, ha!
view release on metacpan or search on metacpan
lib/Acme/Gosub.pm view on Meta::CPAN
my $fallthrough;
sub import
{
$fallthrough = grep /\bfallthrough\b/, @_;
$offset = (caller)[2]+1;
filter_add({}) unless @_>1 && $_[1] eq 'noimport';
my $pkg = caller;
1;
}
lib/Acme/Gosub.pm view on Meta::CPAN
}
sub filter
{
my($self) = @_ ;
local $Acme::Gosub::file = (caller)[1];
my $status = 1;
$status = filter_read(1_000_000);
return $status if $status<0;
$_ = filter_blocks($_,$offset);
view release on metacpan or search on metacpan
lib/Acme/MadokaMagica.pm view on Meta::CPAN
@$HollyQuintet,
];
sub alone_members {
my $self = shift;
return $self->members_of($AloneMembers,(caller)[2]);
}
sub main_members {
my $self = shift;
return $self->members_of($MainMembers,(caller)[2]);
}
sub members_of {
my ($self, $team) = @_;
my $line = $_[2] || (caller)[2];
my @members;
for my $member_name (@{ $team }){
my $pkg = "Acme::MadokaMagica::TvMembers::$member_name";
if (eval "require $pkg;1;"){
view release on metacpan or search on metacpan
lib/Acme/NumericMethod.pm view on Meta::CPAN
use strict;
our $VERSION='0.05';
use Lingua::EN::Words2Nums;
sub import {
my $package = (caller)[0];
no strict 'refs';
*{"${package}::AUTOLOAD"} = sub {
no strict;
my $n = $AUTOLOAD;
$n =~ s/.*:://;
view release on metacpan or search on metacpan
local/lib/perl5/Future.pm view on Meta::CPAN
sub DESTROY_debug {
my $self = shift;
return if $GLOBAL_END;
return if $self->{ready} and ( $self->{reported} or !$self->{failure} );
my $lost_at = join " line ", (caller)[1,2];
# We can't actually know the real line where the last reference was lost;
# a variable set to 'undef' or close of scope, because caller can't see it;
# the current op has already been updated. The best we can do is indicate
# 'near'.
local/lib/perl5/Future.pm view on Meta::CPAN
{
my $self = shift;
my ( $exception, @details ) = @_;
if( !ref $exception and $exception !~ m/\n$/ ) {
$exception .= sprintf " at %s line %d\n", (caller)[1,2];
}
$self->fail( $exception, @details );
}
view release on metacpan or search on metacpan
lib/Acme/Syntax/Python.pm view on Meta::CPAN
sub import {
my $class = shift; #We don't need Class Name.
my %params = @_;
my (%context) = (
_filename => (caller)[1],
_line_no => 0,
_last_begin => 0,
_in_block => 0,
_block_depth => 0,
_lambda_block => {},
view release on metacpan or search on metacpan
egrep { $n%7==0 } @a; # 8, 15, 22, 29, 36, 43
=cut
sub egrep (&@) {
my($code,$i,$package)=(shift,-1,(caller)[0]);
my %h=map{($_=>"${package}::$_")}qw(i n prev next prevr nextr);
no strict 'refs';
grep {
#no strict 'refs'; #not here! "no" not allowed in expression in perl5.16
local ${$h{i}} = ++$i;
view release on metacpan or search on metacpan
lib/AnyEvent/Connection.pm view on Meta::CPAN
}
sub disconnect {
my $self = shift;
#$self->{con} or return;
#warn "Disconnecting $self->{connected} || $self->{connecting} || $self->{reconnect} by @{[ (caller)[1,2] ]}";
ref $self->{con} eq 'HASH' and warn dumper($self->{con});
$self->{con} and eval{ $self->{con}->close; };
warn if $@;
delete $self->{con};
my $wascon = $self->{connected} || $self->{connecting};
view release on metacpan or search on metacpan
lib/AnyEvent/DBD/Pg.pm view on Meta::CPAN
our $AUTOLOAD;
sub AUTOLOAD {
my ($method) = $AUTOLOAD =~ /([^:]+)$/;
my $self = shift;
die sprintf qq{Can't locate autoloaded object method "%s" (%s) via package "%s" at %s line %s.\n}, $method, $AUTOLOAD, ref $self, (caller)[1,2]
unless exists $METHOD{$method};
my $fetchmethod = $METHOD{$method};
defined $fetchmethod or croak "Method $method not implemented yet";
ref (my $cb = pop) eq 'CODE' or croak "need callback";
if ($self->{db}->{pg_async_status} == 1 or $self->{current} ) {
view release on metacpan or search on metacpan
my $self = bless \%arg, $class;
$self->{fh} = $client;
my $rbuf;
my @caller = (caller)[1,2]; # the "default" caller
$fork = $fork ? $fork->fork : AnyEvent::Fork->new
or croak "fork: $!";
$fork->require ("AnyEvent::DBI::Slave");
$self->_req (
sub {
return unless $self;
$self->{child_pid} = $_[1];
},
(caller)[1,2],
"req_pid"
);
$self->_req (
sub {
return unless $self;
&{ $self->{on_connect} } if $self->{on_connect};
},
(caller)[1,2],
req_open => $dbi, $user, $pass, %dbi_args
);
$self
}
=cut
for my $cmd_name (qw(attr exec stattr begin_work commit rollback func)) {
eval 'sub ' . $cmd_name . '{
my $cb = pop;
splice @_, 1, 0, $cb, (caller)[1,2], "req_' . $cmd_name . '";
&_req
}';
}
=back
view release on metacpan or search on metacpan
lib/AnyEvent/Memcached/Conn.pm view on Meta::CPAN
our $QRNL = qr<\015?\012>;
our $VERSION = $AnyEvent::Memcached::VERSION;
sub reader {
my ($self,%args) = @_;
$args{cb} or return $self->event( error => "no cb for command at @{[ (caller)[1,2] ]}" );
$self->{h} or return $args{cb}->(undef,"Not connected");
my $result = $args{res} || {};
my $ar = ref $result eq 'ARRAY' ? 1 : 0;
my $cut = exists $args{namespace} ? length $args{namespace} : 0;
my $reader;$reader = sub {
view release on metacpan or search on metacpan
lib/AnyEvent/SMTP/Client.pm view on Meta::CPAN
++$ACTIVE{$host};
$cb->(AnyEvent::Util::guard {
--$ACTIVE;
--$ACTIVE{$host} > 0 or delete $ACTIVE{$host};
--$CO_SLOT{$host}[0];
#warn "Release slot (have $ACTIVE) by @{[ (caller)[1,2] ]}\n";
_slot_schedule $host;
});
} else {
# nobody wants the slot, maybe we can forget about it
delete $CO_SLOT{$host} unless $CO_SLOT{$host}[0];
view release on metacpan or search on metacpan
lib/AnyEvent/Worker.pm view on Meta::CPAN
$self->{fh} = $client;
AnyEvent::Util::fh_nonblocking $client, 1;
my $rbuf;
my @caller = (caller)[1,2]; # the "default" caller
{
Scalar::Util::weaken (my $self = $self);
$self->{rw} = AnyEvent->io (fh => $client, poll => "r", cb => sub {
lib/AnyEvent/Worker.pm view on Meta::CPAN
=cut
sub do {
my $self = shift;
my $cb = pop;
my ($filename,$line) = (caller)[1,2];
unless ($self->{fh}) {
local $@ = my $err = 'no worker connection';
$cb->($self);
$self->_error ($err, $filename, $line, 1);
view release on metacpan or search on metacpan
lib/AnyEvent.pm view on Meta::CPAN
sub _logger($;$) {
my ($level, $renabled) = @_;
$$renabled = $level <= $VERBOSE;
my $logger = [(caller)[0], $level, $renabled];
$AnyEvent::Log::LOGGER{$logger+0} = $logger;
# return unless defined wantarray;
#
view release on metacpan or search on metacpan
lib/Apache/DebugLog/Config.pm view on Meta::CPAN
# Carp::croak(__PACKAGE__ . "loaded without call to import().")
# if ($mod_perl2::VERSION && $ENV{MOD_PERL} && !$IMPORT_GOT_RUN);
#}
sub import {
Apache2::Module::add((caller)[0], \@DIRECTIVES)
if ($mod_perl2::VERSION && $ENV{MOD_PERL});
$IMPORT_GOT_RUN++;
}
sub _set_loglevel {
view release on metacpan or search on metacpan
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
t/T/SWIT.pm view on Meta::CPAN
use Carp;
use File::Basename qw(dirname);
sub swit_startup {
append_file("/tmp/swit_startup_test", sprintf("%d %s %s\n"
, $$, $_[0], (caller)[1]));
}
sub swit_render {
my ($class, $r) = @_;
if ($r->uri !~ /huge/) {
view release on metacpan or search on metacpan
lib/Apache/TestUtil.pm view on Meta::CPAN
}
sub t_cmp ($$;$) {
Carp::carp(join(":", (caller)[1..2]) .
' usage: $res = t_cmp($received, $expected, [$comment])')
if @_ < 2 || @_ > 3;
my ($received, $expected) = @_;
view release on metacpan or search on metacpan
sub error {
my($error, $package, $line, $r);
if (@_) {
($package, $line) = (caller)[0,2];
$ERRMSG = join('', "$package [$line]: ", @_);
eval { $r = Apache->request };
unless ($@) {
$r->log_error($ERRMSG);
}
view release on metacpan or search on metacpan
lib/App/CELL.pm view on Meta::CPAN
sitedir => { type => SCALAR, optional => 1 },
verbose => { type => SCALAR, default => 0 },
} );
my $status;
$log->info( "CELL version $VERSION called from " . (caller)[0] .
" with arguments " . stringify_args( \%ARGS ),
cell => 1, suppress_caller => 1 );
# we only get past this next call if at least the sharedir loads
# successfully (sitedir is optional)
view release on metacpan or search on metacpan
lib/App/Cache.pm view on Meta::CPAN
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
unless ( $self->application ) {
my $caller = (caller)[0];
$self->application($caller);
}
unless ( $self->directory ) {
my $dir = dir( home(), "." . $self->_clean( $self->application ),
view release on metacpan or search on metacpan
lib/App/Dochazka/REST/Model/Shared.pm view on Meta::CPAN
=cut
sub make_test_exists {
my ( $t ) = validate_pos( @_, { type => SCALAR } );
my $pkg = (caller)[0];
return sub {
my ( $conn, $s_key ) = @_;
require Try::Tiny;
my $routine = "load_by_$t";
lib/App/Dochazka/REST/Model/Shared.pm view on Meta::CPAN
my ( $conn, $eid, $ts ) = validate_pos( @_,
{ isa => 'DBIx::Connector' },
{ type => SCALAR },
{ type => SCALAR|UNDEF, optional => 1 }
);
#$log->debug( "priv_by_eid: EID is " . (defined( $eid ) ? $eid : 'undef') . " - called from " . (caller)[1] . " line " . (caller)[2] );
return _st_by_eid( $conn, 'priv', $eid, $ts );
}
=head2 schedule_by_eid
lib/App/Dochazka/REST/Model/Shared.pm view on Meta::CPAN
}
@args = ( $sql, undef, $eid );
}
$log->debug("About to run SQL statement $sql with parameter $eid - " .
" called from " . (caller)[1] . " line " . (caller)[2] );
my $status;
try {
$conn->run( fixup => sub {
( $row ) = $_->selectrow_array( @args );
view release on metacpan or search on metacpan
lib/App/Git/Workflow/Command.pm view on Meta::CPAN
-input => $caller_package,
%p2u_extra,
) and return;
if ( $option->{'version'} ) {
my $name = (caller)[0] . '::name';
no strict qw/refs/; ## no critic
print "${$name} Version = $VERSION\n";
return;
}
elsif ( $option->{'man'} ) {
view release on metacpan or search on metacpan
lib/App/Memcached/CLI/Util.pm view on Meta::CPAN
sub debug {
my $message = shift;
return unless $App::Memcached::CLI::DEBUG;
my ($sec, $usec) = gettimeofday;
printf STDERR "%s.%03d [DEBUG] $message at %s line %d.\n",
strftime('%F %T', localtime($sec)), $usec/1000, (caller)[1,2];
}
sub is_unixsocket {
my $file = shift;
return 1 if (-e $file && -S $file);
view release on metacpan or search on metacpan
lib/App/Memcached/Tool/Util.pm view on Meta::CPAN
sub debug {
my $message = shift;
return unless $App::Memcached::Tool::DEBUG;
my ($sec, $usec) = gettimeofday;
printf STDERR "%s.%03d [DEBUG] $message at %s line %d.\n",
strftime('%F %T', localtime($sec)), $usec/1000, (caller)[1,2];
}
sub is_unixsocket {
my $file = shift;
return 1 if (-e $file && -S $file);
view release on metacpan or search on metacpan
lib/App/Multigit/Script.pm view on Meta::CPAN
exports a C<%options> into your script's namespace (i.e. C<main>).
=cut
sub import {
my $package = (caller)[0];
read_stdin();
my %options = get_default_options($package);
chdir $options{workdir};
_install_symbol( \%options, $package, 'options');
}
view release on metacpan or search on metacpan
lib/App/NDTools/Test.pm view on Meta::CPAN
sub t_ab_cmp {
return "GOT: " . t_dump(shift) . "\nEXP: " . t_dump(shift);
}
sub t_dir {
my $tfile = shift || (caller)[1];
substr($tfile, 0, length($tfile) - 1) . "d";
}
sub t_dump {
return Data::Dumper->new([shift])->Terse(1)->Sortkeys(1)->Quotekeys(0)->Indent(0)->Deepcopy(1)->Dump();
view release on metacpan or search on metacpan
lib/App/Netdisco/Worker/Plugin.pm view on Meta::CPAN
my $workerconf = (ref $first eq 'HASH' ? $first : {});
my $code = (ref $first eq 'CODE' ? $first : $second);
return error "bad param to register_worker"
unless ((ref sub {} eq ref $code) and (ref {} eq ref $workerconf));
my $package = (caller)[0];
($workerconf->{package} = $package) =~ s/^App::Netdisco::Worker::Plugin:://;
if ($package =~ m/Plugin::(\w+)(?:::(\w+))?/) {
$workerconf->{action} ||= lc($1);
$workerconf->{namespace} ||= lc($2) if $2;
}