*** empty log message ***

6 files changed, 817 insertions, 651 deletions

diff --git a/packdrake b/packdrake
index f801ad4..d7b3b91 100755
--- a/packdrake
+++ b/packdrake
@@ -1,449 +1,14 @@
 #!/usr/bin/perl
 
-#- Mandrake Simple Archive Extracter/Builder.
-#- Copyright (C) 2000 MandrakeSoft <fpons@mandrakesoft.com>
-#-
-#- This program is free software; you can redistribute it and/or modify
-#- it under the terms of the GNU General Public License as published by
-#- the Free Software Foundation; either version 2, or (at your option)
-#- any later version.
-#-
-#- This program is distributed in the hope that it will be useful,
-#- but WITHOUT ANY WARRANTY; without even the implied warranty of
-#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-#- GNU General Public License for more details.
-#-
-#- You should have received a copy of the GNU General Public License
-#- along with this program; if not, write to the Free Software
-#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-#- Simple cat archive with gzip/bzip2 for perl.
-#- This new version is merging of the extract_achive and build_archive.
-#-
-#- uncompressing sheme is:
-#-         | |
-#-         | |                                        | |
-#-  $off1 =|*| }                                      | |
-#-         |*| }                               $off2 =|+| }
-#-         |*| } $siz1   =>   'gzip/bzip2 -d'   =>    |+| } $siz2  => $filename
-#-         |*| }                                      |+| }
-#-         |*| }                                      | |
-#-         | |                                        | |
-#-         | |                                        | |
-#-         | |
-#- where %data has the following format:
-#-   { 'filename' => [ 'f', $off1, $siz1, $off2, $siz2 ] }
-#- except for symbolink link where it is:
-#-   { 'filename_symlink' => [ 'l', $symlink_value ] }
-#- and directory where it is only
-#-   { 'filename_directory' => [ 'd' ] }
-#- as you can see, there is no owner, group, filemode... an extension could be
-#- made with 'F' (instead of 'f'), 'L' instead of 'l' for exemple.
-#- we do not need them as it is used for DrakX for fast archive extraction and
-#- owner/filemode is for user running only (ie root).
-#-
-#- archive file contains concatenation of all bzip2'ed group of files whose
-#- filenames are on input,
-#- then a TOC (describing %data, concatenation of toc_line) follow and a
-#- TOC_TRAILER for summary.
-
-#+use strict qw(subs vars refs);
+use strict;
+require packdrake;
 
 #- general information.
-my $VERSION = "0.1";
 my $default_size = 400000;
 my $default_ratio = 6;
 
