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

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;
    }

 view release on metacpan or  search on metacpan

lib/Memoize/Memcached/Attribute.pm  view on Meta::CPAN

sub invalidate {
	my $symbol_name = shift;
	if ($symbol_name !~ /::/) {
		# build the full method from the caller's namespace if necessary
		$symbol_name = join('::', (caller)[0], $symbol_name);
	}

	my $key = Memoize::Memcached::Attribute::_build_key($symbol_name, @_);
	$MEMCACHE->delete($key);
	$MEMCACHE->delete("${key}-wantarray");

 view release on metacpan or  search on metacpan

t/line_numbers.t  view on Meta::CPAN

note "Computed default"; {
    # Using 'sub' to avoid further Method::Signatures interference
    sub return_caller_line {
        return (caller)[2];
    }

#line 30
    func computed_default (
        $static_default   = "test",

 view release on metacpan or  search on metacpan

lib/Mic/Implementation.pm  view on Meta::CPAN

        classmethod => { type => ARRAYREF, optional => 1 },
    });

    strict->import();

    $arg{-caller} = (caller)[0];
    $class->define(%arg);
}

sub define {
    my ($class, %arg) = @_;

    my $caller_pkg = delete $arg{-caller} || (caller)[0];
    my $stash = Package::Stash->new($caller_pkg);

    $class->add_attribute_syms(\%arg, $stash);

    $stash->add_symbol('%__meta__', \%arg);

 view release on metacpan or  search on metacpan

lib/Minima/Setup.pm  view on Meta::CPAN

{
    shift; # discard package name

    # If we were called from a .psgi, save
    # its parent as the base directory
    my $caller = path( (caller)[1] );
    if ($caller->basename =~ /\.psgi$/) {
        $base = $caller->absolute->parent;
    } else {
        $base = path('.')->absolute;
    }

 view release on metacpan or  search on metacpan

lib/Minions.pm  view on Meta::CPAN

        foreach my $class ( keys %$bindings ) {
            $Bound_implementation_of{$class} = $bindings->{$class};
        }
    }
    elsif ( my $methods = $arg{declare_interface} ) {
        my $caller_pkg = (caller)[0];
        $Interface_for{$caller_pkg} = $methods;
    }
    else {
        $class->minionize(\%arg);
    }

lib/Minions.pm  view on Meta::CPAN

sub minionize {
    my (undef, $spec) = @_;

    my $cls_stash;
    if ( ! $spec->{name} ) {
        my $caller_pkg = (caller)[0];

        if ( $caller_pkg eq __PACKAGE__ ) {
            $caller_pkg = (caller 1)[0];
        }
        $cls_stash = Package::Stash->new($caller_pkg);

 view release on metacpan or  search on metacpan

lib/Module/ConfigureRequires.pm  view on Meta::CPAN

 exit 0;
}

sub set_up {
 for($0, (caller)[1]) {
  /\bMakefile\.PL\z/i and goto &set_up_for_mm;
  /\bBuild\.PL\z/i and goto &set_up_for_mb;
 }
 require Carp;
 Carp'croak(

 view release on metacpan or  search on metacpan

CryptSource.pm  view on Meta::CPAN

=cut

my %Files;

sub import {
    return $Files{(caller)[1]}++
	if ($0 !~ /\.exe$/i) and (($ARGV[0] || '') eq '--ensrc');

    return unless ($ARGV[0] || '') eq '--desrc'; local *FH;

    %Files = %{+eval{thaw(unpack('N/a*', Crypt::Rijndael->new(md5_hex(

 view release on metacpan or  search on metacpan

lib/Module/Generic.pm  view on Meta::CPAN

            $sigil eq '&' )
        {
            no warnings 'once';
            my $filename = $opts->{filename};
            my $start_line = $opts->{start_line};
            ( $filename, $start_line ) = (caller)[1,2] if( !defined( $filename ) );
            my $end_line = $opts->{end_line} || ( $start_line ||= 0 );
            # <http://perldoc.perl.org/perldebguts.html#Debugger-Internals>
            $DB::sub{ $class . '::' . $name } = "${filename}:${start_line}-${end_line}";
        }
    }

 view release on metacpan or  search on metacpan

lib/Module/Pluggable/Loader.pm  view on Meta::CPAN

our $VERSION = '1.100860';
# ABSTRACT: Just load plugins, aware of development directories

sub import {
    my ($class, @namespaces) = @_;
    my $caller = (caller)[0];
    require Module::Pluggable;
    Module::Pluggable->import(
        package     => $caller,
        search_path => \@namespaces,
        (   @Devel::SearchINC::inc

 view release on metacpan or  search on metacpan

lib/Module/Pluggable/Singleton.pm  view on Meta::CPAN

=cut

sub import {
    my ($class, %opts) = @_;
    my $caller = (caller)[0];
    $opts{require} = 1; # you find out earlier if it has a syntax error
    $opts{package} = $caller;

    my $finder = Module::Pluggable::Singleton::Object->new(%opts);

 view release on metacpan or  search on metacpan

lib/Module/Runtime.pm  view on Meta::CPAN

            $errs .= "\"$_\" is not exported by the $me module\n";
        }
    }
    if($errs ne "") {
        die sprintf "%sCan't continue after import errors at %s line %u.\n",
            $errs, (caller)[1,2];
    }
}

# Logic duplicated from Params::Classify.  Duplicating it here avoids
# an extensive and potentially circular dependency graph.

 view release on metacpan or  search on metacpan

lib/Mojo/Pg/Che/Results.pm  view on Meta::CPAN

  
  #~ if ($sth->can($method) && scalar grep $_ eq $method, @STH_METHODS) {
    #~ return $sth->$method(@_);
  #~ }
  
  #~ 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];
  
#~ }

1;

 view release on metacpan or  search on metacpan

lib/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 download {
  my ($self, $url, $options) = (shift, shift, shift // {});

 view release on metacpan or  search on metacpan

t/Monitoring-Plugin-Range.t  view on Meta::CPAN

sub test_expected {
    my $r = shift;
    my $expected = shift;
    foreach (sort {$a<=>$b} keys %$expected) {
	is $r->check_range($_), $expected->{$_},
	"    $_ should " . ($expected->{$_} ? 'not ' : '') . "be in the range (line ".(caller)[2].")";
    }
}

test_expected( $r, $expected );