aboutsummaryrefslogtreecommitdiffstats
path: root/URPM/Build.pm
diff options
context:
space:
mode:
Diffstat (limited to 'URPM/Build.pm')
-rw-r--r--URPM/Build.pm200
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;