-#- used for uncompressing archive and listing.
-my %toc_trailer;
-my @data;
-my %data;
-
-#- used for compression, always set in main.
-my $tmpz = '';
-
-#- taken from DrakX common stuff, for conveniance and modified to match our expectation.
-sub dirname { @_ == 1 or die "packdrake: usage: dirname <name>\n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' }
-sub basename { @_ == 1 or die "packdrake: usage: basename <name>\n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ }
-sub mkdir_ {
-    my $root = dirname $_[0];
-    if (-e $root) {
-	-d $root or die "packdrake: mkdir: error creating directory $_[0]: $root is a file and i won't delete it\n";
-    } else {
-	mkdir_($root);
-    }
-    -d $_[0] and return;
-    mkdir $_[0], 0755 or die "packdrake: mkdir: error creating directory $_: $!\n";
-}
-sub symlink_ { mkdir_ dirname($_[1]); unlink $_[1]; symlink $_[0], $_[1] }
-
-#- for building an archive.
-sub toc_line {
-    my ($file, $data) = @_;
-
-    for ($data->[0]) {
-	return(/l/ && pack("anna*", 'l', length($file), length($data->[1]), "$file$data->[1]") ||
-	       /d/ && pack("ana*", 'd', length($file), $file) ||
-	       /f/ && pack("anNNNNa*", 'f', length($file), $data->[1], $data->[2], $data->[3], $data->[4], $file) ||
-	       die "packdrake: unknown extension $_\n");
-    }
-}
-
-sub cat_compress {
-    my ($compress, @filenames) = @_;
-    local *F;
-    open F, "| $compress >$tmpz" or die "packdrake: cannot start \"$compress\"\n";
-    foreach (@filenames) {
-	my ($buf, $siz, $sz);
-	local *FILE;
-	open FILE, $_ or die "packdrake: cannot open $_: $!\n";
-	$siz = -s $_;
-	while (($sz = sysread(FILE, $buf, $siz > 16384 ? 16384 : $siz))) {
-	    $siz -= $sz;
-	    syswrite(F, $buf);
-	    last unless $siz > 0;
-	}
-	close FILE;
-    }
-    close F;
-    -s $tmpz;
-}
-
-sub toc_trailer {
-    my ($toc_d_count, $toc_l_count, $toc_f_count, $toc_str_size, $uncompress) = @_;
-
-    #- 'cz[0' is toc_trailer header where 0 is version information, only 0 now.
-    #- '0]cz' is toc_trailer trailer that match the corresponding header for information.
-    return pack "a4NNNNa40a4", 'cz[0', $toc_d_count, $toc_l_count, $toc_f_count, $toc_str_size, $uncompress, '0]cz';
-}
-
-#- compute the closure of filename list according to symlinks or directory
-#- contents inside the archive.
-sub compute_closure {
-    my %file;
-    my @file;
-
-    #- keep in mind when a filename already exist and remove doublons.
-    @file{@_} = ();
-
-    #- navigate through filename list to follow symlinks.
-    do {
-	@file = grep { !$file{$_} } keys %file;
-	foreach (@file) {
-	    my $file = $_;
-
-	    #- keep in mind this one has been processed and does not need
-	    #- to be examined again.
-	    $file{$file} = 1;
-
-	    exists $data{$file} or next;
-
-	    for ($data{$file}[0]) {
-		#- on symlink, try to follow it and mark %file if
-		#- it is still inside the archive contents.
-		/l/ && do {
-		    my ($source, $target) = ($file, $data{$file}[1]);
-
-		    $source =~ s|[^/]*$||; #- remove filename to navigate directory.
-		    if ($source) {
-			while ($target =~ s|^\./|| || $target =~ s|//+|/| || $target =~ s|/$|| or
-			       $source and $target =~ s|^\.\./|| and $source =~ s|[^/]*/$||) {}
-		    }
-
-		    #- FALL THROUGH with new selection.
-		    $file = $target =~ m|^/| ? $target : $source.$target;
-		};
-
-		#- on directory, try all files on data starting with
-		#- this directory, provided they are not already taken
-		#- into account.
-		/[ld]/ && do {
-		    @file{grep { !$file{$_} && m|^$file$| || m|^$file/| } keys %data} = ();
-		    last;
-		};
-	    }
-	}
-    } while (@file > 0);
-
-    keys %file;
-}
-
-#- degraded reading of toc at end of archive, do not check filelist.
-sub read_toc_trailer {
-    my ($file) = @_;
-    my $toc_trailer;
-
-    local *ARCHIVE;
-    open ARCHIVE, "<$file" or die "packdrake: cannot open archive file $file\n";
-
-    #- seek to end of file minus 64, size of trailer.
-    #- read toc_trailer, check header/trailer for version 0.
-    seek ARCHIVE, -64, 2;
-    read ARCHIVE, $toc_trailer, 64 or die "packdrake: cannot read toc_trailer of archive file $file\n";
-    @toc_trailer{qw(header toc_d_count toc_l_count toc_f_count toc_str_size uncompress trailer)} =
-	unpack "a4NNNNZ40a4", $toc_trailer;
-    $toc_trailer{header} eq 'cz[0' && $toc_trailer{trailer} eq '0]cz' or die "packdrake: bad toc_trailer in archive file $file\n";
-
-    close ARCHIVE;
-}
-
-#- read toc at end of archive.
-sub read_toc {
-    my ($file) = @_;
-    my ($toc, $toc_trailer, $toc_size);
-    my @toc_str;
-    my @toc_data;
-
-    local *ARCHIVE;
-    open ARCHIVE, "<$file" or die "packdrake: cannot open archive file $file\n";
-
-    #- seek to end of file minus 64, size of trailer.
-    #- read toc_trailer, check header/trailer for version 0.
-    seek ARCHIVE, -64, 2;
-    read ARCHIVE, $toc_trailer, 64 or die "packdrake: cannot read toc_trailer of archive file $file\n";
-    @toc_trailer{qw(header toc_d_count toc_l_count toc_f_count toc_str_size uncompress trailer)} =
-	unpack "a4NNNNZ40a4", $toc_trailer;
-    $toc_trailer{header} eq 'cz[0' && $toc_trailer{trailer} eq '0]cz' or die "packdrake: bad toc_trailer in archive file $file\n";
-
-    #- read toc, extract data hashes.
-    $toc_size = $toc_trailer{toc_str_size} + 16*$toc_trailer{toc_f_count};
-    seek ARCHIVE, -64-$toc_size, 2;
-
-    #- read strings separated by \n, so this char cannot be inside filename, oops.
-    read ARCHIVE, $toc, $toc_trailer{toc_str_size} or die "packdrake: cannot read toc of archive file $file\n";
-    @toc_str = split "\n", $toc;
-
-    #- read data for file.
-    read ARCHIVE, $toc, 16*$toc_trailer{toc_f_count} or die "packdrake: cannot read toc of archive file $file\n";
-    @toc_data = unpack "N". 4*$toc_trailer{toc_f_count}, $toc;
-
-    close ARCHIVE;
-
-    foreach (0..$toc_trailer{toc_d_count}-1) {
-	my $file = $toc_str[$_];
-	push @data, $file;
-	$data{$file} = [ 'd' ];
-    }
-    foreach (0..$toc_trailer{toc_l_count}-1) {
-	my ($file, $symlink) = ($toc_str[$toc_trailer{toc_d_count}+2*$_],
-				$toc_str[$toc_trailer{toc_d_count}+2*$_+1]);
-	push @data, $file;
-	$data{$file} = [ 'l', $symlink ];
-    }
-    foreach (0..$toc_trailer{toc_f_count}-1) {
-	my $file = $toc_str[$toc_trailer{toc_d_count}+2*$toc_trailer{toc_l_count}+$_];
-	push @data, $file;
-	$data{$file} = [ 'f', @toc_data[4*$_ .. 4*$_+3] ];
-    }
-
-    scalar keys %data == $toc_trailer{toc_d_count}+$toc_trailer{toc_l_count}+$toc_trailer{toc_f_count} or
-	die "packdrake: mismatch count when reading toc, bad archive file $file\n";
-}
-
-sub catsksz {
-    my ($input, $seek, $siz, $output) = @_;
-    my ($buf, $sz);
-
-    while (($sz = sysread($input, $buf, $seek > 65536 ? 65536 : $seek))) {
-	$seek -= $sz;
-	last unless $seek > 0;
-    }
-    while (($sz = sysread($input, $buf, $siz > 65536 ? 65536 : $siz))) {
-	$siz -= $sz;
-	syswrite($output, $buf);
-	last unless $siz > 0;
-    }
-}
-
-sub cat_archive {
-    my $pid;
-
-    foreach (@_)  {
-	#- update %data according to TOC_TRAILER of each archive.
-	read_toc_trailer($_);
-
-	#- dump all the file according to 
-	if (my $pid = fork()) {
-	    waitpid $pid, 0;
-	} else {
-	    open STDIN, "<$_" or die "packdrake: unable to open archive $_\n";
-	    open STDERR, ">/dev/null" or die "packdrake: unable to open archive $_\n";
-
-	    exec split " ", $toc_trailer{uncompress};
-
-	    die "packdrake: unable to cat the archive\n";
-	}
-    }
-}
-
-sub extract_archive {
-    my ($archivename, $dir, @file) = @_;
-    my %extract_table;
-
-    #- update %data according to TOC of archive.
-    read_toc($archivename);
-
-    #- as a special features, if both $dir and $file are empty, list contents of archive.
-    if (!$dir && !@file) {
-	my $count = scalar keys %data;
-	print "$count files in archive, uncompression method is \"$toc_trailer{uncompress}\"\n";
-	foreach my $file (@data) {
-	    for ($data{$file}[0]) {
-		/l/ && do { printf "l %13c %s -> %s\n", ' ', $file, $data{$file}[1]; last; };
-		/d/ && do { printf "d %13c %s\n", ' ', $file; last; };
-		/f/ && do { printf "f %12d %s\n", $data{$file}[4], $file; last; };
-	    }
-	}
-	exit 0;
-    }
-
-    #- compute closure.
-    @file = compute_closure(@file);
-
-    foreach my $file (@file) {
-	#- check for presence of file, but do not abort, continue with others.
-	$data{$file} or do { print STDERR "packdrake: unable to find file $file in archive $archivename\n"; next };
-
-	my $newfile = "$dir/$file";
-
-	print "extracting $file\n";
-	for ($data{$file}[0]) {
-	    /l/ && do { symlink_ $data{$file}[1], $newfile; last; };
-	    /d/ && do { mkdir_ $newfile; last; };
-	    /f/ && do {
-		mkdir_ dirname $newfile;
-		$extract_table{$data{$file}[1]} ||= [ $data{$file}[2], [] ];
-		push @{$extract_table{$data{$file}[1]}[1]}, [ $newfile, $data{$file}[3], $data{$file}[4] ];
-		$extract_table{$data{$file}[1]}[0] == $data{$file}[2] or die "packdrake: mismatched relocation in toc\n";
-		last;
-	    };
-	    die "packdrake: unknown extension \"$_\" when uncompressing archive $archivename\n";
-	}
-    }
-
-    #- delayed extraction is done on each block for a single  execution
-    #- of uncompress executable.
-    foreach (sort { $a <=> $b } keys %extract_table) {
-	local *OUTPUT;
-	if (open OUTPUT, "-|") {
-	    #- $curr_off is used to handle the reading in a pipe and simulating
-	    #- a seek on it as done by catsksz, so last file position is
-	    #- last byte not read (ie last block read start + last block read size).
-	    my $curr_off = 0;
-	    foreach (sort { $a->[1] <=> $b->[1] } @{$extract_table{$_}[1]}) {
-		my ($newfile, $off, $siz) = @$_;
-		local *FILE;
-		open FILE, $dir ? ">$newfile" : ">&STDOUT";
-		catsksz(\*OUTPUT, $off - $curr_off, $siz, \*FILE);
-		$curr_off = $off + $siz;
-	    }
-	} else {
-	    local *BUNZIP2;
-	    open BUNZIP2, "| $toc_trailer{uncompress}";
-	    local *ARCHIVE;
-	    open ARCHIVE, "<$archivename" or die "packdrake: cannot open archive $archivename\n";
-	    catsksz(\*ARCHIVE, $_, $extract_table{$_}[0], \*BUNZIP2);
-	    exit 0;
-	}
-    }
-}
-
-sub build_archive {
-    my ($archivename, $maxsiz, $compress, $uncompress) = @_;
-    my ($off1, $siz1, $off2, $siz2) = ('', '', 0, 0, 0, 0);
-    my @filelist = ();
-    my @data = ();
-    my %data = ();
-
-    print "choosing compression method with \"$compress\" for archive $archivename\n";
-
-    unlink "$archivename";
-    unlink $tmpz;
-
-    foreach (<STDIN>) {
-	chomp;
-
-	my $file = $_; -e $file or die "packdrake: unable to find file $file\n";
-
-	push @data, $file;
-	#- now symbolic link and directory are supported, extension is
-	#- available with the first field of $data{$file}.
-	if (-l $file) {
-	    $data{$file} = [ 'l', readlink $file ];
-	} elsif (-d $file) {
-	    $data{$file} = [ 'd' ];
-	} else {
-	    $siz2 = -s $file;
-
-	    push @filelist, $file;
-	    $data{$file} = [ 'f', -1, -1, $off2, $siz2 ];
-
-	    if ($off2 + $siz2 > $maxsiz) { #- need compression.
-		$siz1 = cat_compress($compress, @filelist);
-
-		foreach (@filelist) { $data{$_} = [ 'f', $off1, $siz1, $data{$_}[3], $data{$_}[4] ] }
-
-		system "cat $tmpz >>$archivename";
-		$off1 += $siz1;
-		$off2 = 0; $siz2 = 0;
-		@filelist = ();
-	    }
-	    $off2 += $siz2;
-	}
-    }
-    if (scalar @filelist) {
-	$siz1 = cat_compress($compress, @filelist);
-
-	foreach (@filelist) { $data{$_} = [ 'f', $off1, $siz1, $data{$_}[3], $data{$_}[4] ] }
-
-	system "cat $tmpz >>$archivename";
-	$off1 += $siz1;
-	print "real archive size of $archivename is $off1\n";
-    }
-
-    #- produce a TOC directly at the end of the file, follow with
-    #- a trailer with TOC summary and archive summary.
-    local *OUTPUT;
-    open OUTPUT, ">>$archivename";
-
-    my ($toc_str, $toc_data) = ('', '');
-    my @data_d = ();
-    my @data_l = ();
-    my @data_f = ();
-
-    foreach (@data) {
-	my $file = $_;
-	$data{$file} or die "packdrake: internal error on $_\n";
-
-	#- specific according to type.
-	#- with this version, only f has specific data other than strings.
-	for ($data{$file}[0]) {
-	    /d/ && do { push @data_d, $file; last; };
-	    /l/ && do { push @data_l, $file; last; };
-	    /f/ && do { push @data_f, $file; $toc_data .= pack("NNNN",
-							       $data{$file}[1],
-							       $data{$file}[2],
-							       $data{$file}[3],
-							       $data{$file}[4]); last; };
-	    die "packdrake: unknown extension $_\n";
-	}
-    }
-
-    foreach (@data_d) { $toc_str .= $_ . "\n" }
-    foreach (@data_l) { $toc_str .= $_ . "\n" . $data{$_}[1] . "\n" }
-    foreach (@data_f) { $toc_str .= $_ . "\n" }
-
-    print OUTPUT $toc_str;
-    print OUTPUT $toc_data;
-    print OUTPUT toc_trailer(scalar(@data_d), scalar(@data_l), scalar(@data_f),
-			     length($toc_str), $uncompress);
-    close OUTPUT;
-
-    unlink $tmpz;
-}
-
 sub usage {
-    die "packdrake version $VERSION
+    die "packdrake version " . $packdrake::VERSION . "
 Copyright (C) 2000 MandrakeSoft.
 This is free software and may be redistributed under the terms of the GNU GPL.
 
@@ -479,7 +44,7 @@ sub main {
 	/^--build$/      and do { $mode and die $error_mode; $mode = "build"; @nextargv = (\$file); next };
 	/^--extract$/    and do { $mode and die $error_mode; $mode = "extract"; @nextargv = (\$file, \$dir); next };
 	/^--list$/       and do { $mode and die $error_mode; $mode = "list"; @nextargv = (\$file); next };
-	/^--cat$/        and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (); next };
+	/^--cat$/        and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (\$file); next };
 	/^--size$/       and do { push @nextargv, \$size; next };
 	/^--method$/     and do { push @nextargv, \$method; next };
 	/^--compress$/   and do { push @nextargv, \$compress; next };
@@ -489,22 +54,20 @@ sub main {
 	    /b/      and do { $mode and die $error_mode; $mode = "build"; @nextargv = (\$file); next };
 	    /x/      and do { $mode and die $error_mode; $mode = "extract"; @nextargv = (\$file, \$dir); next };
 	    /l/      and do { $mode and die $error_mode; $mode = "list"; @nextargv = (\$file); next };
-	    /c/      and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (); next };
+	    /c/      and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (\$file); next };
 	    /s/      and do { push @nextargv, \$size; next };
 	    /m/      and do { push @nextargv, \$method; next };
 	    die "packdrake: unknown option \"-$1\", check usage with --help\n"; } next };
