diff options
| -rw-r--r-- | URPM.pm | 2 | ||||
| -rw-r--r-- | URPM/Build.pm | 200 | ||||
| -rw-r--r-- | perl-URPM.spec | 4 |
3 files changed, 132 insertions, 74 deletions
@@ -6,7 +6,7 @@ use vars qw($VERSION @ISA); require DynaLoader; @ISA = qw(DynaLoader); -$VERSION = '0.01'; +$VERSION = '0.02'; bootstrap URPM $VERSION; 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; diff --git a/perl-URPM.spec b/perl-URPM.spec index 8e39f02..5c4e827 100644 --- a/perl-URPM.spec +++ b/perl-URPM.spec @@ -47,5 +47,9 @@ rm -rf $RPM_BUILD_ROOT %changelog +* Mon Jun 3 2002 François Pons <fpons@mandrakesoft.com> 0.02-1mdk +- new version with extended parameters list for URPM::Build. +- fixed code to be -w clean. + * Fri May 31 2002 François Pons <fpons@mandrakesoft.com> 0.01-1mdk - initial revision. |