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

 view release on metacpan or  search on metacpan

lib/Moo/Role.pm  view on Meta::CPAN

  while ((my $pack, $file) = caller($lvl++)) {
    if ($pack ne __PACKAGE__ && $pack ne 'Role::Tiny' && !$pack->isa($me)) {
      last;
    }
  }
  _set_loaded($new_name, $file || (caller)[1]);

  return $new_name;
}

sub _gen_apply_defaults_for {

lib/Moo/Role.pm  view on Meta::CPAN

sub apply_roles_to_object {
  my ($me, $object, @roles) = @_;
  my $new = $me->SUPER::apply_roles_to_object($object, @roles);
  my $class = ref $new;
  _set_loaded($class, (caller)[1]);

  if (!exists $APPLY_DEFAULTS{$class}) {
    $APPLY_DEFAULTS{$class} = $me->_gen_apply_defaults_for($class, @roles);
  }
  if (my $apply_defaults = $APPLY_DEFAULTS{$class}) {

 view release on metacpan or  search on metacpan

lib/MooX/Role/Parameterized.pm  view on Meta::CPAN

      "unable to apply parameterized role: not an MooX::Role::Parameterized"
      if !__PACKAGE__->is_role($role);

    $args = [$args] if ref($args) ne ref( [] );

    my $target = defined( $extra{target} ) ? $extra{target} : (caller)[0];

    if (   exists $INFO{$role}
        && exists $INFO{$role}{code_for}
        && ref $INFO{$role}{code_for} eq "CODE" )
    {

lib/MooX/Role/Parameterized.pm  view on Meta::CPAN

    Moo::Role->apply_roles_to_package( $target, $role );
}

sub role(&) {    ##no critic (Subroutines::ProhibitSubroutinePrototypes)
    my $package = (caller)[0];

    $INFO{$package} ||= { is_role => 1 };

    croak "role subroutine called multiple times on '$package'"
      if exists $INFO{$package}{code_for};

    $INFO{$package}{code_for} = shift;
}

sub parameter {
    my $package = (caller)[0];

    $INFO{$package} ||= { is_role => 1 };

    push @{ $INFO{$package}{parameters_definition} ||= [] }, \@_;
}

lib/MooX/Role/Parameterized.pm  view on Meta::CPAN

sub build_apply_roles_to_package {
    my ( $klass, $orig ) = @_;

    return sub {
        my $target = (caller)[0];

        while (@_) {
            my $role = shift;

            eval { use_module($role) };

 view release on metacpan or  search on metacpan

lib/Class/MOP/Class.pm  view on Meta::CPAN

sub make_immutable {
    my ( $self, @args ) = @_;

    return $self unless $self->is_mutable;

    my ($file, $line) = (caller)[1..2];

    $self->_initialize_immutable(
        file => $file,
        line => $line,
        $self->_immutable_options(@args),

 view release on metacpan or  search on metacpan

inc/Class/MOP/Class.pm  view on Meta::CPAN

sub make_immutable {
    my ( $self, @args ) = @_;

    return $self unless $self->is_mutable;

    my ($file, $line) = (caller)[1..2];

    $self->_initialize_immutable(
        file => $file,
        line => $line,
        $self->_immutable_options(@args),

 view release on metacpan or  search on metacpan

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

    my $serial_id = $self->{anon_serial_id};
    return if !$serial_id;

    # XXX: cleaning stash with threads causes panic/SEGV on legacy perls.
    if(exists $INC{'threads.pm'}) {
        # (caller)[2] indicates the caller's line number,
        # which is zero when the current thread is joining (destroying).
        return if( (caller)[2] == 0);
    }

    # clean up mortal anonymous class stuff

    # @ISA is a magical variable, so we must clear it manually.

 view release on metacpan or  search on metacpan

lib/Mousse.pm  view on Meta::CPAN

	my $serial_id = $self->{anon_serial_id};
	return if !$serial_id;

	# XXX: cleaning stash with threads causes panic/SEGV on legacy perls.
	if(exists $INC{'threads.pm'}) {
		# (caller)[2] indicates the caller's line number,
		# which is zero when the current thread is joining (destroying).
		return if( (caller)[2] == 0);
	}

	# clean up mortal anonymous class stuff

	# @ISA is a magical variable, so we must clear it manually.

 view release on metacpan or  search on metacpan

lib/Multi/Dispatch.pm  view on Meta::CPAN

  my $redispatcher = '$' . join q{}, map { ('a'..'z', 'A'..'Z')[rand 52] } 1..20;

  # Enable warnings for this module class...
  warnings->import('Multi::Dispatch');

  Keyword::Simple::define multi       => gen_handler_for('multi', (caller)[0]);
  Keyword::Simple::define multimethod => gen_handler_for('multimethod', (caller)[0]);
}

sub _annotate {
    my ($package, $file) = @_;

lib/Multi/Dispatch.pm  view on Meta::CPAN

            my @failures;
            </VERBOSE>
            <DEBUG>
            warn sprintf "\nDispatching call to <NAME>("
                        . join(', ', map({Data::Dump::dump($_)} @_))
                        . ") at %s line %s\\n", (caller)[1,2];
            </DEBUG>
            while (my $variant = shift @variants) {
                # Skip variants that can't possibly work...
                <VERBOSE>
                # Extract the debugging information...

lib/Multi/Dispatch.pm  view on Meta::CPAN

            <VERBOSE>
            if (1 == grep /-->/, @failures) {
                die sprintf( "Can't call <NAME>(%s)\\n"
                        . "at %s line %s\\n",
                            join(', ', map({Data::Dump::dump($_)} @_)),
                            (caller)[1,2]), map { s/SKIPPED: //r } grep /-->/, @failures;
            }
            </VERBOSE>
            die sprintf( "No suitable variant for call to <KEYWORD> <NAME>()\\n"
                       . "with arguments: (%s)\\n"
                       . "at %s line %s\\n",
                         join(', ', map({Data::Dump::dump($_)} @_)),
                         (caller)[1,2]) <VERBOSE>, @failures</VERBOSE>;

    } =~ s{ <VERBOSE> (.*?) </VERBOSE> }{ $arg{verbose}  ? $1                             : q{} }egxmsr
      =~ s{   <DEBUG> (.*?) </DEBUG>   }{ $arg{debug}    ? $1                             : q{} }egxmsr
      =~ s{       <VARIANT_CODE>       }{ $arg{invocant} ? q{$_[0]->${\$variant->{code}}(@_[1..$#_])}
                                                         : q{&{$variant->{code}}} }egxmsr

 view release on metacpan or  search on metacpan

t/Nagios-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 );

 view release on metacpan or  search on metacpan

inc/Compat.pm  view on Meta::CPAN

VERSION
=cut

# Dirty hack so Test::ConsistentVersion passes
sub VERSION {
	return (caller)[0] eq 'Test::ConsistentVersion'
		? '0.58'
		: $VERSION;
}

my %packages = (

 view release on metacpan or  search on metacpan

MIBLoadOrder.pm  view on Meta::CPAN

sub _myprintf {

  return unless $DEBUG;

   my $_format = shift;
   my ($_pkg, $_line) = (caller)[0,2];
   my $_func = (caller(1))[3];
   $_pkg =~ s/.+://;
   $_func =~ s/.+://;

   printf("%s: %s: [%s]:  $_format", $_pkg, $_func, $_line, @_);

 view release on metacpan or  search on metacpan

lib/Net/DirectConnect/filelist.pm  view on Meta::CPAN

      $self->share_add_file( $full, $tth ), $self->share_changed()
      if !$self->{'file_recv_filelist'} and !$self->{'no_auto_share_downloaded'};  # unless $self->{'no_auto_share_downloaded'};
         #TODO          $self->{db}->insert_hash( 'filelist', $f ) if !$self->{no_sql} and $f->{tth};
    ;
    };
  $self->filelist_load() unless $standalone;    # (caller)[0] ~~ __PACKAGE__;
                                                #$self->log('initok');
  return $self;
}
eval q{ #do
  use lib '../..';