-	$mode =~ /extract|cat/ or @nextargv or die "packdrake: unknown option \"$_\", check usage with --help\n";
+	$mode =~ /extract|list|cat/ or @nextargv or die "packdrake: unknown option \"$_\", check usage with --help\n";
 	my $ref = shift @nextargv; $ref ? $$ref = $_ : push @list, $_;
 	$mode ||= "list";
     }
 
     #- examine and lauch.
-    $mode =~ /cat/ or $file or die "packdrake: no archive filename given, check usage with --help\n";
+    $file or die "packdrake: no archive filename given, check usage with --help\n";
     $size ||= 400000;
     $ratio ||= 6;
 
-    $tmpdir = $ENV{TMPDIR} || "/tmp";
-    $tmpz = "$tmpdir/packdrake-tmp.$$";
     unless ($method) {
 	$file =~ /\.cz$/  and $method = "gzip";
 	$file =~ /\.cz2$/ and $method = "bzip2";
@@ -513,11 +76,12 @@ sub main {
     $compress ||= "$method -$ratio";
     $uncompress ||= "$method -d";
 
+    $mode =~ /extract/ && !$dir && !@list and ($mode, @list) = ('list', $file);
     for ($mode) {
-	/build/   and do { build_archive($file, $size, $compress, $uncompress); last };
-	/extract/ and do { extract_archive($file, $dir, @list); last };
-	/list/    and do { extract_archive($file); last };
-	/cat/     and do { cat_archive(@list); last };
+	/build/   and do { packdrake::build_archive(\*STDIN, $file, $size, $compress, $uncompress); last };
+	/extract/ and do { my $packer = new packdrake($file); $packer->extract_archive($dir, @list); last };
+	/list/    and do { packdrake::list_archive($file, @list); last };
+	/cat/     and do { packdrake::cat_archive($file, @list); last };
 	die "packdrake: internal error, unable to select right mode?\n";
     }
 }
diff --git a/packdrake.pm b/packdrake.pm
new file mode 100644
index 0000000..bdad288
--- /dev/null
+++ b/packdrake.pm
@@ -0,0 +1,508 @@
+package packdrake;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = "0.02";
+
+=head1 NAME
+
+packdrake - Mandrake Simple Archive Extractor/Builder
+
+=head1 SYNOPSYS
+
+    require packdrake;
+
+    packdrake::cat_archive("/export/Mandrake/base/hdlist.cz",
+                           "/export/Mandrake/base/hdlist2.cz");
+    packdrake::list_archive("/tmp/modules.cz2");
+
+    my $packer = new packdrake("/tmp/modules.cz2");
+    $packer->extract_archive("/tmp", "file1.o", "file2.o");
+
+    my $packer = packdrake::build_archive
+        (\*STDIN, "/tmp/modules.cz2",
+         400000, "bzip2", "bzip2 -d");
+    my $packer = packdrake::build_archive
+        (\*STDIN, "/export/Mandrake/base/hdlist.cz",
+         400000, "gzip -9", "gzip -d");
+
+=head1 DESCRIPTION
+
+C<packdrake> is a very simple archive extractor and builder used by MandrakeSoft.
+
+=head1 IMPLEMENTATION
+
+uncompressing sheme is:
+        | |
+        | |                                        | |
+ $off1 =|*| }                                      | |
+        |*| }                               $off2 =|+| }
+        |*| } $siz1   =>   'gzip/bzip2 -d'   =>    |+| } $siz2  => $filename
+        |*| }                                      |+| }
+        |*| }                                      | |
+        | |                                        | |
+        | |                                        | |
+        | |
+where %data has the following format:
+  { 'filename' => [ 'f', $off1, $siz1, $off2, $siz2 ] }
+except for symbolink link where it is:
+  { 'filename_symlink' => [ 'l', $symlink_value ] }
+and directory where it is only
+  { 'filename_directory' => [ 'd' ] }
+as you can see, there is no owner, group, filemode... an extension could be
+made with 'F' (instead of 'f'), 'L' instead of 'l' for exemple.
+we do not need them as it is used for DrakX for fast archive extraction and
+owner/filemode is for user running only (ie root).
+
+archive file contains concatenation of all bzip2'ed group of files whose
+filenames are on input,
+then a TOC (describing %data, concatenation of toc_line) follow and a
+TOC_TRAILER for summary.
+
+=head1 SEE ALSO
+
+packdrake command is a simple executable perl script using this module.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000 MandrakeSoft <fpons@mandrakesoft.com>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+=cut
+
+#- taken from DrakX common stuff, for conveniance and modified to match our expectation.
+sub dirname { @_ == 1 or die "packdrake: usage: dirname <name>\n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' }
+sub basename { @_ == 1 or die "packdrake: usage: basename <name>\n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ }
+sub mkdir_ {
+    my $root = dirname $_[0];
+    if (-e $root) {
+	-d $root or die "packdrake: mkdir: error creating directory $_[0]: $root is a file and i won't delete it\n";
+    } else {
+	mkdir_($root);
+    }
+    -d $_[0] and return;
+    mkdir $_[0], 0755 or die "packdrake: mkdir: error creating directory $_: $!\n";
+}
+sub symlink_ { mkdir_ dirname($_[1]); unlink $_[1]; symlink $_[0], $_[1] }
+
+#- for building an archive, returns the string containing the file and data associated.
+sub build_toc_line {
+    my ($file, $data) = @_;
+
+    for ($data->[0]) {
+	return(/l/ && pack("anna*", 'l', length($file), length($data->[1]), "$file$data->[1]") ||
+	       /d/ && pack("ana*", 'd', length($file), $file) ||
+	       /f/ && pack("anNNNNa*", 'f', length($file), @{$data}[1..4], $file) ||
+	       die "packdrake: unknown extension $_\n");
+    }
+}
+
+sub build_toc_trailer {
+    my ($packer) = @_;
+
+    #- 'cz[0' is toc_trailer header where 0 is version information, only 0 now.
+    #- '0]cz' is toc_trailer trailer that match the corresponding header for information.
+    pack "a4NNNNa40a4", ($packer->{header},
+			 $packer->{toc_d_count}, $packer->{toc_l_count}, $packer->{toc_f_count},
+			 $packer->{toc_str_size}, $packer->{uncompress},
+			 $packer->{trailer});
+}
+
+#- degraded reading of toc at end of archive, do not check filelist.
+sub read_toc_trailer {
+    my ($packer, $file) = @_;
+    my $toc_trailer;
+
+    local *ARCHIVE;
+    open ARCHIVE, "<$file" or die "packdrake: cannot open archive file $file\n";
+    $packer->{archive} = $file;
+
+    #- seek to end of file minus 64, size of trailer.
+    #- read toc_trailer, check header/trailer for version 0.
+    seek ARCHIVE, -64, 2;
+    read ARCHIVE, $toc_trailer, 64 or die "packdrake: cannot read toc_trailer of archive file $file\n";
+    @{$packer}{qw(header toc_d_count toc_l_count toc_f_count toc_str_size uncompress trailer)} =
+      unpack "a4NNNNZ40a4", $toc_trailer;
+    $packer->{header} eq 'cz[0' && $packer->{trailer} eq '0]cz' or die "packdrake: bad toc_trailer in archive file $file\n";
+
+    close ARCHIVE;
+}
+
+#- read toc at end of archive.
+sub read_toc {
+    my ($packer, $file) = @_;
+    my ($toc, $toc_trailer, $toc_size);
+    my @toc_str;
+    my @toc_data;
+
+    local *ARCHIVE;
+    open ARCHIVE, "<$file" or die "packdrake: cannot open archive file $file\n";
+    $packer->{archive} = $file;
+
+    #- seek to end of file minus 64, size of trailer.
+    #- read toc_trailer, check header/trailer for version 0.
+    seek ARCHIVE, -64, 2;
+    read ARCHIVE, $toc_trailer, 64 or die "packdrake: cannot read toc_trailer of archive file $file\n";
+    @{$packer}{qw(header toc_d_count toc_l_count toc_f_count toc_str_size uncompress trailer)} =
+      unpack "a4NNNNZ40a4", $toc_trailer;
+    $packer->{header} eq 'cz[0' && $packer->{trailer} eq '0]cz' or die "packdrake: bad toc_trailer in archive file $file\n";
+
+    #- read toc, extract data hashes.
+    $toc_size = $packer->{toc_str_size} + 16*$packer->{toc_f_count};
+    seek ARCHIVE, -64-$toc_size, 2;
+
+    #- read strings separated by \n, so this char cannot be inside filename, oops.
+    read ARCHIVE, $toc, $packer->{toc_str_size} or die "packdrake: cannot read toc of archive file $file\n";
+    @toc_str = split "\n", $toc;
+
+    #- read data for file.
+    read ARCHIVE, $toc, 16*$packer->{toc_f_count} or die "packdrake: cannot read toc of archive file $file\n";
+    @toc_data = unpack "N". 4*$packer->{toc_f_count}, $toc;
+
+    close ARCHIVE;
+
+    foreach (0..$packer->{toc_d_count}-1) {
+	my $file = $toc_str[$_];
+	push @{$packer->{files}}, $file;
+	$packer->{data}{$file} = [ 'd' ];
+    }
+    foreach (0..$packer->{toc_l_count}-1) {
+	my ($file, $symlink) = ($toc_str[$packer->{toc_d_count}+2*$_],
+				$toc_str[$packer->{toc_d_count}+2*$_+1]);
+	push @{$packer->{files}}, $file;
+	$packer->{data}{$file} = [ 'l', $symlink ];
+    }
+    foreach (0..$packer->{toc_f_count}-1) {
+	my $file = $toc_str[$packer->{toc_d_count}+2*$packer->{toc_l_count}+$_];
+	push @{$packer->{files}}, $file;
+	$packer->{data}{$file} = [ 'f', @toc_data[4*$_ .. 4*$_+3] ];
+    }
+
+    scalar keys %{$packer->{data}} == $packer->{toc_d_count}+$packer->{toc_l_count}+$packer->{toc_f_count} or
+      die "packdrake: mismatch count when reading toc, bad archive file $file\n";
+}
+
+sub catsksz {
+    my ($input, $seek, $siz, $output) = @_;
+    my ($buf, $sz);
+
+    while (($sz = sysread($input, $buf, $seek > 65536 ? 65536 : $seek))) {
+	$seek -= $sz;
+	last unless $seek > 0;
+    }
+    while (($sz = sysread($input, $buf, $siz > 65536 ? 65536 : $siz))) {
+	$siz -= $sz;
+	syswrite($output, $buf);
+	last unless $siz > 0;
+    }
+}
+
+sub cat_compress {
+    my ($packer, @filenames) = @_;
+    local *F;
+    open F, "| $packer->{compress} >$packer->{tmpz}" or die "packdrake: cannot start \"$packer->{compress}\"\n";
+    foreach (@filenames) {
+	my ($buf, $siz, $sz);
+	local *FILE;
+	open FILE, $_ or die "packdrake: cannot open $_: $!\n";
+	$siz = -s $_;
+	while (($sz = sysread(FILE, $buf, $siz > 65536 ? 65536 : $siz))) {
+	    $siz -= $sz;
+	    syswrite(F, $buf);
+	    last unless $siz > 0;
+	}
+	close FILE;
+    }
+    close F;
+    -s $packer->{tmpz};
+}
+
+#- compute the closure of filename list according to symlinks or directory
+#- contents inside the archive.
+sub compute_closure {
+    my $packer = shift;
+    my %file;
+    my @file;
+
+    #- keep in mind when a filename already exist and remove doublons.
+    @file{@_} = ();
+
+    #- navigate through filename list to follow symlinks.
+    do {
+	@file = grep { !$file{$_} } keys %file;
+	foreach (@file) {
+	    my $file = $_;
+
+	    #- keep in mind this one has been processed and does not need
+	    #- to be examined again.
+	    $file{$file} = 1;
+
+	    exists $packer->{data}{$file} or next;
+
+	    for ($packer->{data}{$file}[0]) {
+		#- on symlink, try to follow it and mark %file if
+		#- it is still inside the archive contents.
+		/l/ && do {
+		    my ($source, $target) = ($file, $packer->{data}{$file}[1]);
+
+		    $source =~ s|[^/]*$||; #- remove filename to navigate directory.
+		    if ($source) {
+			while ($target =~ s|^\./|| || $target =~ s|//+|/| || $target =~ s|/$|| or
+			       $source and $target =~ s|^\.\./|| and $source =~ s|[^/]*/$||) {}
+		    }
+
+		    #- FALL THROUGH with new selection.
+		    $file = $target =~ m|^/| ? $target : $source.$target;
+		};
+
+		#- on directory, try all files on data starting with
+		#- this directory, provided they are not already taken
+		#- into account.
+		/[ld]/ && do {
+		    @file{grep { !$file{$_} && m|^$file$| || m|^$file/| } keys %{$packer->{data}}} = ();
+		    last;
+		};
+	    }
+	}
+    } while (@file > 0);
+
+    keys %file;
+}
+
+
+#- getting an packer object.
+sub new {
+    my ($class, $file) = @_;
+    my $packer = bless {
+			#- toc trailer data information.
+			header       => 'cz[0',
+			toc_d_count  => 0,
+			toc_l_count  => 0,
+			toc_f_count  => 0,
+			toc_str_size => 0,
+			uncompress   => 'gzip -d',
+			trailer      => '0]cz',
+
+			#- tempories used for making an archive.
+			tmpz         => ($ENV{TMPDIR} || "/tmp") . "/packdrake-tmp.$$",
+			compress     => 'gzip',
+
+			#- internal data to handle compression or uncompression.
+			archive      => undef,
+			files        => [],
+			data         => {},
+		       }, $class;
+    $file and $packer->read_toc($file);
+    $packer;
+}
+
+sub cat_archive {
+    my $pid;
+
+    foreach (@_)  {
+	my $packer = new packdrake;
+
+	#- update %data according to TOC_TRAILER of each archive.
+	$packer->read_toc_trailer($_);
+
+	#- dump all the file according to 
+	if (my $pid = fork()) {
+	    waitpid $pid, 0;
+	} else {
+	    open STDIN, "<$_" or die "packdrake: unable to open archive $_\n";
+	    open STDERR, ">/dev/null" or die "packdrake: unable to open /dev/null\n";
+
+	    exec split " ", $packer->{uncompress};
+
+	    die "packdrake: unable to cat the archive with $packer->{uncompress}\n";
+	}
+    }
+}
+
+sub list_archive {
+    foreach (@_) {
+	my $packer = new packdrake($_);
+	my $count = scalar keys %{$packer->{data}};
+
+	print STDERR "processing archive \"$_\"\n";
+	print "$count files in archive, uncompression method is \"$packer->{uncompress}\"\n";
+	foreach my $file (@{$packer->{files}}) {
+	    for ($packer->{data}{$file}[0]) {
+		/l/ && do { printf "l %13c %s -> %s\n", ' ', $file, $packer->{data}{$file}[1]; last; };
+		/d/ && do { printf "d %13c %s\n", ' ', $file; last; };
+		/f/ && do { printf "f %12d %s\n", $packer->{data}{$file}[4], $file; last; };
+	    }
+	}
+    }
+}
+
+sub extract_archive {
+    my ($packer, $dir, @file) = @_;
+    my %extract_table;
+
+    #- compute closure.
+    @file = $packer->compute_closure(@file);
+
+    foreach my $file (@file) {
+	#- check for presence of file, but do not abort, continue with others.
+	$packer->{data}{$file} or do { print STDERR "packdrake: unable to find file $file in archive $packer->{archive}\n"; next };
+
+	my $newfile = "$dir/$file";
+
+	print "extracting $file\n";
+	for ($packer->{data}{$file}[0]) {
+	    /l/ && do { symlink_ $packer->{data}{$file}[1], $newfile; last; };
+	    /d/ && do { mkdir_ $newfile; last; };
+	    /f/ && do {	mkdir_ dirname $newfile;
+			my $data = $packer->{data}{$file};
+			$extract_table{$data->[1]} ||= [ $data->[2], [] ];
+			push @{$extract_table{$data->[1]}[1]}, [ $newfile, $data->[3], $data->[4] ];
+			$extract_table{$data->[1]}[0] == $data->[2] or die "packdrake: mismatched relocation in toc\n";
+			last;
+		    };
+	    die "packdrake: unknown extension \"$_\" when uncompressing archive $packer->{archive}\n";
+	}
+    }
+
+    #- delayed extraction is done on each block for a single  execution
+    #- of uncompress executable.
+    foreach (sort { $a <=> $b } keys %extract_table) {
+	local *OUTPUT;
+	if (open OUTPUT, "-|") {
+	    #- $curr_off is used to handle the reading in a pipe and simulating
+	    #- a seek on it as done by catsksz, so last file position is
+	    #- last byte not read (ie last block read start + last block read size).
+	    my $curr_off = 0;
+	    foreach (sort { $a->[1] <=> $b->[1] } @{$extract_table{$_}[1]}) {
+		my ($newfile, $off, $siz) = @$_;
+		local *FILE;
+		open FILE, $dir ? ">$newfile" : ">&STDOUT";
+		catsksz(\*OUTPUT, $off - $curr_off, $siz, \*FILE);
+		$curr_off = $off + $siz;
+	    }
+	} else {
+	    local *BUNZIP2;
+	    open BUNZIP2, "| $packer->{uncompress}";
+	    local *ARCHIVE;
+	    open ARCHIVE, "<$packer->{archive}" or die "packdrake: cannot open archive $packer->{archive}\n";
+	    catsksz(\*ARCHIVE, $_, $extract_table{$_}[0], \*BUNZIP2);
+	    exit 0;
+	}
+    }
+}
+
+sub build_archive {
+    my ($f, $archivename, $maxsiz, $compress, $uncompress, $tmpz) = @_;
+    my ($off1, $siz1, $off2, $siz2) = ('', '', 0, 0, 0, 0);
+    my @filelist = ();
+    my $packer = new packdrake;
+
+    $packer->{archive} = $archivename;
+    $compress && $uncompress and ($packer->{compress}, $packer->{uncompress}) = ($compress, $uncompress);
+    $tmpz and $packer->{tmpz} = $tmpz;
+
+    print STDERR "choosing compression method with \"$packer->{compress}\" for archive $packer->{archive}\n";
+
+    unlink $packer->{archive};
+    unlink $packer->{tmpz};
+
+    my $file;
+    while ($file = <$f>) {
+	chomp $file;
+	-e $file or die "packdrake: unable to find file $file\n";
+
+	push @{$packer->{files}}, $file;
+	#- now symbolic link and directory are supported, extension is
+	#- available with the first field of $data{$file}.
+	if (-l $file) {
+	    $packer->{data}{$file} = [ 'l', readlink $file ];
+	} elsif (-d $file) {
+	    $packer->{data}{$file} = [ 'd' ];
+	} else {
+	    $siz2 = -s $file;
+
+	    push @filelist, $file;
+	    $packer->{data}{$file} = [ 'f', -1, -1, $off2, $siz2 ];
+
+	    if ($off2 + $siz2 > $maxsiz) { #- need compression.
+		$siz1 = cat_compress($packer, @filelist);
+
+		foreach (@filelist) {
+		    $packer->{data}{$_} = [ 'f', $off1, $siz1, $packer->{data}{$_}[3], $packer->{data}{$_}[4] ];
+		}
+
+		system "cat $packer->{tmpz} >>$packer->{archive}";
+		$off1 += $siz1;
+		$off2 = 0; $siz2 = 0;
+		@filelist = ();
+	    }
+	    $off2 += $siz2;
+	}
+    }
+    if (scalar @filelist) {
+	$siz1 = cat_compress($packer, @filelist);
+
+	foreach (@filelist) {
+	    $packer->{data}{$_} = [ 'f', $off1, $siz1, $packer->{data}{$_}[3], $packer->{data}{$_}[4] ];
+	}
+
+	system "cat $packer->{tmpz} >>$packer->{archive}";
+	$off1 += $siz1;
+    }
+    print STDERR "real archive size of $packer->{archive} is $off1\n";
+
+    #- produce a TOC directly at the end of the file, follow with
+    #- a trailer with TOC summary and archive summary.
+    local *OUTPUT;
+    open OUTPUT, ">>$packer->{archive}";
+
+    my ($toc_str, $toc_data) = ('', '');
+    my @data_d = ();
+    my @data_l = ();
+    my @data_f = ();
+
+    foreach my $file (@{$packer->{files}}) {
+	$packer->{data}{$file} or die "packdrake: internal error on $_\n";
+
+	#- specific according to type.
+	#- with this version, only f has specific data other than strings.
+	for ($packer->{data}{$file}[0]) {
+	    /d/ && do { push @data_d, $file; last; };
+	    /l/ && do { push @data_l, $file; last; };
+	    /f/ && do { push @data_f, $file; $toc_data .= pack("NNNN", @{$packer->{data}{$file}}[1..4]); last; };
+	    die "packdrake: unknown extension $_\n";
+	}
+    }
+
+    foreach (@data_d) { $toc_str .= $_ . "\n" }
+    foreach (@data_l) { $toc_str .= $_ . "\n" . $packer->{data}{$_}[1] . "\n" }
+    foreach (@data_f) { $toc_str .= $_ . "\n" }
+
+    @{$packer}{qw(toc_d_count toc_l_count toc_f_count toc_str_size uncompress)} =
+      (scalar(@data_d), scalar(@data_l), scalar(@data_f), length($toc_str), $uncompress);
+
+    print OUTPUT $toc_str;
+    print OUTPUT $toc_data;
+    print OUTPUT build_toc_trailer($packer);
+    close OUTPUT;
+
+    unlink $packer->{tmpz};
+
+    $packer;
+}
+
+1;
diff --git a/parsehdlist.c b/parsehdlist.c
index 8c40a14..f896d92 100644
--- a/parsehdlist.c
+++ b/parsehdlist.c
@@ -84,6 +84,7 @@ void print_list_flags(Header header, int_32 tag_name, int_32 tag_flags, int_32 t
 	if (flags[i] & RPMSENSE_LESS) printf("<");
 	if (flags[i] & RPMSENSE_GREATER) printf(">");
 	if (flags[i] & RPMSENSE_EQUAL) printf("=");
+	if ((flags[i] & (RPMSENSE_LESS|RPMSENSE_EQUAL|RPMSENSE_GREATER)) == RPMSENSE_EQUAL) printf("=");
 	printf(" %s", list_evr[i]);
       }
       printf("\n");
diff --git a/rpmtools.pm b/rpmtools.pm
index b7b7184..50ac88e 100644
--- a/rpmtools.pm
+++ b/rpmtools.pm
@@ -6,29 +6,99 @@ use vars qw($VERSION @ISA);
 require DynaLoader;
 
 @ISA = qw(DynaLoader);
-$VERSION = '0.01';
+$VERSION = '0.02';
 
 bootstrap rpmtools $VERSION;
 
+=head1 NAME
+
+rpmtools - Mandrake perl tools to handle rpm files and hdlist files
+
+=head1 SYNOPSYS
+
+    require rpmtools;
+
+    my $params = new rpmtools;
+
+    $params->read_hdlists("/export/Mandrake/base/hdlist.cz",
+                          "/export/Mandrake/base/hdlist2.cz");
+    $params->read_rpms("/RPMS/rpmtools-2.1-5mdk.i586.rpm");
+    $params->compute_depslist();
+
+    $params->get_packages_installed("", \@packages, \@names);
+    $params->get_all_packages_installed("", \@packages);
+
+    $params->read_depslist(\*STDIN);
+    $params->write_depslist(\*STDOUT);
+
+    rpmtools::version_compare("1.0.23", "1.0.4");
+
+=head1 DESCRIPTION
+
+C<rpmtools> extend perl to manipulate hdlist file used by
+Linux-Mandrake distribution to compute dependancy file.
+
+=head1 SEE ALSO
+
+parsehdlist command is a simple hdlist parser that allow interactive mode
+use by DrakX upgrade algorithms.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000 MandrakeSoft <fpons@mandrakesoft.com>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+=cut
+
 #- build an empty params struct that can be used to compute dependancies.
 sub new {
+    my ($class, @tags) = @_;
+    my %tags; @tags{@_} = ();
     bless {
 	   use_base_flag => 0,
-	   flags         => [ qw(name version release size arch group requires provides) ],
+	   flags         => [ qw(name version release size arch group requires provides),
+			      grep { exists $tags{$_} } qw(sense files obsoletes conflicts) ],
 	   info          => {},
 	   depslist      => [],
 	   provides      => {},
-	  };
+	  }, $class;
 }
 
 #- read one or more hdlist files, use packdrake for decompression.
 sub read_hdlists {
     my ($params, @hdlists) = @_;
 
-    local *F;
-    open F, "packdrake -c ". join (' ', @hdlists) ." |";
-    rpmtools::_parse_(fileno *F, $params->{flags}, $params->{info}, $params->{provides});
-    close F;
+    local (*I, *O); pipe I, O;
+    if (my $pid = fork()) {
+	close O;
+
+	rpmtools::_parse_(fileno *I, $params->{flags}, $params->{info}, $params->{provides});
+
+	close I;
+	waitpid $pid, 0;
+    } else {
+	close I;
+	open STDOUT, ">&O" or die "unable to redirect output";
+
+	require packdrake;
+	packdrake::cat_archive(@hdlists);
+
+	close O;
+	exit 0;
+    }
     1;
 }
 
@@ -65,9 +135,6 @@ sub compute_depslist {
 	$params->{provides}{$_} = [ keys %provides ];
     }
 
-    #- search for entries in provides, if such entries are found,
-    #- another pass has to be done. TODO.
-
     #- take into account in which hdlist a package has been found.
     #- this can be done by an incremental take into account generation
     #- of depslist.ordered part corresponding to the hdlist.
@@ -393,14 +460,17 @@ sub write_compss {
     1;
 }
 
-#- compare a version string.
+#- compare a version string, make sure no deadlock can occur.
+#- bug: "0" and "" are equal (same for "" and "0"), should be
+#- trapped by release comparison (unless not correct).
 sub version_compare {
     my ($a, $b) = @_;
     local $_;
 
     while ($a || $b) {
-	my ($sb, $sa) =  map { $1 if ($a || 0) =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a);
+	my ($sb, $sa) =  map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D*)// } ($b, $a);
 	$_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_;
+	$sa eq '' && $sb eq '' and return $a cmp $b;
     }
 }
 
