view release on metacpan or  search on metacpan

lib/Treex/Core/Scenario.pm  view on Meta::CPAN

    require Treex::Core::ScenarioParser;
    return Treex::Core::ScenarioParser->new();
}

sub _my_dir {
    return dirname( (caller)[1] );
}

sub _build_parser {
    my $self = shift;
    my $parser;

 view release on metacpan or  search on metacpan

lib/Treex/PML/IO.pm  view on Meta::CPAN

=cut

sub CallerDir {
  return
    @_>0
      ? File::Spec->rel2abs($_[0], DirPart( (caller)[1] ))
      : DirPart( (caller)[1] );
}

=item C<register_input_protocol_handler($scheme,$callback)>

Register a callback to fetch URIs of a given protocol. C<$scheme> is

 view release on metacpan or  search on metacpan

lib/UR/ModuleBase.pm  view on Meta::CPAN

    my $formatted_string;
    my $warn_msg;
    {
        local $SIG{__WARN__} = sub {
            my $msg = $_[0];
            my ($filename, $line) = (caller)[1, 2];
            my $short_msg = ($msg =~ /(.*) at \Q$filename\E line $line./)[0];
            $warn_msg = ($short_msg || $msg);
        };
        $formatted_string = sprintf($format, @list);
    }

 view release on metacpan or  search on metacpan

lib/Eutf2.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/UTF8/R2.pm  view on Meta::CPAN

#---------------------------------------------------------------------
# mb::do() like do(), mb.pm compatible
sub UTF8::R2::do ($) {

    # run as Perl script
    return CORE::eval sprintf(<<'END', (caller)[0,2,1]);
package %s;
#line %s "%s"
CORE::do "$_[0]";
END
}

lib/UTF8/R2.pm  view on Meta::CPAN

# mb::eval() like eval(), mb.pm compatible
sub UTF8::R2::eval (;$) {
    local $_ = @_ ? $_[0] : $_;

    # run as Perl script in caller package
    return CORE::eval sprintf(<<'END', (caller)[0,2,1], $_);
package %s;
#line %s "%s"
%s
END
}

lib/UTF8/R2.pm  view on Meta::CPAN

                $INC{$_} = $prefix_file;

                # run as Perl script
                # must use CORE::do to use <DATA>, because CORE::eval cannot do it.
                local $@;
                my $result = CORE::eval sprintf(<<'END', (caller)[0,2,1]);
package %s;
#line %s "%s"
CORE::do "$prefix_file";
END

 view release on metacpan or  search on metacpan

t/002-die.t  view on Meta::CPAN

is_deeply([splice @calls], ['protected']);

my ($package, $line);
eval {
    local $SIG{__DIE__} = sub { ($package, $line) = (caller)[0, 2] };

    unwind_protect { die "oh no" }
      after => sub { push @calls, 'protected' };
};

 view release on metacpan or  search on metacpan

lib/Util/Any.pm  view on Meta::CPAN

    map { $h{$_}++ == 0 ? $_ : () } @_;
}
# /end

