Result:
found 572 distributions and 910 files matching your query !
( run in 1.319 )
Net-FullAuto
view release on metacpan or search on metacpan
lib/Net/FullAuto/FA_Core.pm view on Meta::CPAN
"but a cache key is not defined");
}
}
} elsif ((-1==index $caller,'mirror') &&
(-1==index $caller,'login_retry')) {
my $time_out='$' . (caller)[0] . '::timeout';
$time_out= eval $time_out;
if ($@ || $time_out!~/^[1-9]+/) {
$timeout=30;
} else { $timeout=$time_out }
} else { print "FOUR\n";$timeout=30 }
lib/Net/FullAuto/FA_Core.pm view on Meta::CPAN
handle_error("A cache object exists, ".
"but a cache key is not defined");
}
}
} else {
my $tst='$' . (caller)[0] . '::test';
$tst= eval $tst;
$tst||=0;
if ($@ || $tst!~/^[1-9]+/) {
$Net::FullAuto::FA_Core::test=0;
} else { $Net::FullAuto::FA_Core::test=$tst }
lib/Net/FullAuto/FA_Core.pm view on Meta::CPAN
{
if (defined $_[0] && $_[0]=~/^\d+$/) {
$timeout=$_[0];
} else {
my $time_out='$' . (caller)[0] . '::timeout';
$time_out= eval $time_out;
$time_out||=30;
if ($@ || $time_out!~/^[1-9]+/) {
$timeout=30;
} else { $timeout=$time_out }
} $test=0;$prod=0;
###################################
# The following are being set if
# found defined in Term::Menus
my $log_='$' . (caller)[0] . '::log';
$log_= eval $log_;
$log_=0 if $@ || !$log_;
my $tosspass_='$' . (caller)[0] . '::tosspass';
$tosspass_= eval $tosspass_;
$tosspass_=0 if $@ || !$tosspass_;
## end Term::Menus defs ###########
my $fhtimeout='X';
my $fatimeout=$timeout;
my $tst='$' . (caller)[0] . '::test';
$tst=eval $tst;
$test=$tst if !$@ || $tst=~/^[1-9]+/;
my $_connect='connect_ssh_telnet';
if (exists $Hosts{"__Master_${$}__"}{'Local'}) {
my $loc=$Hosts{"__Master_${$}__"}{'Local'};
lib/Net/FullAuto/FA_Core.pm view on Meta::CPAN
}
} else {
@RCM_Link=('ssh','telnet');
$Hosts{"__Master_${$}__"}{'Local'}=$_connect;
}
$email_defaults='%' . (caller)[0] . '::email_defaults';
%email_defaults=eval $email_defaults;
if ($@) {
$email_defaults=0;
%email_defaults=();
} else { $email_defaults=1 }
my $email_addresses='%' . (caller)[0] . '::email_addresses';
%email_addresses=eval $email_addresses;
%email_addresses=() if $@;
my $test_caller=(caller)[0];
$custom_code_module_file='$' . (caller)[0] . '::fa_code';
$custom_code_module_file=eval $custom_code_module_file;
if ($@) {
my $die="Cannot Locate the \"FullAuto Custom Code\" "
."perl module (.pm) file\n < original "
."default name 'fa_code.pm' >\n\n $@";
lib/Net/FullAuto/FA_Core.pm view on Meta::CPAN
$dot=1;
} elsif ($_[1] eq '__dotdot__') {
$dotdot=1;
}
}
my $caller=(caller)[2];
my $hostlabel=$self->{_hostlabel}->[0];
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
lib/Net/FullAuto/FA_Core.pm view on Meta::CPAN
print "WHAT IS CACHE=$cache\n" if $cache;
print "KEYS=",(join " | ",keys %{$cache}),"\n" if $cache;
#print $Net::FullAuto::FA_Core::LOG "CACHEEEEEEEEEEEEEEEEEEEEEEEEEE=",$cache->{'key'},"\n";
($caller,$cline)=(caller)[1,2];
if (ref $args{DestHost} eq 'ARRAY') {
@dhostlabels=@{$args{DestHost}};
} elsif (4<length $args{DestHost} && unpack('a5',$args{DestHost})
eq 'ARRAY') {
&Net::FullAuto::FA_Core::handle_error(
Net-IEC104
view release on metacpan or search on metacpan
lib/Net/IEC104.pm view on Meta::CPAN
sub DEBUG {
my $d = shift;
if ( $debug >= $d ) {
print @_;
if ( $d < 0 ) {
printf "<-- at %s:%s", (caller)[ 1, 2 ];
}
unless ( $_[$#_] =~ /\s$/ ) {
print "\n";
}
}
Net-Ident
view release on metacpan or search on metacpan
# check for fully qualified name
if ( $fh !~ /'|::/ ) {
print STDDBG "$fh is not fully qualified\n" if $DEBUG;
# get our current package
my $mypkg = (caller)[0];
print STDDBG "We are package $mypkg\n" if $DEBUG;
# search for calling package
my $depth = 1;
my $otherpkg;
Net-MQTT-Simple
view release on metacpan or search on metacpan
lib/Net/MQTT/Simple.pm view on Meta::CPAN
$server or return;
$global = $class->new($server);
no strict 'refs';
*{ (caller)[0] . "::publish" } = \&publish;
*{ (caller)[0] . "::retain" } = \&retain;
*{ (caller)[0] . "::mqtt_get" } = \&get;
}
sub new {
my ($class, $server, $sockopts) = @_;
@_ == 2 or @_ == 3 or _croak "Wrong number of arguments for $class->new";
Net-SC
view release on metacpan or search on metacpan
lib/Net/SC.pm view on Meta::CPAN
local $_;
unless ( exists $self->{ 'CFG_' . uc($section) } ) {
$self->log_error("Use unknown configuration variable : `$section'");
return undef;
} elsif ( uc($section) eq 'CHAIN_DATA' and (caller)[0] ne __PACKAGE__ ) {
#
# íÁÌÅÎØËÁÑ ËÕÞËÁ ÓÏÌÏÍËÉ, ÏÔ ÉÚÍÅÎÅÎÉÑ ÄÁÎÎÙÈ ËÏÎÆÉÇÕÒÁÃÉÏÎÎÏÇÏ ÆÁÊÌÁ...
#
return $self->{ 'CFG_' . uc($section) };
} else {
lib/Net/SC.pm view on Meta::CPAN
#
# syslogd
#
if ( ref $self and $self->configure( 'SYSLOG' ) and $^O !~ /[Ww]in32/ ) {
foreach ( @_ ) {
syslog( 'debug', '%s [ %d ]', $_, (caller)[-1] ) unless /^\s*$/;
}
return 1;
}
#
# ÷ÓÅ ÏÓÔÁÌØÎÏÅ
lib/Net/SC.pm view on Meta::CPAN
if ( ref $self and $self->configure( 'SYSLOG' ) and $^O !~ /[Ww]in32/ ) {
#
# syslogd
#
foreach ( @_ ) {
syslog( 'warning', '%s [ %d ]', $_, (caller)[-1] ) unless /^\s*$/;
}
} elsif ( ref $self and
$self->configure( 'SYSLOG' ) and
defined $self->configure( 'LOG_FH' ) ) {
#
lib/Net/SC.pm view on Meta::CPAN
} elsif ( not defined ( $sym = $self->configure( 'LOG_FH' ) ) ) {
$sym = \*STDERR;
}
my_flock ( $sym, LOCK_EX );
foreach ( @_ ) {
printf $sym "%2.2d/%2.2d %2.2d:%2.2d:%2.2d [ %5.5d : %d ] : %s\n",(localtime(time))[3,4,2,1,0], $$, (caller)[-1], $_ unless /^\s*$/;
}
my_flock ( $sym, LOCK_UN );
}
return 1;
Net-SFTP-Foreign
view release on metacpan or search on metacpan
lib/Net/SFTP/Foreign/Compat.pm view on Meta::CPAN
for my $method (@forbidden) {
my $super = "SUPER::$method";
no strict 'refs';
*{$method} = sub {
unless (index((caller)[0], "Net::SFTP::Foreign") == 0) {
croak "Method '$method' is not available from " . __PACKAGE__
. ", use the real Net::SFTP::Foreign if you want it!";
}
shift->$super(@_);
};
Net-SSH-Perl
view release on metacpan or search on metacpan
t/05-cipher.t view on Meta::CPAN
_check_it($ciph1, $ciph2);
}
sub _check_it {
my($ciph1, $ciph2) = @_;
my $line = (caller)[2];
ok($ciph1, "First argument was true from line $line");
ok($ciph2, "Second argument was true from line $line");
my($enc, $dec);
$enc = $ciph1->encrypt(_checkbytes());
$dec = $ciph2->decrypt($enc);
Net-Telnet-Netgear
view release on metacpan or search on metacpan
lib/Net/Telnet/Netgear.pm view on Meta::CPAN
my $self = shift;
# If this method is being called from this package and it has '-callparent' as the first arg,
# then execute the implementation of the superclass. This is a work-around, because
# unfortunately $self->SUPER::$method does not work. :(
return $self->SUPER::open (splice @_, 1)
if (caller)[0] eq __PACKAGE__ && @_ > 0 && $_[0] eq -callparent;
# Call our magical method.
_open_method ($self, "open", @_);
}
sub fhopen
lib/Net/Telnet/Netgear.pm view on Meta::CPAN
my $self = shift;
# If this method is being called from this package and it has '-callparent' as the first arg,
# then execute the implementation of the superclass. This is a work-around, because
# unfortunately $self->SUPER::$method does not work. :(
return $self->SUPER::fhopen (splice @_, 1)
if (caller)[0] eq __PACKAGE__ && @_ > 0 && $_[0] eq -callparent;
# Call our magical method.
_open_method ($self, "fhopen", @_);
}
sub apply_netgear_defaults
Netx-WebRadio
view release on metacpan or search on metacpan
lib/Netx/WebRadio/Station/Shoutcast.pm view on Meta::CPAN
=cut
sub disconnected {
my $self = shift;
warn "disconnected " . (caller)[0] . " " . (caller)[2] . "\n";
return 0;
}
=head1 BUGS
Nile
view release on metacpan or search on metacpan
lib/Nile.pm view on Meta::CPAN
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub detect_app_path {
my ($self, $script) = @_;
$script ||= (caller)[1];
my ($vol, $dirs, $name) = File::Spec->splitpath(File::Spec->rel2abs($script));
if (-d (my $fulldir = File::Spec->catdir($dirs, $name))) {
$dirs = $fulldir;
Number-Phone-FR
view release on metacpan or search on metacpan
lib/Number/Phone/FR.pm view on Meta::CPAN
eval "require $class; 1" or croak "$@\n";
$class->isa(__PACKAGE__) or croak "$class is not a valid class";
}
} else {
#croak "unexpected arguments for import" if @_;
my $pkg = (caller)[0];
croak "$class is private" unless $pkg =~ m/^Number::Phone(?:::|$)/;
$pkg2impl{$pkg} = $class;
}
}
Number-RGB
view release on metacpan or search on metacpan
lib/Number/RGB.pm view on Meta::CPAN
our @CARP_NOT = ('Attribute::Handlers', __PACKAGE__);
$Carp::Internal{'attributes'}++; # no idea why doesn't work in @CARP_NOT
sub import {
my $class = shift;
my $caller = (caller)[0];
eval qq[
package $caller;
use Attribute::Handlers;
sub RGB :ATTR(RAWDATA) { goto &$class\::RGB }
package $class;
Numeric-LL_Array
view release on metacpan or search on metacpan
LL_Array.pm view on Meta::CPAN
$VERSION = '0.1504';
my %exported;
sub import {
my($p, $f, $tr, $P, @e, $renew) = ( shift, (caller)[1], {}, (caller(0))[0] );
for my $sym (@_) {
$tr{$1} = $2, $tr_c .= $1, $rx = qr/[$tr_c]/, next
if $sym =~ /^:(\w)=(\w)$/;
push @e, $sym and next if $sym =~ /^\d/; # Somebody required a Version
my $Sym = $sym; # Some values may be read-only
ODF-MailMerge
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;
}
ODF-lpOD_Helper
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;
}
OWL2Perl
view release on metacpan or search on metacpan
lib/OWL/Config.pm view on Meta::CPAN
# imports names into the caller's namespace as global variables;
# adapted from the same method in Config::Simple
sub import_names {
shift;
my $namespace = @_ ? shift : (caller)[0];
return if $namespace eq 'OWL::Config';
no strict 'refs';
no warnings; # avoid "Useless use of a variable..."
while ( my ($key, $value) = each %Config ) {
Object-InsideOut
view release on metacpan or search on metacpan
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
return ($ok);
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# expected: $expected\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# expected: $expected\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $g_err\n");
print("# expected: $e_err\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
Object-Pad
view release on metacpan or search on metacpan
hax/make_argcheck_ops.c.inc view on Meta::CPAN
#define make_croak_op(message) S_make_croak_op(aTHX_ message)
static OP *S_make_croak_op(pTHX_ SV *message)
{
sv_catpvs(message, " at %s line %d.\n");
/* die sprintf($message, (caller)[1,2]) */
return op_convert_list(OP_DIE, 0,
op_convert_list(OP_SPRINTF, 0,
op_append_list(OP_LIST,
newSVOP(OP_CONST, 0, message),
newSLICEOP(0,
OpenAPI-Modern
view release on metacpan or search on metacpan
t/lib/Helper.pm view on Meta::CPAN
# Note: if you want your query parameters or uri fragment to be normalized, set them afterwards
# body_content can be a reference; the Content-Type header is used to determine the encoding format:
# see _generate_body
sub request ($method, $uri_string, $headers = [], $body_content = undef) {
die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;
die 'Wide character in body content at ', join(' line ', (caller)[1,2]), ".\n"
if not ref $body_content and length $body_content and $body_content =~ /[^\x00-\xff]/;
($headers, $body_content) = _generate_body($headers, $body_content) if ref $body_content;
my $req;
t/lib/Helper.pm view on Meta::CPAN
# add missing Content-Length, etc
$req->fix_headers;
}
else {
die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
}
return $req;
}
# body_content can be a reference; the Content-Type header is used to determine the encoding format:
# see _generate_body
sub response ($code, $headers = [], $body_content = undef) {
die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;
die 'Wide character in body content at ', join(' line ', (caller)[1,2]), ".\n"
if not ref $body_content and length $body_content and $body_content =~ /[^\x00-\xff]/;
($headers, $body_content) = _generate_body($headers, $body_content) if ref $body_content;
my $res;
t/lib/Helper.pm view on Meta::CPAN
headers => $headers,
defined $body_content ? (content => $body_content) : (),
);
}
else {
die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
}
if ($TYPE eq 'lwp' or $TYPE eq 'plack' or $TYPE eq 'catalyst' or $TYPE eq 'dancer2') {
$res->headers->header('Content-Length' => length $body_content)
if defined $body_content
t/lib/Helper.pm view on Meta::CPAN
return $res;
}
sub uri ($uri_string, @path_parts) {
die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;
my $uri;
if (elem($TYPE, [qw(lwp plack catalyst dancer2)])) {
test_needs('URI');
$uri = URI->new($uri_string);
t/lib/Helper.pm view on Meta::CPAN
elsif ($TYPE eq 'mojo') {
$uri = Mojo::URL->new($uri_string);
$uri->path->parts(\@path_parts) if @path_parts;
}
else {
die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
}
return $uri;
}
# sets query parameters on the request
sub query_params ($request, $pairs) {
die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;
my $uri;
if ($TYPE eq 'lwp') {
$request->uri->query_form($pairs);
}
t/lib/Helper.pm view on Meta::CPAN
$request->env->{REQUEST_URI} .= '?' . $request->env->{QUERY_STRING};
$request->uri->query($request->env->{QUERY_STRING}) if $TYPE eq 'catalyst';
# $request->_clear_parameters if $TYPE eq 'catalyst'; # might need this later
}
else {
die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
}
return $uri;
}
sub remove_header ($message, $header_name) {
die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;
if ($TYPE eq 'lwp') {
$message->headers->remove_header($header_name);
}
elsif ($TYPE eq 'mojo') {
t/lib/Helper.pm view on Meta::CPAN
elsif (elem($TYPE, [qw(plack catalyst dancer2)])) {
$message->headers->remove_header($header_name);
delete $message->env->{uc $header_name =~ s/-/_/r} if $message->can('env');
}
else {
die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
}
}
sub _generate_body ($headers, $body_content) {
my (undef, $content_type) = pairgrep { $a eq 'Content-Type' } @$headers;
t/lib/Helper.pm view on Meta::CPAN
return map +(
($_->headers->content_type//'') =~ m{^multipart/(?:[\w-]+); boundary=(.+)\z},
), $content->parts->@*;
}
die 'unrecognized type ', ref $message, ' at ', join(' line ', (caller)[1,2]), ".\n";
}
# prints the method and URI of the request, or the response code and message of the response,
# or the method and URI of the two-element hash
sub to_str (@args) {
t/lib/Helper.pm view on Meta::CPAN
}
elsif ($message->isa('Plack::Response') or $message->isa('Catalyst::Response')) {
return $message->status.' '.HTTP::Status::status_message($message->status);
}
die 'unrecognized type ', ref $message, ' at ', join(' line ', (caller)[1,2]), ".\n";
}
# create a Result object out of the document errors; suitable for stringifying
# as the OpenAPI::Modern constructor might do.
sub document_result ($document) {
OpenPlugin
view release on metacpan or search on metacpan
OpenPlugin/Application.pm view on Meta::CPAN
# CGI.pm. Otherwise, it just passes the request onto OpenPlugin.
sub param {
my $self = shift;
my @params = @_;
if( (caller)[0] eq "CGI::Application" ) {
return $self->SUPER::param->get_incoming( @params );
}
else {
return $self->SUPER::param( @params );
}
OpenPlugin/Application.pm view on Meta::CPAN
# CGI.pm. Otherwise, it just passes the request onto OpenPlugin.
sub header {
my $self = shift;
my @params = @_;
if( (caller)[0] eq "CGI::Application" ) {
return $self->SUPER::httpheader->send_outgoing( @params );
}
else {
return $self->SUPER::httpheader( @params );
}
OpenTracing-AutoScope
view release on metacpan or search on metacpan
t/lib/Line/Storage.pm view on Meta::CPAN
my %lines;
sub remember_line {
my ($name) = @_;
die "$name already taken" if $lines{$name};
$lines{$name} = (caller)[2];
return;
}
sub recall_line {
my ($name) = @_;
OurNet-BBS
view release on metacpan or search on metacpan
lib/OurNet/BBS/Utils.pm view on Meta::CPAN
sub locate {
my ($file, $path) = @_;
unless ($path) {
$path = (caller)[0];
$path =~ s|::\w+$||;
}
$path =~ s|::|/|g;
P
view release on metacpan or search on metacpan
sub ops($) { my $p = shift; my $c = ref $p || $p;
bless $p = {};
use Carp qw(croak);
my $caller = (caller)[0];
my $args = $_[0];
croak "ops takes a hash to pass arguments" unless HASH $args;
foreach (sort keys %$args) {
if (defined $_dflts{$_}) { $p->{$_} = $args->{$_} }
else {
PAR-Packer
view release on metacpan or search on metacpan
t/data/lib/Myfile.pm view on Meta::CPAN
use strict;
use warnings;
use Cwd;
sub from_caller { Cwd::realpath(_from_caller()) }
sub _from_caller { (caller)[1] }
sub from_file { Cwd::realpath(__FILE__) }
1;
PApp
view release on metacpan or search on metacpan
PApp/XML.pm view on Meta::CPAN
my $self = shift;
my $dom = shift;
my $temp = bless {
attr => {@_},
}, PApp::XML::Template::;
my $package = (caller)[0];
$temp->{code} = $temp->_dom2sub($dom, $self, $package);
delete $temp->{attr}{special};
PDF-Boxer
view release on metacpan or search on metacpan
lib/PDF/Boxer/Role/SizePosition.pm view on Meta::CPAN
sub move{
my ($self, $x, $y) = @_;
return if
($self->margin_left && $self->margin_left == $x)
&& ($self->margin_top && $self->margin_top == $y);
warn $self->name." move $x, $y from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
$self->adjust({ margin_left => $x, margin_top => $y });
}
sub set_width{
my ($self, $arg) = @_;
return if $self->width && $self->width == $arg;
warn $self->name." set width $arg from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
$self->adjust({ width => $arg });
}
sub set_margin_width{
my ($self, $arg) = @_;
return if $self->margin_width && $self->margin_width == $arg;
warn $self->name." set margin_width $arg from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
$self->adjust({ margin_width => $arg });
}
sub set_height{
my ($self, $arg) = @_;
return if $self->height && $self->height == $arg;
warn $self->name." set height $arg from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
$self->adjust({ height => $arg });
}
sub set_margin_height{
my ($self, $arg) = @_;
return if $self->margin_height && $self->margin_height == $arg;
warn $self->name." set margin_height $arg from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
$self->adjust({ margin_height => $arg });
}
sub set_size{
my ($self, $x, $y) = @_;
return if
($self->width && $self->width == $x)
&& ($self->height && $self->height == $y);
warn $self->name." size $x, $y from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
$self->adjust({ width => $x, height => $y });
}
sub set_margin_size{
my ($self, $x, $y) = @_;
return if $self->margin_width == $x && $self->margin_height == $y;
warn $self->name." size $x, $y from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
$self->adjust({ margin_width => $x, margin_height => $y });
}
sub child_height_set{};
sub child_width_set{};
PDF-Tiny
view release on metacpan or search on metacpan
# 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,
PDL
view release on metacpan or search on metacpan
lib/PDL/Demos.pm view on Meta::CPAN
defined($PERLDL::TERM) ? $PERLDL::TERM->readline($prompt) : ( print $prompt, <> );
}
sub act($) {
local $SIG{__DIE__} = \&Carp::confess;
actnw($_[0], (caller)[0]);
my $prompt = "---- (press enter)";
defined($PERLDL::TERM) ? $PERLDL::TERM->readline($prompt) : ( print $prompt, <> );
}
sub _eval_pkg {
lib/PDL/Demos.pm view on Meta::CPAN
local $SIG{__DIE__} = \&Carp::confess;
my ($script, $pack) = @_;
print "---- Code:";
print $script;
print "---- Output:\n";
_eval_pkg($script, $pack // (caller)[0]);
print "----\n";
print "----\nOOPS!!! Something went wrong, please make a bug report!: $@\n----\n" if $@;
}
my ($searched, @found);
PDLA-Core
view release on metacpan or search on metacpan
Basic/SourceFilter/FilterUtilCall.pm view on Meta::CPAN
# and one to an import file.
# --CED 5-Nov-2007
#
sub import {
my ($class) = @_;
($file,$offset) = (caller)[1,2]; # for error reporting
$offset++;
## Parse class name into a regexp suitable for filtration
my $terminator = terminator_regexp($class);
PDLA
view release on metacpan or search on metacpan
Basic/SourceFilter/FilterUtilCall.pm view on Meta::CPAN
# and one to an import file.
# --CED 5-Nov-2007
#
sub import {
my ($class) = @_;
($file,$offset) = (caller)[1,2]; # for error reporting
$offset++;
## Parse class name into a regexp suitable for filtration
my $terminator = terminator_regexp($class);
( run in 1.319 second using v1.01-cache-2.11-cpan-aadc1410aed )