diff --git a/rpmtools.spec b/rpmtools.spec
index ca54718..e76bfee 100644
--- a/rpmtools.spec
+++ b/rpmtools.spec
@@ -1,5 +1,5 @@
 %define name rpmtools
-%define release 4mdk
+%define release 5mdk
 
 # do not modify here, see Makefile in the CVS
 %define version 2.1
@@ -48,10 +48,16 @@ rm -rf $RPM_BUILD_ROOT
 %{_bindir}/genbasefiles
 %dir %{perl_sitearch}/auto/rpmtools
 %{perl_sitearch}/auto/rpmtools/rpmtools.so
+%{perl_sitearch}/packdrake.pm
 %{perl_sitearch}/rpmtools.pm
-
+%{_libdir}/perl5/man/*/*
 
 %changelog
+* Wed Dec  6 2000 François Pons <fpons@mandrakesoft.com> 2.1-5mdk
+- split packdrake into packdrake.pm, updated version to 0.02.
+- rpmtools.pm to 0.02 too.
+- added man pages.
+
 * Thu Nov 23 2000 François Pons <fpons@mandrakesoft.com> 2.1-4mdk
 - fixed deadlock with version_compare().
 - fixed memory leaks in parsehdlist.
diff --git a/rpmtools.xs b/rpmtools.xs
index 01bbdfd..07b35b4 100644
--- a/rpmtools.xs
+++ b/rpmtools.xs
@@ -12,6 +12,22 @@
 #include <rpm/rpmlib.h>
 #include <rpm/header.h>
 
+#define HDFLAGS_NAME          0x00000001
+#define HDFLAGS_VERSION       0x00000002
+#define HDFLAGS_RELEASE       0x00000004
+#define HDFLAGS_ARCH          0x00000008
+#define HDFLAGS_GROUP         0x00000010
+#define HDFLAGS_SIZE          0x00000020
+#define HDFLAGS_SENSE         0x00080000
+#define HDFLAGS_REQUIRES      0x00100000
+#define HDFLAGS_PROVIDES      0x00200000
+#define HDFLAGS_OBSOLETES     0x00400000
+#define HDFLAGS_CONFLICTS     0x00800000
+#define HDFLAGS_FILES         0x01000000
+#define HDFLAGS_DIRSIND       0x02000000
+#define HDFLAGS_FILESIND      0x04000000
+
+
 char *get_name(Header header, int_32 tag) {
   int_32 type, count;
   char *name;
@@ -28,22 +44,49 @@ int get_int(Header header, int_32 tag) {
   return *i;
 }
 
-HV* get_info(Header header) {
-  HV* info = newHV();
-  char *name = get_name(header, RPMTAG_NAME);
-  STRLEN len = strlen(name);
-
-  if (info != 0) {
-    SV* sv_name = newSVpv(name, len);
-    SV* sv_version = newSVpv(get_name(header, RPMTAG_VERSION), 0);
-    SV* sv_release = newSVpv(get_name(header, RPMTAG_RELEASE), 0);
+int get_bflag(AV* flag) {
+  int bflag = 0;
+  int flag_len;
+  SV** ret;
+  STRLEN len;
+  char* str;
+  int i;
 
-    hv_store(info, "name", 4, sv_name, 0);
-    hv_store(info, "version", 7, sv_version, 0);
-    hv_store(info, "release", 7, sv_release, 0);
+  flag_len = av_len(flag);
+  for (i = 0; i <= flag_len; ++i) {
+    ret = av_fetch(flag, i, 0); if (!ret) continue;
+    str = SvPV(*ret, len);
+
+    switch (len) {
+    case 4:
+      if (!strncmp(str, "name", 4))      bflag |= HDFLAGS_NAME;
+      else if (!strncmp(str, "arch", 4)) bflag |= HDFLAGS_ARCH;
+      else if (!strncmp(str, "size", 4)) bflag |= HDFLAGS_SIZE;
+      break;
+    case 5:
+      if (!strncmp(str, "group", 5))      bflag |= HDFLAGS_GROUP;
+      else if (!strncmp(str, "sense", 5)) bflag |= HDFLAGS_SENSE;
+      else if (!strncmp(str, "files", 5)) bflag |= HDFLAGS_FILES;
+      break;
+    case 7:
+      if (!strncmp(str, "version", 7))      bflag |= HDFLAGS_VERSION;
+      else if (!strncmp(str, "release", 7)) bflag |= HDFLAGS_RELEASE;
+      else if (!strncmp(str, "dirsind", 7)) bflag |= HDFLAGS_DIRSIND;
+      break;
+    case 8:
+      if (!strncmp(str, "requires", 8))      bflag |= HDFLAGS_REQUIRES;
+      else if (!strncmp(str, "provides", 8)) bflag |= HDFLAGS_PROVIDES;
+      else if (!strncmp(str, "filesind", 8)) bflag |= HDFLAGS_FILESIND;
+      break;
+    case 9:
+      if (!strncmp(str, "obsoletes", 9))      bflag |= HDFLAGS_OBSOLETES;
+      else if (!strncmp(str, "conflicts", 9)) bflag |= HDFLAGS_CONFLICTS;
+      break;
+    }
   }
+  bflag |= HDFLAGS_NAME; /* this one should always be used */
 
