File Coverage

blib/lib/Devel/PatchPerl/Plugin/Darwin/getcwd.pm
Criterion Covered Total %
statement 9 31 29.0
branch 0 14 0.0
condition n/a
subroutine 3 4 75.0
pod 0 1 0.0
total 12 50 24.0


line stmt bran cond sub pod time code
1             package Devel::PatchPerl::Plugin::Darwin::getcwd;
2 1     1   74417 use strict;
  1         3  
  1         28  
3 1     1   4 use warnings;
  1         2  
  1         38  
4              
5             our $VERSION = '0.001';
6              
7 1     1   394 use version;
  1         1638  
  1         6  
8              
9             sub patchperl {
10 0     0 0   my ($class, %argv) = @_;
11              
12 0 0         if ($^O ne "darwin") {
13 0           return 1; # OK
14             }
15 0           my $version = version->parse($argv{version});
16 0 0         if ($version >= v5.30.0) {
17 0           return 1; # OK
18             }
19              
20 0           my ($file) = grep -f, qw(
21             dist/PathTools/Cwd.pm
22             dist/Cwd/Cwd.pm
23             cpan/Cwd/Cwd.pm
24             lib/Cwd.pm
25             );
26 0 0         die "Missing Cwd.pm" if !$file;
27              
28 0           warn "patching $file\n";
29              
30 0           my $find = q[my $start = @_ ? shift : '.';];
31 0 0         open my $in, "<", $file or die;
32 0 0         open my $out, ">", "$file.tmp" or die;
33 0           while (my $l = <$in>) {
34 0           print {$out} $l;
  0            
35 0 0         if ($l =~ /\Q$find\E/) {
36 0           print {$out} q[ if ($start eq ".") { return _backtick_pwd() } # XXX patched by Devel-PatchPerl-Plugin-Darwin-getcwd], "\n";
  0            
37             }
38             }
39 0           close $in;
40 0           close $out;
41 0 0         rename "$file.tmp", $file or die "rename $!";
42 0           return 1;
43             }
44              
45              
46             1;
47             __END__