Result:
found 526 distributions and 816 files matching your query !
( run in 3.615 )
Template-Plex
view release on metacpan or search on metacpan
lib/Template/Plex.pm view on Meta::CPAN
}
else{
DEBUG and Log::OK::TRACE and log_trace __PACKAGE__." class load called for $path";
#called on package
my $dummy=[];
$dummy->[Template::Plex::meta_]={file=>(caller)[1]};
bless $dummy, "Template::Plex";
$opts{caller}=$dummy;
$template=Template::Plex::Internal->new(\&Template::Plex::Internal::_prepare_template, $path, $vars, %opts);
TemplateRex
view release on metacpan or search on metacpan
lib/TemplateRex.pm view on Meta::CPAN
my %conf_hsh = __PACKAGE__->get_defaults();
%conf_hsh = (%conf_hsh, %arg_hsh);
# Set package for embedded function to caller unless otherwise specified.
unless ( $conf_hsh{'func_package'} ) { $conf_hsh{'func_package'} = (caller)[0] }
# The object data structure
my $self = bless {
'temp' => {},
'temp_tree' => {},
Term-Menus
view release on metacpan or search on metacpan
lib/Term/Menus.pm view on Meta::CPAN
}
sub Menu
{
#print "MENUCALLER=",(caller)[0]," and ",__PACKAGE__,"\n";<STDIN>;
#print "MENUCALLER=",caller,"\n";
my $MenuUnit_hash_ref=$_[0];
#print "WHAT IS THIS=",&Data::Dump::Streamer::Dump($MenuUnit_hash_ref)->Out(),"\n";
$MenuUnit_hash_ref->{Name}=&pw($MenuUnit_hash_ref);
my $select_many=0;
lib/Term/Menus.pm view on Meta::CPAN
my $Persists= (defined $_[9]) ? $_[9] : {};
my $parent_menu= (defined $_[10]) ? $_[10] : '';
my $no_wantarray=0;
if ((defined $_[11] && $_[11]) ||
((caller)[0] ne __PACKAGE__ && !wantarray)) {
$no_wantarray=1;
}
if (defined $_[12] && $_[12]) {
return '','','','','','','','','','','',$_[12];
}
Term-Query
view release on metacpan or search on metacpan
sub define_var {
my( $var ) = shift; # the variable name
my( $ref ) = shift; # the value to define
return 1 unless length($var); # don't work with nulls
if (!(ref($var) or $var =~ /::/)) { # variable already qualified?
my( $pkg, $file ) = (caller)[0,1]; # get caller info
my( $i );
# Walk the stack until we get the first level outside of Query.pm
for ($i = 1; $file =~ /Query\.pm/; $i++) {
($pkg, $file) = (caller $i)[0,1];
}
Term-Sample
view release on metacpan or search on metacpan
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift; # || $_;
my %args = @_;
my $type = $args{type};
if(ref($sample) ne "ARRAY" && ($type eq "basic" || $type eq "avg" || $type eq "average")) {
print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
elsif(ref($sample) ne "HASH" && ($type eq "analysis" || $type eq "overview" || $type eq "details")) {
print "Error: Invalid analysis data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
if(ref($sample) eq "ARRAY") {
if(!$type || $type eq 'basic') {
for my $key (0..$#{$sample}) {
print "\n";
}
}
} else {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
}
sub to_string {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift;
if(ref($sample) ne "ARRAY") {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $str;
$str.=$sample->[$_]->{key} for (0..$#{$sample});
my $sample1 = shift;
my $sample2 = shift;
my %args = @_;
my $v = $args{verbose} || 0;
if(ref($sample1) ne "HASH" || ref($sample2) ne "HASH") {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}: Both arguments must be HASH refrences from analyze().\n";
return undef;
}
my $diff = 0;
my $count = 0;
$out->[$key]->{delay} += ($sample->[$key]->{delay}/$x);
$out->[$key]->{inter} += ($sample->[$key]->{inter}/$x);
}
}
} else {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $out;
}
sub save {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift;
my $file = shift;
if(ref($sample) ne "ARRAY" && ref($sample) ne "HASH") {
print "Error: Invalid save data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
open(F, ">$file");
sub load {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $file = shift;
if(!(-f $file)) {
print "Error: File $file doesn't exist at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
open(F, $file);
my @lines = <F>;
for my $key (0..$db{index_size}) {
($sample->[$key]->{key},$sample->[$key]->{delay},$sample->[$key]->{inter}) =
split /\:\:/, $db{"index$key"};
}
} else {
print "Error: Invalid file type in file $file at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $sample;
}
sub analyze {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift;
if(ref($sample) ne "ARRAY") {
print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $delay = 0;
my $inter = 0;
my %args = @_;
my ($key,$sample);
while(($key,$sample) = each %args) {
if(ref($sample) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
print "Error: Invalid sample data type for key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
if(!exists $self->{samples}->{$key}) {
$self->{samples}->{$key} = $sample;
} else {
sub remove {
my $self = shift;
my $key = shift;
if(!exists $self->{samples}->{$key} && !$self->{silent}) {
print "Error: Key `$key' does not exist in set at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
delete $self->{samples}->{$key};
return $self;
}
sub get {
my $self = shift;
my $key = shift;
if(!exists $self->{samples}->{$key} && !$self->{silent}) {
print "Error: Key `$key' does not exist in set at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $self->{samples}->{$key};
}
my $self = shift;
my $match = shift;
my $term = $self->{term};
my $v = shift || 0;
if(ref($match) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $test = ($self->{type} eq 'sample')?$term->analyze($match):$match;
my @diffs = ();
my ($key,$sample);
while(($key,$sample) = each %{$self->{samples}}) {
if(ref($sample) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
print "Error: Corrupted sample data type for key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $analysis = ($self->{type} eq 'sample')?$term->analyze($sample):$sample;
my $i=++$#diffs;
$diffs[$i] = { diff => $term->diff($analysis, $test), key => $key };
my ($key,$sample);
while(($key,$sample) = each %{$self->{samples}}) {
print F "_____KEY_____=$key\n";
if(ref($sample) ne "ARRAY" && ref($sample) ne "HASH" && !$self->{silent}) {
print "Error: Corrupted data type key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
if(ref($sample) eq "HASH") {
print F "type=hash\n";
sub load {
my $self = shift;
my $file = shift;
if(!(-f $file) && !$self->{silent}) {
print "Error: File $file doesn't exist at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $self if(!(-f $file) && $self->{silent});
for my $x (0..$db{index_size}) {
($self->{samples}->{$key}->[$x]->{key},$self->{samples}->{$key}->[$x]->{delay},$self->{samples}->{$key}->[$x]->{inter}) =
split /\:\:/, $db{"index$x"};
}
} else {
print "Error: Invalid file type in file $file at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
}
return $self;
Test-CVE
view release on metacpan or search on metacpan
lib/Test/CVE.pm view on Meta::CPAN
my %attr = @_;
my $tb = __PACKAGE__->builder;
# By default skip this test is not in a development env
if (!exists $attr{author} and
((caller)[1] =~ m{(?:^|/)xt/[^/]+\.t$} or
$ENV{AUTHOR_TESTING} or
-d ".git" && $^X =~ m{/perl$})) {
$attr{author}++;
}
unless ($attr{author}) {
Test-Class
view release on metacpan or search on metacpan
t/runtests_die.t view on Meta::CPAN
package main;
use Test::Builder::Tester tests => 1;
$ENV{TEST_VERBOSE}=0;
my $filename = sub { return (caller)[1] }->();
my $identifier = ($Test::More::VERSION < 0.88) ? 'object' : 'thing';
test_out( qr/not ok 1 - (?:The $identifier|undef) isa '?Object'?\n/);
test_err( "# Failed test ($filename at line 15)");
test_err( "# (in Foo->test_object)" );
Test-Effects
view release on metacpan or search on metacpan
lib/Test/Effects.pm view on Meta::CPAN
$expected->{$option} = $NULL_VALUE_FOR{$option};
}
}
# Ensure there's a description...
$desc //= sprintf "Testing effects_ok() at %s line %d", (caller)[1,2];
# Are we echoing this test???
my $is_terse
= exists $expected->{'VERBOSE'} ? !$expected->{'VERBOSE'}
: !$lexical_hint{'Test::Effects::VERBOSE'};
Test-Exception
view release on metacpan or search on metacpan
t/lives_and.t view on Meta::CPAN
sub works {return shift};
sub dies { die 'oops' };
my $die_line = __LINE__ - 1;
my $filename = sub { return (caller)[1] }->();
lives_and {is works(42), 42} 'lives_and, no_exception & success';
test_out('not ok 1 - lives_and, no_exception & failure');
test_fail(+3);
Test-Group
view release on metacpan or search on metacpan
lib/Test/Group/Tester.pm view on Meta::CPAN
=cut
sub want_test {
my ($type, $name, @diag) = @_;
my $call_line = (caller)[2];
$type =~ /^(pass|fail|skip)\z/i or croak
"want_test type=[$type], need pass|fail|skip";
$type = lc $1;
lib/Test/Group/Tester.pm view on Meta::CPAN
sub fail_diag {
wantarray or croak "fail_diag needs a list context";
my ($test_name, $from_test_builder, $line, $file) = @_;
$file ||= (caller)[1];
my @diag;
if ($from_test_builder and $ENV{HARNESS_ACTIVE}) {
# Test::Builder adds a blank diag line for a failed test
Test-Harness
view release on metacpan or search on metacpan
sub my_open (*@) {
if ($useOrigOpen) {
if ( defined( $_[0] ) ) {
use Symbol qw();
my $handle = Symbol::qualify( $_[0], (caller)[0] );
no strict 'refs';
if ( @_ == 1 ) {
return CORE::open($handle);
}
elsif ( @_ == 2 ) {
Test-Kwalitee
view release on metacpan or search on metacpan
lib/Test/Kwalitee.pm view on Meta::CPAN
# this setting is internal and for this distribution only - there is
# no reason for you to need to circumvent this check in any other context.
# Please DO NOT enable this test to run for users, as it can fail
# unexpectedly as parts of the toolchain changes!
unless $ENV{_KWALITEE_NO_WARN} or $ENV{AUTHOR_TESTING} or $ENV{RELEASE_TESTING}
or (caller)[1] =~ m{^(?:\.[/\\])?xt\b}
or ((caller)[0]->isa(__PACKAGE__) and (caller(1))[1] =~ m{^(?:\.[/\\])?xt\b});
my @run_tests = grep { /^[^-]/ } @tests;
my @skip_tests = map { s/^-//; $_ } grep { /^-/ } @tests;
# These don't really work unless you have a tarball, so skip them
Test-Lib
view release on metacpan or search on metacpan
lib/Test/Lib.pm view on Meta::CPAN
sub import {
my $class = shift;
my $dir = shift;
if (! defined $dir) {
my $file = File::Spec->rel2abs((caller)[1]);
$dir = File::Spec->catpath((File::Spec->splitpath($file))[0,1], '');
}
for my $i (0..5) {
my $tdir = File::Spec->catdir($dir, (File::Spec->updir) x $i);
my $abs_path = Cwd::abs_path($tdir);
Test-Log-Log4perl
view release on metacpan or search on metacpan
lib/Test/Log/Log4perl.pm view on Meta::CPAN
};
return;
}
sub _cur_filename { (caller)[1] }
1;
package Log::Log4perl::Logger::IgnoreAll;
use base qw(Log::Log4perl::Logger);
Test-Log4perl
view release on metacpan or search on metacpan
lib/Test/Log4perl.pm view on Meta::CPAN
};
return;
}
sub _cur_filename { (caller)[1] }
1;
package Log::Log4perl::Logger::IgnoreAll;
use base qw(Log::Log4perl::Logger);
Test-MockFile
view release on metacpan or search on metacpan
lib/Test/MockFile/FileHandle.pm view on Meta::CPAN
$! = EBADF;
return 0;
}
unless ( $len =~ m/^-?[0-9.]+$/ ) {
CORE::warn(qq{Argument "$len" isn't numeric in syswrite at @{[ join ' line ', (caller)[1,2] ]}.\n});
$! = EINVAL;
return 0;
}
$len = int($len); # Perl seems to do this to floats.
if ( $len < 0 ) {
CORE::warn(qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n});
$! = EINVAL;
return 0;
}
my $strlen = length($buf);
lib/Test/MockFile/FileHandle.pm view on Meta::CPAN
if ( $offset < 0 ) {
$offset = $strlen + $offset;
}
if ( $offset < 0 || $offset > $strlen ) {
CORE::warn(qq{Offset outside string at @{[ join ' line ', (caller)[1,2] ]}.\n});
$! = EINVAL;
return 0;
}
# Write directly — syswrite must NOT inherit $, or $\ from PRINT.
lib/Test/MockFile/FileHandle.pm view on Meta::CPAN
return undef;
}
# Validate $len the same way WRITE does — match real sysread behavior.
unless ( $len =~ m/^-?[0-9.]+$/ ) {
CORE::warn(qq{Argument "$len" isn't numeric in sysread at @{[ join ' line ', (caller)[1,2] ]}.\n});
$! = EINVAL;
return undef;
}
$len = int($len);
if ( $len < 0 ) {
CORE::warn(qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n});
$! = EINVAL;
return undef;
}
# If the caller's buffer is undef, we need to make it a string of 0 length to start out with.
Test-Modern
view release on metacpan or search on metacpan
lib/Test/Modern.pm view on Meta::CPAN
} @_;
push @_, @EXPORT if $symbols == 0;
my $globals = ref($_[0]) eq 'HASH' ? shift() : {};
$globals->{into_file} = (caller)[1] unless ref($globals->{into});
unshift @_, $me, $globals;
goto \&Exporter::Tiny::import;
}
Test-More-Bash
view release on metacpan or search on metacpan
lib/Test/More/Bash.pm view on Meta::CPAN
has test => ();
has bash => ();
sub import {
my $test_file = (caller)[1];
# Allow this generated test to pass:
return if $test_file =~ m{000-compile-modules.t$};
__PACKAGE__->new(
Test-Ratchet
view release on metacpan or search on metacpan
lib/Test/Ratchet.pm view on Meta::CPAN
}
sub clank($) {
my $subref = shift;
my $caller = sprintf "%s, line %s", (caller)[1,2];
my $clank = rec { my $rec = shift; delete $Test::Ratchet::Clank::CLANK{ refaddr $rec }; &$subref };
$Test::Ratchet::Clank::CLANK{refaddr $clank} = $caller;
bless $clank, "Test::Ratchet::Clank";
}
Test-Simple
view release on metacpan or search on metacpan
t/Legacy/overload.t view on Meta::CPAN
package main;
local $SIG{__DIE__} = sub {
my($call_file, $call_line) = (caller)[1,2];
fail("SIGDIE accidentally called");
diag("From $call_file at $call_line");
};
my $obj = Overloaded->new('foo', 42);
Test-Tech
view release on metacpan or search on metacpan
t/Test/Tech/V001024/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;
for (my $x=0; $x < @_; $x+=2) {
my ($k,$v) = @_[$x,$x+1];
if ($k =~ /^test(s)?$/) { $max = $v; }
Test
view release on metacpan or search on metacpan
lib/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; }
Text-FixedLengthMultiline
view release on metacpan or search on metacpan
t/02parse.t view on Meta::CPAN
{
# Set the global variables
undef $fmt;
undef %data;
$fmt = Text::FixedLengthMultiline->new(@_);
isa_ok($fmt, 'Text::FixedLengthMultiline', 'Line '.(caller)[2]);
return $fmt;
}
# Parse a line and test the result
# 2 tests
sub test_parse()
{
my ($line, $expected_data, $expected_result) = @_;
my $test_name = 'Line ' . ((caller)[2]) . ' parsing result for: '.(defined $line ? "<$line>" : 'undef');
is($fmt->parse_line($line, \%data), $expected_result, $test_name);
is_deeply(\%data, $expected_data, $test_name);
}
&new_fmt(format => [ 'col1' => 6 ]);
Text-MacroScript
view release on metacpan or search on metacpan
t/macrodir.t view on Meta::CPAN
#------------------------------------------------------------------------------
# run one test
sub run_test {
my($opts) = @_;
$opts->{caller_line} = (caller)[2];
# set flags
for ($opts->{-args}) {
$opts->{-verbose} = /-v\b|--verbose\b/ ? 1 : 0;
Text-Md2Inao
view release on metacpan or search on metacpan
lib/Text/Md2Inao/Builder/DSL.pm view on Meta::CPAN
use parent qw/Exporter/;
our @EXPORT = qw/case/;
sub case ($&) {
my ($select, $code) = @_;
my $class = (caller)[0];
my $self = $class->new;
for (split ",", $select) {
s/\s+//g;
$self->dispatch_table->{$_} = $code;
}
Text-Reform
view release on metacpan or search on metacpan
lib/Text/Reform.pm view on Meta::CPAN
}
elsif (defined wantarray) # CONTEXT BEING CAPTURED
{
$_[0]->{_prev} = { %std_config };
$_[0]->{_used} = 0;
$_[0]->{_line} = join " line ", (caller)[1..2];;
%{$_[0]} = %std_config = (%std_config, %{$_[0]});
fix_config(%std_config);
return bless $_[0], 'FormOpt';
}
else # PERMANENT RESET
{
$_[0]->{_used} = 1;
$_[0]->{_line} = join " line ", (caller)[1..2];;
%std_config = (%std_config, %{$_[0]});
fix_config(%std_config);
return;
}
}
Text-Table-Boxed
view release on metacpan or search on metacpan
t/t_TestCommon.pm view on Meta::CPAN
# This is only visible with using "perl -Ilib t/xxx.t"
# not with 'prove -l' and so mostly pointless!
sub t_ok($;$) {
my ($isok, $test_label) = @_;
my $lno = (caller)[2];
$test_label = ($test_label//"") . " (line $lno)";
@_ = ( $isok, $test_label );
goto &Test2::V0::ok; # show caller's line number
}
sub ok_with_lineno($;$) { goto &t_ok };
sub t_is($$;$) {
my ($got, $exp, $test_label) = @_;
my $lno = (caller)[2];
$test_label = ($test_label//$exp//"undef") . " (line $lno)";
@_ = ( $got, $exp, $test_label );
goto &Test2::V0::is; # show caller's line number
}
sub is_with_lineno($$;$) { goto &t_is }
sub t_like($$;$) {
my ($got, $exp, $test_label) = @_;
my $lno = (caller)[2];
$test_label = ($test_label//$exp) . " (line $lno)";
@_ = ( $got, $exp, $test_label );
goto &Test2::V0::like; # show caller's line number
}
sub like_with_lineno($$;$) { goto &t_like }
sub _mycheck_end($$$) {
my ($errmsg, $test_label, $ok_only_if_failed) = @_;
return
if $ok_only_if_failed && !$errmsg;
my $lno = (caller)[2];
&Test2::V0::diag("**********\n${errmsg}***********\n") if $errmsg;
@_ = ( !$errmsg, $test_label );
goto &ok_with_lineno;
}
Tie-EncryptedHash
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;
}
Tie-FormA
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; }
Tie-InSecureHash
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;
( run in 3.615 seconds using v1.01-cache-2.11-cpan-b301d465b3d )