use Time::HiRes;
use Module::CoreList;
+use CPAN::Perl::Releases;
use version;
use LWP::UserAgent;
select $old_fh;
}
-my $has_cpan_perl_releases;
-BEGIN {
- local $@;
- if (eval { require CPAN::Perl::Releases; 1 }) {
- print "Will use CPAN::Perl::Releases\n";
- $has_cpan_perl_releases = 1;
- }
-}
-
my %opts;
getopts('ft:m:', \%opts);
"$int$frac" => [ $num_version, $pretty_version ];
}
+my $latest_dev_rev = 21;
+
+sub perl_is_supported {
+ my $v = "$_[0]";
+
+ return unless $v >= '5.010001';
+
+ if ($v =~ /^5\.([0-9]{2}[13579])/) {
+ return $1 >= $latest_dev_rev;
+ }
+
+ return 1;
+}
+
my %perls = map key_version($_),
- grep "$_" >= '5.010001',
+ grep perl_is_supported($_),
keys %Module::CoreList::released;
{
sub perl_archive_for {
my $version = shift;
- my $path;
+ my $tarballs = CPAN::Perl::Releases::perl_tarballs($version);
+ my $path = $tarballs->{'tar.gz'};
+ die "Could not find the archive for perl $version" unless defined $path;
- if ($has_cpan_perl_releases) {
- my $tarballs = CPAN::Perl::Releases::perl_tarballs($version);
+ my ($file) = ($path =~ m{([^/]*)$});
- if (defined $tarballs) {
- $path = $tarballs->{'tar.gz'};
- }
- } else {
- my $uri = "http://search.cpan.org/dist/perl-$version";
-
- local $_;
- fetch_uri($uri => \$_);
-
- if (m{id/(([^/])/\2([^/])/\2\3[^/]*/perl-\Q$version\E\.tar\.(?:gz|bz2))}) {
- $path = $1;
- }
- }
-
- if (defined $path) {
- my ($file) = ($path =~ m{([^/]*)$});
- return "http://$cpan_mirror/authors/id/$path", $file;
- } else {
- die "Could not infer the archive for perl $version";
- }
+ return "http://$cpan_mirror/authors/id/$path", $file;
}
sub bandwidth {
}
my %manglers = (
- 'regcomp.c' => \&patch_regcomp,
- 'regexec.c' => \&patch_regexec,
+ 'dquote_static.c' => sub { $_[0] },
+ 'inline_invlist.c' => sub { $_[0] },
+ 'regcomp.c' => \&patch_regcomp,
+ 'regexec.c' => \&patch_regexec,
);
sub patch_source_file {
open my $out, '>', $dst or die "Can't open $dst for writing: $!";
while (defined(my $line = <$in>)) {
- print $out $mangler->($line, $dst);
+ my @lines = $mangler->($line, $dst);
+
+ for (@lines) {
+ s/\s*$/\n/; # Remove trailing whitespace
+ 1 while s/^( *)\t/$1 . (' ' x 8)/e; # Replace leading tabs by 8 spaces
+ s|^((?: )+) {0,3}([^ ])|(' ' x ((length $1) / 4)) . $2|e;
+ s/\t/ /g;
+ }
+
+ print $out @lines;
}
- my $patched_chunks = join ' ', @{$patched_chunks{$dst}};
- my $expected_chunks = join ' ', @{$expected_chunks{$file}};
+ my $patched_chunks = join ' ', @{$patched_chunks{$dst} || [ ]};
+ my $expected_chunks = join ' ', @{$expected_chunks{$file} || [ ]};
unless ($patched_chunks eq $expected_chunks) {
die "File $dst was not properly patched (got \"$patched_chunks\", expected \"$expected_chunks\")\n";
}