1package InstallPar; 2 3$unzip_cmd = 'unzip $dist -d $path'; 4$unzip_cmd = '7za x $dist -o$path -r' if ($^O eq 'MSWin32'); 5 6$DEBUG = 0; 7 8use Config; 9use File::Path; 10use File::Spec; 11use File::Temp; 12use Cwd; 13 14sub install_all 15{ 16 my (@jobs) = @_; 17 my ($job, $module, $version, $file); 18 19 foreach $job (@jobs) 20 { 21 next unless test(@$job); 22 unless ($file = find_file(@$job)) 23 { 24 warn "Can't find a PAR file for $job->[0] v$job->[1]"; 25 next; 26 } 27 install($job->[0], $file); 28 } 29} 30 31sub test 32{ 33 my ($module, $version) = @_; 34 35 if (eval "require $module") # installed 36 { 37 return 0 if (${"${module}::VERSION"} >= $version); 38 } 39 return 1; 40} 41 42sub find_file 43{ 44 my ($module, $version) = @_; 45 my ($fbase) = $module; 46 my (@res, $res); 47 48 $fbase =~ s|::|-|og; 49 $fbase .= "-$version-$Config::Config{archname}"; 50 @res = glob("$fbase*.par"); 51 $res = (grep {$_ eq "$fbase-$Config::Config{version}.par"} @res)[0]; 52 return $res if $res; 53 return $res[0] if ($res[0]); 54 55# try non binary modules 56 $fbase = $module; 57 $fbase =~ s/::/-/og; 58 @res = glob("$fbase-$version-noarch*.par"); 59 $res = (grep {$_ eq "$fbase-$Config::Config{version}.par"} @res)[0]; 60 return $res if $res; 61 return $res[0] if ($res[0]); 62} 63 64sub install 65{ 66 my ($module, $fname) = @_; 67 my ($cwd) = getcwd; 68 my ($dist, $tmpdir) = unzip_to_tmpdir($fname, 'blib'); 69 my ($name) = $module; 70 my ($rv); 71 72 $name =~ s|::|/|og; 73 74 if (-d 'script') 75 { 76 require ExtUtils::MY; 77 foreach my $file (glob("script/*")) 78 { 79 next unless -T $file; 80 if ($DEBUG) 81 { print STDERR "Scripting $file\n"; } 82 elsif ($^O eq 'MSWin32' && ! -f "$file.bat" && $file !~m/\.bat$/oi) 83 { system("pl2bat", $file); } 84 else 85 { ExtUtils::MY->fixin($file); } 86 chmod(0555, $file); 87 } 88 } 89 chdir('..'); 90 91 $name =~ s{::|-}{/}g; 92 require ExtUtils::Install; 93 94 if ($DEBUG) 95 { print STDERR "Installing $name from $fname in $tmpdir\n"; } 96 else 97 { $rv = ExtUtils::Install::install_default($name); } 98 99# elsif ($action eq 'uninstall') { 100# require Config; 101# $rv = ExtUtils::Install::uninstall( 102# "$Config::Config{installsitearch}/auto/$name/.packlist" 103# ); 104# } 105 106 chdir($cwd); 107 File::Path::rmtree([$tmpdir]); 108 return $rv; 109} 110 111sub uninstall 112{ 113 $rv = ExtUtils::Install::uninstall("$Config::Config{installsitearch}/auto/$name/.packlist"); 114} 115 116sub unzip_to_tmpdir 117{ 118 my ($dist, $subdir) = @_; 119 120 $dist = File::Spec->rel2abs($dist); 121 my $tmpdir = File::Temp::mkdtemp(File::Spec->catdir(File::Spec->tmpdir, "parXXXXX")) or die $!; 122 $tmpdir = File::Spec->catdir($tmpdir, $subdir) if defined $subdir; 123 unzip($dist, $tmpdir) || die "Can't unzip $dist to $tmpdir"; 124 chdir $tmpdir; 125 return ($dist, $tmpdir); 126} 127 128sub unzip 129{ 130 my ($dist, $path) = @_; 131 my ($failed); 132 return 0 unless -f $dist; 133 $path ||= File::Spec->curdir; 134 135 if (eval { require Archive::Zip; 1 }) 136 { 137 my (@members, $file, $m); 138 my $zip = Archive::Zip->new; 139 $SIG{__WARN__} = sub { print STDERR $_[0] unless $_[0] =~ /\bstat\b/ }; 140 unless ($zip->read($dist) == Archive::Zip::AZ_OK()) 141 { 142 $failed = 1; 143 last; 144 } 145 146 @members = $zip->members(); 147 foreach $m (@members) 148 { 149 $file = "$path/" . $m->fileName(); 150 151 $file = Archive::Zip::_asLocalName($file); 152 next if ($^O eq "MSWin32" && $file =~ m/::/o); 153 if ($m->extractToFileNamed($file) != AZ_OK) 154 { 155 $failed = 1; 156 last; 157 } 158 } 159 return 1; 160# $zip->extractTree('', "$path/") == Archive::Zip::AZ_OK()); # but with filtering 161 } 162 else 163 { $failed = 1; } 164# try using a system command 165 if ($failed && $unzip_cmd) 166 { 167 my ($cmd) = $unzip_cmd; 168 $cmd =~ s/\$([\w+])/$$1/oge; 169 print STDERR "$cmd\n" if ($DEBUG); 170 return 1 unless system($cmd); 171 } 172 return 0; 173} 174 1751; 176