\(caller\)\[ results from the CPAN

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 all matches for this distribution

Method-Signatures

1 match

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 all matches for this distribution

Mic

2 results

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 all matches for this distribution

Minima

1 match

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 all matches for this distribution

Minions

2 results

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 all matches for this distribution

Module-ConfigureRequires

1 match

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 all matches for this distribution

Module-CryptSource

1 match

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 all matches for this distribution

Module-Generic

1 match

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 all matches for this distribution

Module-Pluggable-Loader

1 match

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 all matches for this distribution

Module-Pluggable-Singleton

1 match

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 all matches for this distribution

Module-Runtime

1 match

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 all matches for this distribution

Mojo-Pg-Che

1 match

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 all matches for this distribution

Mojolicious

4 results

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 all matches for this distribution

Monitoring-Plugin

1 match

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 all matches for this distribution

Moo

2 results

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 all matches for this distribution

MooX-Role-Parameterized

1 match

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 all matches for this distribution

Moose

1 match

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 all matches for this distribution

MooseX-CoverableModifiers

1 match

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 all matches for this distribution

Mouse

1 match

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 all matches for this distribution

Mousse

1 match

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 all matches for this distribution

Multi-Dispatch

1 match

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 all matches for this distribution

Nagios-Monitoring-Plugin

1 match

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 all matches for this distribution

Net-Curl

2 results

inc/Compat.pm view on Meta::CPAN

VERSION
=cut

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

my %packages = (

view all matches for this distribution

Net-Dev-MIBLoadOrder

1 match

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 all matches for this distribution

Net-DirectConnect

1 match

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 '../..';

view all matches for this distribution

Net-FullAuto

1 match

                         "but a cache key is not defined");
         }
      }
   } elsif ((-1==index $caller,'mirror') &&
         (-1==index $caller,'login_retry')) {
      my $time_out='$' . (caller)[0] . '::timeout';
      $time_out= eval $time_out;
      if ($@ || $time_out!~/^[1-9]+/) {
         $timeout=30;
      } else { $timeout=$time_out }
   } else { print "FOUR\n";$timeout=30 }

            handle_error("A cache object exists, ".
                         "but a cache key is not defined");
         }
      }
   } else {
      my $tst='$' . (caller)[0] . '::test';
      $tst= eval $tst;
      $tst||=0;
      if ($@ || $tst!~/^[1-9]+/) {
         $Net::FullAuto::FA_Core::test=0;
      } else { $Net::FullAuto::FA_Core::test=$tst }

{

   if (defined $_[0] && $_[0]=~/^\d+$/) {
      $timeout=$_[0];
   } else {
      my $time_out='$' . (caller)[0] . '::timeout';
      $time_out= eval $time_out;
      $time_out||=30;
      if ($@ || $time_out!~/^[1-9]+/) {
         $timeout=30;
      } else { $timeout=$time_out }
   } $test=0;$prod=0;

   ###################################
   # The following are being set if
   # found defined in Term::Menus
   my $log_='$' . (caller)[0] . '::log';
   $log_= eval $log_;
   $log_=0 if $@ || !$log_;
   my $tosspass_='$' . (caller)[0] . '::tosspass';
   $tosspass_= eval $tosspass_;
   $tosspass_=0 if $@ || !$tosspass_;
   ## end Term::Menus defs ###########

   my $fhtimeout='X';
   my $fatimeout=$timeout;
   my $tst='$' . (caller)[0] . '::test';
   $tst=eval $tst;
   $test=$tst if !$@ || $tst=~/^[1-9]+/;
   my $_connect='connect_ssh_telnet';
   if (exists $Hosts{"__Master_${$}__"}{'Local'}) {
      my $loc=$Hosts{"__Master_${$}__"}{'Local'};

      }
   } else {
      @RCM_Link=('ssh','telnet');
      $Hosts{"__Master_${$}__"}{'Local'}=$_connect;
   }
   $email_defaults='%' . (caller)[0] . '::email_defaults';
   %email_defaults=eval $email_defaults;
   if ($@) {
      $email_defaults=0;
      %email_defaults=();
   } else { $email_defaults=1 }
   my $email_addresses='%' . (caller)[0] . '::email_addresses';
   %email_addresses=eval $email_addresses;
   %email_addresses=() if $@;
   my $test_caller=(caller)[0];
   $custom_code_module_file='$' . (caller)[0] . '::fa_code';
   $custom_code_module_file=eval $custom_code_module_file;
   if ($@) {
      my $die="Cannot Locate the \"FullAuto Custom Code\" "
           ."perl module (.pm) file\n       < original "
           ."default name 'fa_code.pm' >\n\n       $@";

         $dot=1;
      } elsif ($_[1] eq '__dotdot__') {
         $dotdot=1;
      }
   }
   my $caller=(caller)[2];
   my $hostlabel=$self->{_hostlabel}->[0];
   my ($ip,$hostname,$use,$ms_share,$ms_domain,
       $cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
       $owner,$group,$sdtimeout,$transfer_dir,$uname,
       $ping,$password,$proxy,$identityfile,$spawn,


print "WHAT IS CACHE=$cache\n" if $cache;
print "KEYS=",(join " | ",keys %{$cache}),"\n" if $cache;
#print $Net::FullAuto::FA_Core::LOG "CACHEEEEEEEEEEEEEEEEEEEEEEEEEE=",$cache->{'key'},"\n";
   
   ($caller,$cline)=(caller)[1,2];
   if (ref $args{DestHost} eq 'ARRAY') {
      @dhostlabels=@{$args{DestHost}};
   } elsif (4<length $args{DestHost} && unpack('a5',$args{DestHost})
         eq 'ARRAY') {
      &Net::FullAuto::FA_Core::handle_error(

view all matches for this distribution

Net-IEC104

1 match

lib/Net/IEC104.pm view on Meta::CPAN

sub DEBUG {
    my $d = shift;
    if ( $debug >= $d ) {
        print @_;
        if ( $d < 0 ) {
            printf "<-- at %s:%s", (caller)[ 1, 2 ];
        }
        unless ( $_[$#_] =~ /\s$/ ) {
            print "\n";
        }
    }

view all matches for this distribution

Net-Ident

1 match

Ident.pm view on Meta::CPAN

        # check for fully qualified name
        if ( $fh !~ /'|::/ ) {
            print STDDBG "$fh is not fully qualified\n" if $DEBUG;

            # get our current package
            my $mypkg = (caller)[0];
            print STDDBG "We are package $mypkg\n" if $DEBUG;

            # search for calling package
            my $depth = 1;
            my $otherpkg;

view all matches for this distribution

Net-MQTT-Simple

1 match

lib/Net/MQTT/Simple.pm view on Meta::CPAN

    $server or return;

    $global = $class->new($server);

    no strict 'refs';
    *{ (caller)[0] . "::publish" }  = \&publish;
    *{ (caller)[0] . "::retain"  }  = \&retain;
    *{ (caller)[0] . "::mqtt_get" } = \&get;
}

sub new {
    my ($class, $server, $sockopts) = @_;
    @_ == 2 or @_ == 3 or _croak "Wrong number of arguments for $class->new";

view all matches for this distribution

Net-SC

1 match

	local $_;

	unless ( exists $self->{ 'CFG_' . uc($section) } ) {
		$self->log_error("Use unknown configuration variable : `$section'");
		return undef;
	} elsif ( uc($section) eq 'CHAIN_DATA' and (caller)[0] ne __PACKAGE__ ) {
		#
		# íÁÌÅÎØËÁÑ ËÕÞËÁ ÓÏÌÏÍËÉ, ÏÔ ÉÚÍÅÎÅÎÉÑ ÄÁÎÎÙÈ ËÏÎÆÉÇÕÒÁÃÉÏÎÎÏÇÏ ÆÁÊÌÁ...
		#
		return $self->{ 'CFG_' . uc($section) };
	} else {

	#
	# syslogd
	#
	if ( ref $self and $self->configure( 'SYSLOG' ) and $^O !~ /[Ww]in32/ ) {
		foreach ( @_ ) {
			syslog( 'debug', '%s [ %d ]', $_, (caller)[-1] ) unless /^\s*$/;
		}
		return 1;
	}
	#
	# ÷ÓÅ ÏÓÔÁÌØÎÏÅ

	if ( ref $self and $self->configure( 'SYSLOG' ) and $^O !~ /[Ww]in32/ ) {
		#
		# syslogd
		#
		foreach ( @_ ) {
			syslog( 'warning', '%s [ %d ]', $_, (caller)[-1] ) unless /^\s*$/;
		}
	} elsif (	ref $self and
				$self->configure( 'SYSLOG' ) and
				defined $self->configure( 'LOG_FH' ) ) {
		#