view release on metacpan or search on metacpan
inc/My/ModuleBuild.pm view on Meta::CPAN
%args = (%args, Alien::Base::Wrapper->mb_args);
$args{include_dirs} = 'xs';
$args{c_source} = 'xs';
my $self = $class->SUPER::new(%args);
$self->add_to_cleanup(
File::Spec->catfile('xs', 'func.h.tmp'),
File::Spec->catfile('xs', 'func.h'),
'*.core',
inc/My/ModuleBuild.pm view on Meta::CPAN
sub ACTION_build
{
my $self = shift;
$self->depends_on('build_prep');
$self->SUPER::ACTION_build(@_);
}
sub ACTION_test
{
# doesn't seem like this should be necessary, but without
# this, it doesn't call my ACTION_build
my $self = shift;
$self->depends_on('build');
$self->SUPER::ACTION_test(@_);
}
sub ACTION_install
{
# doesn't seem like this should be necessary, but without
# this, it doesn't call my ACTION_build
my $self = shift;
$self->depends_on('build');
$self->SUPER::ACTION_install(@_);
}
my $dir;
my $count = 0;
my $cc;
view release on metacpan or search on metacpan
inc/Module/Install/ExtraTests.pm view on Meta::CPAN
. qq{"-e" "Module::Install::ExtraTests::__harness('Test::Harness', $is_author, '$a_str', '$r_str', '$s_str', \$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n};
}
sub dist_test {
my ($self, @args) = @_;
my $text = $self->SUPER::dist_test(@args);
my @lines = split /\n/, $text;
$_ =~ s/ (\S*MAKE\S* test )/ RELEASE_TESTING=1 $1 / for grep { m/ test / } @lines;
return join "\n", @lines;
}
view release on metacpan or search on metacpan
# A stupid hack to get ExtUtils::MakeMaker to write Makefiles that cause items
# listed in OBJECT to be built in the directory they actually exist in.
#
sub const_cccmd {
my ( $self, @args ) = @_;
my $ret = $self->SUPER::const_cccmd(@args);
$ret .= ' -o $@';
return $ret;
}
#
# A small hack to get the bootstrap file to be placed in the src/ directory.
#
sub dynamic_bs {
my ( $self, %args ) = @_;
my $ret = $self->SUPER::dynamic_bs(%args);
$ret =~ s/BOOTSTRAP = \$\(BASEEXT\)\.bs/BOOTSTRAP = src\/\$\(BASEEXT\)\.bs/m;
return $ret;
}
#
# A hack to clean gcov data spewed by Devel::Cover.
#
sub clean {
my ( $self, %args ) = @_;
my $ret = $self->SUPER::clean(%args);
my $srcdir = $self->{'postamble'}->{'srcdir'};
$ret .= sprintf( "\t- \$(RM_F) *.gcov %s/*.gcda %s/*.gcno\n", $srcdir, $srcdir );
return $ret;
view release on metacpan or search on metacpan
xt/lib/ATWDumbbench.pm view on Meta::CPAN
use warnings;
use parent 'Dumbbench';
sub new {
my ( $class, @args ) = @_;
my $self = $class->SUPER::new(@args);
$self->{atw_measure_map} = {};
return $self;
}
sub measurements {
view release on metacpan or search on metacpan
lib/Archive/Zip/DirectoryMember.pm view on Meta::CPAN
sub fileName {
my $self = shift;
my $newName = shift;
$newName =~ s{/?$}{/} if defined($newName);
return $self->SUPER::fileName($newName);
}
# So people don't get too confused. This way it looks like the problem
# is in their code...
sub contents {
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
our @ISA = qw(Array::Iterator);
sub _init {
my ($self, @args) = @_;
$self->{loop_counter} = 0;
$self->SUPER::_init(@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>