Fix CPAN::FindDependencies under jcpan

src/main/java/org/perlonjava/runtime/perlmodule/ArchiveZip.java

@@ -1,6 +1,7 @@
 package org.perlonjava.runtime.perlmodule;
 
 import org.perlonjava.runtime.operators.ReferenceOperators;
+import org.perlonjava.runtime.regex.RuntimeRegex;
 import org.perlonjava.runtime.runtimetypes.*;
 
 import java.io.*;
@@ -562,22 +563,32 @@ public static RuntimeList membersMatching(RuntimeArray args, int ctx) {
         }
 
         RuntimeHash self = args.get(0).hashDeref();
-        String regex = args.get(1).toString();
+        RuntimeScalar regex = args.get(1);
+        if (regex.type == RuntimeScalarType.HASHREFERENCE) {
+            RuntimeScalar hashRegex = regex.hashDeref().get("regex");
+            if (hashRegex == null) {
+                return new RuntimeList();
+            }
+            regex = hashRegex;
+        }
         RuntimeArray members = getMembers(self);
 
         RuntimeList result = new RuntimeList();
         try {
-            java.util.regex.Pattern pattern = java.util.regex.Pattern.compile(regex);
             for (int i = 0; i < members.size(); i++) {
                 RuntimeHash member = members.get(i).hashDeref();
                 RuntimeScalar memberName = member.get("_name");
-                if (memberName != null && pattern.matcher(memberName.toString()).find()) {
+                if (memberName != null && RuntimeRegex.matchRegex(
+                        regex, memberName, RuntimeContextType.SCALAR).scalar().getBoolean()) {
                     result.add(members.get(i));
                 }
             }
         } catch (Exception e) {
             // Invalid regex, return empty list
         }
+        if (ctx == RuntimeContextType.SCALAR) {
+            return new RuntimeScalar(result.size()).getList();
+        }
         return result;
     }
 
@@ -1008,6 +1019,10 @@ public static RuntimeList contents(RuntimeArray args, int ctx) {
             }
 
             RuntimeScalar contents = member.get("_contents");
+            if (ctx == RuntimeContextType.SCALAR) {
+                return (contents != null ? contents : scalarUndef).getList();
+            }
+
             // Return (content, status) in list context
             RuntimeList result = new RuntimeList();
             result.add(contents != null ? contents : scalarUndef);

src/main/perl/lib/Archive/Tar.pm

