view release on metacpan or search on metacpan
lib/Geo/Calc.pm view on Meta::CPAN
}
sub _precision {
my ( $self, $number, $precision ) = @_;
die "Error: Private method called" unless (caller)[0]->isa( ref($self) );
my $mbf = Math::BigFloat->new( $number );
$mbf->precision( $precision );
return $mbf->bstr() + 0;
lib/Geo/Calc.pm view on Meta::CPAN
sub _ib_precision {
my ( $self, $brng, $precision, $mul ) = @_;
$mul ||= 1;
die "Error: Private method called" unless (caller)[0]->isa( ref($self) );
my $mbf = Math::BigFloat->new( POSIX::fmod( $mul * ( Math::Trig::rad2deg( $brng ) ) + 360, 360 ) );
$mbf->precision( $precision );
return $mbf->bstr() + 0;
}
sub _fb_precision {
my ( $self, $brng, $precision ) = @_;
die "Error: Private method called" unless (caller)[0]->isa( ref($self) );
my $mbf = Math::BigFloat->new( POSIX::fmod( ( Math::Trig::rad2deg( $brng ) ) + 180, 360 ) );
$mbf->precision( $precision );
return $mbf->bstr() + 0;
view release on metacpan or search on metacpan
lib/Getopt/App.pm view on Meta::CPAN
}
sub extract_usage {
my %pod2usage;
$pod2usage{'-sections'} = shift;
$pod2usage{'-input'} = shift || (caller)[1];
$pod2usage{'-verbose'} = 99 if $pod2usage{'-sections'};
require Pod::Usage;
open my $USAGE, '>', \my $usage;
Pod::Usage::pod2usage(-exitval => 'noexit', -output => $USAGE, %pod2usage);
view release on metacpan or search on metacpan
local($pdt_reg_exp6) = '^\s*required_file_list\s*$';
local($full_help) = 0;
local($usage_help) = 0;
local($file_list) = 'optional_file_list';
local($error) = 0;
local($pkg) = (caller)[0];
local($value, $rt, $type, $required, @P_PARAMETER, %P_INFO, %P_ALIAS,
@P_REQUIRED, %P_VALID_VALUES, %P_ENV, %P_SET);
local($option, $default_value, $list, $parameter, $alias, @keys,
$found, $length, %P_EVALUATE, %P_DEFAULT_VALUE);
local(@local_pdt);
my($prompt, $I, %cmds) = @_;
$noReadLine = 1 if not evap_isatty( $I );
my($proc, $args, %long, %alias, $name, $long, $alias);
my $pkg = (caller)[0];
my $inp = ref($I) ? $I : "${pkg}::${I}";
$evap_embed = 1; # enable embedding
$shell = (defined $ENV{'SHELL'} and $ENV{'SHELL'} ne '') ?
$ENV{'SHELL'} : '/bin/sh';
view release on metacpan or search on metacpan
lib/Getopt/Long/More.pm view on Meta::CPAN
# copied verbatim from Getopt::Long, with a bit of modification (add my)
sub GetOptionsFromString(@) {
my ($string) = shift;
require Text::ParseWords;
my $args = [ Text::ParseWords::shellwords($string) ];
local $Getopt::Long::caller ||= (caller)[0];
my $ret = GetOptionsFromArray($args, @_);
return ( $ret, $args ) if wantarray;
if ( @$args ) {
$ret = 0;
warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n");
lib/Getopt/Long/More.pm view on Meta::CPAN
sub GetOptionsFromArray {
require Getopt::Long;
my $ary = shift;
local $Getopt::Long::caller ||= (caller)[0]; # grab and set this asap.
my @go_opts_spec;
if ( ref($_[0]) ) {
require Scalar::Util;
view release on metacpan or search on metacpan
lib/Getopt/Long.pm view on Meta::CPAN
sub GetOptionsFromString(@) {
my ($string) = shift;
require Text::ParseWords;
my $args = [ Text::ParseWords::shellwords($string) ];
$caller ||= (caller)[0]; # current context
my $ret = GetOptionsFromArray($args, @_);
return ( $ret, $args ) if wantarray;
if ( @$args ) {
$ret = 0;
warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n");
lib/Getopt/Long.pm view on Meta::CPAN
sub GetOptionsFromArray(@) {
my ($argv, @optionlist) = @_; # local copy of the option descriptions
my $argend = '--'; # option list terminator
my %opctl = (); # table of option specs
my $pkg = $caller || (caller)[0]; # current context
# Needed if linkage is omitted.
my @ret = (); # accum for non-options
my %linkage; # linkage
my $userlinkage; # user supplied HASH
my $opt; # current option
view release on metacpan or search on metacpan
lib/Getopt/Mixed/Help.pm view on Meta::CPAN
my $max_length = 0;
my $env_prefix = undef;
my $use_multiple = 0;
my $multiple = undef;
my %multiple_options = ();
my $package = (caller)[0];
# preparation loop (module parameters):
while (@_ > 0)
{
my $option = shift;
view release on metacpan or search on metacpan
lib/Getopt/Mixed.pm view on Meta::CPAN
# nextOption yourself; getOptions doesn't support it:
$order = $PERMUTE if $order == $RETURN_IN_ORDER;
my ($option,$value,$package);
$package = (caller)[0];
while (($option, $value) = nextOption()) {
$option =~ s/\W/_/g; # Make a legal Perl identifier
$value = 1 unless defined $value;
my $code = "\$" . $package . "::opt_$option = \$value;";
view release on metacpan or search on metacpan
Glade/Two/Generate.pm view on Meta::CPAN
} else {
# We have no value and no default to use so bail out here
$Glade_Perl->diag_print (1, "error No value in supplied ".
"%s and NO default was supplied in ".
"%s called from %s line %s",
"$proto->{'widget'}{'name'}\->{'$key'}", $me, (caller)[0], (caller)[2]);
return undef;
}
}
# We must have some sort of value to use by now
unless ($request) {
view release on metacpan or search on metacpan
Glade/PerlUI.pm view on Meta::CPAN
} else {
# We have no value and no default to use so bail out here
$Glade_Perl->diag_print (1, "error No value in supplied ".
"%s and NO default was supplied in ".
"%s called from %s line %s",
"$proto->{'name'}\->{'$key'}", $me, (caller)[0], (caller)[2] );
return undef;
}
} else {
# We have a value to use
# $Glade_Perl->diag_print (8, "$indent- Value supplied in ".
view release on metacpan or search on metacpan
lib/Grammar/Marpa.pm view on Meta::CPAN
my $ebnf = ref($_[0]) eq 'HASH' ? undef : shift(@_);
my $pkg;
my %args;
if (ref ($_[-1]) eq 'HASH') {
%args = %{pop(@_)};
$pkg = shift(@_) // (caller)[0];
}
elsif (@_ % 2) {
$pkg = shift;
%args = @_;
}
else {
$pkg = (caller)[0];
%args = @_;
}
my %Gargs;
$Gargs{ bless_package } = delete $args{ bless_package } if $args{ bless_package };
$Gargs{ trace_file_handle } = $args{ trace_file_handle } if $args{ trace_file_handle };
view release on metacpan or search on metacpan
lib/Egreek.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/HTML/DOM/EventTarget.pm view on Meta::CPAN
sub AUTOLOAD {
my($pack,$meth) = our $AUTOLOAD =~ /(.*)::(.*)/s;
$meth =~ /^on([a-z]+)\z/
or die "Can't locate object method \"$meth\" via package "
. qq'"$pack" at '.join' line ',(caller)[1,2]
,. "\n";
shift->event_handler($1, @_);
}
sub DESTROY{}
view release on metacpan or search on metacpan
lib/HTML/YaTmpl.pm view on Meta::CPAN
if( exists $ENV{HTML_TMPL_SEARCH_PATH} ) {
my $sep=$Config{path_sep} || ':';
$I->path=[split $sep, $ENV{HTML_TMPL_SEARCH_PATH}];
}
}
$I->package=(caller)[0];
$I->errors=[];
foreach my $m (@CLASS_MEMBERS) {
$I->$m=$o{$m} if( exists $o{$m} );
}
view release on metacpan or search on metacpan
t/lib/Test/HT.pm view on Meta::CPAN
($identifier, $arg) = ref $_[0] ? (undef, shift) : (shift, shift || {});
my $comment = (defined $_[0] and ! ref $_[0])
? shift(@_)
: sprintf("ht_test at %s, line %s", (caller)[1, 2]);
my $extra = (! defined $_[0]) ? {}
: (! reftype $_[0]) ? confess("bogus extra value")
: (reftype $_[0] eq 'CODE') ? { assert => $_[0] }
: (reftype $_[0] eq 'HASH') ? $_[0]
view release on metacpan or search on metacpan
HashObject.pm view on Meta::CPAN
}
}
elsif (!defined $self->method_keys && $key eq 'keys') {
$self->method_keys($value);
}
elsif ( $self->object->isa( (caller)[0] ) ) {
return $self->{storage}->{$key} = $value;
}
elsif (grep /^$key$/, @{$self->method_keys}) {
$self->object->$key($value);
}
HashObject.pm view on Meta::CPAN
}
sub FETCH {
my $self = shift;
my $key = shift;
if ( $self->object->isa((caller)[0]) ) {
return $self->{storage}->{$key};
}
elsif (grep /^$key$/, @{$self->method_keys}) {
return $self->object->$key;
}
HashObject.pm view on Meta::CPAN
}
}
sub FIRSTKEY {
my $self = shift;
if ( $self->object->isa((caller)[0]) ) {
return (keys %{$self->{storage}})[0];
}
else {
# we have to do this for data dumps...
return (@{$self->defined_public_keys})[0];
HashObject.pm view on Meta::CPAN
my $self = shift;
my $last_method = shift;
my @keys;
if ( $self->object->isa((caller)[0]) ) {
@keys = keys %{$self->{storage}};
}
else {
@keys = @{$self->defined_public_keys};
}
HashObject.pm view on Meta::CPAN
sub EXISTS {
my $self = shift;
my $key = shift;
if ( $self->object->isa((caller)[0]) ) {
return exists $self->{storage}->{$key};
}
else {
return (grep /^$key$/, @{$self->defined_public_keys});
}
HashObject.pm view on Meta::CPAN
sub DELETE {
my $self = shift;
my $key = shift;
if ( $self->object->isa((caller)[0]) ) {
return delete $self->{storage}->{$key};
}
else {
warn "Cannot delete methods. Please set the values instead.";
}
}
# override this method if you have some default for clearing the method hash values...
sub CLEAR {
my $self = shift;
if ( $self->object->isa((caller)[0]) ) {
$self->{storage} = {};
}
else {
warn "Cannot clear tied method calls";
}
}
sub SCALAR {
my $self = shift;
if ( $self->object->isa((caller)[0]) ) {
return scalar keys %{$self->{storage}};
}
else {
return scalar @{$self->defined_public_keys};
}
view release on metacpan or search on metacpan
lib/Hyper/Developer/Server.pm view on Meta::CPAN
my $arg_ref = shift;
my $config = delete $arg_ref->{$PACKAGE};
my $self = HTTP::Server::Simple::new($class, %{$arg_ref});
$self->{$PACKAGE} = {
base_path => dirname((caller)[1]) . '/../../',
refresh => Module::Refresh->new(),
%{$config}
};
return $self;
view release on metacpan or search on metacpan
t/010examples-lzma.t view on Meta::CPAN
$aok &= is $stdout, $expected, " expected content is ok"
if defined $expected ;
if (! $aok) {
diag "Command line: $cmd";
my ($file, $line) = (caller)[1,2];
diag "Test called from $file, line $line";
}
1 while unlink $stderr;
}
view release on metacpan or search on metacpan
lib/IO/Compress/Base.pm view on Meta::CPAN
sub _def
{
my $obj = shift ;
my $class= (caller)[0] ;
my $name = (caller(1))[3] ;
$obj->croakError("$name: expected at least 1 parameters\n")
unless @_ >= 1 ;
view release on metacpan or search on metacpan
lib/IO/Event.pm view on Meta::CPAN
$sock{PeerAddr} = $a;
} else {
$sock{$a} = $b;
}
my $handler = $sock{Handler} || (caller)[0];
delete $sock{Handler};
my $timeout;
if ($sock{Timeout}) {
$timeout = $sock{Timeout};
lib/IO/Event.pm view on Meta::CPAN
$sock{Peer} = $a;
} else {
$sock{$a} = $b;
}
my $handler = $sock{Handler} || (caller)[0];
delete $sock{Handler};
my $desc = $sock{Description}
|| join(" ", map { "$_=$sock{$_}" } sort keys %sock);
delete $sock{Description};
view release on metacpan or search on metacpan
lib/IO/Lambda.pm view on Meta::CPAN
if ( $DEBUG_CALLER > 1) {
$l-> {caller} = Carp::longmess;
chomp $l-> {caller};
$l-> {caller} =~ s/^ at //;
} else {
$l-> {caller} = join(':', (caller)[1,2]);
}
}
$l;
}
view release on metacpan or search on metacpan
$opts->{input} = $in;
$opts->{output} = $out;
}
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $line = (caller)[2];
no warnings 'redefine';
local *IO::Prompt::Simple::_isa_tty = sub { $isa_tty };
note "$desc at line $line"; do {
view release on metacpan or search on metacpan
t/session_cache.t view on Meta::CPAN
ok("0 entries in cache, room for 3");
&$dump_cache;
sub ok {
my $line = (caller)[2];
print "ok # $_[0]\n";
}
sub diag {
my $msg = shift;
$msg =~s{^}{ # }mg;
view release on metacpan or search on metacpan
lib/IOC/Service.pm view on Meta::CPAN
use warnings;
our $VERSION = '0.02';
use overload '%{}' => sub {
return $_[0] if (caller)[0] eq 'IOC::Service::Deferred';
$_[0] = $_[0]->{service}->instance();
$_[0]
},
'@{}' => sub { $_[0] = $_[0]->{service}->instance(); $_[0] },
'${}' => sub { $_[0] = $_[0]->{service}->instance(); $_[0] },
view release on metacpan or search on metacpan
lib/IPC/PerlSSH.pm view on Meta::CPAN
my $self = shift;
my ( $name, $code ) = @_;
$self->store( $name, $code );
my $caller = (caller)[0];
{
no strict 'refs';
*{$caller."::$name"} = sub { $self->call( $name, @_ ) };
}
}
view release on metacpan or search on metacpan
if ( $^O =~ /Win32/ && ++$tries <= 10 ) {
print STDOUT "# Waiting for Win32 to allow $f to be unlinked ($!)\n";
select undef, undef, undef, 0.1;
next;
}
die "$! unlinking $f at ", join( ", line ", (caller)[ 1, 2 ] ), "\n";
}
}
my $text = "Hello World\n";
my @perl = ($perl);
view release on metacpan or search on metacpan
lib/IPTables/IPv4/DBTarpit/Inst.pm view on Meta::CPAN
my $W = local *W;
return "could not open $file for write"
unless open($W,'>'.$file);
$file =~ m|([^/]+)$|;
my $whoami = (caller)[1];
print $W qq|# $1 |, scalar localtime(), q|
#
# This configuration file was automatically generated by '|. $whoami .q|'
#
# Don't edit this file, edit '|. $whoami .q|' instead.
view release on metacpan or search on metacpan
}
my $tmp = join ':1:', @arguments,':1';
@arguments = split ':', $tmp;
$offset = (caller)[2]+1;
filter_add({@arguments}) ;
}
#---------------------------------------------------------------------------
#---------------------------------------------------------------------------
view release on metacpan or search on metacpan
lib/Inline/Files/Virtual.pm view on Meta::CPAN
# Create a new Inline file (for Inline::Files only)
if (not $file and defined $Inline::Files::{get_filename}) {
(my $marker = *{$glob}{NAME}) =~ s|.*::(.*)|$1|;
if ($marker =~ /^[A-Z](?:_*[A-Z0-9]+)*$/) {
if ($file = Inline::Files::get_filename((caller)[0])) {
$marker = "__${marker}__\n";
my $vfile = sprintf "$file(NEW%-0.8d)", ++$new_counter;
$vfs{$vfile} =
{ data => '',
marker => $marker,
view release on metacpan or search on metacpan
lib/Installer/cpanm.pm view on Meta::CPAN
$fatpacked{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER';
package Exporter;require 5.006;our$Debug=0;our$ExportLevel=0;our$Verbose ||= 0;our$VERSION='5.70';our (%Cache);sub as_heavy {require Exporter::Heavy;my$c=(caller(1))[3];$c =~ s/.*:://;\&{"Exporter::Heavy::heavy_$c"}}sub export {goto &{as_heavy()}}s...
EXPORTER
$fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY';
package Exporter::Heavy;use strict;no strict 'refs';require Exporter;our$VERSION=$Exporter::VERSION;sub _rebuild_cache {my ($pkg,$exports,$cache)=@_;s/^&// foreach @$exports;@{$cache}{@$exports}=(1)x @$exports;my$ok=\@{"${pkg}::EXPORT_OK"};if (@$ok...
EXPORTER_HEAVY
$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD';
use strict;use warnings;package File::pushd;our$VERSION='1.009';our@EXPORT=qw(pushd tempd);our@ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub {...
FILE_PUSHD
view release on metacpan or search on metacpan
t/Iterator-Simple-Lookahead.t view on Meta::CPAN
my $s;
#------------------------------------------------------------------------------
sub t_get (@) {
my $where = "[line ".(caller)[2]."]";
for (@_) {
is $s->peek, $_, "$where peek is ".($_||"undef");
is $s->next, $_, "$where next is ".($_||"undef");
$s->unget($_);
is $s->(), $_, "$where () is ".($_||"undef");