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
view release on metacpan or search on metacpan
lib/Log/Report/Translator/POT.pm view on Meta::CPAN
sub new(@)
{ my $class = shift;
# Caller cannot wait until init()
$class->SUPER::new(callerfn => (caller)[1], @_);
}
sub init($)
{ my ($self, $args) = @_;
$self->SUPER::init($args);
view release on metacpan or search on metacpan
lib/Log/Report/Minimal.pm view on Meta::CPAN
sub __($) { shift }
sub __x($@)
{ @_%2 or error __x"even length parameter list for __x at {where}"
, where => join(' line ', (caller)[1,2]);
_interpolate @_, _expand => 1;
}
view release on metacpan or search on metacpan
lib/Log/Report.pm view on Meta::CPAN
{ # used for 'maintenance' and testing
return delete $reporter->{textdomains}{$_[0]} if $_[1] eq 'DELETE';
return $reporter->{textdomains}{$_[0]} if $_[1] eq 'EXISTS';
}
my $name = (@_%2 ? shift : pkg2domain((caller)[0])) || 'default';
my $domain = $reporter->{textdomains}{$name} ||= Log::Report::Domain->new(name => $name);
$domain->configure(@_, where => [caller]) if @_;
$domain;
}
view release on metacpan or search on metacpan
lib/Log/YetAnother.pm view on Meta::CPAN
# $logger->_log($level, @messages);
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');
}
# Push the message to the internal messages array
push @{$self->{messages}}, { level => $level, message => join(' ', grep defined, @messages) };
view release on metacpan or search on metacpan
lib/MIDI/Simple.pm view on Meta::CPAN
=cut
sub n { # a note
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
&MIDI::Simple::_parse_options($it, @_);
foreach my $note_val (@{$it->{"Notes"}}) {
# which should presumably not be a null list
unless($note_val =~ /^\d+$/) {
carp "note value \"$note_val\" from Notes is non-numeric! Skipping.";
lib/MIDI/Simple.pm view on Meta::CPAN
=cut
sub r { # a rest
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
&MIDI::Simple::_parse_options($it, @_);
${$it->{"Time"}} += ${$it->{"Duration"}};
return;
}
###########################################################################
lib/MIDI/Simple.pm view on Meta::CPAN
=cut
sub noop { # no operation
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
&MIDI::Simple::_parse_options($it, @_);
return;
}
#--------------------------------------------------------------------------
lib/MIDI/Simple.pm view on Meta::CPAN
) { # I'm a method!
print "~ new_score as a MIDI::Simple constructor\n" if $Debug;
$it = bless {};
&_init_score($it);
} else { # I'm a proc!
my $cpackage = (caller)[0];
print "~ new_score as a proc for package $cpackage\n" if $Debug;
if( ref($package{ $cpackage }) ) { # Already exists in %package
print "~ reinitting pobj $cpackage\n" if $Debug;
&_init_score( $it = $package{ $cpackage } );
# no need to call _package_object
lib/MIDI/Simple.pm view on Meta::CPAN
# read-or-write methods
sub Score (;\@) { # yes, a prototype!
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
if(@_) {
if($am_method){
@{$it->{'Score'}} = @_;
} else {
@{$it->{'Score'}} = @{$_[0]}; # sneaky, huh!
lib/MIDI/Simple.pm view on Meta::CPAN
}
}
sub Cookies {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
%{$it->{'Cookies'}} = @_ if @_; # Better have an even number of elements!
return %{$it->{'Cookies'}};
}
sub Time {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
${$it->{'Time'}} = $_[0] if @_;
return ${$it->{'Time'}};
}
sub Duration {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
${$it->{'Duration'}} = $_[0] if @_;
return ${$it->{'Duration'}};
}
sub Channel {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
${$it->{'Channel'}} = $_[0] if @_;
return ${$it->{'Channel'}};
}
sub Octave {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
${$it->{'Octave'}} = $_[0] if @_;
return ${$it->{'Octave'}};
}
sub Tempo {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
${$it->{'Tempo'}} = $_[0] if @_;
return ${$it->{'Tempo'}};
}
sub Notes {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
@{$it->{'Notes'}} = @_ if @_;
return @{$it->{'Notes'}};
}
sub Volume {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
${$it->{'Volume'}} = $_[0] if @_;
return ${$it->{'Volume'}};
}
#-#-#-#-#-#-#-#-##-#-#-#-#-#-#-#-#-#-#-#-##-#-#-#-#-#-#-#-##-#-#-#-#-#-#-#-
# read-only methods that return references
sub Score_r {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
return $it->{'Score'};
}
sub Time_r {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
return $it->{'Time'};
}
sub Duration_r {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
return $it->{'Duration'};
}
sub Channel_r {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
return $it->{'Channel'};
}
sub Octave_r {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
return $it->{'Octave'};
}
sub Tempo_r {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
return $it->{'Tempo'};
}
sub Notes_r {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
return $it->{'Notes'};
}
sub Volume_r {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
return $it->{'Volume'};
}
sub Cookies_r {
my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
: ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
return $it->{'Cookies'};
}
###########################################################################
###########################################################################
lib/MIDI/Simple.pm view on Meta::CPAN
=cut
sub _test_proc {
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
print " am method: $am_method\n it: $it\n params: <", join(',',@_), ">\n";
}
###########################################################################
lib/MIDI/Simple.pm view on Meta::CPAN
=cut
sub write_score {
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
my($out, $ticks, $score_r) =
( $_[0], (${$it->{'Tempo'}} || 96), $it->{'Score'} );
croak "First parameter to MIDI::Simple::write_score can't be null\n"
unless( ref($out) || length($out) );
lib/MIDI/Simple.pm view on Meta::CPAN
my $it;
if($am_cons) { # just make a new object and return it.
$it = MIDI::Simple->new_score;
$it->{'Score'} = $score_r;
} else { # need to fudge it back into the pobj
my $cpackage = (caller)[0];
#print "~ read_score as a proc for package $cpackage\n";
if( ref($package{ $cpackage }) ) { # Already exists in %package
print "~ reinitting pobj $cpackage\n" if $Debug;
&_init_score( $it = $package{ $cpackage } );
# no need to call _package_object
lib/MIDI/Simple.pm view on Meta::CPAN
=cut
sub synch {
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
my @subs = grep(ref($_) eq 'CODE', @_);
print " My subs: ", map("<$_> ", @subs), ".\n"
if $Debug;
lib/MIDI/Simple.pm view on Meta::CPAN
sub make_opus {
# Make a format-0 one-track MIDI out of this score.
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
my($ticks, $score_r) = (${$it->{'Tempo'}}, $it->{'Score'});
carp "Encoding a score with no notes!" unless @$score_r;
my $events_r = ( MIDI::Score::score_r_to_events_r($score_r) )[0];
carp "Creating a track with no events!" unless @$events_r;
lib/MIDI/Simple.pm view on Meta::CPAN
=cut
sub dump_score {
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
return &MIDI::Score::dump_score( $it->{'Score'} );
}
###########################################################################
###########################################################################
lib/MIDI/Simple.pm view on Meta::CPAN
sub interval { # apply an interval to a list of notes.
my(@out);
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
my($interval_r, @notes) = @_;
croak "first argument to &MIDI::Simple::interval must be a listref\n"
unless ref($interval_r);
# or a valid key into a hash %Interval?
lib/MIDI/Simple.pm view on Meta::CPAN
sub Self { # pointless as a method -- but as a sub, useful if
# you want to access your current package's object.
# Juuuuuust in case you need it.
my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
? (1, shift @_)
: (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
return $it;
}
=back
view release on metacpan or search on metacpan
lib/MOSES/MOBY/Config.pm view on Meta::CPAN
# imports names into the caller's namespace as global variables;
# adapted from the same method in Config::Simple
sub import_names {
shift;
my $namespace = @_ ? shift : (caller)[0];
return if $namespace eq 'MOSES::MOBY::Config';
no strict 'refs';
no warnings; # avoid "Useless use of a variable..."
while ( my ($key, $value) = each %Config ) {
view release on metacpan or search on metacpan
t/Test/Simple.pm view on Meta::CPAN
_print *TESTOUT, $msg;
#'#
unless( $test ) {
my($pack, $file, $line) = (caller)[0,1,2];
if( $pack eq 'Test::More' ) {
($file, $line) = (caller(1))[1,2];
}
_print *TESTERR, "# Failed test ($file at line $line)\n";
}
view release on metacpan or search on metacpan
lib/Mail/Message/Body/Delayed.pm view on Meta::CPAN
: $_[0]->forceRealize->nrLines;
}
sub string_unless_carp()
{ my $self = shift;
return $self->load->string if (caller)[0] ne 'Carp';
(my $class = ref $self) =~ s/^Mail::Message/MM/g;
"$class object";
}
view release on metacpan or search on metacpan
inc/Sort/Versions.pm view on Meta::CPAN
}
@A <=> @B;
}
sub versions () {
my $callerpkg = (caller)[0];
my $caller_a = "${callerpkg}::a";
my $caller_b = "${callerpkg}::b";
no strict 'refs';
return versioncmp($$caller_a, $$caller_b);
}
view release on metacpan or search on metacpan
lib/Mail/Message/Body.pm view on Meta::CPAN
sub string() {shift->notImplemented}
sub string_unless_carp()
{ my $self = shift;
return $self->string unless (caller)[0] eq 'Carp';
(my $class = ref $self) =~ s/^Mail::Message/MM/;
"$class object";
}
view release on metacpan or search on metacpan
BDBaccess/Makefile.PL view on Meta::CPAN
my $localconf = $home .'/'. $conf;
# what to do with dialog if called from MAKE or parent Makefile
my $configtxt;
if ((caller)[0]) { # exists, the called by another routine
my $master = abs_path('../').'/'.$conf;
hard_fail("failed to access $_")
if ($_ = cpfromto($master,$localconf));
$CONFIG = do $localconf;
view release on metacpan or search on metacpan
lib/Math/Currency.pm view on Meta::CPAN
$value =~ tr/,/./;
}
$value =~ tr/-()0-9.//cd; #strip any formatting characters
$value = "-$value" if $value =~ s/(^\()|(\)$)//g; # handle parens
if ( (caller)[0] =~ /Math\::BigInt/ ) # only when called from objectify()
{
return Math::BigFloat->new($value);
}
my $self;
view release on metacpan or search on metacpan
lib/Math/Formula/Context.pm view on Meta::CPAN
}
sub run($%)
{ my ($self, $expr, %args) = @_;
my $name = delete $args{name} || join '#', (caller)[1,2];
my $result = Math::Formula->new($name, $expr)->evaluate($self, %args);
while($result && $result->isa('MF::NAME'))
{ $result = $self->evaluate($result->token, %args);
}
view release on metacpan or search on metacpan
lib/Math/ModInt.pm view on Meta::CPAN
sub residue {
Nonexistent->raise('undefined residue');
}
sub modulus {
return 0 if __PACKAGE__ eq (caller)[0]; # special case for _oadd etc.
Nonexistent->raise('undefined modulus');
}
sub signed_residue {
my ($this) = @_;
view release on metacpan or search on metacpan
lib/Matts/Message/Parser.pm view on Meta::CPAN
@Try_Encodings = qw(euc-cn euc-jp shiftjis euc-kr big5-eten iso-8859-15 );
sub debug {
return unless $ENV{DEBUG};
warn((caller)[2], @_);
}
sub mkbinmode {
if ($] > 5.007) {
binmode($_[0], ':utf8');
view release on metacpan or search on metacpan
lib/Apache/MVC.pm view on Meta::CPAN
=cut
sub warn {
my ($self,@args) = @_;
my ($package, $line) = (caller)[0,2];
my $ar = $self->parent ? $self->parent->{ar} : $self->{ar};
if ( $args[0] and ref $self ) {
$ar->warn("[$package line $line] ", @args) ;
} else {
print "warn called by ", caller, " with ", @_, "\n";
view release on metacpan or search on metacpan
lib/Memoize/Expire/ByInstance.pm view on Meta::CPAN
$self->{_hash} = ( exists( $opts{HASH} ) && ref( $opts{HASH} ) eq 'HASH' ) ? $opts{HASH} : {};
bless( $self, $class );
# Memoize doesn't deal well with "memoize('Package::method', ...)"; hence it must be tied and memoized
# in the same package that its used in... kinda annoying for unit testing... but handy in that I can use caller
$self->__insert_destroy_wrapper( (caller)[0] ) if( $opts{AUTO_DESTROY} );
$self->_argument_seperator( $opts{ARGUMENT_SEPERATOR} || FILE_SEPERATOR );
return $self;
}