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
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
{
my ($self, $level, @messages) = @_;
if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
Carp::croak('Illegal Operation: This method can only be called by a subclass or ourself');
}
if(!defined($syslog_values{$level})) {
Carp::Croak(ref($self), ": Invalid level '$level'"); # "Can't happen"
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->(@_) };
}
view release on metacpan or search on metacpan
lib/Log/Handler.pm view on Meta::CPAN
# use Log::Handler qw/foo LOGFOO bar LOGBAR/;
sub import {
return unless @_ > 1;
my $class = shift;
my %create = @_ > 1 ? @_ : (@_, undef);
my $caller = (caller)[0];
foreach my $appl (keys %create) {
my $export = $create{$appl};
my $logger = ();
view release on metacpan or search on metacpan
lib/Log/Info.pm view on Meta::CPAN
push @{$channel{$chan}{trans}}, $trans;
our %chan_trans;
$chan_trans{$chan}->{$name} = +{ pos => $#{$channel{$chan}{trans}},
tran => $trans,
create_line => join(':', (caller)[1,2]),
};
return $name;
}
sub remove_chan_trans {
lib/Log/Info.pm view on Meta::CPAN
# Always terminate with a newline. This ensures conformity of message
# with that checked in SIG{__DIE__}, which otherwise may have an
# "\n at line..." appended.
# If we want such appendages, we can add them ourselves
$message =~
s/([^\n])\z/sprintf("%s at %s line %d", $1, (caller)[1,2]) . "\n"/e;
$message =~ s/\n+\z/\n/;
Log(CHAN_INFO, LOG_ERR, "$message")
unless $message eq $lastmessage;
$lastmessage = $message;
}
view release on metacpan or search on metacpan
lib/Log/Log4Cli.pm view on Meta::CPAN
use Term::ANSIColor qw(colored);
BEGIN {
*CORE::GLOBAL::die = sub {
my $msg = join(' ', grep { defined } @_) || "Died";
$msg .= " at " . join(' line ', (caller)[1,2]);
&die_fatal($msg, 255);
};
}
our $VERSION = '0.22'; # Don't forget to change in pod below
view release on metacpan or search on metacpan
lib/Log/Log4perl/AutoInit.pm view on Meta::CPAN
sub get_logger {
my $category = shift;
_init();
$category = $default_category unless defined $category;
$category = (caller)[0] unless defined $category;
return Log::Log4perl::get_logger($category);
}
my $initialized = 0; # move to state when we can drop 5.8 support