summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOlivier Thauvin <nanardon@mandriva.org>2007-07-11 15:31:45 +0000
committerOlivier Thauvin <nanardon@mandriva.org>2007-07-11 15:31:45 +0000
commitfa0f51b5344e5819c30f4f2d8d53399cab417528 (patch)
tree7d44d129779fca82dafc9e82e609b5d26f83931d
parentec1cd1c50853b5204b9daffc57110ac81dbb15b5 (diff)
downloadperl-MDV-Distribconf-fa0f51b5344e5819c30f4f2d8d53399cab417528.tar
perl-MDV-Distribconf-fa0f51b5344e5819c30f4f2d8d53399cab417528.tar.gz
perl-MDV-Distribconf-fa0f51b5344e5819c30f4f2d8d53399cab417528.tar.bz2
perl-MDV-Distribconf-fa0f51b5344e5819c30f4f2d8d53399cab417528.tar.xz
perl-MDV-Distribconf-fa0f51b5344e5819c30f4f2d8d53399cab417528.zip
- remove useless functions
- document remaining one
-rw-r--r--lib/MDV/Distribconf/Build.pm495
1 files changed, 13 insertions, 482 deletions
diff --git a/lib/MDV/Distribconf/Build.pm b/lib/MDV/Distribconf/Build.pm
index 70fbeec..153c336 100644
--- a/lib/MDV/Distribconf/Build.pm
+++ b/lib/MDV/Distribconf/Build.pm
@@ -13,7 +13,6 @@ MDV::Distribconf::Build - Subclass to MDV::Distribconf to build configuration
use strict;
use warnings;
use File::Path;
-use RPM4;
use MDV::Packdrakeng;
use File::Temp qw(tempfile);
use File::Copy qw(cp);
@@ -336,311 +335,22 @@ sub write_productid {
return 1;
}
-sub DESTROY {
- my ($self) = @_;
- return if($self->{noclean});
- foreach (@{$self->{tempfiles} || []}, keys %{$self->{tempfile} || {}}) {
- unlink($_);
- }
-}
+=item $distrib->list_existing_medias()
-sub _first_pass {
- my ($self, $header) = @_;
- #print $header->fullname() . "\n";
+List media which really exists on the disk
- my $r = $header->dep('REQUIRENAME', 0);
- push(@{$self->{packageinfo}}, { n => scalar($header->fullname()), r => $r } );
- $r->init();
- while ($r->next() >= 0) {
- $r->flags & (1 << 24) and next; # rpmlib dep
- push(@{$self->{requires}{$r->name()}}, { id => $#{$self->{packageinfo}}, dep => $r });
- }
-}
+=cut
-sub list_medias_exists {
+sub list_existing_medias {
my ($self) = @_;
grep { -d $self->getfullmediapath($_, 'path') } $self->listmedia();
}
-sub clean_info {
- my ($self) = @_;
- $self->{requires} = {};
- $self->{packageinfo} = [];
- $self->{depslist} = {};
- $self->{group} = {};
- $self->{provides} = {};
- $self->{media} = {};
-}
-
-sub traverse_media {
- my ($self, $media, $callback) = @_;
- my ($onlyh, $onlyd);
-
- my ($hdlisttoread, $pack);
- my $dir = $self->getfullpath($media, 'path');
- if ($self->{media}{$media}{temphdlist}) {
- $hdlisttoread = $self->{media}{$media}{temphdlist};
- } elsif (-f $self->getfullmediapath($media, 'hdlist')) {
- ($onlyh, $onlyd) = MDV::Distribconf::Utils::hdlist_vs_dir(
- $self->getfullmediapath($media, 'hdlist'),
- $dir,
- );
- if (@{$onlyh || []} + @{$onlyd || []}) {
- printf(
- "Delta for %s, +%d -%d\n",
- $media,
- scalar(@{$onlyd || []}),
- scalar(@{$onlyh || []}),
- );
- }
- my @countindir = glob("$dir/*.rpm");
- if (@countindir && (@{$onlyh || []} / @countindir) < 0.50) {
- $hdlisttoread = $self->getfullmediapath($media, 'hdlist');
- } else {
- @{$onlyd} = ();
- if (opendir(my $dh, $dir)) {
- while (my $f = readdir($dh)) {
- $f =~ /\.rpm$/ and push(@{$onlyd}, $f);
- }
- close($dh);
- }
- }
- if (@{$onlyh || []} + @{$onlyd || []}) {
- $self->{media}{$media}{unsych} = 1;
- ($self->{media}{$media}{temphdlist}, $pack) = $self->get_temp_pack(
- $self->getfullmediapath($media, 'hdlist')
- );
- }
- } else {
- if (opendir(my $dh, $dir)) {
- while (my $f = readdir($dh)) {
- $f =~ /\.rpm$/ and push(@{$onlyd}, $f);
- }
- close($dh);
- }
- $self->{media}{$media}{unsych} = 1;
- ($self->{media}{$media}{temphdlist}, $pack) = $self->get_temp_pack(
- $self->getfullmediapath($media, 'hdlist')
- );
- }
- $self->{media}{$media}{temphdlist} ||= $self->getfullmediapath($media, 'hdlist');
-
- my $addtopack = sub {
- my ($header) = @_;
- if ($pack) {
- my $tmp = new File::Temp( UNLINK => 1, SUFFIX => '.hdr' );
- $header->write($tmp);
- seek($tmp, 0, 0);
- $pack->add_virtual('f', scalar($header->fullname()), $tmp);
- close($tmp);
- }
- };
-
- my @rpmsneed = map { "$dir/" . $_ } @{$onlyd || []};
- RPM4::parserpms(
- rpms => \@rpmsneed,
- checkrpms => 0,
- callback => sub {
- my %args = @_;
- $args{header} or do {
- warn "invalid rpm $args{rpm}\n";
- return 1;
- };
- my $ba = ($args{rpm} =~ m:.*/([^/]*)$:)[0];
- if ($ba ne $args{header}->fullname() . ".rpm") {
- warn "$media/$ba differ of header info (" . $args{header}->fullname() . ")\n";
- }
- #printf "+ %s\n", scalar($args{header}->fullname());
- #$self->_first_pass($args{header}, $pack);
- $addtopack->($args{header});
- $callback->($args{header});
- 1;
- },
- );
-
- if ($hdlisttoread && open(my $hz, "zcat '$hdlisttoread' 2>/dev/null |")) {
- while(my $h = RPM4::stream2header($hz)) {
- if (grep { $h->fullname() . '.rpm' eq $_} @{$onlyh || []}) {
- next;
- }
- $addtopack->($h);
- $callback->($h);
- #$self->_first_pass($args{header}, $pack);
- }
- close($hz);
- }
-}
-
-sub list_unsynch_medias {
- my ($self) = @_;
- grep { $self->{media}{$_}{unsych} } keys %{ $self->{media} || {} }
-}
+=item $distrib->set_medias_size($media)
-sub load_media {
- my ($self, $media, $callback) = @_;
- if ($self->{media}{$media}{load_done}) {
- return;
- } else {
- $self->{media}{$media}{load_done} = 1;
- }
-
- $callback ||= sub {};
- $self->{media}{$media}{start} = $#{$self->{packageinfo} || []} + 1;
- $self->traverse_media(
- $media,
- sub {
- $self->_first_pass($_[0]);
- $callback->($_[0]);
- }
- );
-}
+Set media size into media.cfg for $media
-sub populate_media {
- my ($self, $media) = @_;
-
- if ($self->{media}{$media}{populate_done}) {
- return;
- } else {
- $self->{media}{$media}{populate_done} = 1;
- }
- $self->load_media($media);
-
- my $count = $self->{media}{$media}{start};
- my $synthhandle;
- if ($self->list_unsynch_medias()) {
- my $synthf = $self->get_temp_file(
- $self->getfullmediapath($media, 'synthesis')
- );
-
- open($synthhandle, "| gzip --best > '$synthf'");
- }
-
- $self->traverse_media(
- $media,
- sub {
- my ($h) = @_;
- my $synthinfo;
- if ($synthhandle) {
- $synthinfo = {
- fullname => scalar($h->fullname()),
- summary => $h->tag(1004),
- epoch => $h->tag(1003) || 0,
- size => $h->tag(1009),
- group => $h->tag(1016),
- os => $h->tag('OS'),
- hdrid => pack("H*",$h->tag('HDRID')),
- provides => [],
- requires => [],
- obsoletes => [],
- conflicts => [],
- };
- }
-
- push(@{$self->{group}{$h->tag('group')}}, $count);
-
- if (my $f = $h->files()) {
- $f->init();
- while ($f->next() >= 0) {
- exists($self->{requires}{$f->filename}) or next;
- push(@{$synthinfo->{requires}}, $f->filename) if ($synthinfo);
- foreach my $po (@{$self->{requires}{$f->filename}}) {
- exists($self->{depslist}{$po->{id}}{$count}) and next;
- while((my $idx = $po->{dep}->next()) >= 0) {
- if ($po->{dep}->name eq $f->filename) {
- push(@{$self->{provides}{$f->filename}}, $count);
- $self->{depslist}{$po->{id}}{$idx}{$count} = 1;
- last;
- }
- }
- }
- }
- }
- if (my $p = $h->dep('PROVIDENAME')) {
- $p->init();
- while ($p->next() >= 0) {
- push(@{$self->{provides}{$p->name}}, $count);
- if ($synthinfo) {
- my @d = $p->info();
- push(@{$synthinfo->{provides}}, sprintf(
- "%s%s%s",
- "$d[1]",
- ($p->flags() & RPM4::flagvalue('sense', [ 'PREREQ' ])) ? '[*]' : '',
- $d[2] ? '[' . ($d[2] eq '=' ? '==' : $d[2]) . " $d[3]\]" : '' ));
- }
- exists($self->{requires}{$p->name}) or next;
- foreach my $po (@{$self->{requires}{$p->name}}) {
- exists($self->{depslist}{$po->{id}}{$count}) and next;
- $po->{dep}->init();
- while((my $idx = $po->{dep}->next()) >= 0) {
- if ($po->{dep}->overlap($p)) {
- $self->{depslist}{$po->{id}}{$idx}{$count} = 1;
- last;
- }
- }
- }
- }
- }
- if ($synthinfo) {
- if (my $p = $self->{packageinfo}[$count]->{r}) {
- $p->init();
- while ($p->next() >= 0) {
- $p->flags & (1 << 24) and next; # rpmlib dep
- my @d = $p->info();
- push(@{$synthinfo->{requires}}, sprintf(
- "%s%s%s",
- "$d[1]",
- ($p->flags() & RPM4::flagvalue('sense', [ 'PREREQ' ])) ? '[*]' : '',
- $d[2] ? '[' . ($d[2] eq '=' ? '==' : $d[2]) . " $d[3]\]" : '' ));
- }
- }
- if (my $p = $h->dep('OBSOLETENAME')) {
- $p->init();
- while ($p->next() >= 0) {
- my @d = $p->info();
- push(@{$synthinfo->{obsoletes}}, sprintf(
- "%s%s%s",
- "$d[1]",
- ($p->flags() & RPM4::flagvalue('sense', [ 'PREREQ' ])) ? '[*]' : '',
- $d[2] ? '[' . ($d[2] eq '=' ? '==' : $d[2]) . " $d[3]\]" : '' ));
- }
- }
- if (my $p = $h->dep('CONFLICTNAME')) {
- $p->init();
- while ($p->next() >= 0) {
- if ($synthinfo) {
- my @d = $p->info();
- push(@{$synthinfo->{conflicts}}, sprintf(
- "%s%s%s",
- "$d[1]",
- ($p->flags() & RPM4::flagvalue('sense', [ 'PREREQ' ])) ? '[*]' : '',
- $d[2] ? '[' . ($d[2] eq '=' ? '==' : $d[2]) . " $d[3]\]" : '' ));
- }
- }
- }
-
- foreach my $deptag (qw(provides conflicts obsoletes requires)) {
- my @deps;
- { my %uniq; @uniq{@{$synthinfo->{$deptag} || []}} = (); @deps = keys(%uniq); }
- printf($synthhandle '@%s@%s'."\n",
- $deptag,
- join('@', @deps)) if (@deps);
- }
- printf($synthhandle '@summary@%s'. "\n",
- $synthinfo->{summary},
- );
- printf($synthhandle '@info@%s@%d@%d@%s'."\n",
- $synthinfo->{fullname},
- $synthinfo->{epoch},
- $synthinfo->{size},
- $synthinfo->{group},
- );
- }
-
- $count++;
- }
- );
- close($synthhandle) if ($synthhandle);
-}
+=cut
sub set_media_size {
my ($self, $media) = @_;
@@ -662,196 +372,17 @@ sub set_media_size {
$self->setvalue($media, 'size', $showsize);
}
-sub set_all_medias_size {
- my ($self) = @_;
- foreach my $media ($self->list_medias_exists()) {
- $self->set_media_size($media);
- }
-}
-
-sub load_all_medias {
- my ($self) = @_;
- foreach my $media ($self->list_medias_exists()) {
- $self->load_media($media);
- }
-}
-
-sub populate_all_medias {
- my ($self) = @_;
- $self->load_all_medias();
- foreach my $media ($self->list_medias_exists()) {
- $self->populate_media($media);
- }
-}
-
-sub generate_base_files {
- my ($self) = @_;
- $self->populate_all_medias();
- $self->generate_depslist();
- $self->generate_compss();
- $self->generate_provides();
-}
-
-sub generate_depslist {
- my ($self) = @_;
- if (open(my $hdepl, '>', $self->get_temp_file($self->getfullpath(undef, 'depslist.ordered')))) {
- my %ordered;
- foreach my $id (keys %{$self->{depslist} || {}}) {
- foreach my $depindex (keys %{$self->{depslist}{$id} || {}}) {
- foreach (keys %{$self->{depslist}{$id}{$depindex} || {}}) {
- $ordered{$_} ||= 0; $ordered{$_}++;
- }
- }
- }
-
- my (@ord, %map);
-
- foreach my $id (sort { ($ordered{$a} || 0) <=> ($ordered{$b} || 0) } (0..$#{$self->{packageinfo}})) {
- push(@ord, $id);
- $map{$id} = $#ord;
- }
-
- foreach my $id (@ord) {
- my $r = ${$self->{packageinfo}}[$id]->{r} or next;
- $r->init;
- my %found;
- while ((my $idx = $r->next) >= 0) {
- $r->flags & (1 << 24) and next; # rpmlib dep
- if (exists($self->{depslist}{$id}{$idx}) && $self->{depslist}{$id}{$idx}) {
- @found{
- grep { $_ eq $id } # hum ??
- join('|', grep { defined($_) } map { $map{$_} } keys %{$self->{depslist}{$id}{$idx}})
- } = ();
- } else {
- $found{'NOTFOUND_' . $r->name} = 1;
- }
- }
- ${$self->{packageinfo}}[$id]->{r} = undef;
- printf $hdepl "%s 0 %s\n", ${$self->{packageinfo}}[$id]->{n}, join(' ', keys %found);
- }
- close($hdepl);
- } else {
- return;
- }
- 1;
-}
-
-sub generate_compss {
- my ($self) = @_;
- if (open(my $hcompss, '>', $self->get_temp_file($self->getfullpath(undef, 'compss')))) {
- foreach my $g (sort keys %{$self->{group} || {}}) {
- print $hcompss "$g\n";
- foreach my $p (
- sort map { ${$self->{packageinfo}}[$_]->{n} }
- @{$self->{group}{$g} || []}
- ) {
- print $hcompss "\t$p\n";
- }
- print $hcompss "\n";
- }
- close($hcompss);
- } else {
- return;
- }
- 1;
-}
+=item $distrib->set_all_medias_size()
-sub generate_provides {
- my ($self) = @_;
- if (open(my $hpro, '>', $self->get_temp_file($self->getfullpath(undef, 'provides')))) {
- foreach my $pro (keys %{$self->{provides} || {}}) {
- my %list; @list{map { ${$self->{packageinfo}}[$_]->{n} } @{$self->{provides}{$pro} || []}} = ();
- printf $hpro "%s@%s\n", $pro, join('@', keys %list);
- }
- close($hpro);
- } else {
- return;
- }
-}
-
-sub link_index_to_distrib {
- my ($self) = @_;
- foreach my $media ($self->list_medias_exists()) {
- foreach (qw(hdlist synthesis)) {
- my ($mfile, $gfile) = (
- $self->getfullmediapath($media, $_),
- $self->getfullpath($media, $_)
- );
- printf "link %s to %s\n", $mfile, $gfile;
- if (((stat($mfile))[1] || -1) != ((stat($gfile))[1] || -1)) {
- if (-f $gfile) {
- unlink($gfile) or next;
- }
- link($mfile, $gfile) or return;
- }
- }
- }
- 1;
-}
+Set media size into media.cfg
-sub rebuild_md5 {
- my ($self) = @_;
- my $needredo = 0;
- foreach my $media ($self->list_medias_exists()) {
- my ($bad, $md5) = MDV::Distribconf::Utils::checkmd5(
- $self->getfullmediapath($media, 'MD5SUM'),
- map { $self->getfullmediapath($media, $_) } qw(hdlist synthesis),
- );
- if (@{$bad || []}) {
- printf "Writting %s\n", $self->getfullmediapath($media, 'MD5SUM');
- if(open(my $md5f, ">", $self->getfullmediapath($media, 'MD5SUM'))) {
- foreach (keys %{$md5 || {}}) {
- printf $md5f "%s %s\n", $md5->{$_}, $_;
- }
- close($md5f);
- } else {
- return;
- }
- }
- }
- my ($bad, $md5) = MDV::Distribconf::Utils::checkmd5(
- $self->getfullpath(undef, 'MD5SUM'),
- (map { $self->getfullmediapath($_, 'hdlist') } $self->list_medias_exists()),
- (map { $self->getfullmediapath($_, 'synthesis') } $self->list_medias_exists()),
- );
- if (@{$bad || []}) {
- printf "Writting %s\n", $self->getfullpath(undef, 'MD5SUM');
- if(open(my $md5f, ">", $self->getfullpath(undef, 'MD5SUM'))) {
- foreach (keys %{$md5 || {}}) {
- printf $md5f "%s %s\n", $md5->{$_}, $_;
- }
- close($md5f);
- } else {
- return;
- }
- }
- 1;
-}
+=cut
-sub push_temp_files {
+sub set_all_medias_size {
my ($self) = @_;
- foreach (keys %{$self->{tempfile} || {}}) {
- printf "%s => %s\n", $self->{tempfile}{$_}, $_;
- cp($self->{tempfile}{$_}, $_) or return;
- push(@{$self->{tempfiles}}, $self->{tempfile}{$_});
- delete($self->{tempfile}{$_});
+ foreach my $media ($self->list_existing_medias()) {
+ $self->set_media_size($media);
}
- 1;
-}
-
-sub get_temp_pack {
- my ($self, $destfile) = @_;
- my ($handle, $filename) = tempfile( TEMPLATE => 'packXXXX', SUFFIX => '.cz' );
- close($handle);
- $self->{tempfile}{$destfile} = $filename;
- return($filename, MDV::Packdrakeng->new(archive => $filename));
-}
-
-sub get_temp_file {
- my ($self, $destfile, @tempopts) = @_;
- my ($handle, $filename) = tempfile( @tempopts );
- close($handle);
- $self->{tempfile}{$destfile} = $filename;
}
1;