-  return info;
+  return bflag;
 }
 
 SV *get_table_sense(Header header, int_32 tag_name, int_32 tag_flags, int_32 tag_version, HV* iprovides) {
@@ -108,33 +151,152 @@ SV *get_table_sense(Header header, int_32 tag_name, int_32 tag_flags, int_32 tag
   return &PL_sv_undef;
 }
 
-#define HDFLAGS_NAME          0x00000001
-#define HDFLAGS_VERSION       0x00000002
-#define HDFLAGS_RELEASE       0x00000004
-#define HDFLAGS_ARCH          0x00000008
-#define HDFLAGS_GROUP         0x00000010
-#define HDFLAGS_SIZE          0x00000020
-#define HDFLAGS_SENSE         0x00080000
-#define HDFLAGS_REQUIRES      0x00100000
-#define HDFLAGS_PROVIDES      0x00200000
-#define HDFLAGS_OBSOLETES     0x00400000
-#define HDFLAGS_CONFLICTS     0x00800000
-#define HDFLAGS_FILES         0x01000000
-#define HDFLAGS_DIRSIND       0x02000000
-#define HDFLAGS_FILESIND      0x04000000
+HV* get_info(Header header, int bflag, HV* provides) {
+  int_32 type, count;
+  char **list;
+  int_32 *flags;
+  SV** ret;
+  STRLEN len;
+  char* str;
+  int i;
+  SV* sv_name = newSVpv(get_name(header, RPMTAG_NAME), 0);
+  HV* header_info = newHV();
+
+  /* correct bflag according to provides hash else not really usefull */
+  if (provides) bflag |= HDFLAGS_REQUIRES;
+
+  hv_store(header_info, "name", 4, sv_name, 0);
+  if (bflag & HDFLAGS_VERSION)
+    hv_store(header_info, "version", 7, newSVpv(get_name(header, RPMTAG_VERSION), 0), 0);
+  if (bflag & HDFLAGS_RELEASE)
+    hv_store(header_info, "release", 7, newSVpv(get_name(header, RPMTAG_RELEASE), 0), 0);
+  if (bflag & HDFLAGS_ARCH)
+    hv_store(header_info, "arch", 4, newSVpv(get_name(header, RPMTAG_ARCH), 0), 0);
+  if (bflag & HDFLAGS_GROUP)
+    hv_store(header_info, "group", 5, newSVpv(get_name(header, RPMTAG_GROUP), 0), 0);
+  if (bflag & HDFLAGS_SIZE)
+    hv_store(header_info, "size", 4, newSViv(get_int(header, RPMTAG_SIZE)), 0);
+  if (bflag & HDFLAGS_REQUIRES)
+    hv_store(header_info, "requires", 8, get_table_sense(header,                 RPMTAG_REQUIRENAME,
+							 bflag & HDFLAGS_SENSE ? RPMTAG_REQUIREFLAGS : 0,
+							 bflag & HDFLAGS_SENSE ? RPMTAG_REQUIREVERSION : 0, provides), 0);
+  if (bflag & HDFLAGS_PROVIDES)
+    hv_store(header_info, "provides", 8, get_table_sense(header,                 RPMTAG_PROVIDENAME,
+							 bflag & HDFLAGS_SENSE ? RPMTAG_PROVIDEFLAGS : 0,
+							 bflag & HDFLAGS_SENSE ? RPMTAG_PROVIDEVERSION : 0, 0), 0);
+  if (bflag & HDFLAGS_OBSOLETES)
+    hv_store(header_info, "obsoletes", 9, get_table_sense(header,                 RPMTAG_OBSOLETENAME,
+							  bflag & HDFLAGS_SENSE ? RPMTAG_OBSOLETEFLAGS : 0,
+							  bflag & HDFLAGS_SENSE ? RPMTAG_OBSOLETEVERSION : 0, 0), 0);
+  if (bflag & HDFLAGS_CONFLICTS)
+    hv_store(header_info, "conflicts", 9, get_table_sense(header,                 RPMTAG_CONFLICTNAME,
+							  bflag & HDFLAGS_SENSE ? RPMTAG_CONFLICTFLAGS : 0,
+							  bflag & HDFLAGS_SENSE ? RPMTAG_CONFLICTVERSION : 0, 0), 0);
+  if (provides || (bflag & HDFLAGS_FILES)) {
+    /* at this point, there is a need to parse all files to update provides of needed files,
+       or to store them. */
+    AV* table_files = bflag & HDFLAGS_FILES ? newAV() : 0;
+    char ** baseNames, ** dirNames;
+    int_32 * dirIndexes;
+
+    headerGetEntry(header, RPMTAG_OLDFILENAMES, &type, (void **) &list, &count);
+
+    if (list) {
+      for (i = 0; i < count; i++) {
+	SV** isv;
+
+	len = strlen(list[i]);
+
+	if (provides && (isv = hv_fetch(provides, list[i], len, 0)) != 0) {
+	  if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) {
+	    SV* choice_table = (SV*)newAV();
+	    SvREFCNT_dec(*isv); /* drop the old as we are changing it */
+	    *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef;
+	  }
+	  if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name));
+	}
+	/* if (provides && hv_exists(provides, list[i], len))
+	   hv_store(provides, list[i], len, newSVpv(name, 0), 0); */
+	if (table_files)
+	  av_push(table_files, newSVpv(list[i], len));
+      }
+    }
+
+    headerGetEntry(header, RPMTAG_BASENAMES, &type, (void **) &baseNames, 
+		   &count);
+    headerGetEntry(header, RPMTAG_DIRINDEXES, &type, (void **) &dirIndexes, 
+		   NULL);
+    headerGetEntry(header, RPMTAG_DIRNAMES, &type, (void **) &dirNames, NULL);
+
+    if (baseNames && dirNames && dirIndexes) {
+      char buff[4096];
+      char *p;
+
+      for(i = 0; i < count; i++) {
+	SV** isv;
+
+	len = strlen(dirNames[dirIndexes[i]]);
+	if (len >= sizeof(buff)) continue;
+	memcpy(p = buff, dirNames[dirIndexes[i]], len + 1); p += len;
+	len = strlen(baseNames[i]);
+	if (p - buff + len >= sizeof(buff)) continue;
+	memcpy(p, baseNames[i], len + 1); p += len;
+
+	if (provides && (isv = hv_fetch(provides, buff, p - buff, 0)) != 0) {
+	  if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) {
+	    SV* choice_table = (SV*)newAV();
+	    SvREFCNT_dec(*isv); /* drop the old as we are changing it */
+	    *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef;
+	  }
+	  if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name));
+	}
+	if (table_files)
+	  av_push(table_files, newSVpv(buff, p - buff));
+      }
+    }
+
+    if (table_files)
+      hv_store(header_info, "files", 5, newRV_noinc((SV*)table_files), 0);
+  }
+  if (provides) {
+    /* we have to examine provides to update the hash here. */
+    headerGetEntry(header, RPMTAG_PROVIDENAME, &type, (void **) &list, &count);
+
+    if (list) {
+      for (i = 0; i < count; i++) {
+	SV** isv;
+
+	len = strlen(list[i]);
+
+	isv = hv_fetch(provides, list[i], len, 1);
+	if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) {
+	  SV* choice_table = (SV*)newAV();
+	  SvREFCNT_dec(*isv); /* drop the old as we are changing it */
+	  *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef;
+	}
+	if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name));
+      }
+    }
+  }
+
+  return header_info;
+}
 
 
 MODULE = rpmtools			PACKAGE = rpmtools
 
 
 int