sub import {
  my ($pkg, $caller) = (shift, (caller)[0]);
  return $pkg->_base_import($caller, @_) if @_ and $_[0] =~/^-[A-Z]\w+$/o;

  my %opt;
  if (@_ > 1 and ref $_[-1] eq 'HASH') {
    @opt{qw/prefix module_prefix debug smart_rename plugin/}

 view release on metacpan or  search on metacpan

t/lib/Misleading.pm  view on Meta::CPAN

$VERSION = 0.42;
my ($major, $minor) = $VERSION =~ m/(\d+)(?:\.(\d+))?/;

my %opt = ();
%opt = (
    package => (exists($opt{package}) ? $opt{package} : (caller)[0]),
);

1;

 view release on metacpan or  search on metacpan

lib/WAIT/Index.pm  view on Meta::CPAN

  bless $self, ref($type) || $type;
}

sub drop {
  my $self = shift;
  if ((caller)[0] eq 'WAIT::Table') { # Table knows about this
    my $file = $self->{file};
    ! (!-e $file or unlink $file);
  } else {                            # notify our database
    require Carp;
    Carp::croak(ref($self)."::drop called directly");

 view release on metacpan or  search on metacpan

lib/WWW/Mechanize/Firefox.pm  view on Meta::CPAN

    $window ||= $self->tab->{linkedBrowser}->{contentWindow};
    # Report errors from scope of caller
    # This feels weirdly backwards here, but oh well:
    #local @CARP_NOT = (ref $self->repl); # we trust this

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

    $eval_in_sandbox->($window,$doc,$str,$js_env,$caller,$line);
};
*eval = \&eval_in_page;

 view release on metacpan or  search on metacpan

lib/Web/MREST/Resource.pm  view on Meta::CPAN

    # add standard properties to the payload
    $declared_status->payload->{'uri_path'} = $self->context->{'uri_path'};
    $declared_status->payload->{'resource_name'} = $self->context->{'resource_name'};
    $declared_status->payload->{'http_method'} = $self->context->{'method'};
    $declared_status->payload->{'found_in'} = {
        package => (caller)[0],
        file => (caller)[1],
        line => (caller)[2]+0,
    };

    # the object is "done": push it onto the context
    $self->push_onto_context( {
        'declared_status' => $declared_status,

 view release on metacpan or  search on metacpan

lib/WebService/MODIS.pm  view on Meta::CPAN

### Internal functions 

### retrieve a list of available MODIS Products
### and return a hash with the name of the first subdirectory 
sub getAvailProducts () {
    my $caller = (caller)[0];
    carp "This is an internal WebService::MODIS function. You should know what you are doing." if ($caller ne "WebService::MODIS");

    my %lookupTable = ();
    my $ua = new LWP::UserAgent;
    foreach my $subdir (@DATA_DIR) {

lib/WebService/MODIS.pm  view on Meta::CPAN

### get the available second level directories, named by date
### (YYYY.MM.DD) under which the hdf files reside. This does
### not ensure that the files are really there.
sub getAvailDates() {
    my $caller = (caller)[0];
    carp "This is an internal WebService::MODIS function. You should know what you are doing." if ($caller ne "WebService::MODIS");

    my %lookupTable = ();

    my $ua = new LWP::UserAgent;

lib/WebService/MODIS.pm  view on Meta::CPAN

    return %lookupTable;
}

### return a file list for one product and date on the server
sub getDateFullURLs($$) {
    my $caller = (caller)[0];
    carp "This is an internal WebService::MODIS function. You should know what you are doing." if ($caller ne "WebService::MODIS");

    my $product = shift;
    my $date = shift;

 view release on metacpan or  search on metacpan

API.pm  view on Meta::CPAN

    my $closure = shift->new(@_)
        or return undef;
    my $procname = ${Win32::API::GetMagicSV($closure)}{procname};
    #dont allow "sub main:: {0;}"
    Win32::SetLastError(ERROR_INVALID_PARAMETER), return undef if $procname eq '';
    _ImportXS($closure, (caller)[0].'::'.$procname);
    return $closure;
}

#######################################################################
# PRIVATE METHODS

 view release on metacpan or  search on metacpan

lib/Ewindows1250.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/Ewindows1252.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/Ewindows1254.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/Ewindows1257.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/Ewindows1258.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/Workflow/Exception.pm  view on Meta::CPAN

    my ( $type, @items ) = @_;

    my ( $msg, %params ) = _massage(@items);
    my $caller = caller;
    my $log = Log::Any->get_logger( category => $caller ); # log as if part of the package of the caller
    my ( $pkg, $line ) = (caller)[ 0, 2 ];
    my ( $prev_pkg, $prev_line ) = ( caller 1 )[ 0, 2 ];

    # Do not log condition errors
    my $method = $TYPE_LOGGING{$type};
    $log->$method(

 view release on metacpan or  search on metacpan

lib/XML/API.pm  view on Meta::CPAN

            $rootattrs->{$key} = $val;
        }
        $attrs = $rootattrs;
    }

    my ( $file, $line ) = (caller)[ 1, 2 ] if ( $self->{debug} );

    if ( $self->{langnext} ) {
        $attrs->{'xml:lang'} = delete $self->{langnext};
    }
    if ( $self->{dirnext} ) {

lib/XML/API.pm  view on Meta::CPAN

sub _close {
    my $self = shift;
    my $element = shift || croak '_close($element)';

    my ( $file, $line ) = (caller)[ 1, 2 ] if ( $self->{debug} );

    if ( !$self->{current} ) {
        carp 'attempt to close non-existent element "' . $element . '"';
        return;
    }

 view release on metacpan or  search on metacpan

t/05-wrongs.t  view on Meta::CPAN

use XML::Fast 'xml2hash';

sub dies_ok(&;@) {
	my $code = shift;
	my $name = pop || 'line '.(caller)[2];
	my $qr = shift;
	local $@;
	if( eval { $code->(); 1} ) {
		fail $name;
	} else {

 view release on metacpan or  search on metacpan

lib/XML/Filter/Dispatcher/Parser.pm  view on Meta::CPAN

                        : $_
                    : "<undef>" ,
                @_
            ),
            " (grammar rule at ",
            (caller)[1],
            ", line ",
            (caller)[2],
            ")"
        );

        return ();
    }

 view release on metacpan or  search on metacpan

lib/XML/Hash/LX.pm  view on Meta::CPAN

	#warn "@rv";
	return wantarray ? @rv : $rv[0];
}

sub hash2xml($;%) {
	#warn "hash2xml(@_) from @{[ (caller)[1,2] ]}";
	my $hash = shift;
	my %opts = @_;
	my $str = delete $opts{doc} ? 0 : 1;
	my $encoding = delete $opts{encoding} || delete $opts{enc} || 'utf-8';
	my $doc = XML::LibXML::Document->new('1.0', $encoding);

 view release on metacpan or  search on metacpan

t/XSLoader.t  view on Meta::CPAN

package Foo::Bar;
XSLoader::load("Foo::Bar");
END
 the_test:
  ok $fell_back,
    'XSLoader will not load relative paths based on (caller)[1]';
  File::Path::rmtree($name);
}

 view release on metacpan or  search on metacpan

lib/YAML/Active.pm  view on Meta::CPAN

    node_activate(YAML::XS::LoadFile($node), $phase);
}

sub assert_arrayref {
    return if UNIVERSAL::isa($_[0], 'ARRAY');
    die sprintf "%s expects an array ref", (caller)[0];
}

sub assert_hashref {
    return if UNIVERSAL::isa($_[0], 'HASH');
    die sprintf "%s expects a hash ref", (caller)[0];
}
sub yaml_NULL { bless {}, NULL }

# end of activation-related code
# start of dump-related code

 view release on metacpan or  search on metacpan

lib/Youri/Config.pm  view on Meta::CPAN

    GetOptions(@args);

    if ($args->{help}) {
        if (!@ARGV) {
            # standard help, available immediatly
            my $filename = (caller)[1];
            pod2usage(
                -input   => $filename,
                -verbose => 0
            );
        }

 view release on metacpan or  search on metacpan

lib/Zoidberg/Utils/GetOpt.pm  view on Meta::CPAN

		if (! $type) { # no arg
			error "option '$opt' doesn't take an argument" if defined $arg;
			$opts{$opt} = ($pre eq '+') ? 0 : 1;
		}
		elsif (ref $type) { # CODE ... for default opts
			output $type->( (caller(1))[3], (caller)[0] ); # subroutine, package
			error {silent => 1, exit_status => 0}, 'getopt needed to pop stack';
		}
		else {
			$arg = defined($arg) ? $arg : shift(@args);
			error "option '$opt' requires an argument" unless defined $arg;

 view release on metacpan or  search on metacpan

local/lib/perl5/LWP/UserAgent.pm  view on Meta::CPAN

}


sub add_handler {
    my($self, $phase, $cb, %spec) = @_;
    $spec{line} ||= join(":", (caller)[1,2]);
    my $conf = $self->{handlers}{$phase} ||= do {
        require HTTP::Config;
        HTTP::Config->new;
    };
    $conf->add(%spec, callback => $cb);

local/lib/perl5/LWP/UserAgent.pm  view on Meta::CPAN

sub set_my_handler {
    my($self, $phase, $cb, %spec) = @_;
    $spec{owner} = (caller(1))[3] unless exists $spec{owner};
    $self->remove_handler($phase, %spec);
    $spec{line} ||= join(":", (caller)[1,2]);
    $self->add_handler($phase, $cb, %spec) if $cb;
}

sub get_my_handler {
    my $self = shift;

local/lib/perl5/LWP/UserAgent.pm  view on Meta::CPAN

        elsif (ref($init) eq "HASH") {
            $spec{$_}= $init->{$_}
                for keys %$init;
        }
        $spec{callback} ||= sub {};
        $spec{line} ||= join(":", (caller)[1,2]);
        $conf->add(\%spec);
        return \%spec;
    }
    return wantarray ? @h : $h[0];
}

 view release on metacpan or  search on metacpan

xsub.pm  view on Meta::CPAN

  -e $so or die;
}

sub bootstrap {
  my $p = shift;
  my ($q, $qpm) = (caller)[0, 1];
  my ($qc, $qso);

  local *XSUB  = \@{$XSUB{$qpm}};
  defined @XSUB or return;

 view release on metacpan or  search on metacpan

lib/Fatal.pm  view on Meta::CPAN

        croak(sprintf(ERROR_NO_LEX,$class));
    }

    shift @_;   # Remove :lexical

    my $pkg = (caller)[0];

    # If we've been called with arguments, then the developer
    # has explicitly stated 'no autodie qw(blah)',
    # in which case, we disable Fatalistic behaviour for 'blah'.