view release on metacpan or  search on metacpan

xs/ppport.h  view on Meta::CPAN

	    ccstack = top_si->si_cxstack;
	    cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
	}
	if (cxix < 0)
	    return NULL;
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
		ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
	    level++;
	if (!level--)
	    break;

xs/ppport.h  view on Meta::CPAN

    if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
        const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
	/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
	   field below is defined for any cx. */
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
	    cx = &ccstack[dbcxix];
    }

    return cx;

 view release on metacpan or  search on metacpan

lib/Archive/Par.pm  view on Meta::CPAN

sub recoverable {
  my $self = shift;

  croak sprintf("PRECONDITION on %s:%s: failed; not checked\n",
                (caller(0))[0,3])
    unless $self->checked;
  croak sprintf("PRECONDITION on %s:%s: failed; par ok\n",
                (caller(0))[0,3])
    if $self->ok;

  grep(! ($self->file_ok($_) || $self->file_recoverable($_)),
       $self->status_keys) == 0
}

lib/Archive/Par.pm  view on Meta::CPAN

sub restore {
  my $self = shift; my $class = ref $self;
  my ($remove_old_files) = @_;

  croak sprintf("PRECONDITION on %s:%s: failed; not recoverable\n",
                (caller(0))[0,3])
    unless $self->recoverable;

  my $fn = $self->fn;
  my $out;
  run([qw( par -m -f restore), $fn], '&>', \$out);

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

	    ccstack = top_si->si_cxstack;
	    cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
	}
	if (cxix < 0)
	    return NULL;
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
		ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
	    count++;
	if (!count--)
	    break;

ppport.h  view on Meta::CPAN

    if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
        const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
	/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
	   field below is defined for any cx. */
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
	    cx = &ccstack[dbcxix];
    }

    return cx;

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}

sub _running_under {
    my $thing = shift;
    print <<"END_MESSAGE";

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

    @found;
}

sub _caller {
    my $depth = 0;
    my $call  = caller($depth);
    while ( $call eq __PACKAGE__ ) {
        $depth++;
        $call = caller($depth);
    }
    return $call;
}

1;

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

	    ccstack = top_si->si_cxstack;
	    cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
	}
	if (cxix < 0)
	    return NULL;
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
		ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
	    count++;
	if (!count--)
	    break;

ppport.h  view on Meta::CPAN

    if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
        const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
	/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
	   field below is defined for any cx. */
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
	    cx = &ccstack[dbcxix];
    }

    return cx;

 view release on metacpan or  search on metacpan

lib/Archive/Unrar.pm  view on Meta::CPAN

################ PUBLIC METHODS ################ 

sub list_files_in_archive {
	
   my $caller_sub = ( caller(1) )[3];
   my %params=@_;

	my ($file,$password) = @params{qw (file password)};
	
    my ( $blockencrypted, $pass_req, $continue ) = extract_headers($file);

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

    return (@Existing, @Missing);
}

sub _running_under {

 view release on metacpan or  search on metacpan

private/MakeUtil.pm  view on Meta::CPAN

    my $upgrade ;
    my $downgrade ;
    my $do_downgrade ;

    my $caller = (caller(1))[3] || '';

    if ($caller =~ /downgrade/)
    {
        $downgrade = 1;
    }

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

	    ccstack = top_si->si_cxstack;
	    cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
	}
	if (cxix < 0)
	    return NULL;
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
		ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
	    level++;
	if (!level--)
	    break;

ppport.h  view on Meta::CPAN

    if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
        const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
	/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
	   field below is defined for any cx. */
	/* caller() should not report the automatic calls to &DB::sub */
	if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
	    cx = &ccstack[dbcxix];
    }

    return cx;

 view release on metacpan or  search on metacpan

lib/Ark/Form.pm  view on Meta::CPAN