-get_packages_installed(prefix, packages, lnames)
+get_packages_installed(prefix, packages, lnames, ...)
   char* prefix
   SV* packages
   SV* lnames
   PREINIT:
+  SV* flags = &PL_sv_undef;
   int count = 0;
   CODE:
+  if (items > 3)
+    flags = ST(3);
   if (SvROK(packages) && SvTYPE(SvRV(packages)) == SVt_PVAV &&
       SvROK(lnames) && SvTYPE(SvRV(lnames)) == SVt_PVAV) {
     AV* pkgs = (AV*)SvRV(packages);
@@ -143,13 +305,15 @@ get_packages_installed(prefix, packages, lnames)
     SV** isv;
     rpmdb db;
     dbiIndexSet matches;
-    int num, i, j, rc, len;
+    int bflag, num, i, j, rc, len;
     char *name;
     Header header;
     rpmdbMatchIterator mi;
 
     if (rpmReadConfigFiles(NULL, NULL) == 0) {
       if (rpmdbOpen(prefix, &db, O_RDONLY, 0644) == 0) {
+	bflag = SvROK(flags) && SvTYPE(SvRV(flags)) ?
+	  get_bflag((AV*)SvRV(flags)) : (HDFLAGS_NAME | HDFLAGS_VERSION | HDFLAGS_RELEASE);
 	len = av_len(names);
 	for (j = 0; j <= len; ++j) {
 	  isv = av_fetch(names, j, 0);
@@ -158,7 +322,7 @@ get_packages_installed(prefix, packages, lnames)
 	  count=0;
           while (header = rpmdbNextIterator(mi)) {
 	    count++;
-	    info = get_info(header);
+	    info = get_info(header, bflag, NULL);
 
 	    if (info != 0) av_push(pkgs, newRV_noinc((SV*)info));
 
@@ -175,26 +339,31 @@ get_packages_installed(prefix, packages, lnames)
 
 
 int
-get_all_packages_installed(prefix, packages)
+get_all_packages_installed(prefix, packages, ...)
   char* prefix
   SV* packages
   PREINIT:
+  SV* flags = &PL_sv_undef;
   int count = 0;
   CODE:
+  if (items > 2)
+    flags = ST(2);
   if (SvROK(packages) && SvTYPE(SvRV(packages)) == SVt_PVAV) {
     AV* pkgs = (AV*)SvRV(packages);
     HV* info;
     rpmdb db;
-    int num;
+    int bflag, num;
     Header header;
     rpmdbMatchIterator mi;
     
     if (rpmReadConfigFiles(NULL, NULL) == 0) {
       if (rpmdbOpen(prefix, &db, O_RDONLY, 0644) == 0) {
+	bflag = SvROK(flags) && SvTYPE(SvRV(flags)) ?
+	  get_bflag((AV*)SvRV(flags)) : (HDFLAGS_NAME | HDFLAGS_VERSION | HDFLAGS_RELEASE);
 	mi = rpmdbInitIterator(db, RPMDBI_PACKAGES, NULL, 0);
 	
 	while (header = rpmdbNextIterator(mi)) {
-	  info = get_info(header);
+	  info = get_info(header, bflag, NULL);
 
 	  if (info != 0) av_push(pkgs, newRV_noinc((SV*)info));
 
@@ -224,11 +393,8 @@ _parse_(fileno_or_rpmfile, flag, info, ...)
     FD_t fd;
     int fd_is_hdlist;
     Header header;
-    int_32 type, count;
-    char **list;
-    int_32 *flags;
 
-    int bflag = 0;
+    int bflag;
     AV* iflag;
     HV* iinfo;
     HV* iprovides;
@@ -257,164 +423,15 @@ _parse_(fileno_or_rpmfile, flag, info, ...)
     iprovides = (HV*)(provides != &PL_sv_undef ? SvRV(provides) : 0);
 
     /* examine flag and set up iflag, which is faster to fecth out */
-    flag_len = av_len(iflag);
-    for (i = 0; i <= flag_len; ++i) {
-      ret = av_fetch(iflag, i, 0); if (!ret) continue;
-      str = SvPV(*ret, len);
-
-      switch (len) {
-      case 4:
-	if (!strncmp(str, "name", 4))      bflag |= HDFLAGS_NAME;
-	else if (!strncmp(str, "arch", 4)) bflag |= HDFLAGS_ARCH;
-	else if (!strncmp(str, "size", 4)) bflag |= HDFLAGS_SIZE;
-	break;
-      case 5:
-	if (!strncmp(str, "group", 5))      bflag |= HDFLAGS_GROUP;
-	else if (!strncmp(str, "sense", 5)) bflag |= HDFLAGS_SENSE;
-	else if (!strncmp(str, "files", 5)) bflag |= HDFLAGS_FILES;
-	break;
-      case 7:
-	if (!strncmp(str, "version", 7))      bflag |= HDFLAGS_VERSION;
-	else if (!strncmp(str, "release", 7)) bflag |= HDFLAGS_RELEASE;
-	else if (!strncmp(str, "dirsind", 7)) bflag |= HDFLAGS_DIRSIND;
-	break;
-      case 8:
-	if (!strncmp(str, "requires", 8))      bflag |= HDFLAGS_REQUIRES;
-	else if (!strncmp(str, "provides", 8)) bflag |= HDFLAGS_PROVIDES;
-	else if (!strncmp(str, "filesind", 8)) bflag |= HDFLAGS_FILESIND;
-	break;
-      case 9:
-	if (!strncmp(str, "obsoletes", 9))      bflag |= HDFLAGS_OBSOLETES;
-	else if (!strncmp(str, "conflicts", 9)) bflag |= HDFLAGS_CONFLICTS;
-	break;
-      }
-    }
-    bflag |= HDFLAGS_NAME; /* this one should always be used */
-    if (iprovides) bflag |= HDFLAGS_REQUIRES; /* not really usefull else */
+    bflag = get_bflag(iflag);
 
     /* start the big loop,
        parse all header from fileno, then extract information to store into iinfo and iprovides. */
     while (fd_is_hdlist >= 0 ? (fd_is_hdlist > 0 ?
 				((header=headerRead(fd, HEADER_MAGIC_YES)) != 0) :
 				((fd_is_hdlist = -1), rpmReadPackageHeader(fd, &header, &i, NULL, NULL) == 0)) : 0) {
-      char *name = get_name(header, RPMTAG_NAME);
-      SV* sv_name = newSVpv(name, 0);
-      HV* header_info = newHV();
-
-      if (bflag & HDFLAGS_NAME)
-	hv_store(header_info, "name", 4, SvREFCNT_inc(sv_name), 0);
-      if (bflag & HDFLAGS_VERSION)
-	hv_store(header_info, "version", 7, newSVpv(get_name(header, RPMTAG_VERSION), 0), 0);
-      if (bflag & HDFLAGS_RELEASE)
-	hv_store(header_info, "release", 7, newSVpv(get_name(header, RPMTAG_RELEASE), 0), 0);
-      if (bflag & HDFLAGS_ARCH)
-	hv_store(header_info, "arch", 4, newSVpv(get_name(header, RPMTAG_ARCH), 0), 0);
-      if (bflag & HDFLAGS_GROUP)
-	hv_store(header_info, "group", 5, newSVpv(get_name(header, RPMTAG_GROUP), 0), 0);
-      if (bflag & HDFLAGS_SIZE)
-	hv_store(header_info, "size", 4, newSViv(get_int(header, RPMTAG_SIZE)), 0);
-      if (bflag & HDFLAGS_REQUIRES)
-	hv_store(header_info, "requires", 8, get_table_sense(header,                 RPMTAG_REQUIRENAME,
-							     bflag & HDFLAGS_SENSE ? RPMTAG_REQUIREFLAGS : 0,
-							     bflag & HDFLAGS_SENSE ? RPMTAG_REQUIREVERSION : 0, iprovides), 0);
-      if (bflag & HDFLAGS_PROVIDES)
-	hv_store(header_info, "provides", 8, get_table_sense(header,                 RPMTAG_PROVIDENAME,
-							     bflag & HDFLAGS_SENSE ? RPMTAG_PROVIDEFLAGS : 0,
-							     bflag & HDFLAGS_SENSE ? RPMTAG_PROVIDEVERSION : 0, 0), 0);
-      if (bflag & HDFLAGS_OBSOLETES)
-	hv_store(header_info, "obsoletes", 9, get_table_sense(header,                 RPMTAG_OBSOLETENAME,
-							      bflag & HDFLAGS_SENSE ? RPMTAG_OBSOLETEFLAGS : 0,
-							      bflag & HDFLAGS_SENSE ? RPMTAG_OBSOLETEVERSION : 0, 0), 0);
-      if (bflag & HDFLAGS_CONFLICTS)
-	hv_store(header_info, "conflicts", 9, get_table_sense(header,                 RPMTAG_CONFLICTNAME,
-							      bflag & HDFLAGS_SENSE ? RPMTAG_CONFLICTFLAGS : 0,
-							      bflag & HDFLAGS_SENSE ? RPMTAG_CONFLICTVERSION : 0, 0), 0);
-      if (iprovides || (bflag & HDFLAGS_FILES)) {
-	/* at this point, there is a need to parse all files to update provides of needed files,
-	   or to store them. */
-	AV* table_files = bflag & HDFLAGS_FILES ? newAV() : 0;
-	char ** baseNames, ** dirNames;
-	int_32 * dirIndexes;
-
-	headerGetEntry(header, RPMTAG_OLDFILENAMES, &type, (void **) &list, &count);
-
-	if (list) {
-	  for (i = 0; i < count; i++) {
-	    SV** isv;
-
-	    len = strlen(list[i]);
-
-	    if (iprovides && (isv = hv_fetch(iprovides, list[i], len, 0)) != 0) {
-	      if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) {
-		SV* choice_table = (SV*)newAV();
-		SvREFCNT_dec(*isv); /* drop the old as we are changing it */
-		*isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef;
-	      }
-	      if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name));
-	    }
-	    /*	    if (iprovides && hv_exists(iprovides, list[i], len))
-		    hv_store(iprovides, list[i], len, newSVpv(name, 0), 0); */
-	    if (table_files)
-	      av_push(table_files, newSVpv(list[i], len));
-	  }
-	}
-
-	headerGetEntry(header, RPMTAG_BASENAMES, &type, (void **) &baseNames, 
-		       &count);
-	headerGetEntry(header, RPMTAG_DIRINDEXES, &type, (void **) &dirIndexes, 
-		       NULL);
-	headerGetEntry(header, RPMTAG_DIRNAMES, &type, (void **) &dirNames, NULL);
-
-	if (baseNames && dirNames && dirIndexes) {
-	  char buff[4096];
-	  char *p;
-
-	  for(i = 0; i < count; i++) {
-	    SV** isv;
-
-	    len = strlen(dirNames[dirIndexes[i]]);
-	    if (len >= sizeof(buff)) continue;
-	    memcpy(p = buff, dirNames[dirIndexes[i]], len + 1); p += len;
-	    len = strlen(baseNames[i]);
-	    if (p - buff + len >= sizeof(buff)) continue;
-	    memcpy(p, baseNames[i], len + 1); p += len;
-
-	    if (iprovides && (isv = hv_fetch(iprovides, buff, p - buff, 0)) != 0) {
-	      if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) {
-		SV* choice_table = (SV*)newAV();
-		SvREFCNT_dec(*isv); /* drop the old as we are changing it */
-		*isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef;
-	      }
-	      if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name));
-	    }
-	    if (table_files)
-	      av_push(table_files, newSVpv(buff, p - buff));
-	  }
-	}
-
-	if (table_files)
-	  hv_store(header_info, "files", 5, newRV_noinc((SV*)table_files), 0);
-      }
-      if (iprovides) {
-	/* we have to examine provides to update the hash here. */
-	headerGetEntry(header, RPMTAG_PROVIDENAME, &type, (void **) &list, &count);
-
-	if (list) {
-	  for (i = 0; i < count; i++) {
-	    SV** isv;
-
-	    len = strlen(list[i]);
-
-	    isv = hv_fetch(iprovides, list[i], len, 1);
-	    if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) {
-	      SV* choice_table = (SV*)newAV();
-	      SvREFCNT_dec(*isv); /* drop the old as we are changing it */
-	      *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef;
-	    }
-	    if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name));
-	  }
-	}
-      }
+      SV* sv_name = newSVpv(get_name(header, RPMTAG_NAME), 0);
+      HV* header_info = get_info(header, bflag, iprovides);
 
       /* once the hash header_info is built, store a reference to it
 	 in iinfo.