Result:
found more than 569 distributions - search limited to the first 2001 files matching your query
( run in 2.206 )
API-MikroTik
view release on metacpan or search on metacpan
lib/API/MikroTik.pm view on Meta::CPAN
deprecated "API::MikroTik is deprecated in favour of MikroTik::Client\n";
use constant CONN_TIMEOUT => $ENV{API_MIKROTIK_CONNTIMEOUT};
use constant DEBUG => $ENV{API_MIKROTIK_DEBUG} || 0;
use constant PROMISES => !!(eval { require Mojo::Promise; 1 });
our $VERSION = 'v0.242';
has error => '';
has host => '192.168.88.1';
API-Name
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
"ExtUtils::MakeMaker" => 0,
"Mojolicious" => "6.22"
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
API-Octopart
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'API-Octopart-*' },
);
# Compatibility with old versions of ExtUtils::MakeMaker
unless (eval { ExtUtils::MakeMaker->VERSION('6.64'); 1 }) {
my $test_requires = delete $WriteMakefileArgs{TEST_REQUIRES} || {};
@{$WriteMakefileArgs{PREREQ_PM}}{keys %$test_requires} = values %$test_requires;
}
unless (eval { ExtUtils::MakeMaker->VERSION('6.55_03'); 1 }) {
my $build_requires = delete $WriteMakefileArgs{BUILD_REQUIRES} || {};
@{$WriteMakefileArgs{PREREQ_PM}}{keys %$build_requires} = values %$build_requires;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION('6.52'); 1 };
delete $WriteMakefileArgs{MIN_PERL_VERSION}
unless eval { ExtUtils::MakeMaker->VERSION('6.48'); 1 };
delete $WriteMakefileArgs{LICENSE}
unless eval { ExtUtils::MakeMaker->VERSION('6.31'); 1 };
WriteMakefile(%WriteMakefileArgs);
API-ParallelsWPB
view release on metacpan or search on metacpan
lib/API/ParallelsWPB/Response.pm view on Meta::CPAN
$json_content = $res->content;
$response = decode_json( $json_content )->{response} if $json_content;
}
else {
my $error_json = $res->content;
eval { $error = decode_json( $error_json )->{error}->{message}; 1; }
or do { $error = $error_json };
}
return bless(
{
API-Plesk
view release on metacpan or search on metacpan
lib/API/Plesk.pm view on Meta::CPAN
# LWP6 hack to prevent verification of hostname
$ua->ssl_opts(verify_hostname => 0) if $ua->can('ssl_opts');
warn $req->as_string if defined $self->{debug} && $self->{debug} > 1;
my $res = eval {
local $SIG{ALRM} = sub { die "connection timeout" };
alarm $self->{timeout};
$ua->request($req);
};
alarm 0;
lib/API/Plesk.pm view on Meta::CPAN
my $module = "$pkg.pm";
$module =~ s/::/\//g;
local $@;
eval { require $module };
if ( $@ ) {
confess "Failed to load $pkg: $@";
}
return $pkg->new(plesk => $self);
API-PleskExpand
view release on metacpan or search on metacpan
# Calling undefined method from Plesk.pm
{
our $our_warning;
local $SIG{__DIE__} = sub { $our_warning = shift; }; # confess <=> die
eval { API::PleskExpand->new(%TestData::online_expand_valid_params)->aaa__bbbccc() };
like($our_warning, qr/aaa__bbbccc/,
'Checking AUTOLOAD by calling undefined method.');
}
API-PureStorage
view release on metacpan or search on metacpan
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();
API-Stripe
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
"ExtUtils::MakeMaker" => 0,
"Mojolicious" => "6.22"
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
API-Trello
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
"ExtUtils::MakeMaker" => 0,
"Mojolicious" => "6.22"
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
API-Twitter
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
"Mojolicious" => "6.22",
"Net::OAuth" => "0.28"
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
API-Wunderlist
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
"ExtUtils::MakeMaker" => 0,
"Mojolicious" => "6.22"
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
APISchema
view release on metacpan or search on metacpan
lib/APISchema/DSL.pm view on Meta::CPAN
local $_directive->{include} = sub {
my ($file) = @_;
-r $_[0] or Carp::croak(sprintf 'No such file: %s', $file);
my $content = file($file)->slurp;
my $with_utf8 = "use utf8;\n" . $content;
eval $with_utf8;
Carp::croak($@) if $@;
};
local $_directive->{title} = sub {
$schema->title(@_);
};
APNS-Agent
view release on metacpan or search on metacpan
lib/APNS/Agent.pm view on Meta::CPAN
my $payload;
if (my $payload_json = $req->param('payload') ) {
state $json_driver = JSON::XS->new->utf8;
local $@;
$payload = eval { $json_driver->decode($payload_json) };
return [400, [], ['BAD REQUEST']] if $@;
}
elsif (my $alert = $req->param('alert')) {
$payload = +{
alert => decode_utf8($alert),
lib/APNS/Agent.pm view on Meta::CPAN
sub _send {
my ($self, $token, $payload) = @_;
local $@;
my $identifier;
eval {
$identifier = $self->_apns->send(pack("H*", $token) => {
aps => $payload,
});
};
APP-REST-RestTestSuite
view release on metacpan or search on metacpan
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
}
my $log_path = $args{LOG_FILE_PATH} || getcwd() || $ENV{PWD};
my $log_dir = $log_path . $separator . 'LOG';
eval { mkpath( $log_dir, 0, 0755 ) unless ( -d $log_dir ); };
if ($@) {
my $err = $@;
$err =~ s/line\s+\d+//g;
die qq|Unable to create LOG directory ERROR: $err\n|;
APR-Emulate-PSGI
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
my $self = $class->new(@_);
my $who = $self->_caller;
#-------------------------------------------------------------
# all of the following checks should be included in import(),
# to allow "eval 'require Module::Install; 1' to test
# installation of Module::Install. (RT #51267)
#-------------------------------------------------------------
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
inc/Module/Install.pm view on Meta::CPAN
# This reportedly fixes a rare Win32 UTC file time issue, but
# as this is a non-cross-platform XS module not in the core,
# we shouldn't really depend on it. See RT #24194 for detail.
# (Also, this module only supports Perl 5.6 and above).
eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
inc/Module/Install.pm view on Meta::CPAN
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} =
inc/Module/Install.pm view on Meta::CPAN
$call = caller($depth);
}
return $call;
}
# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
inc/Module/Install.pm view on Meta::CPAN
$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
$string =~ s/^\n+//s;
return $string;
}
# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
APR-HTTP-Headers-Compat
view release on metacpan or search on metacpan
t/compat/base/headers.t view on Meta::CPAN
is( j( $h->header( "foo" ) ), 1 );
is( $h->header( "foo-bar" ), 3 );
is( $h->header( "foo_bar" ), 3 );
is( $h->header( "Not-There" ), undef );
is( j( $h->header( "Not-There" ) ), "" );
is( eval { $h->header }, undef );
ok( $@ );
is( $h->header( "Foo", 11 ), 1 );
is( $h->header( "Foo", [ 1, 1 ] ), 11 );
is( $h->header( "Foo" ), "1, 1" );
t/compat/base/headers.t view on Meta::CPAN
is( $h->as_string, "Bar: 2\nFoo: 1\n" );
$h->init_header( Foo => [ 2, 3 ] );
$h->init_header( Baz => [ 2, 3 ] );
is( $h->as_string, "Bar: 2\nBaz: 2\nBaz: 3\nFoo: 1\n" );
eval { $h->init_header( A => 1, B => 2, C => 3 ) };
ok( $@ );
is( $h->as_string, "Bar: 2\nBaz: 2\nBaz: 3\nFoo: 1\n" );
is( $h->clone->remove_header( "Foo" ), 1 );
is( $h->clone->remove_header( "Bar" ), 1 );
t/compat/base/headers.t view on Meta::CPAN
my @tmp;
$h->scan( sub { push( @tmp, @_ ) } );
is( j( @tmp ), "ETag|1|Content-Type|text/plain|Foo|2|Foo|3" );
@tmp = ();
eval {
$h->scan( sub { push( @tmp, @_ ); die if $_[0] eq "Content-Type" }
);
};
ok( $@ );
is( j( @tmp ), "ETag|1|Content-Type|text/plain" );
t/compat/base/headers.t view on Meta::CPAN
# other date fields
for my $field (
qw(expires if_modified_since if_unmodified_since
last_modified)
) {
eval <<'EOT'; die $@ if $@;
is($h->$field, undef);
is($h->$field(time), undef);
ok((time - $h->$field) =~ /^[01]$/);
EOT
}
t/compat/base/headers.t view on Meta::CPAN
is( $h->authorization_basic( "u", "p" ), "u:" );
is( $h->authorization_basic, "u:p" );
is( j( $h->authorization_basic ), "u|p" );
is( $h->authorization, "Basic dTpw" );
is( eval { $h->authorization_basic( "u2:p" ) }, undef );
ok( $@ );
is( j( $h->authorization_basic ), "u|p" );
is( $h->proxy_authorization_basic( "u2", "p2" ), undef );
is( j( $h->proxy_authorization_basic ), "u2|p2" );
ARCv2
view release on metacpan or search on metacpan
lib/Arc/Connection.pm view on Meta::CPAN
return $command; # There was an error if undef is return
}
## process an ARCv2 command. (protocol)
## Process a command by evaling $this->_R$cmd. Also checks if
## this command was expected now (looks into the $this->{_expectedcmds} array).
## Used by client and server.
##in> $cmd
##out> true, if ARCv2 command has been in place, otherwise false
##eg> while (my $cmd = $this->_RecvCommand() && $this->_ProcessLine($cmd)) {}
lib/Arc/Connection.pm view on Meta::CPAN
$this->_Debug("Received Command: $cmd (",@{$this->{_expectedcmds}},")");
if (grep { $_ eq $cmd } @{$this->{_expectedcmds}} ) {
$cmd = "_R".$cmd;
$ret = $this->_SetError("Evaluation of command $cmd failed ($@).")
unless eval { $this->$cmd; }
} else {
$ret = $this->_SetError("Unexpected command: $cmd");
}
return $ret;
}
ARGV-Abs
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
"TESTS" => "t/*.t"
}
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
my $pp = $WriteMakefileArgs{PREREQ_PM};
for my $mod ( keys %$br ) {
if ( exists $pp->{$mod} ) {
$pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod};
Makefile.PL view on Meta::CPAN
}
}
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
ARGV-ENV
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
"TESTS" => "t/*.t"
}
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
my $pp = $WriteMakefileArgs{PREREQ_PM};
for my $mod ( keys %$br ) {
if ( exists $pp->{$mod} ) {
$pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod};
Makefile.PL view on Meta::CPAN
}
}
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
ARGV-OrDATA
view release on metacpan or search on metacpan
t/00-data.t view on Meta::CPAN
use Test::More tests => 3;
use FindBin;
open *STDIN, '<&', IO::Pty->new
if ! -t && eval { require IO::Pty };
SKIP: {
skip "Can't run the test when stdin is not the terminal", 3
unless -t;
ARGV-Struct
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
"Test::More" => 0,
"Types::Standard" => 0
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
ARGV-URL
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
"TESTS" => "t/*.t"
}
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
my $pp = $WriteMakefileArgs{PREREQ_PM};
for my $mod ( keys %$br ) {
if ( exists $pp->{$mod} ) {
$pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod};
Makefile.PL view on Meta::CPAN
}
}
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
ARS-Simple
view release on metacpan or search on metacpan
lib/ARS/Simple.pm view on Meta::CPAN
$cfg =~ s/\.pm$/.cfg/;
if ($compiled or -e $cfg)
{
# In a Perl2Exe or PerlApp created executable or PerlCtrl
# generated COM object or the cfg is known to exist
eval {require $cfg};
if ($@ and $@ !~ /Can't locate /) #' <-- syntax higlighter
{
carp "Error in $cfg : $@";
}
}
ARSObject
view release on metacpan or search on metacpan
lib/ARSObject.pm view on Meta::CPAN
#,-fpbv=>[] # buffer values
#,-fpbn=>'' # buffer name == record common name
};
bless $s,$c;
set($s, @_);
$s->{-storable} =eval('use Storable; 1') if !exists($s->{-storable});
$s
}
sub AUTOLOAD { # Use self->arsXXX() syntax for ars_XXX(ctrl,...) calls
lib/ARSObject.pm view on Meta::CPAN
sub DESTROY {
my $s =shift;
$s->{-die} =undef;
$s->{-warn}=undef;
$s->{-ctrl} && eval{ars_Logoff($s->{-ctrl})};
$s->{-ctrl}=undef;
$s->{-dbi} && eval{$s->{-dbi}->disconnect()};
$s->{-dbi} =undef;
$s->{-cgi} =undef;
$s->{-diemsg} =undef;
$s->{-warnmsg} =undef;
}
lib/ARSObject.pm view on Meta::CPAN
foreach my $k (keys %a) {
$s->{$k} =$a{$k}
}
if ($a{-die}) {
if ($a{-die} =~/^Carp/) {
eval('use ' .$a{-die} .';');
$s->{-die} =\&Carp::confess;
$s->{-warn}=\&Carp::carp;
}
elsif ($a{-die} =~/^CGI::Carp/) {
eval('use ' .$a{-die} .';');
$s->{-die} =\&CGI::Carp::confess;
$s->{-warn}=\&CGI::Carp::carp;
if ($s->{-diemsg}) {
my $dm =$s->{-diemsg};
CGI::Carp::set_message(sub{&$dm(@_); $s->disconnect() if $s;})
}
}
elsif ($a{-die} =~/^CGI::Die/) {
eval('use Carp;');
$s->{-die} =\&Carp::confess;
$s->{-warn}=\&Carp::carp;
my $sigdie =$SIG{__DIE__};
$SIG{__DIE__} =sub{
return if ineval();
if ($s && $s->{-diemsg}) {
&{$s->{-diemsg}}(@_)
}
else {
print $s->{-cgi}->header(-content=>'text/html'
lib/ARSObject.pm view on Meta::CPAN
# $SIG{__DIE__} =$sigdie;
# &$sigdie(@_) if ref($sigdie) eq 'CODE';
# CORE::die($_[0]);
};
$SIG{__WARN__} =sub{
return if !$^W ||ineval();
if ($s && $s->{-warnmsg}) {
&{$s->{-warnmsg}}(@_)
}
else {
print '<div style="font-weight: bolder">Warnig: '
lib/ARSObject.pm view on Meta::CPAN
}
$s
}
sub ineval { # is inside eval{}?
# for PerlEx and mod_perl
# see CGI::Carp::ineval comments and errors
return $^S if !($ENV{GATEWAY_INTERFACE}
&& ($ENV{GATEWAY_INTERFACE} =~/PerlEx/))
&& !$ENV{MOD_PERL};
my ($i, @a) =(1);
while (@a =caller($i)) {
return(0) if $a[0] =~/^(?:PerlEx::|Apache::Perl|Apache::Registry|Apache::ROOT)/i;
return(1) if $a[3] eq '(eval)';
$i +=1;
}
$^S
}
lib/ARSObject.pm view on Meta::CPAN
}
sub dsdump { # Data structure dump to string
my ($s, $d) =@_; # (data structure) -> dump string
eval('use Data::Dumper');
my $o =Data::Dumper->new([$d]);
$o->Indent(1);
$o->Deepcopy(1);
$o->Dump();
}
sub dsparse { # Data structure dump string to perl structure
my ($s, $d) =@_; # (string) -> data structure
eval('use Safe; 1')
&& Safe->new()->reval($d)
}
sub dscmp { # Compare data structures
my($s, $ds1, $ds2) =@_;
lib/ARSObject.pm view on Meta::CPAN
$msk =~s/mm/%M/i;
$msk =~s/dd/%d/;
$msk =~s/hh/%H/;
$msk =~s/hh/%h/i;
$msk =~s/ss/%S/;
#eval('use POSIX');
my $r =POSIX::strftime($msk, @tme);
# &{$s->{-warn}}("Not defined strtime('$msk'," .join(',', map {defined($_) ? $_ : 'undef'} @tme) .")")
# if !defined($r);
$r
}
lib/ARSObject.pm view on Meta::CPAN
$m =chop($m);
$m ='M' if $m eq 'm' && $th{$m};
$m =lc($m) if $m ne 'M';
$th{$m}=$d;
}
#eval('use POSIX');
my $r =POSIX::mktime($th{'s'}||0,$th{'M'}||0,$th{'h'}||0,$th{'d'}||0,($th{'m'}||1)-1,$th{'y'}||0,0,0,(localtime(time))[8]);
# &{$s->{-warn}}("Not defined timestr('$_[0]')")
# if !defined($r);
$r
}
lib/ARSObject.pm view on Meta::CPAN
return(undef)
}
my @t =localtime($_[1]);
my $i =5;
foreach my $a (@_[2..$#_]) {$t[$i] += ($a||0); $i--}
#eval('use POSIX');
POSIX::mktime(@t[0..5],0,0,$t[8])
}
sub charset {
$_[0]->{-charset} && ($_[0]->{-charset} =~/^\d/)
? 'windows-' .$_[0]->{-charset}
: ($_[0]->{-charset} || ($_[0]->{-cgi} && $_[0]->{-cgi}->charset())
|| eval('!${^ENCODING}') && eval('use POSIX; POSIX::setlocale(POSIX::LC_CTYPE)=~/\\.([^.]+)$/ ? "cp$1" : "cp1252"'))
}
sub cptran { # Translate strings between codepages
my ($s,$f,$t,@s) =@_; # (from, to, string,...) -> string,...
if (($] >=5.008) && eval("use Encode; 1")) {
map {$_= /oem|866/i ? 'cp866'
: /ansi|1251/i ? 'cp1251'
: /koi/i ? 'koi8-r'
: /8859-5/i ? 'iso-8859-5'
: $_
lib/ARSObject.pm view on Meta::CPAN
if ($v =~/oem|866/i) {$v ='€‚ƒ„…ð†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™œ›šžŸ ¡¢£¤¥ñ¦§¨©ª«¬®¯àáâãäåæçèéìëêíîï'}
elsif ($v =~/ansi|1251/i) {$v ='ÀÁÂÃÄŨÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÜÛÚÝÞßàáâãäå¸æçèéêëìíîïðñòóôõö÷øùüûúýþÿ'}
elsif ($v =~/koi/i) {$v ='áâ÷çäå³öúéêëìíîïðòóôõæèãþûýøùÿüàñÁÂ×ÇÄÅ£ÖÚÉÊËÌÍÎÏÐÒÓÔÕÆÈÃÞÛÝØÙßÜÀÑ'}
elsif ($v =~/8859-5/i) {$v ='°±²³´µ¡¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÌËÊÍÎÏÐÑÒÓÔÕñÖ×ØÙÚÛÜÝÞßàáâãäåæçèéìëêíîï'}
}
map {eval("~tr/$f/$t/") if defined($_)} @s;
}
@s >1 ? @s : $s[0];
}
lib/ARSObject.pm view on Meta::CPAN
sub fopen { # Open file
my $s =shift; # ('-b',filename) -> success
my $o =$_[0] =~/^-(?:\w[\w\d+-]*)*$/ ? shift : '-';
my $f =$_[0]; $f ='<' .$f if $f !~/^[<>]/;
eval('use IO::File');
my $h =IO::File->new($f) || return(&{$s->{-die}}($s->efmt('$!',undef,'cannot open file','fopen',$f)));
$h->binmode() if $h && ($o =~/b/);
$h
}
lib/ARSObject.pm view on Meta::CPAN
my($s,$n,$d)=@_;
$d =$s->{$n} if !$d && ($n =~/^-/);
my $f =$s->vfname($n, '.new');
my $r;
if (($n =~/^-/) && exists($s->{"${n}-storable"}) ? $s->{"${n}-storable"} : $s->{-storable}) {
for (my $i =0; ($i <$fretry) && eval("use Storable; 1"); $i++) {
$r =Storable::store($d, $f);
last if $r;
}
return(&{$s->{-die}}($s->efmt('$!',$s->{-cmd},undef,'Storable::store',$f)))
if !$r;
lib/ARSObject.pm view on Meta::CPAN
return($d);
}
my $r;
if (0) {
$r =($k && exists($s->{"${k}-storable"}) ? $s->{"${k}-storable"} : $s->{-storable})
? eval("use Storable; 1")
&& Storable::retrieve($f)
|| return(&{$s->{-die}}($s->efmt('$!',$s->{-cmd},undef,'Storable::retrieve',$f)))
: ((eval{do($f)}) || return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},undef,'do',$f))));
}
else {
local *FILE;
for (my $i =0; $i <$fretry; $i++) {
$r =open(FILE, "<$f");
lib/ARSObject.pm view on Meta::CPAN
||return(&{$s->{-die}}($s->efmt('$!',$s->{-cmd},undef,'sysread',$f)));
$r =($v
? $v !~/^\$VAR1\s*=/
: ($k && exists($s->{"${k}-storable"}) ? $s->{"${k}-storable"} : $s->{-storable}))
? ((seek(FILE,0,0) ||1)
&& eval("use Storable; 1")
&& Storable::fd_retrieve(\*FILE)
|| return(&{$s->{-die}}($s->efmt('$!',$s->{-cmd},undef,'Storable::retrieve',$f))))
: ((eval{close(FILE); 1}) &&
do($f) || return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},undef,'do',$f)))
);
eval{close(FILE)};
}
$s->{$k} =$r if $k;
$r
}
lib/ARSObject.pm view on Meta::CPAN
."vfdata('$_[1]', sub{})";
my ($rr, $v);
if (ref($_[0]->{$_[1]}) eq 'ARRAY') {
$rr =[];
for(my $i=0; $i<=$#{$_[0]->{$_[1]}}; $i++) {
if (!defined(eval{$v =&{$_[2]}($_[0], $_[1], $i, $_ =$_[0]->{$_[1]}->[$i])}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$_[0]->{-die}}($_[0]->efmt($@,$_[0]->{-cmd})));
}
elsif ($v) {
lib/ARSObject.pm view on Meta::CPAN
}
}
elsif (ref($_[0]->{$_[1]}) eq 'HASH') {
$rr ={};
foreach my $i (keys %{$_[0]->{$_[1]}}) {
if (!defined(eval{$v =&{$_[2]}($_[0], $_[1], $i, $_ =$_[0]->{$_[1]}->{$i})}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$_[0]->{-die}}($_[0]->efmt($@,$_[0]->{-cmd})));
}
elsif ($v) {
lib/ARSObject.pm view on Meta::CPAN
my ($rh, $t) =({});
local $_;
local $_[0]->{-cmd} =($_[0]->{-cmd} ? $_[0]->{-cmd} .': ' : '')
."vfhash('$f', '$k', sub{})";
foreach my $ke (keys %{$s->{$kk}}) {
if (!defined(eval{$t =&$v($s, $f, $k, $_ =$s->{$kk}->{$ke})}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$s->{-die}}($s->efmt($@,$s->{-cmd})));
}
elsif ($t) {
lib/ARSObject.pm view on Meta::CPAN
$s->vfload($f, 1) if !$s->{$f} ||(ref($s->{$f}) eq 'CODE');
if (ref($s->{$f}) eq 'ARRAY') {
for(my $i=0; $i<=$#{$s->{$f}}; $i++) {
if (!defined($s->{$f}->[$i]->{$k})) {
}
elsif ($v && !defined(eval{$t =&$v($s, $f, $k, $_ =$s->{$f}->[$i])}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$s->{-die}}($s->efmt($@,$s->{-cmd})));
}
elsif (!$v ||$t) {
lib/ARSObject.pm view on Meta::CPAN
}
else {
foreach my $kh (keys %{$s->{$f}}) {
if (!defined($s->{$f}->{$kh}->{$k})) {
}
elsif ($v && !defined(eval{$t =&$v($s, $f, $k, $_ =$s->{$k}->{$kh})}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$s->{-die}}($s->efmt($@,$s->{-cmd})));
}
elsif (!$v ||$t) {
lib/ARSObject.pm view on Meta::CPAN
}
sub connect { # Connect to ARS server
eval('use ARS'); # (-param=>value,...) -> self
my $s =shift; # -srv, -usr, -pswd, -lang
$s->set(@_);
$s->set(-die=>'Carp') if !$s->{-die};
local $s->{-cmd} ="connect()";
return($s) if $s->{-ctrl};
print $s->cpcon("connect()\n") if $s->{-echo};
return($s) if $s->{-ctrl} && ARS::ars_VerifyUser($s->{-ctrl});
$s->{-ctrl} =ARS::ars_Login(
$s->{-srv}, $s->{-usr}, $s->{-pswd}, $s->{-lang}
, '' # , join('-', ($ENV{COMPUTERNAME} ||$ENV{HOSTNAME} ||eval('use Sys::Hostname;hostname') ||'localhost'), getlogin() || $> || '', $$, $^T, time())
, 0, 0)
|| return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_Login', map {$_=>$s->{$_}} qw(-srv -usr -lang))));
$s->{-ctrl} && ARS::ars_SetSessionConfiguration($s->{-ctrl}, &ARS::AR_SESS_OVERRIDE_PREV_IP, 1);
$s->arsmeta();
$s
}
sub disconnect { # Disconnect data servers
my $s =shift;
$s->{-ctrl} && eval{ars_Logoff($s->{-ctrl})};
$s->{-ctrl}=undef;
$s->{-dbi} && eval{$s->{-dbi}->disconnect()};
$s->{-dbi} =undef;
}
sub arsmeta { # Load/refresh ARS metadata
lib/ARSObject.pm view on Meta::CPAN
$s->{-meta}->{$f} ={}
if !$s->{-meta}->{$f};
foreach my $ff (keys %{$fs->{-fields}}) {
$s->{-meta}->{$f}->{-fields}->{$ff} ={}
if !$s->{-meta}->{$f}->{-fields}->{$ff};
eval {@{$s->{-meta}->{$f}->{-fields}->{$ff}}{keys %{$fs->{-fields}->{$ff}}}
=values %{$fs->{-fields}->{$ff}}};
}
}
$s->arsmetaix()
}
lib/ARSObject.pm view on Meta::CPAN
, $fl
, @fs)) {
if (!ref($e)) {
$_ =$id =$e
}
elsif (!defined(eval{&$c($s, $f, $_ =$id, entryOut($s, $f, $e))}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},'eval(-for)')));
}
}
return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},'undef','ars_GetListEntryWithFields')))
if !defined($id) && $ARS::ars_errstr;
return($s);
lib/ARSObject.pm view on Meta::CPAN
else {
$i =1;
$_ =$e;
next
}
if (!defined(eval{&$c($s, $f, $_
, $a{-fetch}
? $s->entry(-from=>$f, -id=>$_
, ref($a{-fetch}) ? (-fields => $a{-fetch}) : ())
: ())}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},'eval(-for)')));
}
}
return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetListEntry')))
if !defined($i) && $ARS::ars_errstr;
return($s)
lib/ARSObject.pm view on Meta::CPAN
# (-dbiconnect=>[]) -> dbi object
set(@_);
set($_[0],-die=>'Carp') if !$_[0]->{-die};
print $_[0]->cpcon("dbiconnect()\n")
if $_[0]->{-echo};
eval('use DBI; 1') ||return(&{$_[0]->{-die}}($_[0]->efmt('No DBI')));
$_[0]->{-dbi} =DBI->connect(ref($_[0]->{-dbiconnect}) ? @{$_[0]->{-dbiconnect}} : $_[0]->{-dbiconnect})
|| &{$_[0]->{-die}}($_[0]->efmt(DBI->errstr,undef,undef,'dbiconnect') ."\n");
}
lib/ARSObject.pm view on Meta::CPAN
my $s =shift;
no warnings;
local $^W =0;
$ENV{HTTP_USER_AGENT} =$ENV{HTTP_USER_AGENT}||'';
$ENV{PERLXS} ='PerlIS' if !$ENV{PERLXS} && ($^O eq 'MSWin32') && $0 =~/[\\\/]perlis\.dll$/i;
eval('use CGI; 1')
||return(&{$s->{-die}}($s->efmt('No CGI')));
$s->{-cgi} =$CGI::Q =$CGI::Q =eval{CGI->new(@_)}
||return($s->{-die}
? &{$s->{-die}}($s->efmt($@, undef, undef, 'cgi'))
: CORE::die($s->efmt($@, undef, undef, 'cgi')));
$s->set(-die=>'CGI::Carp fatalsToBrowser') if !$s->{-die};
return(&{$s->{-die}}($s->efmt($s->{-cgi}->{'.cgi_error'}, undef, undef, 'cgi')))
lib/ARSObject.pm view on Meta::CPAN
set(@_); # (-smtphost) -> self->{-smtp}
set($_[0],-die=>'Carp') if !$_[0]->{-die};
my $s =shift;
no warnings;
local $^W =0;
eval('use Net::SMTP; 1') ||return(&{$s->{-die}}($@, $s->efmt('Net::SMTP')));
$s->{-smtp} =eval {
local $^W=undef;
eval("use Net::SMTP");
$s->{-smtphost}
? Net::SMTP->new($s->{-smtphost})
: CORE::die($s->efmt('SMTP host name required'))
};
return(&{$s->{-die}}("SMTP host '" .($s->{-smtphost}||'') ."': $@\n"))
lib/ARSObject.pm view on Meta::CPAN
$lf =$s->vfname($lf) if $lf && ($lf !~/[\\\/]/);
my $wl;
if (ref($cs) ? scalar(@$cs) : $cs) {
return(&{$s->{-die}}("MSWin32 required for `at` in soon()\n"))
if $^O ne 'MSWin32';
if (defined($mm) && ($^O eq 'MSWin32') && eval('use Win32::Event; 1')) {
# MSDN: 'CreateEvent', 'Kernel Object Namespaces'
my $q =_sooncl($s, $cs, 1);
my $n =$q;
$n =~s/[\\]/!/g;
$n ="Global\\$n";
lib/ARSObject.pm view on Meta::CPAN
}
elsif (ref($cr) eq 'CODE') {
local *OLDOUT;
local *OLDERR;
if ($lf) {
eval{fileno(STDOUT) && open(OLDOUT, '>&STDOUT')};
eval{fileno(STDERR) && open(OLDERR, '>&STDERR')};
open(STDOUT, ">>$lf");
open(STDERR, ">>$lf");
}
$r =&$cr(@_);
if ($lf) {
eval{fileno(OLDOUT) && close(STDOUT) && open(STDOUT, '>&OLDOUT')};
eval{fileno(OLDERR) && close(STDERR) && open(STDERR, '>&OLDERR')};
}
}
else {
my $cmd =$cr;
if (ref($cr) eq 'ARRAY') {
lib/ARSObject.pm view on Meta::CPAN
}
}
if (!$ae) {
}
elsif (ref($ae) eq 'CODE' && ($ord eq '-action')) {
$r =eval{&$ae($s, $act, $ord, $rp, $f, $_ =cfpvv($s,$f), cfpvp($s,$f)
, {map {&$ffc($s, $_)
? ()
: ($_->{-namedb} => &$fvu($s, $_))
} cfpused($s)}
)}
}
elsif (ref($ae) eq 'CODE') { # -preact
$r =eval{&$ae($s, $act, $ord, $rp, $f, $_ =cfpvv($s, $f), cfpvp($s,$f)
, {map {&$ffc($s, $_) || !defined(cfpv($s, $_))
? ()
: ($_->{-namedb} => cfpv($s, $_))
} @{$s->{-fpl}}}
)}
lib/ARSObject.pm view on Meta::CPAN
$r =undef;
$@ ="Form not defined"
}
elsif ($frk && ($fn=$frk->{-namedb}) && ($fv =cfpv($s, $frk->{master}))) {
$s->{-fpbv} =$f->{-namedb}
? eval{$s->connect()
&& $s->query(-form=>$frm
,-fields=>'*'
,-where=>"'$fn'=" .$s->arsquot($fv))}
: [];
if ($s->{-fpbv}) {
lib/ARSObject.pm view on Meta::CPAN
else {
$r =undef
}
}
elsif ($f && ($fv =cfpv($s, $f))) {
$r =eval{$s->connect()
&& $s->entry(-form=>$frm
,-id=>$fv)};
}
elsif ( (($fn =$af->{-namedb}) && defined($fv =cfpv($s, $af)))
|| (($fn =cfpnd($s, cfpv($s, $af))) && defined($fv =cfpv($s, $fn)))
) {
$r =eval{$s->connect()
&& $s->query(-form=>$frm
,-fields=>'*'
,-where=>"'$fn'=" .$s->arsquot($fv))};
if ($r) {
$r =shift @$r;
lib/ARSObject.pm view on Meta::CPAN
$r =undef;
$@ ="Key not defined"
}
}
elsif ($ae eq 'entryNew') { # -preact
$r =eval{$s->connect()
&& $s->entryNew(-form => $frm)}
if $frm;
}
elsif ($ae eq 'entryIns') { # -action
my $fs =$f->{-vfname} ||$af->{-vfname};
$r =eval{$s->connect()
&& $s->entryIns(-form=>$frm
, map { &$ffc($s, $_) ||(exists($_->{-entryIns}) && !$_->{-entryIns})
? ()
: ($_->{-namedb} => &$fvu($s, $_))
} cfpused($s))}
lib/ARSObject.pm view on Meta::CPAN
}
elsif (($af->{-vfclear} || $f->{-vfclear}) && $s->{"${fs}-calc"}) {
$s->vfclear($fs);
}
elsif (($af->{-vfrenew} || $f->{-vfrenew}) && $s->{"${fs}-store"}) {
eval{$s->vfclear($fs); $s->vfrenew($fs)}
}
elsif ($af->{-vfedit} || $f->{-vfedit}) {
my $fn =$f->{-namedb} ||$af->{-namedb};
my $ft =defined($f->{-vftran}) ? $f->{-vftran} : $af->{-vftran};
my $fv =cfpv($s, $f);
lib/ARSObject.pm view on Meta::CPAN
$s->vfclear($fs);
}
}
elsif ($ae eq 'entryUpd') { # -action
my $fs =$f->{-vfname} ||$af->{-vfname};
$r =eval{$s->connect()
&& $s->entryUpd(-form=>$frm, -id=>cfpvv($s,$f)
, map { &$ffc($s, $_) ||(exists($_->{-entryUpd}) && !$_->{-entryUpd})
? ()
: ($_->{-namedb} => &$fvu($s, $_))
} cfpused($s))}
lib/ARSObject.pm view on Meta::CPAN
}
elsif (($af->{-vfclear} || $f->{-vfclear}) && $s->{"${fs}-calc"}) {
$s->vfclear($fs);
}
elsif (($af->{-vfrenew} || $f->{-vfrenew}) && $s->{"${fs}-store"}) {
eval{$s->vfclear($fs); $s->vfrenew($fs)}
}
elsif ($af->{-vfedit} || $f->{-vfedit}) {
my $fn =$f->{-namedb} ||$af->{-namedb};
my $ft =defined($f->{-vftran}) ? $f->{-vftran} : $af->{-vftran};
my $fv =cfpv($s, $f);
lib/ARSObject.pm view on Meta::CPAN
$s->vfclear($fs);
}
}
elsif ($act eq 'entryDel') { # -action
my $fs =$f->{-vfname} ||$af->{-vfname};
$r =eval{$s->connect()
&& $s->entryDel(-form=>$frm
, -id=>cfpvv($s,$f))}
if $frm && cfpvv($s,$f);
if (!$r) {
$@ ="Unknown 'entryDel' error" if !$@
lib/ARSObject.pm view on Meta::CPAN
}
elsif (($af->{-vfclear} || $f->{-vfclear}) && $s->{"${fs}-calc"}) {
$s->vfclear($fs);
}
elsif (($af->{-vfrenew} || $f->{-vfrenew}) && $s->{"${fs}-store"}) {
eval{$s->vfclear($fs); $s->vfrenew($fs)}
}
elsif ($af->{-vfedit} || $f->{-vfedit}) {
my $fn =$f->{-namedb} ||$af->{-namedb};
my $fv =cfpv($s, $f);
my $fa =$s->vfdata($fs);
ARSperl
view release on metacpan or search on metacpan
# definitions required for backwards compatibility
if (!defined &ARS::AR_IMPORT_OPT_CREATE) {
eval 'sub AR_IMPORT_OPT_CREATE { 0; }';
}
if (!defined &ARS::AR_IMPORT_OPT_OVERWRITE) {
eval 'sub AR_IMPORT_OPT_OVERWRITE { 1; }';
}
bootstrap ARS $ARS::VERSION;
tie $ARS::ars_errstr, ARS::ERRORSTR;
ASNMTAP
view release on metacpan or search on metacpan
applications/archive.pl view on Meta::CPAN
use warnings; # Must be used in test mode only. This reduces a little process speed
#use diagnostics; # Must be used in test mode only. This reduces a lot of process speed
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
BEGIN { if ( $ENV{ASNMTAP_PERL5LIB} ) { eval 'use lib ( "$ENV{ASNMTAP_PERL5LIB}" )'; } }
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use DBI;
use Time::Local;
ASP4-PSGI
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} = delete $INC{$file};
ASP4
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} = delete $INC{$file};
ASP4x-Captcha-Imager
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} = delete $INC{$file};
ASP4x-Linker
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} = delete $INC{$file};
( run in 2.206 seconds using v1.01-cache-2.11-cpan-98e64b0badf )