sub set_param_data {
    my ($self, $name, %params) = @_;

    my $overwrite = $name =~ s/^\+//;
    my $class     = caller(1);

    $params{name} = $name;

    $class->_fields_messages({}) unless $class->_fields_messages;
    if (my $messages = delete $params{messages}) {

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

    return (@Existing, @Missing);
}

sub _running_under {

 view release on metacpan or  search on metacpan

lib/Array/AsHash.pm  view on Meta::CPAN

    Carp::croak($message);
};

my $_validate_kv_pairs = sub {
    my ( $self, $arg_for ) = @_;
    my $sub = $arg_for->{sub} || ( caller(1) )[3];

    if ( @{ $arg_for->{pairs} } % 2 ) {
        $self->$_croak("Arguments to $sub must be an even-sized list");
    }
};

 view release on metacpan or  search on metacpan

lib/Array/Compare.pm  view on Meta::CPAN

  # @check contains the indexes into the two arrays, i.e. the numbers
  # from 0 to one less than the number of elements.
  my @check = 0 .. $#$row1;

  my ($pkg, $caller) = (caller(1))[0, 3];
  $caller = '' unless defined $caller;
  my $perm = $caller eq __PACKAGE__ . "::perm";

  # Filter @check so it only contains indexes that should be compared.
  # N.B. Makes no sense to do this if we are called from 'perm'.

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}

sub _running_under {
    my $thing = shift;
    print <<"END_MESSAGE";

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

sub _read {

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

 view release on metacpan or  search on metacpan

lib/Articulate/Error.pm  view on Meta::CPAN

);

has caller => (
  is      => 'rw',
  default => sub {
    ( [ caller(0) ]->[0] =~ m/Throwable/ )
      ? [ 'hmm', caller(2) ]
      : [ caller(1) ];
  }
);

# This needs to go at the end, because of Class::XSAccessor stuff

 view release on metacpan or  search on metacpan

lib/Asm/C.pm  view on Meta::CPAN

# podDocumentation
__DATA__
use Time::HiRes qw(time);
use Test::More;

my $localTest = ((caller(1))[0]//'Asm::C') eq "Asm::C";                         # Local testing mode

Test::More->builder->output("/dev/null") if $localTest;                         # Reduce number of confirmation messages during testing

if ($^O =~ m(bsd|linux)i)
  {if (confirmHasCommandLineCommand(q(gcc))

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

 view release on metacpan or  search on metacpan

lib/Assert/Conditional.pm  view on Meta::CPAN

# without parentheses. That's because the constant subroutine
# that gets installed necessarily no longer has the prototype
# needed to support a code ref in the dative slot syntactically.
sub _reimport_nulled_code_protos {
    my($my_pack) = @_;
    my $his_pack = caller(1);

    no strict "refs";

    for my $export (@{$my_pack . "::EXPORT_OK"}) {
        my $real_proto = prototype($my_pack . "::$export");

lib/Assert/Conditional.pm  view on Meta::CPAN

    my $frame = 0;

    my $next_frame = sub {
        package DB;
        our @args;
        my @frame = caller(1 + $frame++);
        $self = $args[0] // "undef";
        $self = "undef" if ref $self && !Scalar::Util::blessed($self);
        return @frame;
    };

 view release on metacpan or  search on metacpan

lib/Assert/Refute/Build.pm  view on Meta::CPAN

    croak "build_refute(): unknown options: @extra"
        if @extra;
    croak "build_refute(): list and args options are mutually exclusive"
        if $opt{list} and defined $opt{args};

    my @caller = caller(0);
    my $target = $opt{target} || $caller[0];

    confess "Too bad (@caller)" if !$target or $target eq __PACKAGE__;

    my $nargs = $opt{args} || 0;

 view release on metacpan or  search on metacpan

lib/Astro/App/Satpass2.pm  view on Meta::CPAN

#	stack, otherwise returns false.

use constant INTERACTIVE_CALLER => __PACKAGE__ . '::dispatch';
sub _is_interactive {
    my $level = 0;
    while ( my @info = caller( $level ) ) {
	INTERACTIVE_CALLER eq $info[3]
	    and return $level;
	$level++;
    }
    return;

lib/Astro/App/Satpass2.pm  view on Meta::CPAN

	    };
	    return $module;
	}
	{
	    my $inx = 1;
	    while (my @clr = caller($inx++)) {
		$clr[3] eq '(eval)' and next;
		my @raw = split '::', $clr[3];
		substr ($raw[-1], 0, 1) eq '_' and next;
		push @probs, "for method $raw[-1]";
		last;