removed need of packdrake binary

6 files changed, 81 insertions, 31 deletions

diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index 46246aa2b..5e5cb3d03 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -427,7 +427,12 @@ sub insmod {
 	    $f = "/tmp/$_.o";
 	    my $cz = "/lib/modules" . (arch() eq 'sparc64' && "64") . ".cz"; -e $cz or $cz .= "2";
 	    if (-e $cz) {
-		run_program::run("packdrake -x $cz /tmp $_.o");
+		eval {
+		    require packdrake;
+		    my $packer = new packdrake($cz);
+		    $packer->extract_archive("/tmp", "$_.o");
+		};
+		#run_program::run("packdrake -x $cz /tmp $_.o");
 	    } elsif (-e "/lib/modules.cpio.bz2") {
 		run_program::run("cd /tmp ; bzip2 -cd /lib/modules.cpio.bz2 | cpio -i $_.o");
 	    } else {
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 7c8cd1d1f..6cee53a11 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -428,7 +428,7 @@ sub install_urpmi {
 		      http => $ENV{URLPREFIX},
 		      cdrom => "removable_cdrom_$::i://mnt/cdrom" }}{$method} . "/$_->{rpmsdir}";
 
-	local *FILES; open FILES, "packdrake -c /tmp/$_->{hdlist} | parsehdlist - |";
+	local *FILES; open FILES, "parsehdlist /tmp/$_->{hdlist} |";
 	chop, print LIST "$dir/$_\n" foreach <FILES>;
 	close FILES or log::l("parsehdlist failed"), return;
 	close LIST;
diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm
index 78f5a13e1..edf74e87e 100644
--- a/perl-install/keyboard.pm
+++ b/perl-install/keyboard.pm
@@ -256,7 +256,12 @@ sub xmodmap_file {
     my ($keyboard) = @_;
     my $f = "$ENV{SHARE_PATH}/xmodmap/xmodmap.$keyboard";
     if (! -e $f) {
-	run_program::run("packdrake", "-x", "$ENV{SHARE_PATH}/xmodmap.cz2", '/tmp', "xmodmap.$keyboard");
+	eval {
+	    require packdrake;
+	    my $packer = new packdrake("$ENV{SHARE_PATH}/xmodmap.cz2");
+	    $packer->extract_archive("/tmp", "xmodmap.$keyboard");
+	};
+	#run_program::run("packdrake", "-x", "$ENV{SHARE_PATH}/xmodmap.cz2", '/tmp', "xmodmap.$keyboard");
 	$f = "/tmp/xmodmap.$keyboard";
     }
     -e $f && $f;
@@ -272,9 +277,18 @@ sub setup {
 	load(scalar cat_($f));
     } else {
 	local *F;
-	open F, "packdrake -x $ENV{SHARE_PATH}/keymaps.cz2 '' $o->[1].bkmap |";
-	local $/ = undef;
-	eval { load(join('', <F>)) };
+	#open F, "packdrake -x $ENV{SHARE_PATH}/keymaps.cz2 '' $o->[1].bkmap |";
+	if (my $pid = open F, "-|") {
+	    local $/ = undef;
+	    eval { load(join('', <F>)) };
+	    waitpid $pid, 0;
+	} else {
+	    eval {
+		require packdrake;
+		my $packer = new packdrake("$ENV{SHARE_PATH}/keymaps.cz2");
+		$packer->extract_archive(undef, "$o->[1].bkmap");
+	    };
+	}
     }
     my $f = xmodmap_file($keyboard);
     eval { run_program::run('xmodmap', $f) } unless $::testing || !$f;
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index a282c444a..13b06b1df 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -279,9 +279,14 @@ sub set {
 	    @ENV{qw(LANG LC_ALL LANGUAGE LINGUAS)} = ();
 
 	    eval { commands::rm("-r", "$ENV{SHARE_PATH}/locale") };
-	    require 'run_program.pm';
-	    run_program::run("packdrake", "-x", "$ENV{SHARE_PATH}/locale.cz2", "$ENV{SHARE_PATH}/locale", "UTF-8");
-	    run_program::run("packdrake", "-x", "$ENV{SHARE_PATH}/locale.cz2", "$ENV{SHARE_PATH}/locale", $languages{$lang}[2]);
+	    eval {
+		require packdrake;
+		my $packer = new packdrake("$ENV{SHARE_PATH}/locale.cz2");
+		$packer->extract_archive("$ENV{SHARE_PATH}/locale", "UTF-8", $languages{$lang}[2]);
+	    };
+	    #require 'run_program.pm';
+	    #run_program::run("packdrake", "-x", "$ENV{SHARE_PATH}/locale.cz2", "$ENV{SHARE_PATH}/locale", "UTF-8");
+	    #run_program::run("packdrake", "-x", "$ENV{SHARE_PATH}/locale.cz2", "$ENV{SHARE_PATH}/locale", $languages{$lang}[2]);
 	}
 
 	$ENV{LC_ALL}    = $lang;
@@ -367,6 +372,7 @@ sub load_po($) {
     my $f; -e ($f = "$_/po/$lang.po") and last foreach @INC;
 
     local *F;
+    my $pid;
     unless ($f && -e $f) {
 	-e ($f = "$_/po/$lang.po.bz2") and last foreach @INC;
 	if (-e $f) {
@@ -374,7 +380,14 @@ sub load_po($) {
 	} else {
 	    -e ($f = "$_/po.cz2") and last foreach @INC;
 	    log::l("trying to load $lang.po from $f");
-	    open F, "packdrake -x $f '' $lang.po 2>/dev/null |";
+	    #open F, "packdrake -x $f '' $lang.po 2>/dev/null |";
+	    unless ($pid = open F, "-|") {
+		eval {
+		    require packdrake;
+		    my $packer = new packdrake($f);
+		    $packer->extract_archive(undef, "$lang.po");
+		};
+	    }
 	}
     } else {
 	open F, $f; #- not returning here help avoiding reading the same multiple times.
@@ -404,6 +417,7 @@ sub load_po($) {
     $s .= ");";
     no strict "vars";
     eval $s;
+    $pid and waitpid $pid, 0;
     !$@;
 }
 
@@ -420,6 +434,7 @@ sub load_console_font {
     my ($charset) = $languages{$lang} && $languages{$lang}[1] ;
     my ($f, $u, $m) = @{$charsets{$charset} || []};
 
+    require run_program;
     run_program::run('consolechars', '-v',
 		          ('-f', $f || 'lat0-sun16'),
 		     $u ? ('-u', $u) : (),
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index bc698a5a2..74dc12074 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -470,7 +470,12 @@ sub unload {
 sub load_raw {
     my @l = map { my ($i, @i) = @$_; [ $i, \@i ] } grep { $_->[0] !~ /ignore/ } @_;
     my $cz = "/lib/modules" . (arch() eq 'sparc64' && "64") . ".cz"; -e $cz or $cz .= "2";
-    run_program::run("packdrake", "-x", $cz, "/tmp", map { "$_->[0].o" } @l);
+    eval {
+	require packdrake;
+	my $packer = new packdrake($cz);
+	$packer->extract_archive("/tmp", map { "$_->[0].o" } @l);
+    };
+    #run_program::run("packdrake", "-x", $cz, "/tmp", map { "$_->[0].o" } @l);
     my @failed = grep {
 	my $m = "/tmp/$_->[0].o";
 	if (-e $m && run_program::run(["insmod_", "insmod"], '2>', '/dev/tty5', '-f', $m, @{$_->[1]})) {
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 7ee8b14f0..dd2c05ed2 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -122,10 +122,15 @@ sub extractHeaders($$$) {
 
     cleanHeaders($prefix);
 
-    run_program::run("packdrake", "-x",
-		     "/tmp/$medium->{hdlist}",
-		     "$prefix/tmp/headers",
-		     map { packageHeaderFile($_) } @$pkgs);
+    eval {
+	require packdrake;
+	my $packer = new packdrake("/tmp/$medium->{hdlist}");
+	$packer->extract_archive("$prefix/tmp/headers", map { packageHeaderFile($_) } @$pkgs);
+    };
+    #run_program::run("packdrake", "-x",
+	#	     "/tmp/$medium->{hdlist}",
+	#	     "$prefix/tmp/headers",
+	#	     map { packageHeaderFile($_) } @$pkgs);
 
     foreach (@$pkgs) {
 	my $f = "$prefix/tmp/headers/". packageHeaderFile($_);
@@ -417,38 +422,44 @@ sub psUsingHdlist {
 
     #- extract filename from archive, this take advantage of verifying
     #- the archive too.
-    local *F; open F, "packdrake $newf |";
-    local $_;
-    while (<F>) {
-	chomp;
-	/^[dlf]\s+/ or next;
-	if (/^f\s+\d+\s+(.*)/) {
-	    my $pkg = [ (undef) x 8 ]; $pkg->[$FILE] = $1; $pkg->[$MEDIUM] = $m;
+#    local *F; open F, "packdrake $newf |";
+#    local $_;
+#    while (<F>) {
+#	chomp;
+#	/^[dlf]\s+/ or next;
+    eval {
+	require packdrake;
+	my $packer = new packdrake($newf);
+	foreach (@{$packer->{files}}) {
+	    $packer->{data}{$_}[0] eq 'f' or next;
+	    #if (/^f\s+\d+\s+(.*)/) {
+	    #my $pkg = [ (undef) x 8 ]; $pkg->[$FILE] = $1; $pkg->[$MEDIUM] = $m;
+	    my $pkg = [ (undef) x 8 ]; $pkg->[$FILE] = $_; $pkg->[$MEDIUM] = $m;
 	    my $specific_arch = packageSpecificArch($pkg);
 	    if (!$specific_arch || compat_arch($specific_arch)) {
 		my $old_pkg = $packages->{names}{packageName($pkg)};
 		if ($old_pkg) {
 		    if (packageVersion($pkg) eq packageVersion($old_pkg) && packageRelease($pkg) eq packageRelease($old_pkg)) {
 			if (better_arch($specific_arch, packageSpecificArch($old_pkg))) {
-			    log::l("replacing old package with package $1 with better arch: $specific_arch");
+			    log::l("replacing old package with package $_ with better arch: $specific_arch");
 			    $packages->{names}{packageName($pkg)} = $pkg;
 			} else {
-			    log::l("keeping old package against package $1 with worse arch");
+			    log::l("keeping old package against package $_ with worse arch");
 			}
 		    } else {
-		        log::l("ignoring package $1 already present in distribution with different version or release");
+		        log::l("ignoring package $_ already present in distribution with different version or release");
 		    }
 		} else {
 		    $packages->{names}{packageName($pkg)} = $pkg;
 		}
 	    } else {
-	        log::l("ignoring package $1 with incompatible arch: $specific_arch");
+	        log::l("ignoring package $_ with incompatible arch: $specific_arch");
 	    }
-	} else {
-	    die "bad hdlist file: $newf";
-	}
-    }
-    close F or die "unable to parse $newf";
+	}# else {
+	#    die "bad hdlist file: $newf";
+	#}
+    };
+    #close F or die "unable to parse $newf";
 
     #- update maximal index.
     $m->{max} = scalar(keys %{$packages->{names}}) - 1;