@@ -291,17 +291,17 @@ sub _get_handle {
 
             ### different reader/writer modules, different error vars... sigh
             if( MODE_READ->($mode) ) {
-                $fh = IO::Uncompress::Bunzip2->new( $file, MultiStream => 1 ) or do {
+                $fh = Compress::Bzip2::bzopen( $file, 'rb' ) or do {
                     $self->_error( qq[Could not read '$file': ] .
-                        $IO::Uncompress::Bunzip2::Bunzip2Error
+                        $Compress::Bzip2::bzerrno
                     );
                     return;
                 };
 
             } else {
-                $fh = IO::Compress::Bzip2->new( $file ) or do {
+                $fh = Compress::Bzip2::bzopen( $file, 'wb' ) or do {
                     $self->_error( qq[Could not write to '$file': ] .
-                        $IO::Compress::Bzip2::Bzip2Error
+                        $Compress::Bzip2::bzerrno
                     );
                     return;
                 };

src/main/perl/lib/Archive/Tar/Constant.pm

@@ -75,8 +75,7 @@ use constant ZLIB           => do { !$ENV{'PERL5_AT_NO_ZLIB'} and
 
                             ### allow BZIP to be turned off using ENV: DEBUG only
 use constant BZIP           => do { !$ENV{'PERL5_AT_NO_BZIP'} and
-                                        eval { require IO::Uncompress::Bunzip2;
-                                               require IO::Compress::Bzip2; };
+                                        eval { require Compress::Bzip2; };
                                     $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1
                                 };
 

src/main/perl/lib/Archive/Zip/MemberRead.pm

@@ -0,0 +1,153 @@
+package Archive::Zip::MemberRead;
+
+use strict;
+use warnings;
+
+use Archive::Zip qw(:ERROR_CODES);
+
+our $VERSION = '1.68';
+
+my $nl = $^O eq 'MSWin32' ? "\r\n" : "\n";
+my $DEFAULT_BUFFER_SIZE = 32768;
+
+sub Archive::Zip::Member::readFileHandle {
+    return Archive::Zip::MemberRead->new(shift);
+}
+
+sub new {
+    my ($class, $zip, $file) = @_;
+    my $member;
+
+    if ($zip && $file) {
+        $member = ref($file) ? $file : $zip->memberNamed($file);
+    }
+    elsif ($zip && ref($zip)) {
+        $member = $zip;
+    }
+    else {
+        die 'Archive::Zip::MemberRead::new needs a zip and filename, zip and member, or member';
+    }
+
+    my $self = bless {}, $class;
+    $self->set_member($member);
+    return $self;
+}
+
+sub set_member {
+    my ($self, $member) = @_;
+    $self->{member} = $member;
+    $self->{contents} = defined $member ? $member->contents : '';
+    $self->rewind;
+}
+
+sub setLineEnd {
+    shift;
+    $nl = shift;
+}
+
+sub rewind {
+    my $self = shift;
+    $self->{offset} = 0;
+    $self->{line_no} = 0;
+    $self->{at_end} = 0;
+    delete $self->{buffer};
+}
+
+sub input_record_separator {
+    my $self = shift;
+    if (@_) {
+        $self->{sep} = shift;
+        $self->{sep_re} = _sep_as_re($self->{sep});
+    }
+    return exists $self->{sep} ? $self->{sep} : $/;
+}
+
+sub _sep_re {
+    my $self = shift;
+    return exists $self->{sep} ? $self->{sep_re} : _sep_as_re($/);
+}
+
+sub _sep_as_re {
+    my $sep = shift;
+    if (defined $sep) {
+        if ($sep eq '') {
+            return "(?:$nl){2,}";
+        }
+        else {
+            $sep =~ s/\n/$nl/og;
+            return quotemeta $sep;
+        }
+    }
+    return undef;
+}
+
+sub input_line_number {
+    my $self = shift;
+    return $self->{line_no};
+}
+
+sub close {
+    my $self = shift;
+    $self->rewind;
+}
+
+sub buffer_size {
+    my ($self, $size) = @_;
+    if (!$size) {
+        return $self->{chunkSize} || $DEFAULT_BUFFER_SIZE;
+    }
+    $self->{chunkSize} = $size;
+}
+
+sub getline {
+    my ($self, $argref) = @_;
+
+    my $size = $self->buffer_size;
+    my $sep = $self->_sep_re;
+
+    my $preserve_line_ending;
+    if (ref $argref eq 'HASH') {
+        $preserve_line_ending = $argref->{preserve_line_ending};
+        $sep =~ s/\\([^A-Za-z_0-9])+/$1/g if defined $sep;
+    }
+
+    while (1) {
+        if (defined($sep) && defined($self->{buffer}) && $self->{buffer} =~ s/^(.*?)$sep//s) {
+            my $line = $1;
+            $self->{line_no}++;
+            return $preserve_line_ending ? $line . $sep : $line;
+        }
+        elsif ($self->{at_end}) {
+            $self->{line_no}++ if $self->{buffer};
+            return delete $self->{buffer};
+        }
+
+        my $chunk;
+        my $read = $self->read($chunk, $size);
+        die 'ERROR: Error reading chunk from archive' unless defined $read;
+        $self->{at_end} = !$read;
+        $self->{buffer} .= $chunk if $read;
+    }
+}
+
+sub read {
+    my $self = $_[0];
+    my $size = $_[2];
+
+    return undef unless defined $self->{contents};
+    $size = 0 unless defined $size;
+
+    my $offset = $self->{offset} || 0;
+    my $available = length($self->{contents}) - $offset;
+    if ($available <= 0 || $size <= 0) {
+        $_[1] = '';
+        return 0;
+    }
+
+    my $bytes = $available < $size ? $available : $size;
+    $_[1] = substr($self->{contents}, $offset, $bytes);
+    $self->{offset} = $offset + $bytes;
+    return length($_[1]);
+}
+
+1;

src/main/perl/lib/CPAN/Config.pm

@@ -230,6 +230,34 @@ match:
 patches:
   - "Net-Server-2.018/Proto.pm.patch"
 YAML
+        'CPAN-FindDependencies.yml' => <<'YAML',
+---
+comment: |
+  PerlOnJava distroprefs for CPAN::FindDependencies.
+
+  CPAN::FindDependencies::MakeMaker uses fork/exec to run Makefile.PL
+  under a timeout while capturing output. PerlOnJava has no fork(), so
+  the helper either emits a TAP skip before tests run or execs Makefile.PL
+  in place and loses the parent process. Patch the helper to use a timed
+  subprocess when running under jperl.
+match:
+  distribution: "^DCANTRELL/CPAN-FindDependencies-3\\.13"
+patches:
+  - "CPAN-FindDependencies-3.13/MakeMaker.pm.patch"
+YAML
+    );
+    my %bundled_dd = (
+        'CPAN-FindDependencies.dd' => <<'DD',
+$VAR1 = {
+  'comment' => 'PerlOnJava distroprefs for CPAN::FindDependencies. Patch MakeMaker helper to avoid fork() under jperl.',
+  'match' => {
+    'distribution' => '^DCANTRELL/CPAN-FindDependencies-3\\.13'
+  },
+  'patches' => [
+    'CPAN-FindDependencies-3.13/MakeMaker.pm.patch'
+  ]
+};
+DD
     );
 
     # Create prefs directory if needed
@@ -256,6 +284,20 @@ YAML
             close $fh;
         }
     }
+    for my $file (keys %bundled_dd) {
+        my $dest = File::Spec->catfile($prefs_dir, $file);
+        if (-f $dest) {
+            open my $rfh, '<', $dest or next;
+            my $existing = do { local $/; <$rfh> };
+            close $rfh;
+            next unless $existing =~ /PerlOnJava/;
+            next if $existing eq $bundled_dd{$file};
+        }
+        if (open my $fh, '>', $dest) {
+            print $fh $bundled_dd{$file};
+            close $fh;
+        }
+    }
 }
 _bootstrap_prefs();
 
@@ -287,6 +329,39 @@ sub _bootstrap_patches {
 
      # Load just in time once explicitly invoked.
 PATCH
+    my $cpan_finddeps_makemaker_patch = <<'PATCH';
+--- lib/CPAN/FindDependencies/MakeMaker.pm.orig
++++ lib/CPAN/FindDependencies/MakeMaker.pm
+@@ -61,6 +61,28 @@ sub getreqs_from_mm {
+             return "Makefile.PL didn't finish in a reasonable time\n";
+         }
+     } else {
++        if ($Config{perlpath} =~ /(?:^|[\/\\])jperl(?:\.bat)?$/) {
++            my @cmd = ($Config{perlpath}, 'Makefile.PL');
++            unshift(@cmd, 'timeout', '10') unless $^O eq 'MSWin32';
++            my $status;
++            eval { capture { $status = system(@cmd); } };
++            if ($@) {
++                chdir($cwd);
++                return $@;
++            }
++
++            my $exit = defined($status) ? ($status >> 8) : -1;
++            if ($exit == 124) {
++                chdir($cwd);
++                return "Makefile.PL didn't finish in a reasonable time\n";
++            }
++
++            open($MKFH, 'Makefile') || warn "Can't read Makefile\n";
++            my $makefile_str = <$MKFH>;
++            close($MKFH);
++            chdir($cwd);
++            return _parse_makefile( $makefile_str );
++        }
+         # execute, suppressing noise ...
+         eval { capture {
+             if(my $pid = fork()) { # parent
+PATCH
 
     # Map: target path relative to $patches_dir  =>  source path inside the JAR
     # (or on-disk dev tree during `make`). The source is located via @INC.
@@ -298,34 +373,49 @@ PATCH
         [ 'Net-Server-2.018/Proto.pm.patch',
           undef,
           $net_server_proto_patch ],
+        [ 'CPAN-FindDependencies-3.13/MakeMaker.pm.patch',
+          undef,
+          $cpan_finddeps_makemaker_patch ],
     );
 
-    # Fast path: if every target exists, skip everything.
+    # Fast path: if every target exists and inline targets are current, skip everything.
     my $needs_write = 0;
     for my $pair (@bundled) {
-        my ($rel, undef) = @$pair;
+        my ($rel, undef, $inline_content) = @$pair;
         my $dest = File::Spec->catfile($patches_dir, $rel);
         unless (-f $dest) { $needs_write = 1; last }
+        if (defined $inline_content) {
+            open my $in, '<', $dest or do { $needs_write = 1; last };
+            my $existing = do { local $/; <$in> };
+            close $in;
+            if ($existing ne $inline_content) { $needs_write = 1; last }
+        }
     }
     return unless $needs_write;
 
     require File::Path;
     for my $pair (@bundled) {
         my ($rel, $src_rel, $inline_content) = @$pair;
         my $dest = File::Spec->catfile($patches_dir, $rel);
-        next if -f $dest;
-
         my $dest_dir = File::Spec->catpath('', (File::Spec->splitpath($dest))[0,1]);
         File::Path::make_path($dest_dir) unless -d $dest_dir;
 
         if (defined $inline_content) {
+            if (-f $dest) {
+                open my $in, '<', $dest or next;
+                my $existing = do { local $/; <$in> };
+                close $in;
+                next if $existing eq $inline_content;
+            }
             if (open my $out, '>', $dest) {
                 print $out $inline_content;
                 close $out;
             }
             next;
         }
 
+        next if -f $dest;
+
         # Locate the source file in @INC (finds either jar:PERL5LIB/… at
         # runtime or src/main/perl/lib/… during make/test).
         my $src;