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/JQ/Lite/Util.pm view on Meta::CPAN
my $decode_json_impl = \&_decode_json;
{
no warnings 'redefine';
*_decode_json = sub {
my @args = @_;
my $want_structured = (caller)[0] eq 'JQ::Lite';
return $decode_json_impl->(@args) unless $want_structured;
my ($value, $ok, $err);
{
local $@;
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
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
view release on metacpan or search on metacpan
lib/Elatin7.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/Elatin8.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/Elatin9.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/Lingua/EN/Inflect.pm view on Meta::CPAN
{
my $num = shift;
if (@_ % 2 and require Carp) {
die "Missing value in option list (odd number of option args) at"
. join ' line ', (caller)[1,2];
}
my %arg = ( %default_args, @_ );
my $group = $arg{group};
view release on metacpan or search on metacpan
lib/Lingua/ENG/Inflect.pm view on Meta::CPAN
{
my $num = shift;
if (@_ % 2 and require Carp) {
die "Missing value in option list (odd number of option args) at"
. join ' line ', (caller)[1,2];
}
my %arg = ( %default_args, @_ );
my $group = $arg{group};
view release on metacpan or search on metacpan
lib/Lingua/Romana/Perligata.pm view on Meta::CPAN
my $translate = 0;
my $debug = 0;
sub import {
filter_add({});
$offset = (caller)[2]+1;
$translate = grep /^converte?$/i, @_[1..$#_];
$debug = grep /^investiga?$/i, @_[1..$#_];
$lex = grep /^discribe?$/i, @_[1..$#_];
1;
}
view release on metacpan or search on metacpan
lib/Lingua/Shakespeare.pm view on Meta::CPAN
my ($num_errors, $num_warnings, @token, $current_act, $current_scene);
sub import {
filter_add({});
$yylineno = (caller)[2]+1;
1;
}
sub unimport { filter_del() }
view release on metacpan or search on metacpan
lib/Log/Abstraction.pm view on Meta::CPAN
# ---------------------------------------------------------------------------
sub _log :Private {
my ($self, $level, @messages) = @_;
# Reject direct calls from outside this package (also enforced by :Private)
if(!(caller)[0]->isa(__PACKAGE__)) {
Carp::croak('Illegal Operation: _log is a private method');
}
# Sanity-check the level (should not be reachable in normal use)
if(!defined($syslog_values{$level})) {
view release on metacpan or search on metacpan
if (!$Configuration) {
$Configuration = new Log::Channel::Config;
}
my $package = (caller)[0];
if ($package ne "main") {
unshift @_, $package;
}
if (!$Channel{$package}) {
# make sure channel exists for the entire package
is specified, the full verbose text will go to the log channel.
=cut
sub _carp {
my $topic = (caller)[0];
my $channel = $Channel{$topic}->{channel};
$channel = Log::Channel->_make($topic) unless $channel;
$channel->(Carp::shortmess @_);
be output to two places - the channel, and STDERR (or whatever die() does).
=cut
sub _croak {
my $topic = (caller)[0];
my $channel = $Channel{$topic}->{channel};
$channel = Log::Channel->_make($topic) unless $channel;
$channel->(Carp::shortmess @_);
=cut
sub export {
my ($channel, $subname) = @_;
my $package = (caller)[0];
no strict 'refs';
*{"$package\::$subname"} = sub { $channel->(@_) };
}