view release on metacpan or search on metacpan
t/arg_regexp.t view on Meta::CPAN
sub lm { lmm() }
sub rx { qr/$_[0]/ }
# Use full generality on sufficiently recent versions. On early Perl
# releases, U+E9 is 0x51 on all EBCDIC code pages supported then.
my $e9 = sprintf "%02x", (($] ge 5.007_003)
? utf8::unicode_to_native(0xe9)
: ((ord("A") == 193)
? 0x51
: 0xE9));
my $xe9 = "\\x$e9";
view release on metacpan or search on metacpan
method where { sprintf "(%d,%d)", $self->{x}, $self->{y} }
}
# nested anon method (RT132321)
SKIP: {
skip "This causes SEGV on perl 5.16 (RT132321)", 1 if $] lt "5.018";
class RT132321 {
field _genvalue;
method new : common {
my $self = $class->SUPER::new(@_);
view release on metacpan or search on metacpan
lib/Convert/Base32.pm view on Meta::CPAN
return pack('B*', $str);
}
if ($] lt '5.800000') {
require bytes;
*encode_base32 = \&encode_base32_pre58;
*decode_base32 = \&decode_base32_pre58;
} else {
*encode_base32 = \&encode_base32_perl58;
view release on metacpan or search on metacpan
t/HashBase.t view on Meta::CPAN
local $SIG{__WARN__} = sub { };
*main::Const::Test::FOO = sub { 0 };
}
ok(!$pkg->FOO, "overrode const sub");
{
local $TODO = "known to fail on $]" if $] le "5.006002";
is($pkg->do_it, 'const', "worked as expected, const was constant");
}
BEGIN {
$INC{'Object/HashBase/Test/HBase/Wrapped.pm'} = __FILE__;
view release on metacpan or search on metacpan
lib/Dancer2/Plugin/OpenAPI.pm view on Meta::CPAN
has main_api_module => (
is => 'ro',
lazy => 1,
from_config => 1,
default => sub {
return if $] lt '5.036000';
$Dancer2::Plugin::OpenAPI::FIRST_LOADED //= caller;
},
);
view release on metacpan or search on metacpan
lib/Data/Domain.pm view on Meta::CPAN
my @msgs_call_args = ($name, $msg_id, @args);
shift @msgs_call_args if $USE_OLD_MSG_API; # because older versions did not pass the $name arg
# perl v5.22 and above warns if there are too many @args for sprintf.
# The line below prevents that warning
no if $] ge '5.022000', warnings => 'redundant';
# if there is a user-defined message, return it
if (defined $msgs) {
for (ref $msgs) {
/^CODE/ and return $msgs->(@msgs_call_args); # user function
view release on metacpan or search on metacpan
sub Dump {
return &Dumpxs
unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl})
# Use pure perl version on earlier releases on EBCDIC platforms
|| (! $IS_ASCII && $] lt 5.021_010);
return &Dumpperl;
}
#
# dump the refs in the current dumper object.
view release on metacpan or search on metacpan
12.875
=cut
# Perl 5.10 introduced the ">" and "<" modifiers for pack which can be used to
# force a specific endianness.
if( $] lt '5.010' ) {
my $str = join('', unpack("H*", pack 'L' => 0x12345678));
if('78563412' eq $str) { # little endian, so reverse byteorder
*hexstr754_from_double = sub { return uc unpack('H*' => reverse pack 'd' => shift); };
*binstr754_from_double = sub { return uc unpack('B*' => reverse pack 'd' => shift); };
view release on metacpan or search on metacpan
lib/Data/Printer/Filter/SCALAR.pm view on Meta::CPAN
use strict;
use warnings;
use Data::Printer::Filter;
use Scalar::Util;
use constant HAS_BOOLEAN => $] ge '5.036000';
filter 'SCALAR' => \&parse;
filter 'LVALUE' => sub {
my ($scalar_ref, $ddp) = @_;
my $string = parse($scalar_ref, $ddp);
view release on metacpan or search on metacpan
lib/Data/Roundtrip.pm view on Meta::CPAN
my $high = shift || "";
if ($high eq "iso8859") { # Doesn't escape the Latin1 printables
if ($Data_Dumper_IS_ASCII) {
s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
}
elsif ($] ge 5.007_003) {
my $high_control = utf8::unicode_to_native(0x9F);
s/$high_control/sprintf('\\%o',ord($1))/eg;
}
} elsif ($high eq "utf8") {
# Some discussion of what to do here is in
view release on metacpan or search on metacpan
lib/Data/UUID/MT.pm view on Meta::CPAN
sub CLONE { defined($_) && $_->reseed for @objects }
# HoH: $builders{$Config{uvsize}}{$version}
my %builders = (
'8' => {
'1' => ($] ge 5.010 ? '_build_64bit_v1' : '_build_64bit_v1_old' ),
'4' => ($] ge 5.010 ? '_build_64bit_v4' : '_build_64bit_v4_old' ),
'4s' => ($] ge 5.010 ? '_build_64bit_v4s' : '_build_64bit_v4s_old'),
},
'4' => {
'1' => '_build_32bit_v1',
'4' => '_build_32bit_v4',
'4s' => '_build_32bit_v4s',
view release on metacpan or search on metacpan
) and @ARGV <= ( $opt{y} ? 1 : 2 ) or pod2usage( { -verbose => 0 } );
my $on_date;
if ( $opt{events} ) {
if ( $opt{accented} ) {
$] lt '5.008'
and die "-accented requires at least Perl 5.8\n";
$on_date = __PACKAGE__->can( '__on_date_accented' );
eval q<binmode STDOUT, ':encoding(utf-8)'>;
} else {
$on_date = __PACKAGE__->can( '__on_date' );
view release on metacpan or search on metacpan
t/DebugStatementsTest.t view on Meta::CPAN
td '$hash', $r_spell, $d_spell;
td '$nestedhash', $r_spell, $d_spell;
td '$list[10]', $r_spell, $d_spell;
td '$hash{ten}', $r_spell, $d_spell;
my $warning = qr(WARNING:.*was given a reference to a variable instead of a single-quoted string);
if ( $] lt '5.018' ) {
#tsub 'd', '$scalar', $warning, 'scalar warning';
tdd { d( \$scalar ) } $warning, 'scalar warning'; # 5.18
}
#td '\$scalar', $warning, 'warning';
my $undefinedvar;
t/DebugStatementsTest.t view on Meta::CPAN
tdd { d('$listref->[$i]') } qr($header${vr}'?$listref->[$i]'?), '$listref->[$i]';
my $ref = 'flintstones';
tdd { d('$nestedhashref->{$ref}') } $rnf, '$nestedhashref->{flintstones}';
tdd { d('$Data::Dumper::Terse') } "$header \$Data::Dumper::Terse = 1\n", 'package variable';
my $allopt = 'bcenstz';
if ( $] lt '5.018' ) {
tdd { d('$scalar', $allopt) } qr($header At line undef:\s+[\$\@\%]\S+\s+=\s+'myvalue'\s+at\s+\S+), '$scalar with all options';
my $rlest = qr($header\s+At line undef:.*\d+.*\s+${lsort}\s+at\s+\S+);
my $rhest = qr($header\s+At line undef:.*\d+.*\s+${h}\s+at\s+\S+);
tdd { d('@list', $allopt) } $rlest, '@list with all options';
tdd { d('%hash', $allopt) } $rhest, '%hash with all options';
t/DebugStatementsTest.t view on Meta::CPAN
tdd { LS($0) } qr($header$rd), "File ls($0)";
$d = 1;
tdd { ls("filename_does_not_exist") } qr(does not exist), 'ls(filename_does_not_exist)';
tdd { ls('$filename') } qr(did not understand file name), "ls('\$filename') error";
tdd { ls($0) } qr($header$rd), "File ls($0)";
if ( $] lt '5.018' ) {
tdd { ls('.') } qr($header$rd), "Directory ls(.)";
tdd { ls("$0 $0") } qr($header$rd.*\n$header$rd), "ls($0 $0)";
tdd { ls("$0 .") } qr($header$rd.*\n$header$rd), "ls($0 .)";
##tdd { ls($filename), 2 } '', 'ls() with too high a debug level';
}
view release on metacpan or search on metacpan
lib/Devel/Command/DBSub/DB_5_8_6.pm view on Meta::CPAN
package Devel::Command::DBSub::DB_5_8_6;
sub import {
# Includes 5.8.6, 5.8.7 and 5.8.8.
# Also includes 5.9.2, 5.9.3 and 5.9.4.
if( $] gt "5.008005" or
( $] gt "5.009001" and
$] lt "5.009005"
)
) {
return \&DB::alt_586_DB;
}
else {
view release on metacpan or search on metacpan
t/testutil.pl view on Meta::CPAN
# Fatalize warnings, so that we don't introduce new warnings. But on early
# perls the burden of avoiding warnings becomes too large, and someone still
# trying to use such outmoded versions should be willing to accept warnings in
# our test suite.
$SIG{__WARN__} = sub { die "Fatalized: $_[0]" } if $] ge "5.6.0";
# This defines ASCII/UTF-8 vs EBCDIC/UTF-EBCDIC
$::IS_ASCII = ord 'A' == 65;
$TODO = 0;
view release on metacpan or search on metacpan
t/002-fixtures.t view on Meta::CPAN
$report_fname
and unlink $report_fname;
}
for my $file (glob "$FIXTURES/*.pl") {
next if $file eq "$FIXTURES/cover-05.pl" && $] lt '5.018000';
test_fixture($file);
}
done_testing;
view release on metacpan or search on metacpan
my $orig = $tzil->slurp_file('source/lib/DZT/Sample.pm');
my $next_re = _regex_for_version( q['], next_version($version) );
$next_re = qr/$next_re$/m;
local $TODO = 'qr/...$/m is broken before 5.10' if $] lt '5.010000';
if (!$c->{all_matching} || $version eq '0.001') {
like( $orig, $next_re, "version line updated in single-quoted source file" );
}
else {
unlike( $orig, $next_re, "version line not updated in source file - did not match release version");
like( $orig, qr/1;\s+# last line/,
"last line correct in single-quoted source file" );
$orig = $tzil->slurp_file('source/lib/DZT/DQuote.pm');
local $TODO = 'qr/...$/m is broken before 5.10' if $] lt '5.010000';
if (!$c->{all_matching} || $version eq '0.001') {
like( $orig, $next_re, "version line updated from double-quotes to single-quotes in source file");
}
else {
unlike( $orig, $next_re, "version line not updated in source file - did not match release version");
like( $orig, qr/1;\s+# last line/, "last line correct in revised source file" );
$orig = $tzil->slurp_file('source/lib/DZT/Mismatched.pm');
local $TODO = 'qr/...$/m is broken before 5.10' if $] lt '5.010000';
if ($c->{all_matching} && $version ne '0.003' && $version ne '0.004') {
unlike( $orig, $next_re, "version line not updated in source file - did not match release version");
}
else {
view release on metacpan or search on metacpan
|| $request->{headers}{'transfer-encoding'};
$request->{cb} = $args->{content};
}
elsif ( length $args->{content} ) {
my $content = $args->{content};
if ( $] ge '5.008' ) {
utf8::downgrade($content, 1)
or die(qq/Wide character in request message body\n/);
}
$request->{headers}{'content-type'} ||= "application/octet-stream";
$request->{headers}{'content-length'} = length $content
view release on metacpan or search on metacpan
lib/Exporter/Almighty.pm view on Meta::CPAN
use parent qw( Exporter::Tiny );
my @builtins;
BEGIN { @builtins = qw( is_bool created_as_string created_as_number ) };
use if $] lt '5.036000', 'builtins::compat' => @builtins;
use if $] ge '5.036000', 'builtin' => @builtins;
no if $] ge '5.036000', 'warnings' => qw( experimental::builtin );
use B qw( perlstring );
use Carp qw( croak );
use Eval::TypeTiny qw( eval_closure set_subname );
use Exporter::Tiny qw( mkopt );
view release on metacpan or search on metacpan
lib/Exporter/Tiny.pm view on Meta::CPAN
our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION = '1.006002';
our @EXPORT_OK = qw< mkopt mkopt_hash _croak _carp >;
BEGIN {
*_HAS_NATIVE_LEXICAL_SUB = ( $] ge '5.037002' )
? sub () { !!1 }
: sub () { !!0 };
*_HAS_MODULE_LEXICAL_SUB = ( $] ge '5.011002' and eval('require Lexical::Sub') )
? sub () { !!1 }
: sub () { !!0 };
};
sub _croak ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::croak }
lib/Exporter/Tiny.pm view on Meta::CPAN
# Returns a coderef suitable to be used as a sub installer for lexical imports.
#
sub _exporter_lexical_installer {
_HAS_NATIVE_LEXICAL_SUB and return sub {
my ( $sigilname, $sym ) = @{ $_[1] };
no warnings ( $] ge '5.037002' ? 'experimental::builtin' : () );
builtin::export_lexically( $sigilname, $sym );
};
_HAS_MODULE_LEXICAL_SUB and return sub {
my ( $sigilname, $sym ) = @{ $_[1] };
( $sigilname =~ /^\w/ )
view release on metacpan or search on metacpan
t/010_module_build.t view on Meta::CPAN
use strict;
use Test::More;
BEGIN {
plan skip_all => 'no Module::Build' if !eval { require Module::Build; 1 };
plan skip_all => 'no ExtUtils::CBuilder' if !eval { require ExtUtils::CBuilder; 1 };
plan skip_all => 'perl 5.8.8 and EU::CBuilder bug if CC has "++"' if $ExtUtils::CBuilder::VERSION <= 0.280230 and $] lt '5.010';
}
use lib 't/lib';
use TestUtils;
diag "Module::Build version: $Module::Build::VERSION";
view release on metacpan or search on metacpan
bundled/CPAN-Meta/CPAN/Meta.pm view on Meta::CPAN
sub save {
my ($self, $file, $options) = @_;
my $version = $options->{version} || '2';
my $layer = $] ge '5.008001' ? ':utf8' : '';
if ( $version ge '2' ) {
carp "'$file' should end in '.json'"
unless $file =~ m{\.json$};
}
view release on metacpan or search on metacpan
t/00_smoke.t view on Meta::CPAN
use Test::More tests=>14; # remember to keep in sync with done_testing
BEGIN {
diag "This is Perl $] at $^X on $^O";
BAIL_OUT("Perl 5.8.1 is required") if $] lt '5.008001';
}
use FindBin ();
use lib $FindBin::Bin;
use File_Replace_Testlib;
view release on metacpan or search on metacpan
t/00_smoke.t view on Meta::CPAN
use Test::More tests=>11; # remember to keep in sync with done_testing
BEGIN {
diag "This is Perl $] at $^X on $^O";
BAIL_OUT("Perl 5.8.1 is required") if $] lt '5.008001';
}
use FindBin ();
use lib $FindBin::Bin;
use File_Replace_Testlib;
view release on metacpan or search on metacpan
lib/File/Replace.pm view on Meta::CPAN
# since this is just for internal typo prevention,
# we can fake it when it's not available
# uncoverable branch false
# uncoverable condition right
# uncoverable condition false
if ($] ge '5.010' || defined &Hash::Util::lock_ref_keys)
{ Hash::Util->import('lock_ref_keys') }
else { *lock_ref_keys = sub {} } # uncoverable statement
}
# For AUTHOR, COPYRIGHT, AND LICENSE see Replace.pod
view release on metacpan or search on metacpan
script/rsybak view on Meta::CPAN
# || $request->{headers}{'transfer-encoding'};
# $request->{cb} = $args->{content};
# }
# elsif ( length $args->{content} ) {
# my $content = $args->{content};
# if ( $] ge '5.008' ) {
# utf8::downgrade($content, 1)
# or die(qq/Wide character in request message body\n/);
# }
# $request->{headers}{'content-type'} ||= "application/octet-stream";
# $request->{headers}{'content-length'} = length $content
script/rsybak view on Meta::CPAN
#$escapes{' '}="+";
#my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
#
#sub _uri_escape {
# my ($self, $str) = @_;
# if ( $] ge '5.008' ) {
# utf8::encode($str);
# }
# else {
# $str = pack("U*", unpack("C*", $str))
# if ( length $str == do { use bytes; length $str } );
script/rsybak view on Meta::CPAN
#
#sub write {
# @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
# my ($self, $buf) = @_;
#
# if ( $] ge '5.008' ) {
# utf8::downgrade($buf, 1)
# or die(qq/Wide character in write()\n/);
# }
#
# my $len = length $buf;
script/rsybak view on Meta::CPAN
# my $data = $request->{cb}->();
#
# defined $data && length $data
# or last;
#
# if ( $] ge '5.008' ) {
# utf8::downgrade($data, 1)
# or die(qq/Wide character in write_content()\n/);
# }
#
# $len += $self->write($data);
script/rsybak view on Meta::CPAN
# my $data = $request->{cb}->();
#
# defined $data && length $data
# or last;
#
# if ( $] ge '5.008' ) {
# utf8::downgrade($data, 1)
# or die(qq/Wide character in write_chunked_body()\n/);
# }
#
# $len += length $data;
view release on metacpan or search on metacpan
lib/File/Symlink/Relative.pm view on Meta::CPAN
use strict;
use warnings;
# OK, the following is probably paranoia. But if Perl 7 decides to
# change this particular default I'm ready. Unless they eliminate $].
no if $] ge '5.020', feature => qw{ signatures };
use Carp;
use Exporter qw{ import };
use File::Spec;
view release on metacpan or search on metacpan
lib/Bio/Graphics/Browser2/Action.pm view on Meta::CPAN
my $q = shift;
my $name = $q->param('name');
my $settings = $self->settings;
my $snapshots = $self->session->snapshots;
warn "[$$] get snapshot $name: $snapshots->{$name}" if DEBUG;
%{$settings} = %{dclone $snapshots->{$name}{data}};
my @selected_tracks = $self->render->visible_tracks;
my $segment_info = $self->render->segment_info_object();
view release on metacpan or search on metacpan
lib/HTTP/AnyUA/Util.pm view on Meta::CPAN
$escapes{' '} = '+';
my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
sub uri_escape {
my $str = shift or _usage(q{uri_escape($str)});
if ($] ge '5.008') {
utf8::encode($str);
}
else {
$str = pack('U*', unpack('C*', $str)) # UTF-8 encode a byte string
if (length $str == do { use bytes; length $str });