cleaned URPM::Build to accept extended parameter list and -w clean.0.02

0.02.

1 files changed, 127 insertions, 73 deletions

diff --git a/URPM/Build.pm b/URPM/Build.pm
index 6ebbfd0..c5af5fc 100644
--- a/URPM/Build.pm
+++ b/URPM/Build.pm
@@ -4,58 +4,74 @@ use strict;
 
 #- prepare build of an hdlist from a list of files.
 #- it can be used to start computing depslist.
+#- parameters are :
+#-   rpms     : array of all rpm file name to parse (mandatory)
+#-   dir      : directory wich will contain headers (default to /tmp/.build_hdlist)
+#-   callback : perl code to be called for each package read (default pack_header)
+#-   clean    : bool to clean cache before (default no).
 sub parse_rpms_build_headers {
-    my ($urpm, $dir, @rpms) = @_;
-    my (%cache, @headers, %names);
-
-    #- build a working directory which will hold rpm headers.
-    $dir ||= '.';
-    -d $dir or mkdir $dir, 0755 or die "cannot create directory $dir\n";
-
-    #- examine cache if it contains any headers which will be much faster to read
-    #- than parsing rpm file directly.
-    local *DIR;
-    opendir DIR, $dir;
-    while (my $file = readdir DIR) {
-	$file =~ /(.+?-[^:\-]+-[^:\-]+\.[^:\-\.]+)(?::(\S+))?$/ or next;
-	$cache{$2 || $1} = $file;
-    }
-    closedir DIR;
+    my ($urpm, %options) = @_;
+    my ($dir, %cache, @headers, %names);
+
+    #- check for mandatory options.
+    if (@{$options{rpms} || []} > 0) {
+	#- build a working directory which will hold rpm headers.
+	$dir = $options{dir} || ($ENV{TMPDIR} || "/tmp") . "/.build_hdlist";
+	$options{clean} and system(($ENV{LD_LOADER} ? ($ENV{LD_LOADER}) : ()), "rm", "-rf", $dir);
+	-d $dir or mkdir $dir, 0755 or die "cannot create directory $dir\n";
+
+	#- examine cache if it contains any headers which will be much faster to read
+	#- than parsing rpm file directly.
+	unless ($options{clean}) {
+	    local *DIR;
+	    opendir DIR, $dir;
+	    while (my $file = readdir DIR) {
+		$file =~ /(.+?-[^:\-]+-[^:\-]+\.[^:\-\.]+)(?::(\S+))?$/ or next;
+		$cache{$2 || $1} = $file;
+	    }
+	    closedir DIR;
+	}
 
-    foreach (@rpms) {
-	my ($key) = /([^\/]*)\.rpm$/ or next; #- get rpm filename.
-	my ($id, $filename);
+	foreach (@{$options{rpms}}) {
+	    my ($key) = /([^\/]*)\.rpm$/ or next; #- get rpm filename.
+	    my ($id, $filename);
 
-	if ($cache{$key} && -s "$dir/$cache{$key}") {
-	    ($id, undef) = $urpm->parse_hdlist("$dir/$cache{$key}", 1);
-	    defined $id or die "bad header $dir/$cache{$key}\n";
+	    if ($cache{$key} && -s "$dir/$cache{$key}") {
+		($id, undef) = $urpm->parse_hdlist("$dir/$cache{$key}", !$options{callback});
+		defined $id or die "bad header $dir/$cache{$key}\n";
+		$options{callback} and $options{callback}->($urpm, $id, %options);
 
-	    $filename = $cache{$key};
-	} else {
-	    ($id, undef) = $urpm->parse_rpm($_);
-	    defined $id or die "bad rpm $_\n";
+		$filename = $cache{$key};
+	    } else {
+		($id, undef) = $urpm->parse_rpm($_);
+		defined $id or die "bad rpm $_\n";
 	
-	    my $pkg = $urpm->{depslist}[$id];
+		my $pkg = $urpm->{depslist}[$id];
+
+		$filename = $pkg->fullname;
+		"$filename.rpm" eq $pkg->filename or $filename .= ":$key";
 
-	    $filename = $pkg->fullname;
-	    "$filename.rpm" eq $pkg->filename or $filename .= ":$key";
+		print STDERR "$dir/$filename\n";
+		unless (-s "$dir/$filename") {
+		    local *F;
+		    open F, ">$dir/$filename";
+		    $pkg->build_header(fileno *F);
+		    close F;
+		}
+		-s "$dir/$filename" or unlink("$dir/$filename"), die "can create header $dir/$filename\n";
 
-	    print STDERR "$dir/$filename\n";
-	    unless (-s "$dir/$filename") {
-		local *F;
-		open F, ">$dir/$filename";
-		$pkg->build_header(fileno *F);
-		close F;
+		#- make smart use of memory (no need to keep header in memory now).
+		if ($options{callback}) {
+		    $options{callback}->($urpm, $id, %options);
+		} else {
+		    $pkg->pack_header;
+		}
 	    }
-	    -s "$dir/$filename" or unlink("$dir/$filename"), die "can create header $dir/$filename\n";
 
-	    #- make smart use of memory (no need to keep header in memory now).
-	    $pkg->pack_header;
+	    #- keep track of header associated (to avoid rereading rpm filename directly
+	    #- if rereading has been made neccessary).
+	    push @headers, $filename;
 	}
-
-	#- keep track of header associated (to avoid rereading rpm filename directly
-	#- if rereading has been made neccessary).
-	push @headers, $filename;
     }
     @headers;
 }
@@ -77,18 +93,23 @@ sub unresolved_provides_clean {
 
 #- read a list of headers (typically when building an hdlist when provides have
 #- been cleaned.
+#- parameters are :
+#-   headers  : array of all headers file name to parse (mandatory)
+#-   dir      : directory wich contains headers (default to /tmp/.build_hdlist)
+#-   callback : perl code to be called for each package read (default pack_header)
 sub parse_headers {
-    my ($urpm, $dir, @headers) = @_;
-    my ($start, $id);
+    my ($urpm, %options) = @_;
+    my ($dir, $start, $id);
 
-    $dir ||= '.';
+    $dir = $options{dir} || ($ENV{TMPDIR} || "/tmp") . "/.build_hdlist";
     -d $dir or die "no directory $dir\n";
 
     $start = @{$urpm->{depslist} || []};
-    foreach (@headers) {
+    foreach (@{$options{headers} || []}) {
 	#- make smart use of memory (no need to keep header in memory now).
-	($id, undef) = $urpm->parse_hdlist("$dir/$_", 1);
+	($id, undef) = $urpm->parse_hdlist("$dir/$_", !$options{callback});
 	defined $id or die "bad header $dir/$_\n";
+	$options{callback} and $options{callback}->($urpm, $id, %options);
     }
     defined $id ? ($start, $id) : ();
 }
@@ -157,11 +178,11 @@ sub compute_deps {
     #- expand choices and closure again.
     my %ordered;
     foreach ($start .. $end) {
-	my %requires;
 	my @requires = ($_);
-	while (my $dep = shift @requires) {
+	my ($dep, %requires);
+	while (defined ($dep = shift @requires)) {
 	    exists $requires{$dep} || /^[^0-9\|]*$/ and next;
-	    foreach ($dep, split ' ', $urpm->{requires}[$dep]) {
+	    foreach ($dep, split ' ', (defined $urpm->{deps}[$dep] ? $urpm->{deps}[$dep] : $urpm->{requires}[$dep])) {
 		if (/\|/) {
 		    push @requires, split /\|/, $_;
 		} else {
@@ -196,7 +217,7 @@ sub compute_deps {
     #- safely be removed from requires of others packages.
     foreach (qw(basesystem glibc kernel)) {
 	foreach (keys %{$urpm->{provides}{$_} || {}}) {
-	    foreach ($_, split ' ', $urpm->{requires}[$_]) {
+	    foreach ($_, split ' ', (defined $urpm->{deps}[$_] ? $urpm->{deps}[$_] : $urpm->{requires}[$_])) {
 		/^[0-9]+$/ and $urpm->{depslist}[$_] and $urpm->{depslist}[$_]->set_flag_base(1);
 	    }
 	}
@@ -220,15 +241,14 @@ sub compute_deps {
 	#- set new id.
 	$pkg->set_id($remap_ids{$_});
 
-	my ($id, $base, %requires_id);
+	my ($id, $base, %requires_id, %not_founds);
 	foreach (split ' ', $urpm->{requires}[$_]) {
 	    if (/\|/) {
 		#- all choices are grouped together at the end of requires,
 		#- this allow computation of dropable choices.
 		my ($to_drop, @choices_base_id, @choices_id);
 		foreach (split /\|/, $_) {
-		    my ($id, $base) = /^[0-9]+$/ ? (exists $remap_ids{$_} ? $remap_ids{$_} : $_,
-						    $urpm->{depslist}[$_]->flag_base) : ($_, 0);
+		    my ($id, $base) = (exists $remap_ids{$_} ? $remap_ids{$_} : $_, $urpm->{depslist}[$_]->flag_base);
 		    $base and push @choices_base_id, $id;
 		    $base &&= ! $pkg->flag_base;
 		    $to_drop ||= $id == $pkg->id || exists $requires_id{$id} || $base;
@@ -250,18 +270,20 @@ sub compute_deps {
 		    $requires_id{$choices_key} = undef;
 		    next;
 		}
+	    } elsif (/^[0-9]+$/) {
+		($id, $base) =  (exists $remap_ids{$_} ? $remap_ids{$_} : $_, $urpm->{depslist}[$_]->flag_base);
 	    } else {
-		($id, $base) = /^[0-9]+$/ ? (exists $remap_ids{$_} ? $remap_ids{$_} : $_,
-					     $urpm->{depslist}[$_]->flag_base) : ($_, 0);
+		$not_founds{$_} = undef;
+		next;
 	    }
 
-	    #- select individual package.
+	    #- select individual package from choices or defined package.
 	    $base &&= ! $pkg->flag_base;
-	    $id == $pkg->id || $base or $requires_id{$id} = undef;
+	    $base || $id == $pkg->id or $requires_id{$id} = undef;
 	}
 	#- be smart with memory usage.
 	delete $urpm->{requires}[$_];
-	$urpm->{deps}[$remap_ids{$_}] = join(' ', sort { $a <=> $b } map { join '|', sort { $a <=> $b } @{ref $_ ? $_ : [$_]} } keys %requires_id);
+	$urpm->{deps}[$remap_ids{$_}] = join(' ', (sort { ($a =~ /^([0-9]+)/)[0] <=> ($b =~ /^([0-9]+)/)[0] } keys %requires_id), keys %not_founds);
 	$depslist[$remap_ids{$_}-$start] = $pkg;
     }
 
@@ -280,8 +302,22 @@ sub compute_deps {
 }
 
 #- build an hdlist from existing depslist, from start to end inclusive.
+#- parameters are :
+#-   hdlist   : hdlist file to use.
+#-   dir      : directory wich contains headers (default to /tmp/.build_hdlist)
+#-   start    : index of first package (default to first index of depslist).
+#-   end      : index of last package (default to last index of depslist).
+#-   ratio    : compression ratio (default 4).
+#-   split    : split ratio (default 400000).
 sub build_hdlist {
-    my ($urpm, $start, $end, $dir, $hdlist, $ratio, $split_ratio) = @_;
+    my ($urpm, %options) = @_;
+    my ($dir, $start, $end, $ratio, $split);
+
+    $dir = $options{dir} || ($ENV{TMPDIR} || "/tmp") . "/.build_hdlist";
+     -d $dir or die "no directory $dir\n";
+
+    $start = $options{start} || 0;
+    $end = $options{end} || $#{$urpm->{depslist}};
 
     #- compression ratio are not very high, sample for cooker
     #- gives the following (main only and cache fed up):
@@ -291,10 +327,10 @@ sub build_hdlist {
     #-   5        9.5 sec     8.20Mb
     #-   4        8.6 sec     8.30Mb   -> good for urpmi
     #-   3        7.6 sec     8.60Mb
-    $ratio ||= 4;
-    $split_ratio ||= 400000;
+    $ratio = $options{ratio} || 4;
+    $split = $options{split} || 400000;
 
-    open B, "| $ENV{LD_LOADER} packdrake -b${ratio}ds '$hdlist' '$dir' $split_ratio";
+    open B, "| " . ($ENV{LD_LOADER} || '') . " packdrake -b${ratio}ds '$options{hdlist}' '$dir' $split";
     foreach (@{$urpm->{depslist}}[$start .. $end]) {
 	my $filename = $_->fullname;
 	"$filename.rpm" ne $_->filename && $_->filename =~ /([^\/]*)\.rpm$/ and $filename .= ":$1";
@@ -305,10 +341,22 @@ sub build_hdlist {
 }
 
 #- build synthesis file.
+#- parameters are :
+#-   synthesis : synthesis file to create (mandatory if fd not given).
+#-   fd        : file descriptor (mandatory if synthesis not given).
+#-   dir       : directory wich contains headers (default to /tmp/.build_hdlist)
+#-   start     : index of first package (default to first index of depslist).
+#-   end       : index of last package (default to last index of depslist).
+#-   ratio     : compression ratio (default 9).
 sub build_synthesis {
-    my ($urpm, $start, $end, $synthesis) = @_;
+    my ($urpm, %options) = @_;
+    my ($start, $end, $ratio);
 
+    $start = $options{start} || 0;
+    $end = $options{end} || $#{$urpm->{depslist}};
     $start > $end and return;
+    $ratio = $options{ratio} || 9;
+    $options{synthesis} || defined $options{fd} or die "invalid parameters given";
 
     #- first pass: traverse provides to find files provided.
     my %provided_files;
@@ -319,8 +367,10 @@ sub build_synthesis {
 	}
     }
 
+
+    #- second pass: write each info including files provided.
     local *F;
-    open F, "| $ENV{LD_LOADER} gzip -9 >'$synthesis'";
+    $options{synthesis} and open F, "| " . ($ENV{LD_LOADER} || '') . " gzip -$ratio >'$options{synthesis}'";
     foreach ($start .. $end) {
 	my $pkg = $urpm->{depslist}[$_];
 	my %files;
@@ -330,18 +380,22 @@ sub build_synthesis {
 	    delete @files{$pkg->provides_nosense};
 	}
 
-	$pkg->build_info(fileno *F, join('@', keys %files));
+	$pkg->build_info($options{synthesis} ? fileno *F : $options{fd}, join('@', keys %files));
     }
     close F;
 }
 
 #- write depslist.ordered file according to info in params.
+#- parameters are :
+#-   depslist : depslist.ordered file to create.
+#-   provides : provides file to create.
+#-   compss   : compss file to create.
 sub build_base_files {
-    my ($urpm, $depslist, $provides, $compss) = @_;
+    my ($urpm, %options) = @_;
     local *F;
 
-    if ($depslist) {
-	open F, ">$depslist";
+    if ($options{depslist}) {
+	open F, ">$options{depslist}";
 	for (0 .. $#{$urpm->{depslist}}) {
 	    my $pkg = $urpm->{depslist}[$_];
 
@@ -351,18 +405,18 @@ sub build_base_files {
 	close F;
     }
 
-    if ($provides) {
-	open F, ">$provides";
+    if ($options{provides}) {
+	open F, ">$options{provides}";
 	while (my ($k, $v) = each %{$urpm->{provides}}) {
 	    printf F "%s\n", join '@', $k, map { scalar $urpm->{depslist}[$_]->fullname } keys %{$v || {}};
 	}
 	close F;
     }
 
-    if ($compss) {
+    if ($options{compss}) {
 	my %p;
 
-	open F, ">$compss";
+	open F, ">$options{compss}";
 	foreach (@{$urpm->{depslist}}) {
 	    $_->group or next;
 	    push @{$p{$_->group} ||= []}, $_->name;