view release on metacpan or search on metacpan
lib/Arcus/Client.pm view on Meta::CPAN
$args->{serialize_methods} //= [ \&Storable::nfreeze, \&Storable::thaw ];
$args->{compress_threshold} //= -1;
$args->{compress_ratio} //= 0.8;
$args->{compress_methods} //= [ \&Compress::Zlib::memGzip,
\&Compress::Zlib::memGunzip ] if $HAVE_ZLIB;
my $arcus = $class->SUPER::new($args);
bless($arcus, $class);
$arcus_info{$$arcus} = $args;
POSIX::AtFork->add_to_child(sub {
$arcus->connect_proxy();
});
return $arcus;
}
sub DESTROY {
my $arcus = shift;
$arcus->SUPER::DESTROY;
if ($arcus_info{$$arcus}) {
delete $arcus_info{$$arcus};
}
}
sub CLONE {
my $class = shift;
foreach my $arcus (keys %arcus_info) {
$class->SUPER::new($arcus);
}
}
for my $method ( qw/set add replace/ ) {
no strict 'refs';
my $super = 'SUPER::'.$method;
*{$method} = sub {
my ($arcus, $key, $value, $exptime) = @_;
my ($conf, $flags) = ($arcus_info{$$arcus}, 0);
return undef unless $conf;
$key = $SANITIZE->($key);
lib/Arcus/Client.pm view on Meta::CPAN
my ($arcus, $key, $cas, $value, $exptime) = @_;
my ($conf, $flags) = ($arcus_info{$$arcus}, 0);
return undef unless $conf;
$key = $SANITIZE->($key);
($value, $flags) = $ENCODE->($conf, $value, $flags);
return $arcus->SUPER::cas($key, $cas, $value, $exptime, $flags);
}
sub cas_multi {
my ($arcus, @kvs) = @_;
my $ctx = wantarray;
lib/Arcus/Client.pm view on Meta::CPAN
my $exptime = $elem->[3] ? $elem->[3] : 0;
$key = $SANITIZE->($key);
($value, $flags) = $ENCODE->($conf, $value, $flags);
push(@skvs, [$key, $cas, $value, $exptime, $flags]);
}
@ref = $arcus->SUPER::cas_multi(@skvs);
return unless defined($ctx);
return @ref if $ctx;
my %href;
foreach my $index (0..$#kvs) {
$href{$kvs[$index]->[0]} = $ref[$index] if defined($ref[$index]);
lib/Arcus/Client.pm view on Meta::CPAN
return \%href;
}
for my $method ( qw/set_multi add_multi replace_multi/ ) {
no strict 'refs';
my $super = 'SUPER::'.$method;
*{$method} = sub {
my ($arcus, @kvs) = @_;
my $ctx = wantarray;
my $conf = $arcus_info{$$arcus};
return undef unless $conf;
lib/Arcus/Client.pm view on Meta::CPAN
}
}
for my $method ( qw/append prepend/ ) {
no strict 'refs';
my $super = 'SUPER::'.$method;
*{$method} = sub {
my ($arcus, $key, $value) = @_;
my $conf = $arcus_info{$$arcus};
return undef unless $conf;
$key = $SANITIZE->($key);
lib/Arcus/Client.pm view on Meta::CPAN
};
}
for my $method ( qw/append_multi prepend_multi/ ) {
no strict 'refs';
my $super = 'SUPER::'.$method;
*{$method} = sub {
my ($arcus, @kvs) = @_;
my $ctx = wantarray;
my $conf = $arcus_info{$$arcus};
return undef unless $conf;
lib/Arcus/Client.pm view on Meta::CPAN
}
}
for my $method ( qw/incr decr/ ) {
no strict 'refs';
my $super = 'SUPER::'.$method;
*{$method} = sub {
my ($arcus, $key, $offset) = @_;
my $conf = $arcus_info{$$arcus};
return undef unless $conf;
$key = $SANITIZE->($key);
lib/Arcus/Client.pm view on Meta::CPAN
};
}
#for my $method ( qw/incr_multi decr_multi/ ) {
# no strict 'refs';
# my $super = substr('SUPER::'.$method, 0, -6);
# *{$method} = sub {
# my ($arcus, @arr) = @_;
# my $ctx = wantarray;
# my (@ref, @keys);
# my $conf = $arcus_info{$$arcus};
lib/Arcus/Client.pm view on Meta::CPAN
sub get {
my ($arcus, $key) = @_;
my $conf = $arcus_info{$$arcus};
return undef unless $conf and defined($key);
$key = $SANITIZE->($key);
my ($value, $flags) = $arcus->SUPER::get($key);
return undef unless defined($value) and defined($flags);
($value) = $DECODE->($conf, $value, $flags);
return $value;
}
lib/Arcus/Client.pm view on Meta::CPAN
next unless defined($skey);
push(@skeys, $skey);
$kmap{$skey} = $key;
}
my $result = $arcus->SUPER::get_multi(@skeys);
my %href;
while (my ($key, $arr) = each %{$result}) {
my ($value, $flags) = @{$arr}[0, 1];
($value) = $DECODE->($conf, $value, $flags);
$href{$kmap{$key}} = $value if defined($value);
lib/Arcus/Client.pm view on Meta::CPAN
sub gets {
my ($arcus, $key) = @_;
my $conf = $arcus_info{$$arcus};
return undef unless $conf and defined($key);
$key = $SANITIZE->($key);
my ($cas, $value, $flags) = $arcus->SUPER::gets($key);
return undef unless defined($cas) and defined($value) and defined($flags);
($value) = $DECODE->($conf, $value, $flags);
return [$cas, $value];
}
lib/Arcus/Client.pm view on Meta::CPAN
next unless defined($skey);
push(@skeys, $skey);
$kmap{$skey} = $key;
}
my $result = $arcus->SUPER::gets_multi(@skeys);
my %href;
while (my ($key, $arr) = each %{$result}) {
my ($cas, $value, $flags) = @{$arr}[0, 1, 2];
($value) = $DECODE->($conf, $value, $flags);
$href{$kmap{$key}} = [$cas, $value] if defined($cas) and defined($value);
lib/Arcus/Client.pm view on Meta::CPAN
sub delete {
my ($arcus, $key) = @_;
my $conf = $arcus_info{$$arcus};
return undef unless $conf;
$key = $SANITIZE->($key);
return $arcus->SUPER::delete($key);
}
#sub delete_multi {
# my ($arcus, @keys) = @_;
# my $ctx = wantarray;
# my @ref;
# my $conf = $arcus_info{$$arcus};
# return undef unless $conf;
# foreach my $key (@keys) {
# $key = $SANITIZE->($key);
# push(@ref, $arcus->SUPER::delete($key));
# }
# return unless defined($ctx);
# return @ref if $ctx;
# my %href = map { $keys[$_] => $ref[$_] } 0..$#keys;
# return \%href;
view release on metacpan or search on metacpan
t/Test/Arepa/T01Smoke.pm view on Meta::CPAN
sub setup : Test(setup => 7) {
my ($self, @args) = @_;
$self->config_path('t/webui/conf/default/config.yml');
$self->SUPER::setup(@_);
$self->login_ok("testuser", "testuser's password");
}
sub test_should_see_builders : Test(1) {
view release on metacpan or search on metacpan
lib/Ark/Models.pm view on Meta::CPAN
$pkg->initialize;
}
unshift @_, $pkg, $flag;
# goto $pkg->can('SUPER::import');
goto &Object::Container::import; # Some perl does not run avobe code, this is a quick fix for it.
}
sub initialize {
my $pkg = shift;
lib/Ark/Models.pm view on Meta::CPAN
sub get {
my $self = shift;
$self = $self->instance unless ref $self;
my $obj = eval { $self->SUPER::get(@_) };
my $err = $@;
return $obj if $obj;
my $target = $_[0];
view release on metacpan or search on metacpan
lib/Armadito/Agent/Antivirus/Armadito.pm view on Meta::CPAN
use Armadito::Agent::HTTP::Client::ArmaditoAV;
sub new {
my ( $class, %params ) = @_;
my $self = $class->SUPER::new(%params);
$self->{name} = "Armadito";
$self->{version} = $self->getVersion();
return $self;
view release on metacpan or search on metacpan
lib/Array/Diff.pm view on Meta::CPAN
Create a new C<Array::Diff> object.
=cut
sub new {
my $self = shift->SUPER::new(@_);
$self->{diff_class} ||= $INC{'Algorithm/Diff/XS.pm'} ? 'Algorithm::Diff::XS' : 'Algorithm::Diff';
$self;
}
view release on metacpan or search on metacpan
t/extract.t view on Meta::CPAN
our $splice_counter;
sub SPLICE {
$splice_counter++;
my $self = shift;
return $self->SUPER::SPLICE(@_);
}
package main;
use Test::More tests => 3;
view release on metacpan or search on metacpan
lib/Array/IntSpan/IP.pm view on Meta::CPAN
foreach my $i (@temp) {
$i->[0] = &ip_as_int($i->[0]);
$i->[1] = &ip_as_int($i->[1]);
}
return $class->SUPER::new(@temp);
}
sub set_range {
my $self = shift;
my(@temp) = @_;
$temp[0] = &ip_as_int($temp[0]);
$temp[1] = &ip_as_int($temp[1]);
return $self->SUPER::set_range(@temp);
}
sub lookup {
my $self = shift;
my($key) = @_;
return $self->SUPER::lookup(&ip_as_int($key));
}
sub ip_as_int {
my($value) = @_;
view release on metacpan or search on metacpan
lib/Array/Iterator/Circular.pm view on Meta::CPAN
sub _init {
my ($self, $length, @args) = @_;
$self->{loop_counter} = 0;
$self->SUPER::_init($length, @args);
}
# always return true, since
# we just keep looping
sub has_next { 1 }
view release on metacpan or search on metacpan
lib/Array/Stream/Transactional/Matcher/Flow.pm view on Meta::CPAN
package Array::Stream::Transactional::Matcher::Flow::optional;
our @ISA = qw(Array::Stream::Transactional::Matcher::Flow::repetition);
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_, 0, 1);
return $self;
}
1;
__END__
view release on metacpan or search on metacpan
lib/Array/Unique/Std.pm view on Meta::CPAN
sub STORESIZE {
my $self = shift;
my $size = shift;
if ($self->FETCHSIZE > $size) {
$self->SUPER::STORESIZE($size);
}
}
sub find {
my $self = shift;
lib/Array/Unique/Std.pm view on Meta::CPAN
my $existing = $self->find($value); # O(n)
if (defined $existing) {
# if ($existing <= $index) {
## nothing to do
# } else {
$self->SUPER::STORE($index, $value); # value in earlier location
$self->SPLICE($existing, 1);
# }
} else {
$self->SUPER::STORE($index, $value); # new value
}
$self->clean;
}
sub PUSH {
my $self = shift;
$self->SUPER::PUSH(@_);
$self->clean;
}
sub UNSHIFT {
my $self = shift;
$self->SUPER::UNSHIFT(@_);
$self->clean;
}
sub SPLICE {
my $self = shift;
my @splice = $self->SUPER::SPLICE(@_);
$self->clean;
return @splice;
}
1;
view release on metacpan or search on metacpan
lib/Arriba/Connection/HTTP.pm view on Meta::CPAN
use base 'Arriba::Connection';
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
if ($self->{client}->NS_proto eq 'TCP') {
setsockopt($self->{client}, IPPROTO_TCP, TCP_NODELAY, 1)
or die $!;
}
view release on metacpan or search on metacpan
lib/Asm/Preproc/Lexer.pm view on Meta::CPAN
# used by new and clone
sub _new {
my($class, $lexer) = @_;
my $self = $class->SUPER::new; # init iterator
$self->_lexer( $lexer );
$self->_input( Iterator::Simple::Lookahead->new );
$self->_line( undef );
$self->_text( "" );
view release on metacpan or search on metacpan
lib/Aspect/Loader/Configuration/YAML.pm view on Meta::CPAN
use base qw(Aspect::Loader::Configuration);
sub new{
my $class = shift;
my $file_path = shift;
my $self = $class->SUPER::new;
$self->load_configuration($file_path);
return $self;
}
sub load_configuration{
view release on metacpan or search on metacpan
lib/Aspect/Advice/Around.pm view on Meta::CPAN
# Pointcuts using "throwing" are irrelevant in before advice
if ( $pointcut->match_contains('Aspect::Pointcut::Returning') ) {
return 'The pointcut returning is illegal when used by around advice';
}
$self->SUPER::_validate(@_);
}
1;
=pod
view release on metacpan or search on metacpan
lib/Assert/Conditional.pm view on Meta::CPAN
############################################################
sub import {
my ($package, @conditional_imports) = @_;
my @normal_imports = $package->_strip_import_conditions(@conditional_imports);
if ($Assert_Never) { $package->SUPER::import(@normal_imports, -if => 0) }
elsif ($Assert_Always) { $package->SUPER::import(@normal_imports, -if => 1) }
else { $package->SUPER::import(@conditional_imports ) }
$package->_reimport_nulled_code_protos();
}
# This is just pretty extreme, but it's also about the only way to
# make the Exporter shut up about things we sometimes need to do in
lib/Assert/Conditional.pm view on Meta::CPAN
my($text) = @_;
$text =~ $_ && return for @$filters;
local $Carp::CarpInternal{"Exporter::Heavy"} = 1;
$old_carp->($text);
};
$package->SUPER::export_to_level($level+2, @export_args);
}
# You have to do this if you have asserts that take a code
# ref as their first argument and people want to use those
# without parentheses. That's because the constant subroutine
view release on metacpan or search on metacpan
lib/Assert/Refute/Driver/More.pm view on Meta::CPAN
my ($class, %opt) = @_;
confess "Test::Builder not initialised, refusing toi proceed"
unless Test::Builder->can("new");
my $self = $class->SUPER::new(%opt);
$self->{builder} = Test::Builder->new; # singletone this far
$self;
};
=head2 refute( $condition, $message )
lib/Assert/Refute/Driver/More.pm view on Meta::CPAN
} elsif ($reason and $reason ne 1) {
$self->{builder}->diag(to_scalar($reason));
};
# Do we even need to track it here?
$self->SUPER::refute($reason, $mess);
};
=head2 subcontract
Proxy to L<Test::More>'s subtest.
lib/Assert/Refute/Driver/More.pm view on Meta::CPAN
sub done_testing {
my $self = shift;
$self->{builder}->done_testing;
$self->SUPER::done_testing;
};
=head2 do_log( $indent, $level, $message )
Just fall back to diag/note.
lib/Assert/Refute/Driver/More.pm view on Meta::CPAN
$self->{builder}->diag($_) for @mess;
} elsif ($level > 0) {
$self->{builder}->note($_) for @mess;
};
$self->SUPER::do_log( $indent, $level, @mess );
};
=head2 get_count
Current test number.
view release on metacpan or search on metacpan
lib/Asterisk/AMI/Common.pm view on Meta::CPAN
use version 0.77; our $VERSION = version->declare("v0.2.8");
sub new {
my ($class, %options) = @_;
return $class->SUPER::new(%options);
}
sub attended_transfer {
my ($self, $channel, $exten, $context, $timeout) = @_;
view release on metacpan or search on metacpan
lib/Asterisk/LCR/Dialer/MinTime.pm view on Meta::CPAN
sub _process
{
my $self = shift;
my $dial = $self->SUPER::_process (@_);
my $str = join '&', @{$dial};
return [ $str ];
}
view release on metacpan or search on metacpan
inc/My/Module/Build.pm view on Meta::CPAN
return;
}
sub harness_switches {
my ( $self ) = @_;
my @res = $self->SUPER::harness_switches();
foreach ( @res ) {
'-MDevel::Cover' eq $_
or next;
$_ .= '=-db,cover_db,-ignore,inc/,-ignore,eg/';
}
view release on metacpan or search on metacpan
lib/Astro/Catalog/Query/2MASS.pm view on Meta::CPAN
=cut
sub _translate_one_to_one {
my $self = shift;
# convert to a hash-list
return ($self->SUPER::_translate_one_to_one,
map { $_, undef }(qw/
catalog
/)
);
}
view release on metacpan or search on metacpan
inc/My/Module/Build.pm view on Meta::CPAN
return;
}
sub harness_switches {
my ( $self ) = @_;
my @res = $self->SUPER::harness_switches();
foreach ( @res ) {
'-MDevel::Cover' eq $_
or next;
$_ .= '=-db,cover_db,-ignore,inc/';
}
view release on metacpan or search on metacpan
lib/Astro/Coord/ECI/VSOP87D/Sun.pm view on Meta::CPAN
our $VERSION = '0.007';
sub new {
my ( $class, %arg ) = @_;
$class->__default( \%arg );
return $class->SUPER::new( %arg );
}
{
my $get = sub {
my ( $self, $name ) = @_;
lib/Astro/Coord/ECI/VSOP87D/Sun.pm view on Meta::CPAN
sub attribute {
my ( $self, $name ) = @_;
exists $accessor{$name}
and return __PACKAGE__;
return $self->SUPER::attribute( $name );
}
sub get {
my ( $self, @arg ) = @_;
my @rslt;
foreach my $name ( @arg ) {
if ( my $code = $accessor{$name} ) {
push @rslt, $code->( $self, $name );
} else {
push @rslt, $self->SUPER::get( $name );
}
wantarray
or return $rslt[0];
}
return @rslt;
lib/Astro/Coord/ECI/VSOP87D/Sun.pm view on Meta::CPAN
while ( @arg ) {
my ( $name, $value ) = splice @arg, 0, 2;
if ( my $code = $mutator{$name} ) {
$code->( $self, $name, $value );
} else {
$self->SUPER::set( $name, $value );
}
}
return $self;
}
}
view release on metacpan or search on metacpan
lib/Astro/Coords/Angle/Hour.pm view on Meta::CPAN
sub in_format {
my $self = shift;
my $format = shift;
$format = lc($format) if $format;
return $self->hours() if (defined $format && $format =~ /^h/);
return $self->SUPER::in_format( $format );
}
=back
=head2 Class Methods
lib/Astro/Coords/Angle/Hour.pm view on Meta::CPAN
if (defined $units && $units =~ /^h/) {
$unt = 'deg';
}
# Do the conversion
my $rad = $self->SUPER::_cvt_torad( $input, $unt );
# scale if we had sexagesimal or hour as units
if (defined $rad && $units =~ /^[sh]/) {
$rad *= 15;
}
lib/Astro/Coords/Angle/Hour.pm view on Meta::CPAN
=cut
sub _guess_units {
my $self = shift;
my $input = shift;
my $guess = $self->SUPER::_guess_units( $input );
$guess = 'h' if $guess =~ /^d/;
return $guess;
}
=item B<_r2f>
view release on metacpan or search on metacpan
lib/Astro/FITS/CFITSIO/Utils.pm view on Meta::CPAN
else {
push @args, $keyw, $value;
}
}
my $self = $class->SUPER::new( @args );
# handle the attributes that we know about
$self->$keyw( $value ) while ( ( $keyw, $value ) = each %args );
return $self;
view release on metacpan or search on metacpan
lib/Astro/FITS/HdrTrans/ACSIS.pm view on Meta::CPAN
sub to_SUBSYSTEM_IDKEY {
my $self = shift;
my $FITS_headers = shift;
# Try the general headers first
my $general = $self->SUPER::to_SUBSYSTEM_IDKEY( $FITS_headers );
return ( defined $general ? $general : "SUBSYSNR" );
}
=item B<_is_FSW>
view release on metacpan or search on metacpan
lib/Astro/FITS/Header/AST.pm view on Meta::CPAN
my %args = @_;
# initialise the inherited status to OK.
my $status = 0;
return $self->SUPER::configure(%args)
if exists $args{Cards} or exists $args{Items};
# read the args hash
unless (exists $args{FrameSet}) {
croak("Arguement hash does not contain FrameSet or Cards");
lib/Astro/FITS/Header/AST.pm view on Meta::CPAN
# Historical default
$fchan->Set( Encoding => "FITS-WCS" );
}
$status = $fchan->Write( $wcsinfo );
}
return $self->SUPER::configure( Cards => \@cards );
}
# shouldn't need to do this, croak! croak!
sub writehdr {
my $self = shift;
view release on metacpan or search on metacpan
lib/Astro/Montenbruck/Ephemeris/Planet/Jupiter.pm view on Meta::CPAN
our $VERSION = 0.01;
sub new {
my $class = shift;
$class->SUPER::new( id => $JU);
}
sub heliocentric {
my ($self, $t) = @_;
view release on metacpan or search on metacpan
inc/Module/Build/AstroNova.pm view on Meta::CPAN
sub ACTION_code {
my $self = shift;
$self->depends_on("libnova");
$self->depends_on("structs");
return $self->SUPER::ACTION_code(@_);
}
sub ACTION_patchlibnova {
my $self = shift;
if ($^O =~ /bsd/i or $^O =~ /solaris/i) {
view release on metacpan or search on metacpan
erfasrc/src/erfaversion.c
palsrc/palVers.c
palsrc/palTest.c
];
return () if exists $exclude{$_[0]};
return $self->SUPER::compile_c(@_);
}
EOF
my $build = $class->new
(
view release on metacpan or search on metacpan
inc/My/Module/Build.pm view on Meta::CPAN
return;
}
sub harness_switches {
my ( $self ) = @_;
my @res = $self->SUPER::harness_switches();
foreach ( @res ) {
'-MDevel::Cover' eq $_
or next;
$_ .= '=-db,cover_db,-ignore,inc/';
}