diff --git a/SOURCES/Backport-Perl4-CoreLibs.patch b/SOURCES/Backport-Perl4-CoreLibs.patch
new file mode 100644
index 0000000..97919ec
--- /dev/null
+++ b/SOURCES/Backport-Perl4-CoreLibs.patch
@@ -0,0 +1,2484 @@
+diff -ENwbur perl-5.16.3-orig/lib/abbrev.pl perl-5.16.3/lib/abbrev.pl
+--- perl-5.16.3-orig/lib/abbrev.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/abbrev.pl 2016-08-18 10:07:06.401442446 +0200
+@@ -0,0 +1,43 @@
++;# Usage:
++;# %foo = ();
++;# &abbrev(*foo,LIST);
++;# ...
++;# $long = $foo{$short};
++
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Text::Abbrev
++#
++
++package abbrev;
++
++sub main'abbrev {
++ local(*domain) = @_;
++ shift(@_);
++ @cmp = @_;
++ local($[) = 0;
++ foreach $name (@_) {
++ @extra = split(//,$name);
++ $abbrev = shift(@extra);
++ $len = 1;
++ foreach $cmp (@cmp) {
++ next if $cmp eq $name;
++ while (@extra && substr($cmp,0,$len) eq $abbrev) {
++ $abbrev .= shift(@extra);
++ ++$len;
++ }
++ }
++ $domain{$abbrev} = $name;
++ while ($#extra >= 0) {
++ $abbrev .= shift(@extra);
++ $domain{$abbrev} = $name;
++ }
++ }
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/assert.pl perl-5.16.3/lib/assert.pl
+--- perl-5.16.3-orig/lib/assert.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/assert.pl 2016-08-18 10:07:06.409442411 +0200
+@@ -0,0 +1,55 @@
++# assert.pl
++# tchrist@convex.com (Tom Christiansen)
++#
++# Usage:
++#
++# &assert('@x > @y');
++# &assert('$var > 10', $var, $othervar, @various_info);
++#
++# That is, if the first expression evals false, we blow up. The
++# rest of the args, if any, are nice to know because they will
++# be printed out by &panic, which is just the stack-backtrace
++# routine shamelessly borrowed from the perl debugger.
++
++sub assert {
++ &panic("ASSERTION BOTCHED: $_[$[]",$@) unless eval $_[$[];
++}
++
++sub panic {
++ package DB;
++
++ select(STDERR);
++
++ print "\npanic: @_\n";
++
++ exit 1 if $] <= 4.003; # caller broken
++
++ # stack traceback gratefully borrowed from perl debugger
++
++ local $_;
++ my $i;
++ my ($p,$f,$l,$s,$h,$a,@a,@frames);
++ for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
++ @a = @args;
++ for (@a) {
++ if (/^StB\000/ && length($_) == length($_main{'_main'})) {
++ $_ = sprintf("%s",$_);
++ }
++ else {
++ s/'/\\'/g;
++ s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
++ s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
++ s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
++ }
++ }
++ $w = $w ? '@ = ' : '$ = ';
++ $a = $h ? '(' . join(', ', @a) . ')' : '';
++ push(@frames, "$w&$s$a from file $f line $l\n");
++ }
++ for ($i=0; $i <= $#frames; $i++) {
++ print $frames[$i];
++ }
++ exit 1;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/bigfloat.pl perl-5.16.3/lib/bigfloat.pl
+--- perl-5.16.3-orig/lib/bigfloat.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/bigfloat.pl 2016-08-18 10:07:06.418442371 +0200
+@@ -0,0 +1,254 @@
++package bigfloat;
++require "bigint.pl";
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Math::BigFloat
++#
++# Arbitrary length float math package
++#
++# by Mark Biggar
++#
++# number format
++# canonical strings have the form /[+-]\d+E[+-]\d+/
++# Input values can have embedded whitespace
++# Error returns
++# 'NaN' An input parameter was "Not a Number" or
++# divide by zero or sqrt of negative number
++# Division is computed to
++# max($div_scale,length(dividend)+length(divisor))
++# digits by default.
++# Also used for default sqrt scale
++
++$div_scale = 40;
++
++# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
++
++$rnd_mode = 'even';
++
++# bigfloat routines
++#
++# fadd(NSTR, NSTR) return NSTR addition
++# fsub(NSTR, NSTR) return NSTR subtraction
++# fmul(NSTR, NSTR) return NSTR multiplication
++# fdiv(NSTR, NSTR[,SCALE]) returns NSTR division to SCALE places
++# fneg(NSTR) return NSTR negation
++# fabs(NSTR) return NSTR absolute value
++# fcmp(NSTR,NSTR) return CODE compare undef,<0,=0,>0
++# fround(NSTR, SCALE) return NSTR round to SCALE digits
++# ffround(NSTR, SCALE) return NSTR round at SCALEth place
++# fnorm(NSTR) return (NSTR) normalize
++# fsqrt(NSTR[, SCALE]) return NSTR sqrt to SCALE places
++
++# Convert a number to canonical string form.
++# Takes something that looks like a number and converts it to
++# the form /^[+-]\d+E[+-]\d+$/.
++sub main'fnorm { #(string) return fnum_str
++ local($_) = @_;
++ s/\s+//g; # strip white space
++ if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/
++ && ($2 ne '' || defined($4))) {
++ my $x = defined($4) ? $4 : '';
++ &norm(($1 ? "$1$2$x" : "+$2$x"), (($x ne '') ? $6-length($x) : $6));
++ } else {
++ 'NaN';
++ }
++}
++
++# normalize number -- for internal use
++sub norm { #(mantissa, exponent) return fnum_str
++ local($_, $exp) = @_;
++ if ($_ eq 'NaN') {
++ 'NaN';
++ } else {
++ s/^([+-])0+/$1/; # strip leading zeros
++ if (length($_) == 1) {
++ '+0E+0';
++ } else {
++ $exp += length($1) if (s/(0+)$//); # strip trailing zeros
++ sprintf("%sE%+ld", $_, $exp);
++ }
++ }
++}
++
++# negation
++sub main'fneg { #(fnum_str) return fnum_str
++ local($_) = &'fnorm($_[$[]);
++ vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
++ if ( ord("\t") == 9 ) { # ascii
++ s/^H/N/;
++ }
++ else { # ebcdic character set
++ s/\373/N/;
++ }
++ $_;
++}
++
++# absolute value
++sub main'fabs { #(fnum_str) return fnum_str
++ local($_) = &'fnorm($_[$[]);
++ s/^-/+/; # mash sign
++ $_;
++}
++
++# multiplication
++sub main'fmul { #(fnum_str, fnum_str) return fnum_str
++ local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
++ if ($x eq 'NaN' || $y eq 'NaN') {
++ 'NaN';
++ } else {
++ local($xm,$xe) = split('E',$x);
++ local($ym,$ye) = split('E',$y);
++ &norm(&'bmul($xm,$ym),$xe+$ye);
++ }
++}
++
++# addition
++sub main'fadd { #(fnum_str, fnum_str) return fnum_str
++ local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
++ if ($x eq 'NaN' || $y eq 'NaN') {
++ 'NaN';
++ } else {
++ local($xm,$xe) = split('E',$x);
++ local($ym,$ye) = split('E',$y);
++ ($xm,$xe,$ym,$ye) = ($ym,$ye,$xm,$xe) if ($xe < $ye);
++ &norm(&'badd($ym,$xm.('0' x ($xe-$ye))),$ye);
++ }
++}
++
++# subtraction
++sub main'fsub { #(fnum_str, fnum_str) return fnum_str
++ &'fadd($_[$[],&'fneg($_[$[+1]));
++}
++
++# division
++# args are dividend, divisor, scale (optional)
++# result has at most max(scale, length(dividend), length(divisor)) digits
++sub main'fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
++{
++ local($x,$y,$scale) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]),$_[$[+2]);
++ if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') {
++ 'NaN';
++ } else {
++ local($xm,$xe) = split('E',$x);
++ local($ym,$ye) = split('E',$y);
++ $scale = $div_scale if (!$scale);
++ $scale = length($xm)-1 if (length($xm)-1 > $scale);
++ $scale = length($ym)-1 if (length($ym)-1 > $scale);
++ $scale = $scale + length($ym) - length($xm);
++ &norm(&round(&'bdiv($xm.('0' x $scale),$ym),&'babs($ym)),
++ $xe-$ye-$scale);
++ }
++}
++
++# round int $q based on fraction $r/$base using $rnd_mode
++sub round { #(int_str, int_str, int_str) return int_str
++ local($q,$r,$base) = @_;
++ if ($q eq 'NaN' || $r eq 'NaN') {
++ 'NaN';
++ } elsif ($rnd_mode eq 'trunc') {
++ $q; # just truncate
++ } else {
++ local($cmp) = &'bcmp(&'bmul($r,'+2'),$base);
++ if ( $cmp < 0 ||
++ ($cmp == 0 &&
++ ( $rnd_mode eq 'zero' ||
++ ($rnd_mode eq '-inf' && (substr($q,$[,1) eq '+')) ||
++ ($rnd_mode eq '+inf' && (substr($q,$[,1) eq '-')) ||
++ ($rnd_mode eq 'even' && $q =~ /[24680]$/) ||
++ ($rnd_mode eq 'odd' && $q =~ /[13579]$/) )) ) {
++ $q; # round down
++ } else {
++ &'badd($q, ((substr($q,$[,1) eq '-') ? '-1' : '+1'));
++ # round up
++ }
++ }
++}
++
++# round the mantissa of $x to $scale digits
++sub main'fround { #(fnum_str, scale) return fnum_str
++ local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
++ if ($x eq 'NaN' || $scale <= 0) {
++ $x;
++ } else {
++ local($xm,$xe) = split('E',$x);
++ if (length($xm)-1 <= $scale) {
++ $x;
++ } else {
++ &norm(&round(substr($xm,$[,$scale+1),
++ "+0".substr($xm,$[+$scale+1,1),"+10"),
++ $xe+length($xm)-$scale-1);
++ }
++ }
++}
++
++# round $x at the 10 to the $scale digit place
++sub main'ffround { #(fnum_str, scale) return fnum_str
++ local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
++ if ($x eq 'NaN') {
++ 'NaN';
++ } else {
++ local($xm,$xe) = split('E',$x);
++ if ($xe >= $scale) {
++ $x;
++ } else {
++ $xe = length($xm)+$xe-$scale;
++ if ($xe < 1) {
++ '+0E+0';
++ } elsif ($xe == 1) {
++ # The first substr preserves the sign, which means that
++ # we'll pass a non-normalized "-0" to &round when rounding
++ # -0.006 (for example), purely so that &round won't lose
++ # the sign.
++ &norm(&round(substr($xm,$[,1).'0',
++ "+0".substr($xm,$[+1,1),"+10"), $scale);
++ } else {
++ &norm(&round(substr($xm,$[,$xe),
++ "+0".substr($xm,$[+$xe,1),"+10"), $scale);
++ }
++ }
++ }
++}
++
++# compare 2 values returns one of undef, <0, =0, >0
++# returns undef if either or both input value are not numbers
++sub main'fcmp #(fnum_str, fnum_str) return cond_code
++{
++ local($x, $y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
++ if ($x eq "NaN" || $y eq "NaN") {
++ undef;
++ } else {
++ ord($y) <=> ord($x)
++ ||
++ ( local($xm,$xe,$ym,$ye) = split('E', $x."E$y"),
++ (($xe <=> $ye) * (substr($x,$[,1).'1')
++ || &bigint'cmp($xm,$ym))
++ );
++ }
++}
++
++# square root by Newtons method.
++sub main'fsqrt { #(fnum_str[, scale]) return fnum_str
++ local($x, $scale) = (&'fnorm($_[$[]), $_[$[+1]);
++ if ($x eq 'NaN' || $x =~ /^-/) {
++ 'NaN';
++ } elsif ($x eq '+0E+0') {
++ '+0E+0';
++ } else {
++ local($xm, $xe) = split('E',$x);
++ $scale = $div_scale if (!$scale);
++ $scale = length($xm)-1 if ($scale < length($xm)-1);
++ local($gs, $guess) = (1, sprintf("1E%+d", (length($xm)+$xe-1)/2));
++ while ($gs < 2*$scale) {
++ $guess = &'fmul(&'fadd($guess,&'fdiv($x,$guess,$gs*2)),".5");
++ $gs *= 2;
++ }
++ &'fround($guess, $scale);
++ }
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/bigint.pl perl-5.16.3/lib/bigint.pl
+--- perl-5.16.3-orig/lib/bigint.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/bigint.pl 2016-08-18 10:07:06.431442314 +0200
+@@ -0,0 +1,320 @@
++package bigint;
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Math::BigInt
++#
++# arbitrary size integer math package
++#
++# by Mark Biggar
++#
++# Canonical Big integer value are strings of the form
++# /^[+-]\d+$/ with leading zeros suppressed
++# Input values to these routines may be strings of the form
++# /^\s*[+-]?[\d\s]+$/.
++# Examples:
++# '+0' canonical zero value
++# ' -123 123 123' canonical value '-123123123'
++# '1 23 456 7890' canonical value '+1234567890'
++# Output values always in canonical form
++#
++# Actual math is done in an internal format consisting of an array
++# whose first element is the sign (/^[+-]$/) and whose remaining
++# elements are base 100000 digits with the least significant digit first.
++# The string 'NaN' is used to represent the result when input arguments
++# are not numbers, as well as the result of dividing by zero
++#
++# routines provided are:
++#
++# bneg(BINT) return BINT negation
++# babs(BINT) return BINT absolute value
++# bcmp(BINT,BINT) return CODE compare numbers (undef,<0,=0,>0)
++# badd(BINT,BINT) return BINT addition
++# bsub(BINT,BINT) return BINT subtraction
++# bmul(BINT,BINT) return BINT multiplication
++# bdiv(BINT,BINT) return (BINT,BINT) division (quo,rem) just quo if scalar
++# bmod(BINT,BINT) return BINT modulus
++# bgcd(BINT,BINT) return BINT greatest common divisor
++# bnorm(BINT) return BINT normalization
++#
++
++# overcome a floating point problem on certain osnames (posix-bc, os390)
++BEGIN {
++ my $x = 100000.0;
++ my $use_mult = int($x*1e-5)*1e5 == $x ? 1 : 0;
++}
++
++$zero = 0;
++
++
++# normalize string form of number. Strip leading zeros. Strip any
++# white space and add a sign, if missing.
++# Strings that are not numbers result the value 'NaN'.
++
++sub main'bnorm { #(num_str) return num_str
++ local($_) = @_;
++ s/\s+//g; # strip white space
++ if (s/^([+-]?)0*(\d+)$/$1$2/) { # test if number
++ substr($_,$[,0) = '+' unless $1; # Add missing sign
++ s/^-0/+0/;
++ $_;
++ } else {
++ 'NaN';
++ }
++}
++
++# Convert a number from string format to internal base 100000 format.
++# Assumes normalized value as input.
++sub internal { #(num_str) return int_num_array
++ local($d) = @_;
++ ($is,$il) = (substr($d,$[,1),length($d)-2);
++ substr($d,$[,1) = '';
++ ($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d)));
++}
++
++# Convert a number from internal base 100000 format to string format.
++# This routine scribbles all over input array.
++sub external { #(int_num_array) return num_str
++ $es = shift;
++ grep($_ > 9999 || ($_ = substr('0000'.$_,-5)), @_); # zero pad
++ &'bnorm(join('', $es, reverse(@_))); # reverse concat and normalize
++}
++
++# Negate input value.
++sub main'bneg { #(num_str) return num_str
++ local($_) = &'bnorm(@_);
++ vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
++ s/^./N/ unless /^[-+]/; # works both in ASCII and EBCDIC
++ $_;
++}
++
++# Returns the absolute value of the input.
++sub main'babs { #(num_str) return num_str
++ &abs(&'bnorm(@_));
++}
++
++sub abs { # post-normalized abs for internal use
++ local($_) = @_;
++ s/^-/+/;
++ $_;
++}
++
++# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
++sub main'bcmp { #(num_str, num_str) return cond_code
++ local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
++ if ($x eq 'NaN') {
++ undef;
++ } elsif ($y eq 'NaN') {
++ undef;
++ } else {
++ &cmp($x,$y);
++ }
++}
++
++sub cmp { # post-normalized compare for internal use
++ local($cx, $cy) = @_;
++ return 0 if ($cx eq $cy);
++
++ local($sx, $sy) = (substr($cx, 0, 1), substr($cy, 0, 1));
++ local($ld);
++
++ if ($sx eq '+') {
++ return 1 if ($sy eq '-' || $cy eq '+0');
++ $ld = length($cx) - length($cy);
++ return $ld if ($ld);
++ return $cx cmp $cy;
++ } else { # $sx eq '-'
++ return -1 if ($sy eq '+');
++ $ld = length($cy) - length($cx);
++ return $ld if ($ld);
++ return $cy cmp $cx;
++ }
++
++}
++
++sub main'badd { #(num_str, num_str) return num_str
++ local(*x, *y); ($x, $y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
++ if ($x eq 'NaN') {
++ 'NaN';
++ } elsif ($y eq 'NaN') {
++ 'NaN';
++ } else {
++ @x = &internal($x); # convert to internal form
++ @y = &internal($y);
++ local($sx, $sy) = (shift @x, shift @y); # get signs
++ if ($sx eq $sy) {
++ &external($sx, &add(*x, *y)); # if same sign add
++ } else {
++ ($x, $y) = (&abs($x),&abs($y)); # make abs
++ if (&cmp($y,$x) > 0) {
++ &external($sy, &sub(*y, *x));
++ } else {
++ &external($sx, &sub(*x, *y));
++ }
++ }
++ }
++}
++
++sub main'bsub { #(num_str, num_str) return num_str
++ &'badd($_[$[],&'bneg($_[$[+1]));
++}
++
++# GCD -- Euclids algorithm Knuth Vol 2 pg 296
++sub main'bgcd { #(num_str, num_str) return num_str
++ local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
++ if ($x eq 'NaN' || $y eq 'NaN') {
++ 'NaN';
++ } else {
++ ($x, $y) = ($y,&'bmod($x,$y)) while $y ne '+0';
++ $x;
++ }
++}
++
++# routine to add two base 1e5 numbers
++# stolen from Knuth Vol 2 Algorithm A pg 231
++# there are separate routines to add and sub as per Kunth pg 233
++sub add { #(int_num_array, int_num_array) return int_num_array
++ local(*x, *y) = @_;
++ $car = 0;
++ for $x (@x) {
++ last unless @y || $car;
++ $x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5) ? 1 : 0;
++ }
++ for $y (@y) {
++ last unless $car;
++ $y -= 1e5 if $car = (($y += $car) >= 1e5) ? 1 : 0;
++ }
++ (@x, @y, $car);
++}
++
++# subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
++sub sub { #(int_num_array, int_num_array) return int_num_array
++ local(*sx, *sy) = @_;
++ $bar = 0;
++ for $sx (@sx) {
++ last unless @y || $bar;
++ $sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0);
++ }
++ @sx;
++}
++
++# multiply two numbers -- stolen from Knuth Vol 2 pg 233
++sub main'bmul { #(num_str, num_str) return num_str
++ local(*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
++ if ($x eq 'NaN') {
++ 'NaN';
++ } elsif ($y eq 'NaN') {
++ 'NaN';
++ } else {
++ @x = &internal($x);
++ @y = &internal($y);
++ local($signr) = (shift @x ne shift @y) ? '-' : '+';
++ @prod = ();
++ for $x (@x) {
++ ($car, $cty) = (0, $[);
++ for $y (@y) {
++ $prod = $x * $y + $prod[$cty] + $car;
++ if ($use_mult) {
++ $prod[$cty++] =
++ $prod - ($car = int($prod * 1e-5)) * 1e5;
++ }
++ else {
++ $prod[$cty++] =
++ $prod - ($car = int($prod / 1e5)) * 1e5;
++ }
++ }
++ $prod[$cty] += $car if $car;
++ $x = shift @prod;
++ }
++ &external($signr, @x, @prod);
++ }
++}
++
++# modulus
++sub main'bmod { #(num_str, num_str) return num_str
++ (&'bdiv(@_))[$[+1];
++}
++
++sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
++ local (*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
++ return wantarray ? ('NaN','NaN') : 'NaN'
++ if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
++ return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
++ @x = &internal($x); @y = &internal($y);
++ $srem = $y[$[];
++ $sr = (shift @x ne shift @y) ? '-' : '+';
++ $car = $bar = $prd = 0;
++ if (($dd = int(1e5/($y[$#y]+1))) != 1) {
++ for $x (@x) {
++ $x = $x * $dd + $car;
++ if ($use_mult) {
++ $x -= ($car = int($x * 1e-5)) * 1e5;
++ }
++ else {
++ $x -= ($car = int($x / 1e5)) * 1e5;
++ }
++ }
++ push(@x, $car); $car = 0;
++ for $y (@y) {
++ $y = $y * $dd + $car;
++ if ($use_mult) {
++ $y -= ($car = int($y * 1e-5)) * 1e5;
++ }
++ else {
++ $y -= ($car = int($y / 1e5)) * 1e5;
++ }
++ }
++ }
++ else {
++ push(@x, 0);
++ }
++ @q = (); ($v2,$v1) = @y[-2,-1];
++ while ($#x > $#y) {
++ ($u2,$u1,$u0) = @x[-3..-1];
++ $q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
++ --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
++ if ($q) {
++ ($car, $bar) = (0,0);
++ for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
++ $prd = $q * $y[$y] + $car;
++ if ($use_mult) {
++ $prd -= ($car = int($prd * 1e-5)) * 1e5;
++ }
++ else {
++ $prd -= ($car = int($prd / 1e5)) * 1e5;
++ }
++ $x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0));
++ }
++ if ($x[$#x] < $car + $bar) {
++ $car = 0; --$q;
++ for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
++ $x[$x] -= 1e5
++ if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
++ }
++ }
++ }
++ pop(@x); unshift(@q, $q);
++ }
++ if (wantarray) {
++ @d = ();
++ if ($dd != 1) {
++ $car = 0;
++ for $x (reverse @x) {
++ $prd = $car * 1e5 + $x;
++ $car = $prd - ($tmp = int($prd / $dd)) * $dd;
++ unshift(@d, $tmp);
++ }
++ }
++ else {
++ @d = @x;
++ }
++ (&external($sr, @q), &external($srem, @d, $zero));
++ } else {
++ &external($sr, @q);
++ }
++}
++1;
+diff -ENwbur perl-5.16.3-orig/lib/bigrat.pl perl-5.16.3/lib/bigrat.pl
+--- perl-5.16.3-orig/lib/bigrat.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/bigrat.pl 2016-08-18 10:07:06.441442270 +0200
+@@ -0,0 +1,155 @@
++package bigrat;
++require "bigint.pl";
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Arbitrary size rational math package
++#
++# by Mark Biggar
++#
++# Input values to these routines consist of strings of the form
++# m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|.
++# Examples:
++# "+0/1" canonical zero value
++# "3" canonical value "+3/1"
++# " -123/123 123" canonical value "-1/1001"
++# "123 456/7890" canonical value "+20576/1315"
++# Output values always include a sign and no leading zeros or
++# white space.
++# This package makes use of the bigint package.
++# The string 'NaN' is used to represent the result when input arguments
++# that are not numbers, as well as the result of dividing by zero and
++# the sqrt of a negative number.
++# Extreamly naive algorthims are used.
++#
++# Routines provided are:
++#
++# rneg(RAT) return RAT negation
++# rabs(RAT) return RAT absolute value
++# rcmp(RAT,RAT) return CODE compare numbers (undef,<0,=0,>0)
++# radd(RAT,RAT) return RAT addition
++# rsub(RAT,RAT) return RAT subtraction
++# rmul(RAT,RAT) return RAT multiplication
++# rdiv(RAT,RAT) return RAT division
++# rmod(RAT) return (RAT,RAT) integer and fractional parts
++# rnorm(RAT) return RAT normalization
++# rsqrt(RAT, cycles) return RAT square root
++
++# Convert a number to the canonical string form m|^[+-]\d+/\d+|.
++sub main'rnorm { #(string) return rat_num
++ local($_) = @_;
++ s/\s+//g;
++ if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
++ &norm($1, $3 ? $3 : '+1');
++ } else {
++ 'NaN';
++ }
++}
++
++# Normalize by reducing to lowest terms
++sub norm { #(bint, bint) return rat_num
++ local($num,$dom) = @_;
++ if ($num eq 'NaN') {
++ 'NaN';
++ } elsif ($dom eq 'NaN') {
++ 'NaN';
++ } elsif ($dom =~ /^[+-]?0+$/) {
++ 'NaN';
++ } else {
++ local($gcd) = &'bgcd($num,$dom);
++ $gcd =~ s/^-/+/;
++ if ($gcd ne '+1') {
++ $num = &'bdiv($num,$gcd);
++ $dom = &'bdiv($dom,$gcd);
++ } else {
++ $num = &'bnorm($num);
++ $dom = &'bnorm($dom);
++ }
++ substr($dom,$[,1) = '';
++ "$num/$dom";
++ }
++}
++
++# negation
++sub main'rneg { #(rat_num) return rat_num
++ local($_) = &'rnorm(@_);
++ tr/-+/+-/ if ($_ ne '+0/1');
++ $_;
++}
++
++# absolute value
++sub main'rabs { #(rat_num) return $rat_num
++ local($_) = &'rnorm(@_);
++ substr($_,$[,1) = '+' unless $_ eq 'NaN';
++ $_;
++}
++
++# multipication
++sub main'rmul { #(rat_num, rat_num) return rat_num
++ local($xn,$xd) = split('/',&'rnorm($_[$[]));
++ local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
++ &norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
++}
++
++# division
++sub main'rdiv { #(rat_num, rat_num) return rat_num
++ local($xn,$xd) = split('/',&'rnorm($_[$[]));
++ local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
++ &norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
++}
++
++# addition
++sub main'radd { #(rat_num, rat_num) return rat_num
++ local($xn,$xd) = split('/',&'rnorm($_[$[]));
++ local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
++ &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
++}
++
++# subtraction
++sub main'rsub { #(rat_num, rat_num) return rat_num
++ local($xn,$xd) = split('/',&'rnorm($_[$[]));
++ local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
++ &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
++}
++
++# comparison
++sub main'rcmp { #(rat_num, rat_num) return cond_code
++ local($xn,$xd) = split('/',&'rnorm($_[$[]));
++ local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
++ &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
++}
++
++# int and frac parts
++sub main'rmod { #(rat_num) return (rat_num,rat_num)
++ local($xn,$xd) = split('/',&'rnorm(@_));
++ local($i,$f) = &'bdiv($xn,$xd);
++ if (wantarray) {
++ ("$i/1", "$f/$xd");
++ } else {
++ "$i/1";
++ }
++}
++
++# square root by Newtons method.
++# cycles specifies the number of iterations default: 5
++sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
++ local($x, $scale) = (&'rnorm($_[$[]), $_[$[+1]);
++ if ($x eq 'NaN') {
++ 'NaN';
++ } elsif ($x =~ /^-/) {
++ 'NaN';
++ } else {
++ local($gscale, $guess) = (0, '+1/1');
++ $scale = 5 if (!$scale);
++ while ($gscale++ < $scale) {
++ $guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2");
++ }
++ "$guess"; # quotes necessary due to perl bug
++ }
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/cacheout.pl perl-5.16.3/lib/cacheout.pl
+--- perl-5.16.3-orig/lib/cacheout.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/cacheout.pl 2016-08-18 10:07:06.452442221 +0200
+@@ -0,0 +1,55 @@
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: FileCache
++
++# Open in their package.
++
++sub cacheout'open {
++ open($_[0], $_[1]);
++}
++
++# Close as well
++
++sub cacheout'close {
++ close($_[0]);
++}
++
++# But only this sub name is visible to them.
++
++sub cacheout {
++ package cacheout;
++
++ ($file) = @_;
++ if (!$isopen{$file}) {
++ if (++$numopen > $maxopen) {
++ local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
++ splice(@lru, $maxopen / 3);
++ $numopen -= @lru;
++ for (@lru) { &close($_); delete $isopen{$_}; }
++ }
++ &open($file, ($saw{$file}++ ? '>>' : '>') . $file)
++ || die "Can't create $file: $!\n";
++ }
++ $isopen{$file} = ++$seq;
++}
++
++package cacheout;
++
++$seq = 0;
++$numopen = 0;
++
++if (open(PARAM,'/usr/include/sys/param.h')) {
++ local($_, $.);
++ while (<PARAM>) {
++ $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
++ }
++ close PARAM;
++}
++$maxopen = 16 unless $maxopen;
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/complete.pl perl-5.16.3/lib/complete.pl
+--- perl-5.16.3-orig/lib/complete.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/complete.pl 2016-08-18 10:07:06.460442186 +0200
+@@ -0,0 +1,120 @@
++;#
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Term::Complete
++#
++;# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91
++;#
++;# Author: Wayne Thompson
++;#
++;# Description:
++;# This routine provides word completion.
++;# (TAB) attempts word completion.
++;# (^D) prints completion list.
++;# (These may be changed by setting $Complete'complete, etc.)
++;#
++;# Diagnostics:
++;# Bell when word completion fails.
++;#
++;# Dependencies:
++;# The tty driver is put into raw mode.
++;#
++;# Bugs:
++;#
++;# Usage:
++;# $input = &Complete('prompt_string', *completion_list);
++;# or
++;# $input = &Complete('prompt_string', @completion_list);
++;#
++
++CONFIG: {
++ package Complete;
++
++ $complete = "\004";
++ $kill = "\025";
++ $erase1 = "\177";
++ $erase2 = "\010";
++}
++
++sub Complete {
++ package Complete;
++
++ local($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
++ if ($_[1] =~ /^StB\0/) {
++ ($prompt, *_) = @_;
++ }
++ else {
++ $prompt = shift(@_);
++ }
++ @cmp_lst = sort(@_);
++
++ system('stty raw -echo');
++ LOOP: {
++ print($prompt, $return);
++ while (($_ = getc(STDIN)) ne "\r") {
++ CASE: {
++ # (TAB) attempt completion
++ $_ eq "\t" && do {
++ @match = grep(/^$return/, @cmp_lst);
++ $l = length($test = shift(@match));
++ unless ($#match < 0) {
++ foreach $cmp (@match) {
++ until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
++ $l--;
++ }
++ }
++ print("\a");
++ }
++ print($test = substr($test, $r, $l - $r));
++ $r = length($return .= $test);
++ last CASE;
++ };
++
++ # (^D) completion list
++ $_ eq $complete && do {
++ print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
++ redo LOOP;
++ };
++
++ # (^U) kill
++ $_ eq $kill && do {
++ if ($r) {
++ undef $r;
++ undef $return;
++ print("\r\n");
++ redo LOOP;
++ }
++ last CASE;
++ };
++
++ # (DEL) || (BS) erase
++ ($_ eq $erase1 || $_ eq $erase2) && do {
++ if($r) {
++ print("\b \b");
++ chop($return);
++ $r--;
++ }
++ last CASE;
++ };
++
++ # printable char
++ ord >= 32 && do {
++ $return .= $_;
++ $r++;
++ print;
++ last CASE;
++ };
++ }
++ }
++ }
++ system('stty -raw echo');
++ print("\n");
++ $return;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/ctime.pl perl-5.16.3/lib/ctime.pl
+--- perl-5.16.3-orig/lib/ctime.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/ctime.pl 2016-08-18 10:07:06.471442137 +0200
+@@ -0,0 +1,59 @@
++;# ctime.pl is a simple Perl emulation for the well known ctime(3C) function.
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: the POSIX ctime function
++;#
++;# Waldemar Kebsch, Federal Republic of Germany, November 1988
++;# kebsch.pad@nixpbe.UUCP
++;# Modified March 1990, Feb 1991 to properly handle timezones
++;# $RCSfile: ctime.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:47 $
++;# Marion Hakanson (hakanson@cse.ogi.edu)
++;# Oregon Graduate Institute of Science and Technology
++;#
++;# usage:
++;#
++;# #include <ctime.pl> # see the -P and -I option in perl.man
++;# $Date = &ctime(time);
++
++CONFIG: {
++ package ctime;
++
++ @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
++ @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
++ 'Jul','Aug','Sep','Oct','Nov','Dec');
++}
++
++sub ctime {
++ package ctime;
++
++ local($time) = @_;
++ local($[) = 0;
++ local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
++
++ # Determine what time zone is in effect.
++ # Use GMT if TZ is defined as null, local time if TZ undefined.
++ # There's no portable way to find the system default timezone.
++
++ $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
++ ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
++ ($TZ eq 'GMT') ? gmtime($time) : localtime($time);
++
++ # Hack to deal with 'PST8PDT' format of TZ
++ # Note that this can't deal with all the esoteric forms, but it
++ # does recognize the most common: [:]STDoff[DST[off][,rule]]
++
++ if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){
++ $TZ = $isdst ? $4 : $1;
++ }
++ $TZ .= ' ' unless $TZ eq '';
++
++ $year += 1900;
++ sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n",
++ $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);
++}
++1;
+diff -ENwbur perl-5.16.3-orig/lib/dotsh.pl perl-5.16.3/lib/dotsh.pl
+--- perl-5.16.3-orig/lib/dotsh.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/dotsh.pl 2016-08-18 10:07:06.481442093 +0200
+@@ -0,0 +1,74 @@
++#
++# @(#)dotsh.pl 03/19/94
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++#
++# Author: Charles Collins
++#
++# Description:
++# This routine takes a shell script and 'dots' it into the current perl
++# environment. This makes it possible to use existing system scripts
++# to alter environment variables on the fly.
++#
++# Usage:
++# &dotsh ('ShellScript', 'DependentVariable(s)');
++#
++# where
++#
++# 'ShellScript' is the full name of the shell script to be dotted
++#
++# 'DependentVariable(s)' is an optional list of shell variables in the
++# form VARIABLE=VALUE,VARIABLE=VALUE,... that 'ShellScript' is
++# dependent upon. These variables MUST be defined using shell syntax.
++#
++# Example:
++# &dotsh ('/foo/bar', 'arg1');
++# &dotsh ('/foo/bar');
++# &dotsh ('/foo/bar arg1 ... argN');
++#
++sub dotsh {
++ local(@sh) = @_;
++ local($tmp,$key,$shell,$command,$args,$vars) = '';
++ local(*dotsh);
++ undef *dotsh;
++ $dotsh = shift(@sh);
++ @dotsh = split (/\s/, $dotsh);
++ $command = shift (@dotsh);
++ $args = join (" ", @dotsh);
++ $vars = join ("\n", @sh);
++ open (_SH_ENV, "$command") || die "Could not open $dotsh!\n";
++ chop($_ = <_SH_ENV>);
++ $shell = "$1 -c" if ($_ =~ /^\#\!\s*(\S+(\/sh|\/ksh|\/zsh|\/csh))\s*$/);
++ close (_SH_ENV);
++ if (!$shell) {
++ if ($ENV{'SHELL'} =~ /\/sh$|\/ksh$|\/zsh$|\/bash$|\/csh$/) {
++ $shell = "$ENV{'SHELL'} -c";
++ } else {
++ print "SHELL not recognized!\nUsing /bin/sh...\n";
++ $shell = "/bin/sh -c";
++ }
++ }
++ if (length($vars) > 0) {
++ open (_SH_ENV, "$shell \"$vars && . $command $args && set \" |") || die;
++ } else {
++ open (_SH_ENV, "$shell \". $command $args && set \" |") || die;
++ }
++
++ while (<_SH_ENV>) {
++ chop;
++ m/^([^=]*)=(.*)/s;
++ $ENV{$1} = $2;
++ }
++ close (_SH_ENV);
++
++ foreach $key (keys(%ENV)) {
++ $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
++ }
++ eval $tmp;
++}
++1;
+diff -ENwbur perl-5.16.3-orig/lib/exceptions.pl perl-5.16.3/lib/exceptions.pl
+--- perl-5.16.3-orig/lib/exceptions.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/exceptions.pl 2016-08-18 10:07:06.491442049 +0200
+@@ -0,0 +1,61 @@
++# exceptions.pl
++# tchrist@convex.com
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++#
++# Here's a little code I use for exception handling. It's really just
++# glorfied eval/die. The way to use use it is when you might otherwise
++# exit, use &throw to raise an exception. The first enclosing &catch
++# handler looks at the exception and decides whether it can catch this kind
++# (catch takes a list of regexps to catch), and if so, it returns the one it
++# caught. If it *can't* catch it, then it will reraise the exception
++# for someone else to possibly see, or to die otherwise.
++#
++# I use oddly named variables in order to make darn sure I don't conflict
++# with my caller. I also hide in my own package, and eval the code in his.
++#
++# The EXCEPTION: prefix is so you can tell whether it's a user-raised
++# exception or a perl-raised one (eval error).
++#
++# --tom
++#
++# examples:
++# if (&catch('/$user_input/', 'regexp', 'syntax error') {
++# warn "oops try again";
++# redo;
++# }
++#
++# if ($error = &catch('&subroutine()')) { # catches anything
++#
++# &throw('bad input') if /^$/;
++
++sub catch {
++ package exception;
++ local($__code__, @__exceptions__) = @_;
++ local($__package__) = caller;
++ local($__exception__);
++
++ eval "package $__package__; $__code__";
++ if ($__exception__ = &'thrown) {
++ for (@__exceptions__) {
++ return $__exception__ if /$__exception__/;
++ }
++ &'throw($__exception__);
++ }
++}
++
++sub throw {
++ local($exception) = @_;
++ die "EXCEPTION: $exception\n";
++}
++
++sub thrown {
++ $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/fastcwd.pl perl-5.16.3/lib/fastcwd.pl
+--- perl-5.16.3-orig/lib/fastcwd.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/fastcwd.pl 2016-08-18 10:07:06.501442005 +0200
+@@ -0,0 +1,43 @@
++# By John Bazik
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Cwd
++#
++# Usage: $cwd = &fastcwd;
++#
++# This is a faster version of getcwd. It's also more dangerous because
++# you might chdir out of a directory that you can't chdir back into.
++
++sub fastcwd {
++ local($odev, $oino, $cdev, $cino, $tdev, $tino);
++ local(@path, $path);
++ local(*DIR);
++
++ ($cdev, $cino) = stat('.');
++ for (;;) {
++ ($odev, $oino) = ($cdev, $cino);
++ chdir('..');
++ ($cdev, $cino) = stat('.');
++ last if $odev == $cdev && $oino == $cino;
++ opendir(DIR, '.');
++ for (;;) {
++ $_ = readdir(DIR);
++ next if $_ eq '.';
++ next if $_ eq '..';
++
++ last unless $_;
++ ($tdev, $tino) = lstat($_);
++ last unless $tdev != $odev || $tino != $oino;
++ }
++ closedir(DIR);
++ unshift(@path, $_);
++ }
++ chdir($path = '/' . join('/', @path));
++ $path;
++}
++1;
+diff -ENwbur perl-5.16.3-orig/lib/find.pl perl-5.16.3/lib/find.pl
+--- perl-5.16.3-orig/lib/find.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/find.pl 2016-08-18 10:07:06.510441965 +0200
+@@ -0,0 +1,47 @@
++# Usage:
++# require "find.pl";
++#
++# &find('/foo','/bar');
++#
++# sub wanted { ... }
++# where wanted does whatever you want. $dir contains the
++# current directory name, and $_ the current filename within
++# that directory. $name contains "$dir/$_". You are cd'ed
++# to $dir when the function is called. The function may
++# set $prune to prune the tree.
++#
++# This library is primarily for find2perl, which, when fed
++#
++# find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
++#
++# spits out something like this
++#
++# sub wanted {
++# /^\.nfs.*$/ &&
++# (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
++# int(-M _) > 7 &&
++# unlink($_)
++# ||
++# ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
++# $dev < 0 &&
++# ($prune = 1);
++# }
++#
++# Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
++
++use File::Find ();
++
++*name = *File::Find::name;
++*prune = *File::Find::prune;
++*dir = *File::Find::dir;
++*topdir = *File::Find::topdir;
++*topdev = *File::Find::topdev;
++*topino = *File::Find::topino;
++*topmode = *File::Find::topmode;
++*topnlink = *File::Find::topnlink;
++
++sub find {
++ &File::Find::find(\&wanted, @_);
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/finddepth.pl perl-5.16.3/lib/finddepth.pl
+--- perl-5.16.3-orig/lib/finddepth.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/finddepth.pl 2016-08-18 10:07:06.520441921 +0200
+@@ -0,0 +1,46 @@
++# Usage:
++# require "finddepth.pl";
++#
++# &finddepth('/foo','/bar');
++#
++# sub wanted { ... }
++# where wanted does whatever you want. $dir contains the
++# current directory name, and $_ the current filename within
++# that directory. $name contains "$dir/$_". You are cd'ed
++# to $dir when the function is called. The function may
++# set $prune to prune the tree.
++#
++# This library is primarily for find2perl, which, when fed
++#
++# find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
++#
++# spits out something like this
++#
++# sub wanted {
++# /^\.nfs.*$/ &&
++# (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
++# int(-M _) > 7 &&
++# unlink($_)
++# ||
++# ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
++# $dev < 0 &&
++# ($prune = 1);
++# }
++
++
++use File::Find ();
++
++*name = *File::Find::name;
++*prune = *File::Find::prune;
++*dir = *File::Find::dir;
++*topdir = *File::Find::topdir;
++*topdev = *File::Find::topdev;
++*topino = *File::Find::topino;
++*topmode = *File::Find::topmode;
++*topnlink = *File::Find::topnlink;
++
++sub finddepth {
++ &File::Find::finddepth(\&wanted, @_);
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/flush.pl perl-5.16.3/lib/flush.pl
+--- perl-5.16.3-orig/lib/flush.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/flush.pl 2016-08-18 10:07:06.529441881 +0200
+@@ -0,0 +1,32 @@
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: IO::Handle
++#
++;# Usage: &flush(FILEHANDLE)
++;# flushes the named filehandle
++
++;# Usage: &printflush(FILEHANDLE, "prompt: ")
++;# prints arguments and flushes filehandle
++
++sub flush {
++ local($old) = select(shift);
++ $| = 1;
++ print "";
++ $| = 0;
++ select($old);
++}
++
++sub printflush {
++ local($old) = select(shift);
++ $| = 1;
++ print @_;
++ $| = 0;
++ select($old);
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/getcwd.pl perl-5.16.3/lib/getcwd.pl
+--- perl-5.16.3-orig/lib/getcwd.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/getcwd.pl 2016-08-18 10:07:06.540441833 +0200
+@@ -0,0 +1,71 @@
++# By Brandon S. Allbery
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Cwd
++#
++#
++# Usage: $cwd = &getcwd;
++
++sub getcwd
++{
++ local($dotdots, $cwd, @pst, @cst, $dir, @tst);
++
++ unless (@cst = stat('.'))
++ {
++ warn "stat(.): $!";
++ return '';
++ }
++ $cwd = '';
++ do
++ {
++ $dotdots .= '/' if $dotdots;
++ $dotdots .= '..';
++ @pst = @cst;
++ unless (opendir(getcwd'PARENT, $dotdots)) #'))
++ {
++ warn "opendir($dotdots): $!";
++ return '';
++ }
++ unless (@cst = stat($dotdots))
++ {
++ warn "stat($dotdots): $!";
++ closedir(getcwd'PARENT); #');
++ return '';
++ }
++ if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
++ {
++ $dir = '';
++ }
++ else
++ {
++ do
++ {
++ unless (defined ($dir = readdir(getcwd'PARENT))) #'))
++ {
++ warn "readdir($dotdots): $!";
++ closedir(getcwd'PARENT); #');
++ return '';
++ }
++ unless (@tst = lstat("$dotdots/$dir"))
++ {
++ # warn "lstat($dotdots/$dir): $!";
++ # closedir(getcwd'PARENT); #');
++ # return '';
++ }
++ }
++ while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
++ $tst[$[ + 1] != $pst[$[ + 1]);
++ }
++ $cwd = "$dir/$cwd";
++ closedir(getcwd'PARENT); #');
++ } while ($dir ne '');
++ chop($cwd);
++ $cwd;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/getopt.pl perl-5.16.3/lib/getopt.pl
+--- perl-5.16.3-orig/lib/getopt.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/getopt.pl 2016-08-18 10:07:06.548441797 +0200
+@@ -0,0 +1,49 @@
++;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternatives: Getopt::Long or Getopt::Std
++#
++;# Process single-character switches with switch clustering. Pass one argument
++;# which is a string containing all switches that take an argument. For each
++;# switch found, sets $opt_x (where x is the switch name) to the value of the
++;# argument, or 1 if no argument. Switches which take an argument don't care
++;# whether there is a space between the switch and the argument.
++
++;# Usage:
++;# do Getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect.
++
++sub Getopt {
++ local($argumentative) = @_;
++ local($_,$first,$rest);
++ local($[) = 0;
++
++ while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
++ ($first,$rest) = ($1,$2);
++ if (index($argumentative,$first) >= $[) {
++ if ($rest ne '') {
++ shift(@ARGV);
++ }
++ else {
++ shift(@ARGV);
++ $rest = shift(@ARGV);
++ }
++ ${"opt_$first"} = $rest;
++ }
++ else {
++ ${"opt_$first"} = 1;
++ if ($rest ne '') {
++ $ARGV[0] = "-$rest";
++ }
++ else {
++ shift(@ARGV);
++ }
++ }
++ }
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/getopts.pl perl-5.16.3/lib/getopts.pl
+--- perl-5.16.3-orig/lib/getopts.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/getopts.pl 2016-08-18 10:07:06.557441758 +0200
+@@ -0,0 +1,66 @@
++;# getopts.pl - a better getopt.pl
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternatives: Getopt::Long or Getopt::Std
++#
++;# Usage:
++;# do Getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a
++;# # side effect.
++
++sub Getopts {
++ local($argumentative) = @_;
++ local(@args,$_,$first,$rest);
++ local($errs) = 0;
++ local($[) = 0;
++
++ @args = split( / */, $argumentative );
++ while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
++ ($first,$rest) = ($1,$2);
++ $pos = index($argumentative,$first);
++ if($pos >= $[) {
++ if($args[$pos+1] eq ':') {
++ shift(@ARGV);
++ if($rest eq '') {
++ ++$errs unless(@ARGV);
++ $rest = shift(@ARGV);
++ }
++ eval "
++ push(\@opt_$first, \$rest);
++ if (!defined \$opt_$first or \$opt_$first eq '') {
++ \$opt_$first = \$rest;
++ }
++ else {
++ \$opt_$first .= ' ' . \$rest;
++ }
++ ";
++ }
++ else {
++ eval "\$opt_$first = 1";
++ if($rest eq '') {
++ shift(@ARGV);
++ }
++ else {
++ $ARGV[0] = "-$rest";
++ }
++ }
++ }
++ else {
++ print STDERR "Unknown option: $first\n";
++ ++$errs;
++ if($rest ne '') {
++ $ARGV[0] = "-$rest";
++ }
++ else {
++ shift(@ARGV);
++ }
++ }
++ }
++ $errs == 0;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/hostname.pl perl-5.16.3/lib/hostname.pl
+--- perl-5.16.3-orig/lib/hostname.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/hostname.pl 2016-08-18 10:07:06.567441713 +0200
+@@ -0,0 +1,31 @@
++# From: asherman@fmrco.com (Aaron Sherman)
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Sys::Hostname
++#
++sub hostname
++{
++ local(*P,@tmp,$hostname,$_);
++ if (open(P,"hostname 2>&1 |") && (@tmp = <P>) && close(P))
++ {
++ chop($hostname = $tmp[$#tmp]);
++ }
++ elsif (open(P,"uname -n 2>&1 |") && (@tmp = <P>) && close(P))
++ {
++ chop($hostname = $tmp[$#tmp]);
++ }
++ else
++ {
++ die "$0: Cannot get hostname from 'hostname' or 'uname -n'\n";
++ }
++ @tmp = ();
++ close P; # Just in case we failed in an odd spot....
++ $hostname;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/importenv.pl perl-5.16.3/lib/importenv.pl
+--- perl-5.16.3-orig/lib/importenv.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/importenv.pl 2016-08-18 10:07:06.577441669 +0200
+@@ -0,0 +1,14 @@
++;# This file, when interpreted, pulls the environment into normal variables.
++;# Usage:
++;# require 'importenv.pl';
++;# or
++;# #include <importenv.pl>
++
++local($tmp,$key) = '';
++
++foreach $key (keys(%ENV)) {
++ $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
++}
++eval $tmp;
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/look.pl perl-5.16.3/lib/look.pl
+--- perl-5.16.3-orig/lib/look.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/look.pl 2016-08-18 10:07:06.586441630 +0200
+@@ -0,0 +1,50 @@
++;# Usage: &look(*FILEHANDLE,$key,$dict,$fold)
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++;# Sets file position in FILEHANDLE to be first line greater than or equal
++;# (stringwise) to $key. Pass flags for dictionary order and case folding.
++
++sub look {
++ local(*FH,$key,$dict,$fold) = @_;
++ local($max,$min,$mid,$_);
++ local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
++ $blksize,$blocks) = stat(FH);
++ $blksize = 8192 unless $blksize;
++ $key =~ s/[^\w\s]//g if $dict;
++ $key = lc $key if $fold;
++ $max = int($size / $blksize);
++ while ($max - $min > 1) {
++ $mid = int(($max + $min) / 2);
++ seek(FH,$mid * $blksize,0);
++ $_ = <FH> if $mid; # probably a partial line
++ $_ = <FH>;
++ chop;
++ s/[^\w\s]//g if $dict;
++ $_ = lc $_ if $fold;
++ if ($_ lt $key) {
++ $min = $mid;
++ }
++ else {
++ $max = $mid;
++ }
++ }
++ $min *= $blksize;
++ seek(FH,$min,0);
++ <FH> if $min;
++ while (<FH>) {
++ chop;
++ s/[^\w\s]//g if $dict;
++ $_ = lc $_ if $fold;
++ last if $_ ge $key;
++ $min = tell(FH);
++ }
++ seek(FH,$min,0);
++ $min;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/newgetopt.pl perl-5.16.3/lib/newgetopt.pl
+--- perl-5.16.3-orig/lib/newgetopt.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/newgetopt.pl 2016-08-18 10:07:06.595441590 +0200
+@@ -0,0 +1,75 @@
++# $Id: newgetopt.pl,v 1.18 2001/09/21 13:34:59 jv Exp $
++
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++# It is now just a wrapper around the Getopt::Long module.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Getopt::Long
++
++{ package newgetopt;
++
++ # Values for $order. See GNU getopt.c for details.
++ $REQUIRE_ORDER = 0;
++ $PERMUTE = 1;
++ $RETURN_IN_ORDER = 2;
++
++ # Handle POSIX compliancy.
++ if ( defined $ENV{"POSIXLY_CORRECT"} ) {
++ $autoabbrev = 0; # no automatic abbrev of options (???)
++ $getopt_compat = 0; # disallow '+' to start options
++ $option_start = "(--|-)";
++ $order = $REQUIRE_ORDER;
++ $bundling = 0;
++ $passthrough = 0;
++ }
++ else {
++ $autoabbrev = 1; # automatic abbrev of options
++ $getopt_compat = 1; # allow '+' to start options
++ $option_start = "(--|-|\\+)";
++ $order = $PERMUTE;
++ $bundling = 0;
++ $passthrough = 0;
++ }
++
++ # Other configurable settings.
++ $debug = 0; # for debugging
++ $ignorecase = 1; # ignore case when matching options
++ $argv_end = "--"; # don't change this!
++}
++
++use Getopt::Long;
++
++################ Subroutines ################
++
++sub NGetOpt {
++
++ $Getopt::Long::debug = $newgetopt::debug
++ if defined $newgetopt::debug;
++ $Getopt::Long::autoabbrev = $newgetopt::autoabbrev
++ if defined $newgetopt::autoabbrev;
++ $Getopt::Long::getopt_compat = $newgetopt::getopt_compat
++ if defined $newgetopt::getopt_compat;
++ $Getopt::Long::option_start = $newgetopt::option_start
++ if defined $newgetopt::option_start;
++ $Getopt::Long::order = $newgetopt::order
++ if defined $newgetopt::order;
++ $Getopt::Long::bundling = $newgetopt::bundling
++ if defined $newgetopt::bundling;
++ $Getopt::Long::ignorecase = $newgetopt::ignorecase
++ if defined $newgetopt::ignorecase;
++ $Getopt::Long::ignorecase = $newgetopt::ignorecase
++ if defined $newgetopt::ignorecase;
++ $Getopt::Long::passthrough = $newgetopt::passthrough
++ if defined $newgetopt::passthrough;
++
++ &GetOptions;
++}
++
++################ Package return ################
++
++1;
++
++################ End of newgetopt.pl ################
+diff -ENwbur perl-5.16.3-orig/lib/open2.pl perl-5.16.3/lib/open2.pl
+--- perl-5.16.3-orig/lib/open2.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/open2.pl 2016-08-18 10:07:06.605441546 +0200
+@@ -0,0 +1,12 @@
++# This is a compatibility interface to IPC::Open2. New programs should
++# do
++#
++# use IPC::Open2;
++#
++# instead of
++#
++# require 'open2.pl';
++
++package main;
++use IPC::Open2 'open2';
++1
+diff -ENwbur perl-5.16.3-orig/lib/open3.pl perl-5.16.3/lib/open3.pl
+--- perl-5.16.3-orig/lib/open3.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/open3.pl 2016-08-18 10:07:06.615441502 +0200
+@@ -0,0 +1,12 @@
++# This is a compatibility interface to IPC::Open3. New programs should
++# do
++#
++# use IPC::Open3;
++#
++# instead of
++#
++# require 'open3.pl';
++
++package main;
++use IPC::Open3 'open3';
++1
+diff -ENwbur perl-5.16.3-orig/lib/pwd.pl perl-5.16.3/lib/pwd.pl
+--- perl-5.16.3-orig/lib/pwd.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/pwd.pl 2016-08-18 10:07:06.625441458 +0200
+@@ -0,0 +1,67 @@
++;# pwd.pl - keeps track of current working directory in PWD environment var
++;#
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Cwd
++#
++;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
++;#
++;# $Log: pwd.pl,v $
++;#
++;# Usage:
++;# require "pwd.pl";
++;# &initpwd;
++;# ...
++;# &chdir($newdir);
++
++package pwd;
++
++sub main'initpwd {
++ if ($ENV{'PWD'}) {
++ local($dd,$di) = stat('.');
++ local($pd,$pi) = stat($ENV{'PWD'});
++ if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
++ chop($ENV{'PWD'} = `pwd`);
++ }
++ }
++ else {
++ chop($ENV{'PWD'} = `pwd`);
++ }
++ if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
++ local($pd,$pi) = stat($2);
++ local($dd,$di) = stat($1);
++ if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
++ $ENV{'PWD'}="$2$3";
++ }
++ }
++}
++
++sub main'chdir {
++ local($newdir) = shift;
++ $newdir =~ s|/{2,}|/|g;
++ if (chdir $newdir) {
++ if ($newdir =~ m#^/#) {
++ $ENV{'PWD'} = $newdir;
++ }
++ else {
++ local(@curdir) = split(m#/#,$ENV{'PWD'});
++ @curdir = '' unless @curdir;
++ foreach $component (split(m#/#, $newdir)) {
++ next if $component eq '.';
++ pop(@curdir),next if $component eq '..';
++ push(@curdir,$component);
++ }
++ $ENV{'PWD'} = join('/',@curdir) || '/';
++ }
++ }
++ else {
++ 0;
++ }
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/shellwords.pl perl-5.16.3/lib/shellwords.pl
+--- perl-5.16.3-orig/lib/shellwords.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/shellwords.pl 2016-08-18 10:07:06.635441413 +0200
+@@ -0,0 +1,14 @@
++;# shellwords.pl
++;#
++;# Usage:
++;# require 'shellwords.pl';
++;# @words = shellwords($line);
++;# or
++;# @words = shellwords(@lines);
++;# or
++;# @words = shellwords(); # defaults to $_ (and clobbers it)
++
++require Text::ParseWords;
++*shellwords = \&Text::ParseWords::old_shellwords;
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/stat.pl perl-5.16.3/lib/stat.pl
+--- perl-5.16.3-orig/lib/stat.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/stat.pl 2016-08-18 10:07:06.644441374 +0200
+@@ -0,0 +1,29 @@
++;# Usage:
++;# require 'stat.pl';
++;# @ary = stat(foo);
++;# $st_dev = @ary[$ST_DEV];
++;#
++$ST_DEV = 0 + $[;
++$ST_INO = 1 + $[;
++$ST_MODE = 2 + $[;
++$ST_NLINK = 3 + $[;
++$ST_UID = 4 + $[;
++$ST_GID = 5 + $[;
++$ST_RDEV = 6 + $[;
++$ST_SIZE = 7 + $[;
++$ST_ATIME = 8 + $[;
++$ST_MTIME = 9 + $[;
++$ST_CTIME = 10 + $[;
++$ST_BLKSIZE = 11 + $[;
++$ST_BLOCKS = 12 + $[;
++
++;# Usage:
++;# require 'stat.pl';
++;# do Stat('foo'); # sets st_* as a side effect
++;#
++sub Stat {
++ ($st_dev,$st_ino,$st_mode,$st_nlink,$st_uid,$st_gid,$st_rdev,$st_size,
++ $st_atime,$st_mtime,$st_ctime,$st_blksize,$st_blocks) = stat(shift(@_));
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/syslog.pl perl-5.16.3/lib/syslog.pl
+--- perl-5.16.3-orig/lib/syslog.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/syslog.pl 2016-08-18 10:07:06.656441321 +0200
+@@ -0,0 +1,199 @@
++#
++# syslog.pl
++#
++# $Log: syslog.pl,v $
++#
++# tom christiansen <tchrist@convex.com>
++# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
++# NOTE: openlog now takes three arguments, just like openlog(3)
++#
++# call syslog() with a string priority and a list of printf() args
++# like syslog(3)
++#
++# usage: require 'syslog.pl';
++#
++# then (put these all in a script to test function)
++#
++#
++# do openlog($program,'cons,pid','user');
++# do syslog('info','this is another test');
++# do syslog('mail|warning','this is a better test: %d', time);
++# do closelog();
++#
++# do syslog('debug','this is the last test');
++# do openlog("$program $$",'ndelay','user');
++# do syslog('notice','fooprogram: this is really done');
++#
++# $! = 55;
++# do syslog('info','problem was %m'); # %m == $! in syslog(3)
++
++package syslog;
++
++use warnings::register;
++
++$host = 'localhost' unless $host; # set $syslog'host to change
++
++if ($] >= 5 && warnings::enabled()) {
++ warnings::warn("You should 'use Sys::Syslog' instead; continuing");
++}
++
++require 'syslog.ph';
++
++ eval 'use Socket; 1' ||
++ eval { require "socket.ph" } ||
++ require "sys/socket.ph";
++
++$maskpri = &LOG_UPTO(&LOG_DEBUG);
++
++sub main'openlog {
++ ($ident, $logopt, $facility) = @_; # package vars
++ $lo_pid = $logopt =~ /\bpid\b/;
++ $lo_ndelay = $logopt =~ /\bndelay\b/;
++ $lo_cons = $logopt =~ /\bcons\b/;
++ $lo_nowait = $logopt =~ /\bnowait\b/;
++ &connect if $lo_ndelay;
++}
++
++sub main'closelog {
++ $facility = $ident = '';
++ &disconnect;
++}
++
++sub main'setlogmask {
++ local($oldmask) = $maskpri;
++ $maskpri = shift;
++ $oldmask;
++}
++
++sub main'syslog {
++ local($priority) = shift;
++ local($mask) = shift;
++ local($message, $whoami);
++ local(@words, $num, $numpri, $numfac, $sum);
++ local($facility) = $facility; # may need to change temporarily.
++
++ die "syslog: expected both priority and mask" unless $mask && $priority;
++
++ @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
++ undef $numpri;
++ undef $numfac;
++ foreach (@words) {
++ $num = &xlate($_); # Translate word to number.
++ if (/^kern$/ || $num < 0) {
++ die "syslog: invalid level/facility: $_\n";
++ }
++ elsif ($num <= &LOG_PRIMASK) {
++ die "syslog: too many levels given: $_\n" if defined($numpri);
++ $numpri = $num;
++ return 0 unless &LOG_MASK($numpri) & $maskpri;
++ }
++ else {
++ die "syslog: too many facilities given: $_\n" if defined($numfac);
++ $facility = $_;
++ $numfac = $num;
++ }
++ }
++
++ die "syslog: level must be given\n" unless defined($numpri);
++
++ if (!defined($numfac)) { # Facility not specified in this call.
++ $facility = 'user' unless $facility;
++ $numfac = &xlate($facility);
++ }
++
++ &connect unless $connected;
++
++ $whoami = $ident;
++
++ if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
++ $whoami = $1;
++ $mask = $2;
++ }
++
++ unless ($whoami) {
++ ($whoami = getlogin) ||
++ ($whoami = getpwuid($<)) ||
++ ($whoami = 'syslog');
++ }
++
++ $whoami .= "[$$]" if $lo_pid;
++
++ $mask =~ s/%m/$!/g;
++ $mask .= "\n" unless $mask =~ /\n$/;
++ $message = sprintf ($mask, @_);
++
++ $sum = $numpri + $numfac;
++ unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
++ if ($lo_cons) {
++ if ($pid = fork) {
++ unless ($lo_nowait) {
++ do {$died = wait;} until $died == $pid || $died < 0;
++ }
++ }
++ else {
++ open(CONS,">/dev/console");
++ print CONS "<$facility.$priority>$whoami: $message\r";
++ exit if defined $pid; # if fork failed, we're parent
++ close CONS;
++ }
++ }
++ }
++}
++
++sub xlate {
++ local($name) = @_;
++ $name = uc $name;
++ $name = "LOG_$name" unless $name =~ /^LOG_/;
++ $name = "syslog'$name";
++ defined &$name ? &$name : -1;
++}
++
++sub connect {
++ $pat = 'S n C4 x8';
++
++ $af_unix = &AF_UNIX;
++ $af_inet = &AF_INET;
++
++ $stream = &SOCK_STREAM;
++ $datagram = &SOCK_DGRAM;
++
++ ($name,$aliases,$proto) = getprotobyname('udp');
++ $udp = $proto;
++
++ ($name,$aliases,$port,$proto) = getservbyname('syslog','udp');
++ $syslog = $port;
++
++ if (chop($myname = `hostname`)) {
++ ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
++ die "Can't lookup $myname\n" unless $name;
++ @bytes = unpack("C4",$addrs[0]);
++ }
++ else {
++ @bytes = (0,0,0,0);
++ }
++ $this = pack($pat, $af_inet, 0, @bytes);
++
++ if ($host =~ /^\d+\./) {
++ @bytes = split(/\./,$host);
++ }
++ else {
++ ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
++ die "Can't lookup $host\n" unless $name;
++ @bytes = unpack("C4",$addrs[0]);
++ }
++ $that = pack($pat,$af_inet,$syslog,@bytes);
++
++ socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
++ bind(SYSLOG,$this) || die "bind: $!\n";
++ connect(SYSLOG,$that) || die "connect: $!\n";
++
++ local($old) = select(SYSLOG); $| = 1; select($old);
++ $connected = 1;
++}
++
++sub disconnect {
++ close SYSLOG;
++ $connected = 0;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/tainted.pl perl-5.16.3/lib/tainted.pl
+--- perl-5.16.3-orig/lib/tainted.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/tainted.pl 2016-08-18 10:07:06.670441259 +0200
+@@ -0,0 +1,9 @@
++# This subroutine returns true if its argument is tainted, false otherwise.
++
++sub tainted {
++ local($@);
++ eval { kill 0 * $_[0] };
++ $@ =~ /^Insecure/;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/termcap.pl perl-5.16.3/lib/termcap.pl
+--- perl-5.16.3-orig/lib/termcap.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/termcap.pl 2016-08-18 10:07:06.678441224 +0200
+@@ -0,0 +1,178 @@
++;# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $
++#
++# This library is no longer being maintained, and is included for backward
++# compatibility with Perl 4 programs which may require it.
++#
++# In particular, this should not be used as an example of modern Perl
++# programming techniques.
++#
++# Suggested alternative: Term::Cap
++#
++;#
++;# Usage:
++;# require 'ioctl.pl';
++;# ioctl(TTY,$TIOCGETP,$foo);
++;# ($ispeed,$ospeed) = unpack('cc',$foo);
++;# require 'termcap.pl';
++;# &Tgetent('vt100'); # sets $TC{'cm'}, etc.
++;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE');
++;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE');
++;#
++sub Tgetent {
++ local($TERM) = @_;
++ local($TERMCAP,$_,$entry,$loop,$field);
++
++ # warn "Tgetent: no ospeed set" unless $ospeed;
++ foreach $key (keys %TC) {
++ delete $TC{$key};
++ }
++ $TERM = $ENV{'TERM'} unless $TERM;
++ $TERM =~ s/(\W)/\\$1/g;
++ $TERMCAP = $ENV{'TERMCAP'};
++ $TERMCAP = '/etc/termcap' unless $TERMCAP;
++ if ($TERMCAP !~ m:^/:) {
++ if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
++ $TERMCAP = '/etc/termcap';
++ }
++ }
++ if ($TERMCAP =~ m:^/:) {
++ $entry = '';
++ do {
++ $loop = "
++ open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\";
++ while (<TERMCAP>) {
++ next if /^#/;
++ next if /^\t/;
++ if (/(^|\\|)${TERM}[:\\|]/) {
++ chop;
++ while (chop eq '\\\\') {
++ \$_ .= <TERMCAP>;
++ chop;
++ }
++ \$_ .= ':';
++ last;
++ }
++ }
++ close TERMCAP;
++ \$entry .= \$_;
++ ";
++ eval $loop;
++ } while s/:tc=([^:]+):/:/ && ($TERM = $1);
++ $TERMCAP = $entry;
++ }
++
++ foreach $field (split(/:[\s:\\]*/,$TERMCAP)) {
++ if ($field =~ /^\w\w$/) {
++ $TC{$field} = 1;
++ }
++ elsif ($field =~ /^(\w\w)#(.*)/) {
++ $TC{$1} = $2 if $TC{$1} eq '';
++ }
++ elsif ($field =~ /^(\w\w)=(.*)/) {
++ $entry = $1;
++ $_ = $2;
++ s/\\E/\033/g;
++ s/\\(200)/pack('c',0)/eg; # NUL character
++ s/\\(0\d\d)/pack('c',oct($1))/eg; # octal
++ s/\\(0x[0-9A-Fa-f][0-9A-Fa-f])/pack('c',hex($1))/eg; # hex
++ s/\\(\d\d\d)/pack('c',$1 & 0177)/eg;
++ s/\\n/\n/g;
++ s/\\r/\r/g;
++ s/\\t/\t/g;
++ s/\\b/\b/g;
++ s/\\f/\f/g;
++ s/\\\^/\377/g;
++ s/\^\?/\177/g;
++ s/\^(.)/pack('c',ord($1) & 31)/eg;
++ s/\\(.)/$1/g;
++ s/\377/^/g;
++ $TC{$entry} = $_ if $TC{$entry} eq '';
++ }
++ }
++ $TC{'pc'} = "\0" if $TC{'pc'} eq '';
++ $TC{'bc'} = "\b" if $TC{'bc'} eq '';
++}
++
++@Tputs = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2);
++
++sub Tputs {
++ local($string,$affcnt,$FH) = @_;
++ local($ms);
++ if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
++ $ms = $1;
++ $ms *= $affcnt if $2;
++ $string = $3;
++ $decr = $Tputs[$ospeed];
++ if ($decr > .1) {
++ $ms += $decr / 2;
++ $string .= $TC{'pc'} x ($ms / $decr);
++ }
++ }
++ print $FH $string if $FH;
++ $string;
++}
++
++sub Tgoto {
++ local($string) = shift(@_);
++ local($result) = '';
++ local($after) = '';
++ local($code,$tmp) = @_;
++ local(@tmp);
++ @tmp = ($tmp,$code);
++ local($online) = 0;
++ while ($string =~ /^([^%]*)%(.)(.*)/) {
++ $result .= $1;
++ $code = $2;
++ $string = $3;
++ if ($code eq 'd') {
++ $result .= sprintf("%d",shift(@tmp));
++ }
++ elsif ($code eq '.') {
++ $tmp = shift(@tmp);
++ if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
++ if ($online) {
++ ++$tmp, $after .= $TC{'up'} if $TC{'up'};
++ }
++ else {
++ ++$tmp, $after .= $TC{'bc'};
++ }
++ }
++ $result .= sprintf("%c",$tmp);
++ $online = !$online;
++ }
++ elsif ($code eq '+') {
++ $result .= sprintf("%c",shift(@tmp)+ord($string));
++ $string = substr($string,1,99);
++ $online = !$online;
++ }
++ elsif ($code eq 'r') {
++ ($code,$tmp) = @tmp;
++ @tmp = ($tmp,$code);
++ $online = !$online;
++ }
++ elsif ($code eq '>') {
++ ($code,$tmp,$string) = unpack("CCa99",$string);
++ if ($tmp[$[] > $code) {
++ $tmp[$[] += $tmp;
++ }
++ }
++ elsif ($code eq '2') {
++ $result .= sprintf("%02d",shift(@tmp));
++ $online = !$online;
++ }
++ elsif ($code eq '3') {
++ $result .= sprintf("%03d",shift(@tmp));
++ $online = !$online;
++ }
++ elsif ($code eq 'i') {
++ ($code,$tmp) = @tmp;
++ @tmp = ($code+1,$tmp+1);
++ }
++ else {
++ return "OOPS";
++ }
++ }
++ $result . $string . $after;
++}
++
++1;
+diff -ENwbur perl-5.16.3-orig/lib/timelocal.pl perl-5.16.3/lib/timelocal.pl
+--- perl-5.16.3-orig/lib/timelocal.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/timelocal.pl 2016-08-18 10:07:06.689441175 +0200
+@@ -0,0 +1,18 @@
++;# timelocal.pl
++;#
++;# Usage:
++;# $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
++;# $time = timegm($sec,$min,$hours,$mday,$mon,$year);
++
++;# This file has been superseded by the Time::Local library module.
++;# It is implemented as a call to that module for backwards compatibility
++;# with code written for perl4; new code should use Time::Local directly.
++
++;# The current implementation shares with the original the questionable
++;# behavior of defining the timelocal() and timegm() functions in the
++;# namespace of whatever package was current when the first instance of
++;# C<require 'timelocal.pl';> was executed in a program.
++
++use Time::Local;
++
++*timelocal::cheat = \&Time::Local::cheat;
+diff -ENwbur perl-5.16.3-orig/lib/validate.pl perl-5.16.3/lib/validate.pl
+--- perl-5.16.3-orig/lib/validate.pl 1970-01-01 01:00:00.000000000 +0100
++++ perl-5.16.3/lib/validate.pl 2016-08-18 10:07:06.696441144 +0200
+@@ -0,0 +1,102 @@
++;# The validate routine takes a single multiline string consisting of
++;# lines containing a filename plus a file test to try on it. (The
++;# file test may also be a 'cd', causing subsequent relative filenames
++;# to be interpreted relative to that directory.) After the file test
++;# you may put '|| die' to make it a fatal error if the file test fails.
++;# The default is '|| warn'. The file test may optionally have a ! prepended
++;# to test for the opposite condition. If you do a cd and then list some
++;# relative filenames, you may want to indent them slightly for readability.
++;# If you supply your own "die" or "warn" message, you can use $file to
++;# interpolate the filename.
++
++;# Filetests may be bunched: -rwx tests for all of -r, -w and -x.
++;# Only the first failed test of the bunch will produce a warning.
++
++;# The routine returns the number of warnings issued.
++
++;# Usage:
++;# require "validate.pl";
++;# $warnings += do validate('
++;# /vmunix -e || die
++;# /boot -e || die
++;# /bin cd
++;# csh -ex
++;# csh !-ug
++;# sh -ex
++;# sh !-ug
++;# /usr -d || warn "What happened to $file?\n"
++;# ');
++
++sub validate {
++ local($file,$test,$warnings,$oldwarnings);
++ foreach $check (split(/\n/,$_[0])) {
++ next if $check =~ /^#/;
++ next if $check =~ /^$/;
++ ($file,$test) = split(' ',$check,2);
++ if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) {
++ $testlist = $2;
++ @testlist = split(//,$testlist);
++ }
++ else {
++ @testlist = ('Z');
++ }
++ $oldwarnings = $warnings;
++ foreach $one (@testlist) {
++ $this = $test;
++ $this =~ s/(-\w\b)/$1 \$file/g;
++ $this =~ s/-Z/-$one/;
++ $this .= ' || warn' unless $this =~ /\|\|/;
++ $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || do valmess('$2','$1')/;
++ $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g;
++ eval $this;
++ last if $warnings > $oldwarnings;
++ }
++ }
++ $warnings;
++}
++
++sub valmess {
++ local($disposition,$this) = @_;
++ $file = $cwd . '/' . $file unless $file =~ m|^/|;
++ if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
++ $neg = $1;
++ $tmp = $2;
++ $tmp eq 'r' && ($mess = "$file is not readable by uid $>.");
++ $tmp eq 'w' && ($mess = "$file is not writable by uid $>.");
++ $tmp eq 'x' && ($mess = "$file is not executable by uid $>.");
++ $tmp eq 'o' && ($mess = "$file is not owned by uid $>.");
++ $tmp eq 'R' && ($mess = "$file is not readable by you.");
++ $tmp eq 'W' && ($mess = "$file is not writable by you.");
++ $tmp eq 'X' && ($mess = "$file is not executable by you.");
++ $tmp eq 'O' && ($mess = "$file is not owned by you.");
++ $tmp eq 'e' && ($mess = "$file does not exist.");
++ $tmp eq 'z' && ($mess = "$file does not have zero size.");
++ $tmp eq 's' && ($mess = "$file does not have non-zero size.");
++ $tmp eq 'f' && ($mess = "$file is not a plain file.");
++ $tmp eq 'd' && ($mess = "$file is not a directory.");
++ $tmp eq 'l' && ($mess = "$file is not a symbolic link.");
++ $tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO).");
++ $tmp eq 'S' && ($mess = "$file is not a socket.");
++ $tmp eq 'b' && ($mess = "$file is not a block special file.");
++ $tmp eq 'c' && ($mess = "$file is not a character special file.");
++ $tmp eq 'u' && ($mess = "$file does not have the setuid bit set.");
++ $tmp eq 'g' && ($mess = "$file does not have the setgid bit set.");
++ $tmp eq 'k' && ($mess = "$file does not have the sticky bit set.");
++ $tmp eq 'T' && ($mess = "$file is not a text file.");
++ $tmp eq 'B' && ($mess = "$file is not a binary file.");
++ if ($neg eq '!') {
++ $mess =~ s/ is not / should not be / ||
++ $mess =~ s/ does not / should not / ||
++ $mess =~ s/ not / /;
++ }
++ print STDERR $mess,"\n";
++ }
++ else {
++ $this =~ s/\$file/'$file'/g;
++ print STDERR "Can't do $this.\n";
++ }
++ if ($disposition eq 'die') { exit 1; }
++ ++$warnings;
++}
++
++1;
diff --git a/SOURCES/perl-5.16.3-File-Glob-Dup-glob-state-in-CLONE.patch b/SOURCES/perl-5.16.3-File-Glob-Dup-glob-state-in-CLONE.patch
new file mode 100644
index 0000000..a26b585
--- /dev/null
+++ b/SOURCES/perl-5.16.3-File-Glob-Dup-glob-state-in-CLONE.patch
@@ -0,0 +1,177 @@
+From faa03ffb8ccbf754d38d041570fcf2ce8816f36b Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Petr=20=C5=A0abata?= <contyk@redhat.com>
+Date: Wed, 2 Sep 2015 16:24:58 +0200
+Subject: [PATCH] File::Glob: Dup glob state in CLONE()
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+File::Glob: Dup glob state in CLONE()
+
+This solves [perl #119897] and [perl #117823], and restores the
+behavior of glob() in conjunction with threads of 5.14 and older.
+
+Since 5.16, code that used glob() inside a thread had been
+unintentionally sharing state between threads, which lead to things
+like this crashing and failing assertions:
+
+./perl -Ilib -Mthreads -e 'scalar glob("*"); threads->create(sub { glob("*") })->join();'
+
+Signed-off-by: Petr Šabata <contyk@redhat.com>
+---
+ MANIFEST | 1 +
+ ext/File-Glob/Glob.xs | 33 ++++++++++++++++++++++
+ ext/File-Glob/t/threads.t | 71 +++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 105 insertions(+)
+ create mode 100644 ext/File-Glob/t/threads.t
+
+diff --git a/MANIFEST b/MANIFEST
+index 181bb3f..9771022 100644
+--- a/MANIFEST
++++ b/MANIFEST
+@@ -3683,6 +3683,7 @@ ext/File-Glob/t/global.t See if File::Glob works
+ ext/File-Glob/TODO File::Glob extension todo list
+ ext/File-Glob/t/rt114984.t See if File::Glob works
+ ext/File-Glob/t/taint.t See if File::Glob works
++ext/File-Glob/t/threads.t See if File::Glob + threads works
+ ext/GDBM_File/GDBM_File.pm GDBM extension Perl module
+ ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines
+ ext/GDBM_File/hints/sco.pl Hint for GDBM_File for named architecture
+diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs
+index d74e7a4..6c69aa6 100644
+--- a/ext/File-Glob/Glob.xs
++++ b/ext/File-Glob/Glob.xs
+@@ -9,6 +9,9 @@
+ #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
+
+ typedef struct {
++#ifdef USE_ITHREADS
++ tTHX interp;
++#endif
+ int x_GLOB_ERROR;
+ HV * x_GLOB_ENTRIES;
+ } my_cxt_t;
+@@ -380,6 +383,33 @@ PPCODE:
+ iterate(aTHX_ doglob_iter_wrapper);
+ SPAGAIN;
+
++#ifdef USE_ITHREADS
++
++void
++CLONE(...)
++INIT:
++ HV *glob_entries_clone = NULL;
++CODE:
++ PERL_UNUSED_ARG(items);
++ {
++ dMY_CXT;
++ if ( MY_CXT.x_GLOB_ENTRIES ) {
++ CLONE_PARAMS param;
++ param.stashes = NULL;
++ param.flags = 0;
++ param.proto_perl = MY_CXT.interp;
++
++ glob_entries_clone = MUTABLE_HV(sv_dup_inc((SV*)MY_CXT.x_GLOB_ENTRIES, ¶m));
++ }
++ }
++ {
++ MY_CXT_CLONE;
++ MY_CXT.x_GLOB_ENTRIES = glob_entries_clone;
++ MY_CXT.interp = aTHX;
++ }
++
++#endif
++
+ BOOT:
+ {
+ #ifndef PERL_EXTERNAL_GLOB
+@@ -394,6 +424,9 @@ BOOT:
+ {
+ dMY_CXT;
+ MY_CXT.x_GLOB_ENTRIES = NULL;
++#ifdef USE_ITHREADS
++ MY_CXT.interp = aTHX;
++#endif
+ }
+ }
+
+diff --git a/ext/File-Glob/t/threads.t b/ext/File-Glob/t/threads.t
+new file mode 100644
+index 0000000..141450a
+--- /dev/null
++++ b/ext/File-Glob/t/threads.t
+@@ -0,0 +1,71 @@
++#!./perl
++
++BEGIN {
++ chdir 't' if -d 't';
++ @INC = '../lib';
++ require Config; import Config;
++ if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
++ print "1..0\n";
++ exit 0;
++ }
++}
++use strict;
++use warnings;
++# Test::More needs threads pre-loaded
++use if $Config{useithreads}, 'threads';
++use Test::More;
++
++BEGIN {
++ if (! $Config{'useithreads'}) {
++ plan skip_all => "Perl not compiled with 'useithreads'";
++ }
++}
++
++use File::Temp qw(tempdir);
++use File::Spec qw();
++use File::Glob qw(csh_glob);
++
++my($dir) = tempdir(CLEANUP => 1)
++ or die "Could not create temporary directory";
++
++my @temp_files = qw(1_file 2_file 3_file);
++for my $file (@temp_files) {
++ open my $fh, ">", File::Spec->catfile($dir, $file)
++ or die "Could not create file $dir/$file: $!";
++ close $fh;
++}
++my $cwd = Cwd::cwd();
++chdir $dir
++ or die "Could not chdir to $dir: $!";
++
++sub do_glob { scalar csh_glob("*") }
++# Stablish some glob state
++my $first_file = do_glob();
++is($first_file, $temp_files[0]);
++
++my @files;
++push @files, threads->create(\&do_glob)->join() for 1..5;
++is_deeply(
++ \@files,
++ [($temp_files[1]) x 5],
++ "glob() state is cloned for new threads"
++);
++
++@files = threads->create({'context' => 'list'},
++ sub {
++ return do_glob(), threads->create(\&do_glob)->join()
++ })->join();
++
++is_deeply(
++ \@files,
++ [@temp_files[1,2]],
++ "..and for new threads inside threads"
++);
++
++my $second_file = do_glob();
++is($second_file, $temp_files[1], "state doesn't leak from threads");
++
++chdir $cwd
++ or die "Could not chdir back to $cwd: $!";
++
++done_testing;
+--
+2.4.3
+
diff --git a/SOURCES/perl-5.16.3-Fix-incorrect-handling-of-CRLF-in-Net-FTP.patch b/SOURCES/perl-5.16.3-Fix-incorrect-handling-of-CRLF-in-Net-FTP.patch
new file mode 100644
index 0000000..eadad5b
--- /dev/null
+++ b/SOURCES/perl-5.16.3-Fix-incorrect-handling-of-CRLF-in-Net-FTP.patch
@@ -0,0 +1,38 @@
+From 7c8b0c1259db2bdd372cc1bdb63bf5b89a969a4a Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
+Date: Tue, 27 Oct 2015 16:33:43 +0100
+Subject: [PATCH] Fix incorrect handling of CRLF in Net::FTP
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+libnet upstream commit ported to perl-5.16.3:
+
+From 24eb8619451c3d8529d903d9133d03a7f447488f Mon Sep 17 00:00:00 2001
+From: Steve Hay <steve.m.hay@googlemail.com>
+Date: Fri, 3 Jan 2014 17:41:55 +0000
+Subject: [PATCH] Fix incorrect handling of CRLF in Net::FTP
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ cpan/libnet/Net/FTP/A.pm | 4 ++--
+ 1 file changed, 2 insertions(+), 2 deletions(-)
+
+diff --git a/cpan/libnet/Net/FTP/A.pm b/cpan/libnet/Net/FTP/A.pm
+index 427d02b..886d252 100644
+--- a/cpan/libnet/Net/FTP/A.pm
++++ b/cpan/libnet/Net/FTP/A.pm
+@@ -77,8 +77,8 @@ sub write {
+ my $timeout = @_ ? shift: $data->timeout;
+
+ my $nr = (my $tmp = substr($buf, 0, $size)) =~ tr/\r\n/\015\012/;
+- $tmp =~ s/([^\015])\012/$1\015\012/sg if $nr;
+- $tmp =~ s/^\012/\015\012/ unless ${*$data}{'net_ftp_outcr'};
++ $tmp =~ s/(?<!\015)\012/\015\012/sg if $nr;
++ $tmp =~ s/^\015// if ${*$data}{'net_ftp_outcr'};
+ ${*$data}{'net_ftp_outcr'} = substr($tmp, -1) eq "\015";
+
+ # If the remote server has closed the connection we will be signal'd
+--
+2.4.3
+
diff --git a/SOURCES/perl-5.16.3-Properly-duplicate-PerlIO-encoding-objects.patch b/SOURCES/perl-5.16.3-Properly-duplicate-PerlIO-encoding-objects.patch
new file mode 100644
index 0000000..b75ad1e
--- /dev/null
+++ b/SOURCES/perl-5.16.3-Properly-duplicate-PerlIO-encoding-objects.patch
@@ -0,0 +1,154 @@
+From a1e8f04634112d64383f0079421cf9cf5a154c0e Mon Sep 17 00:00:00 2001
+From: Vincent Pit <perl@profvince.com>
+Date: Fri, 28 Aug 2015 14:17:00 -0300
+Subject: [PATCH] Properly duplicate PerlIO::encoding objects
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Upstream commit ported to 5.16.3:
+
+commit 0ee3fa26f660ac426e3e082f77d806c9d1471f93
+Author: Vincent Pit <perl@profvince.com>
+Date: Fri Aug 28 14:17:00 2015 -0300
+
+ Properly duplicate PerlIO::encoding objects
+
+ PerlIO::encoding objects are usually initialized by calling Perl methods,
+ essentially from the pushed() and getarg() callbacks. During cloning, the
+ PerlIO API will by default call these methods to initialize the duplicate
+ struct when the PerlIOBase parent struct is itself duplicated. This does
+ not behave so well because the perl interpreter is not ready to call
+ methods at this point, for the stacks are not set up yet.
+
+ The proper way to duplicate the PerlIO::encoding object is to call sv_dup()
+ on its members from the dup() PerlIO callback. So the only catch is to make
+ the getarg() and pushed() calls implied by the duplication of the underlying
+ PerlIOBase object aware that they are called during cloning, and make them
+ wait that the control flow returns to the dup() callback. Fortunately,
+ getarg() knows since its param argument is then non-null, and its return
+ value is passed immediately to pushed(), so it is enough to tag this
+ returned value with a custom magic so that pushed() can see it is being
+ called during cloning.
+
+ This fixes [RT #31923].
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ MANIFEST | 1 +
+ ext/PerlIO-encoding/encoding.xs | 25 +++++++++++++++++++++++--
+ ext/PerlIO-encoding/t/threads.t | 35 +++++++++++++++++++++++++++++++++++
+ 3 files changed, 59 insertions(+), 2 deletions(-)
+ create mode 100644 ext/PerlIO-encoding/t/threads.t
+
+diff --git a/MANIFEST b/MANIFEST
+index 02e8234..5caa981 100644
+--- a/MANIFEST
++++ b/MANIFEST
+@@ -3791,6 +3791,7 @@ ext/PerlIO-encoding/MANIFEST PerlIO::encoding list of files
+ ext/PerlIO-encoding/t/encoding.t See if PerlIO encoding conversion works
+ ext/PerlIO-encoding/t/fallback.t See if PerlIO fallbacks work
+ ext/PerlIO-encoding/t/nolooping.t Tests for PerlIO::encoding
++ext/PerlIO-encoding/t/threads.t Tests PerlIO::encoding and threads
+ ext/PerlIO-mmap/mmap.pm PerlIO layer for memory maps
+ ext/PerlIO-mmap/mmap.xs PerlIO layer for memory maps
+ ext/PerlIO-scalar/scalar.pm PerlIO layer for scalars
+diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs
+index 98d89e9..d5efb62 100644
+--- a/ext/PerlIO-encoding/encoding.xs
++++ b/ext/PerlIO-encoding/encoding.xs
+@@ -49,13 +49,23 @@ typedef struct {
+
+ #define NEEDS_LINES 1
+
++static const MGVTBL PerlIOEncode_tag = { 0, 0, 0, 0, 0, 0, 0, 0 };
++
+ SV *
+ PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
+ {
+ PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
+- SV *sv = &PL_sv_undef;
+- PERL_UNUSED_ARG(param);
++ SV *sv;
+ PERL_UNUSED_ARG(flags);
++ /* During cloning, return an undef token object so that _pushed() knows
++ * that it should not call methods and wait for _dup() to actually dup the
++ * encoding object. */
++ if (param) {
++ sv = newSV(0);
++ sv_magicext(sv, NULL, PERL_MAGIC_ext, &PerlIOEncode_tag, 0, 0);
++ return sv;
++ }
++ sv = &PL_sv_undef;
+ if (e->enc) {
+ dSP;
+ /* Not 100% sure stack swap is right thing to do during dup ... */
+@@ -86,6 +96,14 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *
+ IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv,tab);
+ SV *result = Nullsv;
+
++ if (SvTYPE(arg) >= SVt_PVMG
++ && mg_findext(arg, PERL_MAGIC_ext, &PerlIOEncode_tag)) {
++ e->enc = NULL;
++ e->chk = NULL;
++ e->inEncodeCall = 0;
++ return code;
++ }
++
+ PUSHSTACKi(PERLSI_MAGIC);
+ SPAGAIN;
+
+@@ -558,6 +576,9 @@ PerlIOEncode_dup(pTHX_ PerlIO * f, PerlIO * o,
+ if (oe->enc) {
+ fe->enc = PerlIO_sv_dup(aTHX_ oe->enc, params);
+ }
++ if (oe->chk) {
++ fe->chk = PerlIO_sv_dup(aTHX_ oe->chk, params);
++ }
+ }
+ return f;
+ }
+diff --git a/ext/PerlIO-encoding/t/threads.t b/ext/PerlIO-encoding/t/threads.t
+new file mode 100644
+index 0000000..64f0e55
+--- /dev/null
++++ b/ext/PerlIO-encoding/t/threads.t
+@@ -0,0 +1,35 @@
++#!perl
++
++use strict;
++use warnings;
++
++BEGIN {
++ use Config;
++ if ($Config{extensions} !~ /\bEncode\b/) {
++ print "1..0 # Skip: no Encode\n";
++ exit 0;
++ }
++ unless ($Config{useithreads}) {
++ print "1..0 # Skip: no threads\n";
++ exit 0;
++ }
++}
++
++use threads;
++
++use Test::More tests => 3 + 1;
++
++binmode *STDOUT, ':encoding(UTF-8)';
++
++SKIP: {
++ local $@;
++ my $ret = eval {
++ my $thread = threads->create(sub { pass 'in thread'; return 1 });
++ skip 'test thread could not be spawned' => 3 unless $thread;
++ $thread->join;
++ };
++ is $@, '', 'thread did not croak';
++ is $ret, 1, 'thread returned the right value';
++}
++
++pass 'passes at least one test';
+--
+2.5.5
+
diff --git a/SOURCES/perl-5.20.3-Don-t-leak-the-temp-utf8-copy-of-n.patch b/SOURCES/perl-5.20.3-Don-t-leak-the-temp-utf8-copy-of-n.patch
new file mode 100644
index 0000000..811584a
--- /dev/null
+++ b/SOURCES/perl-5.20.3-Don-t-leak-the-temp-utf8-copy-of-n.patch
@@ -0,0 +1,33 @@
+From 8d89c0509dd5eb1de58dc6617f6e08599eb24792 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Mon, 10 Aug 2015 13:37:26 +0100
+Subject: [PATCH] [PATCH] [perl #123786] don't leak the temp utf8 copy of
+ namepv
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ pad.c | 4 +++-
+ 1 file changed, 3 insertions(+), 1 deletion(-)
+
+diff --git a/pad.c b/pad.c
+index fed2892..f22c3c5 100644
+--- a/pad.c
++++ b/pad.c
+@@ -976,8 +976,10 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
+
+ if (is_utf8)
+ flags |= padadd_UTF8_NAME;
+- else
++ else {
+ flags &= ~padadd_UTF8_NAME;
++ SAVEFREEPV(namepv);
++ }
+ }
+
+ offset = pad_findlex(namepv, namelen, flags,
+--
+2.4.3
+
diff --git a/SPECS/perl.spec b/SPECS/perl.spec
index 6be225d..ecf67b0 100644
--- a/SPECS/perl.spec
+++ b/SPECS/perl.spec
@@ -31,7 +31,7 @@
Name: perl
Version: %{perl_version}
# release number must be even higher, because dual-lived modules will be broken otherwise
-Release: 286%{?dist}
+Release: 291%{?dist}
Epoch: %{perl_epoch}
Summary: Practical Extraction and Report Language
Group: Development/Languages
@@ -151,6 +151,24 @@ Patch32: perl-5.16.3-t-op-taint.t-Perform-SHA-256-algorithm-by-crypt-if-d
# in upstream after 5.19.1
Patch33: perl-5.16.3-Benchmark.t-remove-CPU-speed-sensitive-test.patch
+# Make File::Glob work with threads again, bug #1223045
+# RT#119897, in upstream after 5.19.5
+Patch34: perl-5.16.3-File-Glob-Dup-glob-state-in-CLONE.patch
+
+# Fix CRLF conversion in ASCII FTP upload, bug #1263734, CPAN RT#41642
+Patch35: perl-5.16.3-Fix-incorrect-handling-of-CRLF-in-Net-FTP.patch
+
+# Don't leak the temp utf8 copy of namepv, bug #1063330, CPAN RT#123786
+Patch36: perl-5.20.3-Don-t-leak-the-temp-utf8-copy-of-n.patch
+
+# Fix duplicating PerlIO::encoding when spawning threads, bug #1344749,
+# RT#31923, in upstream after 5.23.3
+Patch37: perl-5.16.3-Properly-duplicate-PerlIO-encoding-objects.patch
+
+# Backported libraries historically supplied with Perl 4 from Perl 5.10.1.
+# It is used as a workaround before adding perl-Perl4-CoreLibs to RHEL 7
+Patch38: Backport-Perl4-CoreLibs.patch
+
# Update some of the bundled modules
# see http://fedoraproject.org/wiki/Perl/perl.spec for instructions
@@ -183,42 +201,10 @@ Provides: perl(:WITH_LARGEFILES)
# PerlIO provides
Provides: perl(:WITH_PERLIO)
# File provides
-Provides: perl(abbrev.pl)
-Provides: perl(assert.pl)
-Provides: perl(bigfloat.pl)
-Provides: perl(bigint.pl)
-Provides: perl(bigrat.pl)
Provides: perl(bytes_heavy.pl)
-Provides: perl(cacheout.pl)
-Provides: perl(complete.pl)
-Provides: perl(ctime.pl)
-Provides: perl(dotsh.pl)
Provides: perl(dumpvar.pl)
-Provides: perl(exceptions.pl)
-Provides: perl(fastcwd.pl)
-Provides: perl(find.pl)
-Provides: perl(finddepth.pl)
-Provides: perl(flush.pl)
-Provides: perl(ftp.pl)
-Provides: perl(getcwd.pl)
-Provides: perl(getopt.pl)
-Provides: perl(getopts.pl)
-Provides: perl(hostname.pl)
-Provides: perl(importenv.pl)
-Provides: perl(look.pl)
-Provides: perl(newgetopt.pl)
-Provides: perl(open2.pl)
-Provides: perl(open3.pl)
Provides: perl(perl5db.pl)
-Provides: perl(pwd.pl)
-Provides: perl(shellwords.pl)
-Provides: perl(stat.pl)
-Provides: perl(syslog.pl)
-Provides: perl(tainted.pl)
-Provides: perl(termcap.pl)
-Provides: perl(timelocal.pl)
Provides: perl(utf8_heavy.pl)
-Provides: perl(validate.pl)
# suidperl isn't created by upstream since 5.12.0
Obsoletes: perl-suidperl <= 4:5.12.2
@@ -1390,6 +1376,61 @@ Parse::CPAN::Meta is a parser for META.yml files, based on the parser half of
YAML::Tiny.
%endif
+%package Perl4-CoreLibs
+Summary: Libraries historically supplied with Perl 4
+Version: 0.001
+Epoch: 0
+License: GPL+ or Artistic
+Group: Development/Libraries
+BuildArch: noarch
+Requires: %perl_compat
+Requires: perl(File::Find)
+Requires: perl(IPC::Open2)
+Requires: perl(IPC::Open3)
+Requires: perl(Socket)
+Requires: perl(Text::ParseWords) >= 3.25
+Requires: perl(Time::Local)
+Requires: perl(warnings::register)
+Provides: perl(abbrev.pl)
+Provides: perl(assert.pl)
+Provides: perl(bigfloat.pl)
+Provides: perl(bigint.pl)
+Provides: perl(bigrat.pl)
+Provides: perl(cacheout.pl)
+Provides: perl(complete.pl)
+Provides: perl(ctime.pl)
+Provides: perl(dotsh.pl)
+Provides: perl(exceptions.pl)
+Provides: perl(fastcwd.pl)
+Provides: perl(find.pl)
+Provides: perl(finddepth.pl)
+Provides: perl(flush.pl)
+Provides: perl(getcwd.pl)
+Provides: perl(getopt.pl)
+Provides: perl(getopts.pl)
+Provides: perl(hostname.pl)
+Provides: perl(importenv.pl)
+Provides: perl(look.pl)
+Provides: perl(newgetopt.pl)
+Provides: perl(open2.pl)
+Provides: perl(open3.pl)
+Provides: perl(pwd.pl)
+Provides: perl(shellwords.pl)
+Provides: perl(stat.pl)
+Provides: perl(syslog.pl)
+Provides: perl(tainted.pl)
+Provides: perl(termcap.pl)
+Provides: perl(timelocal.pl)
+Provides: perl(validate.pl)
+
+%description Perl4-CoreLibs
+This is a collection of .pl files that have historically been bundled with the
+Perl core and were removed from perl 5.16. These files should not be used by
+new code. Functionally, most have been directly superseded by modules in the
+Perl 5 style. This collection exists to support old Perl programs that
+predates satisfactory replacements.
+
+
%if %{dual_life} || %{rebuild_from_scratch}
%package Perl-OSType
Summary: Map Perl operating system names to generic types
@@ -1968,6 +2009,11 @@ tarball from perl.org.
%patch31 -p1
%patch32 -p1
%patch33 -p1
+%patch34 -p1
+%patch35 -p1
+%patch36 -p1
+%patch37 -p1
+%patch38 -p1
%if !%{defined perl_bootstrap}
# Local patch tracking
@@ -2003,6 +2049,11 @@ perl -x patchlevel.h \
'RHEL Patch31: Make *DBM_File desctructors thread-safe (RT#61912)' \
'RHEL Patch32: Use stronger algorithm needed for FIPS in t/op/taint.t (RT#123338)' \
'RHEL Patch33: Remove CPU-speed-sensitive test in Benchmark test' \
+ 'RHEL Patch34: Make File::Glob work with threads again' \
+ 'RHEL Patch35: Fix CRLF conversion in ASCII FTP upload (CPAN RT#41642)' \
+ 'RHEL Patch36: Do not leak the temp utf8 copy of namepv (CPAN RT#123786)' \
+ 'RHEL Patch37: Fix duplicating PerlIO::encoding when spawning threads (RT#31923)' \
+ 'RHEL Patch38: Backported libraries historically supplied with Perl 4' \
%{nil}
%endif
@@ -2708,6 +2759,40 @@ sed \
%exclude %{privlib}/Params/
%exclude %{_mandir}/man3/Params::Check*
+# Perl4-CoreLibs
+%exclude %{privlib}/abbrev.pl
+%exclude %{privlib}/assert.pl
+%exclude %{privlib}/bigfloat.pl
+%exclude %{privlib}/bigint.pl
+%exclude %{privlib}/bigrat.pl
+%exclude %{privlib}/cacheout.pl
+%exclude %{privlib}/complete.pl
+%exclude %{privlib}/ctime.pl
+%exclude %{privlib}/dotsh.pl
+%exclude %{privlib}/exceptions.pl
+%exclude %{privlib}/fastcwd.pl
+%exclude %{privlib}/find.pl
+%exclude %{privlib}/finddepth.pl
+%exclude %{privlib}/flush.pl
+%exclude %{privlib}/getcwd.pl
+%exclude %{privlib}/getopt.pl
+%exclude %{privlib}/getopts.pl
+%exclude %{privlib}/hostname.pl
+%exclude %{privlib}/importenv.pl
+%exclude %{privlib}/look.pl
+%exclude %{privlib}/newgetopt.pl
+%exclude %{privlib}/open2.pl
+%exclude %{privlib}/open3.pl
+%exclude %{privlib}/pwd.pl
+%exclude %{privlib}/shellwords.pl
+%exclude %{privlib}/stat.pl
+%exclude %{privlib}/syslog.pl
+%exclude %{privlib}/tainted.pl
+%exclude %{privlib}/termcap.pl
+%exclude %{privlib}/timelocal.pl
+%exclude %{privlib}/validate.pl
+
+
# Perl-OSType
%exclude %{privlib}/Perl/OSType.pm
%exclude %{_mandir}/man3/Perl::OSType.3pm*
@@ -3443,6 +3528,39 @@ sed \
%{_mandir}/man3/Parse::CPAN::Meta.3*
%endif
+%files Perl4-CoreLibs
+%{privlib}/abbrev.pl
+%{privlib}/assert.pl
+%{privlib}/bigfloat.pl
+%{privlib}/bigint.pl
+%{privlib}/bigrat.pl
+%{privlib}/cacheout.pl
+%{privlib}/complete.pl
+%{privlib}/ctime.pl
+%{privlib}/dotsh.pl
+%{privlib}/exceptions.pl
+%{privlib}/fastcwd.pl
+%{privlib}/find.pl
+%{privlib}/finddepth.pl
+%{privlib}/flush.pl
+%{privlib}/getcwd.pl
+%{privlib}/getopt.pl
+%{privlib}/getopts.pl
+%{privlib}/hostname.pl
+%{privlib}/importenv.pl
+%{privlib}/look.pl
+%{privlib}/newgetopt.pl
+%{privlib}/open2.pl
+%{privlib}/open3.pl
+%{privlib}/pwd.pl
+%{privlib}/shellwords.pl
+%{privlib}/stat.pl
+%{privlib}/syslog.pl
+%{privlib}/tainted.pl
+%{privlib}/termcap.pl
+%{privlib}/timelocal.pl
+%{privlib}/validate.pl
+
%if %{dual_life} || %{rebuild_from_scratch}
%files parent
%{privlib}/parent.pm
@@ -3685,6 +3803,23 @@ sed \
# Old changelog entries are preserved in CVS.
%changelog
+* Wed Aug 17 2016 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.16.3-291
+- Backported and sub-packaged libraries historically supplied with Perl 4
+ into perl-Perl4-CoreLibs
+
+* Tue Aug 16 2016 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.16.3-290
+- Removed deprecated files from provides (bug #1365991)
+
+* Mon Jun 13 2016 Petr Pisar <ppisar@redhat.com> - 4:5.16.3-289
+- Fix duplicating PerlIO::encoding when spawning threads (bug #1344749)
+
+* Wed Mar 02 2016 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.16.3-288
+- Fix CRLF conversion in ASCII FTP upload (bug #1263734)
+- Don't leak the temp utf8 copy of namepv (bug #1063330)
+
+* Wed Mar 02 2016 Petr Šabata <contyk@redhat.com> - 4:5.16.3-287
+- Make File::Glob work with threads again (bug #1223045)
+
* Thu Jul 02 2015 Petr Pisar <ppisar@redhat.com> - 4:5.16.3-286
- Remove CPU-speed-sensitive test in Benchmark test (bug #1238567)
- Rebuild with corrected binutils to fix systemtap support (bug #1238472)