view release on metacpan or search on metacpan
lib/Tie/EncryptedHash.pm view on Meta::CPAN
}
sub FETCH # ($self, $key)
{
my ($self, $key) = @_;
my $entry = _access($self,$key,(caller)[0..1]);
return $entry if $entry;
}
sub STORE # ($self, $key, $value)
{
my ($self, $key, $value) = @_;
my $entry = _access($self,$key,(caller)[0..1],$value);
return $entry if $entry;
}
sub DELETE # ($self, $key)
{
my ($self, $key) = @_;
return _access($self,$key,(caller)[0..1],'',1);
}
sub CLEAR # ($self)
{
my ($self) = @_;
lib/Tie/EncryptedHash.pm view on Meta::CPAN
}
sub EXISTS # ($self, $key)
{
my ($self, $key) = @_;
my @context = (caller)[0..1];
return _access($self,$key,@context) ? 1 : '';
}
sub FIRSTKEY # ($self)
{
lib/Tie/EncryptedHash.pm view on Meta::CPAN
}
sub NEXTKEY # ($self)
{
my $self = $_[0]; my $key;
my @context = (caller)[0..1];
while (defined($key = CORE::each %{$self})) {
last if eval { _access($self,$key,@context) }
}
return $key;
}
view release on metacpan or search on metacpan
t/Tie/Test.pm view on Meta::CPAN
local($\, $,); # guard against -l and other things that screw with
# print
_reset_globals();
_read_program( (caller)[1] );
my $max=0;
while (@_) {
my ($k,$v) = splice(@_, 0, 2);
if ($k =~ /^test(s)?$/) { $max = $v; }
view release on metacpan or search on metacpan
InSecureHash.pm view on Meta::CPAN
}
sub FETCH # ($self, $key)
{
my ($self, $key) = @_;
my $entry = _access($self,$key,(caller)[0..1]);
return $$entry if $entry;
return;
}
sub STORE # ($self, $key, $value)
{
my ($self, $key, $value) = @_;
my $entry = _access($self,$key,(caller)[0..1]);
return $$entry = $value if $entry;
return;
}
sub DELETE # ($self, $key)
{
my ($self, $key) = @_;
return _access($self,$key,(caller)[0..1],'DELETE');
}
sub CLEAR # ($self)
{
my ($self) = @_;
InSecureHash.pm view on Meta::CPAN
}
sub EXISTS # ($self, $key)
{
my ($self, $key) = @_;
my @context = (caller)[0..1];
eval { _access($self,$key,@context); 1 } ? 1 : '';
}
sub FIRSTKEY # ($self)
{
InSecureHash.pm view on Meta::CPAN
sub NEXTKEY # ($self)
{
my $self = $_[0];
my $key;
my @context = (caller)[0..1];
while (defined($key = each %{$self->{fullkeys}}))
{
last if eval { _access($self,$key,@context) };
}
return $key;
view release on metacpan or search on metacpan
lib/Tie/SecureHash.pm view on Meta::CPAN
sub FETCH { # ($self, $key)
my ($self, $key) = @_;
my $entry;
if (! $dangerous) {
$entry = _access($self,$key,(caller)[0..1]);
} elsif ($key =~ /::/) {
$entry = \$self->{fullkeys}->{$key};
} else {
my $caller = (caller)[0];
$entry = $self->_dangerous_access($key, $caller, 'FETCH');
}
return $$entry if $entry;
return;
}
sub STORE { # ($self, $key, $value)
my ($self, $key, $value) = @_;
my $entry;
if (! $dangerous) {
$entry = _access($self,$key,(caller)[0..1]);
} elsif ($key =~ /::/) {
$self->{fullkeys}->{$key} = $value;
$entry = \$self->{fullkeys}->{$key};
} else {
my $caller = (caller)[0];
$entry = $self->_dangerous_access($key,$caller, 'STORE');
}
return $$entry = $value if $entry;
return;
}
sub DELETE { # ($self, $key)
my ($self, $key) = @_;
if (! $dangerous) {
return _access($self,$key,(caller)[0..1],'DELETE');
}
elsif ($key =~ /::/) {
delete $self->{fullkeys}->{$key};
}
else {
my $caller = (caller)[0];
return $self->_dangerous_access($key, $caller, 'DELETE');
}
}
lib/Tie/SecureHash.pm view on Meta::CPAN
sub EXISTS # ($self, $key)
{
my ($self, $key) = @_;
if (! $dangerous) {
my @context = (caller)[0..1];
eval { _access($self,$key,@context); 1 } ? 1 : '';
}
elsif ($key =~ /::/) {
return exists $self->{fullkeys}->{$key};
}
else {
my $caller = (caller)[0];
_complain($self, $key, $caller, 'EXISTS') if $strict;
return exists $self->{fullkeys}->{"$caller::$key"};
}
}
lib/Tie/SecureHash.pm view on Meta::CPAN
my $self = $_[0];
if ($dangerous) {
return CORE::each %{$self->{fullkeys}};
}
my $key;
my @context = (caller)[0..1];
while (defined($key = CORE::each %{$self->{fullkeys}})) {
last if eval { _access($self,$key,@context) };
carp "Attempt to iterate inaccessible key '$key' will be unsafe in 'fast' mode. Use explicit keys" if $ENV{UNSAFE_WARN};
}
view release on metacpan or search on metacpan
lib/Tie/Trace.pm view on Meta::CPAN
my @options = @_;
my $var_name;
eval{
$var_name = PadWalker::var_name(1, $s);
};
my $pkg = defined $var_name ? (caller)[0] : undef;
my $tied_value = tie $s_type eq 'SCALAR' ? $$s : $s_type eq 'ARRAY' ? @$s : %$s, "Tie::Trace", var => $var_name, pkg => $pkg, @options;
local $QUIET = 1;
if($s_type eq 'SCALAR'){
$$s = $s_;
lib/Tie/Trace.pm view on Meta::CPAN
sub SPLICE{
my $self = shift;
my $sz = @{$self->{storage}};
my $off = @_ ? shift : 0;
my $fetchsize = $self->FETCHSIZE;
my $caller_pkg = (caller)[0];
my $func = "";
if($caller_pkg eq "Tie::Trace::Array"){
$func = (caller 1)[3];
$func =~s/^Tie::Trace::Array:://;
}
view release on metacpan or search on metacpan
lib/Time/List/Constant.pm view on Meta::CPAN
use Data::Util qw/install_subroutine/;
sub import {
my ($self, @kinds) = @_;
my $caller = (caller)[0];
install_subroutine( $caller,
DAY => sub{1},
MONTH => sub{2},
WEEK => sub{3},
HOUR => sub{4},
view release on metacpan or search on metacpan
map($params{$_}++,@_,@EXPORT);
if (delete $params{':override'}) {
$class->export('CORE::GLOBAL', keys %params);
}
else {
$class->export((caller)[0], keys %params);
}
}
## Methods ##
view release on metacpan or search on metacpan
lib/Time/Piece/Adaptive.pm view on Meta::CPAN
{
$class->_export ('CORE::GLOBAL', keys %params);
}
else
{
$class->_export((caller)[0], keys %params);
}
}
view release on metacpan or search on metacpan
}
} else {
die "No opttable array ref or getopt hash ref";
}
$self->{'caller'} = (caller)[0];
$self->{'filename'} = delete $a{'-filename'};
$self->{'nosafe'} = delete $a{'-nosafe'};
$self->{'useerrordialog'} = delete $a{'-useerrordialog'};
die "Unrecognized arguments: " . join(" ", %a) if %a;
view release on metacpan or search on metacpan
lib/Tk/TextVi.pm view on Meta::CPAN
$w->{VI_PENDING} = '';
$w->{VI_REPLACE_CHARS} = '';
$w->tagRemove( 'sel', '1.0', 'end' );
# XXX: Hack
if( (caller)[0] eq 'Tk::TextVi' ) {
$w->{VI_FLAGS} |= F_STAT;
}
else {
# TODO: this is broken
$w->Callback( '-statuscommand', $w->{VI_MODE}, $w->{VI_PENDING} );
lib/Tk/TextVi.pm view on Meta::CPAN
die "Tk::TextVi internal state corrupted";
}
# Does the UI need to update?
# XXX: HACK
if( (caller)[0] ne 'Tk::TextVi' ) {
$w->Callback( '-statuscommand',
$w->viMode,
$w->{VI_PENDING} ) if( $w->{VI_FLAGS} & F_STAT );
$w->Callback( '-messagecommand' ) if $w->{VI_FLAGS} & F_MSG ;
$w->Callback( '-errorcommand' ) if $w->{VI_FLAGS} & F_ERR ;
view release on metacpan or search on metacpan
Event/Event/IO.pm view on Meta::CPAN
my ($widget,$file,$mode,$cb) = @_;
my $imode = imode($mode);
unless (ref $file)
{
no strict 'refs';
$file = Symbol::qualify($file,(caller)[0]);
$file = \*{$file};
}
my $obj = tied(*$file);
unless ($obj && $obj->isa('Tk::Event::IO'))
{
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
defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
delete $Cache{$AUTOLOAD};
goto &$AUTOLOAD
}
sub load_stubs { shift->_load_stubs((caller)[0]) }
sub _load_stubs {
my($self, $callpack) = @_;
my $fh = \*{"${callpack}::DATA"};
my $currpack = $callpack;
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
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
t/w32ead_test.pl view on Meta::CPAN
# The tests in lib run in a temporary subdirectory of t, and always
# pass in a list of "programs" to run
@prgs = @_;
} else {
# The tests below t run in t and pass in a file handle. In theory we
# can pass (caller)[1] as the second argument to report errors with
# the filename of our caller, as the handle is always DATA. However,
# line numbers in DATA count from the __END__ token, so will be wrong.
# Which is more confusing than not providing line numbers. So, for now,
# don't provide line numbers. No obvious clean solution - one hack
# would be to seek DATA back to the start and read to the __END__ token,
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