source: soft/build_system/build_system/mkcd/tags/V3_3_6_1mdk/pm/Mkcd/Package.pm @ 1

package Mkcd::Package;

our $VERSION = '0.1.2';

use File::NCopy qw(copy);       
use File::Path;       
use URPM;
use URPM::Build;
use Mkcd::Tools qw(du cleanrpmsrate printDiscsFile);
use strict;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(packageOutOfRpmsrate genDeps getLeaves list_hdlist getSize rpmVersionCompare mkcd_build_hdlist %ARCH);

use vars qw(%ARCH);

=head1 NAME

Packages - mkcd module

=head1 SYNOPSYS

    require Mkcd::Functions;

=head1 DESCRIPTION

C<Mkcd::Functions> include the mkcd low level packages functions.

=head1 SEE ALSO

mkcd

=head1 COPYRIGHT

Copyright (C) 2000,2001 MandrakeSoft <warly@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

%ARCH = ( 
    x86_64 => 1,
    i586 => 1,
    noarch => 1,
    k7 => 1,
    ppc => 1,
    ia64 => 1,
    i686 => 2,
    i486 => 2,
    i386 => 3
);

sub genDeps {
    my ($top,$reps,$deps,$VERBOSE, $TMP) = @_;
    $top or print "ERROR genDeps: no top dir defined\n" and return 0;
    %$reps or return 0;
    -d $top or mkpath $top or die "FATAL genDeps: could not create $top\n";
    
    # FIXME URPM does not bring a read_hdlist function
    # if ($deps || ! (-f "$top/depslist.ordered" && -f "$top/hdlist.cz")) {
        my @rpms;
        my %done;
        foreach my $rep (keys %$reps) {
            #$VERBOSE and print "genDeps: adding rep $rep\n";
            foreach my $rpm (@{$reps->{$rep}}) {
                $done{$rpm} and next;
                push @rpms, "$rep/$rpm.rpm";
                $done{$rpm} = 1
            }
        }
        # Need to create hdlist and synsthesis on filesystem to estimate deps files
        # size in disc->guessHdlistSize.
        return mkcd_build_hdlist(1,
            [ 0, { rpms => \@rpms,
                   hdlist => "$top/hdlist.cz",
                   synthesis => "$top/synthesis.hdlist.cz",
                   callback => sub {
                       my ($urpm, $id) = @_;
                       my $pkg = $urpm->{depslist}[$id];
                       my $fullname = $pkg->fullname;
                       my $filename = $pkg->filename;
                       $filename =~ s/\.rpm$//;
                       $urpm->{sourcerpm}{$fullname} = $pkg->sourcerpm;
                       $urpm->{rpm}{$fullname} = $pkg;
                       $urpm->{rpmkey}{rpm}{$fullname} = $filename;
                       $urpm->{rpmkey}{key}{$filename} = $fullname;
                       $pkg->pack_header 
                   }
               } ], "$TMP/.mkcd_build_hdlist", "$top/depslist.ordered", "$top/provides", "$top/compss");
    #}
}

sub mkcd_build_hdlist {
    my ($num,$hdlist,$headers_dir,$depslist,$provides, $compss) = @_;
    my $urpm = new URPM;
    foreach (1 .. $num) {
        $hdlist->[$_]{headers} = 
           [ $urpm->parse_rpms_build_headers(
                dir => $headers_dir, 
                rpms =>  $hdlist->[$_]{rpms}) ];
    }

    $urpm->unresolved_provides_clean;
    foreach (1 .. $num) {
        my $e = $hdlist->[$_];
        my ($start, $end) = $urpm->parse_headers(dir => $headers_dir, headers => $e->{headers}, callback => $hdlist->[$_]{callback});
        $urpm->compute_deps;
        if (!@{$e->{headers}}) {
            print "WARNING mkcd_build_hdlist: $e->{hdlist} and $e->{synthesis} are empty (start $start end $end)\n";
            next
        }
        if (length $e->{hdlist}) {
            print "mkcd_build_hdlist: write $e->{hdlist}\n";
            $urpm->build_hdlist(start => $start, end => $end, dir => $headers_dir, hdlist => $e->{hdlist}, ratio => 9);
        }
        if (length $e->{synthesis}) {
            print "mkcd_build_hdlist: write $e->{synthesis}\n";
            $urpm->build_synthesis(start => $start, end => $end, synthesis => $e->{synthesis})
        }
    }
    $urpm->build_base_files(depslist => $depslist, provides => $provides, compss => $compss);

    return $urpm;
}

sub packageOutOfRpmsrate {
    my ($rpmsrate) = @_;
    my $rate = cleanrpmsrate($rpmsrate);
    print join("\n", sort(keys %$rate)), "\n";
    1
}

sub getLeaves {
    my ($depslist) = @_;
    open DEP, "$depslist" or die "Could not open $depslist\n";
    my @name;
    my %pkg;
    my $i = 0;
    foreach (<DEP>){
        chomp;
        my ($name, undef, @de) = split " ", $_; 
        ($name, my $version, my $release) = $name =~ /(.*)-([^-]*)-([^-]*)/;
        if ($name){
            foreach my $d (@de) {
                if ($d !~ s/^NOTFOUND_//) { 
                    my @t = split '\|',$d ; 
                    foreach my $t (@t) { if ($t !~ s/NOTFOUND_//) { $pkg{$name[$t]}++ }}
                }else { $pkg{$name[$d]}++}
            }
        }
        $name[$i] = $name;
        $pkg{$name[$i]}++;
        $i++;
    }
    foreach (sort keys %pkg){
        print $pkg{$_} - 1, " $_\n";
    }
    1
}

sub getRpmsrate{
    print "ERROR: this function is deprecated\n";
    return 0;

    my ($rpmsrate,$reps,$tmp,$name,$VERBOSE) = @_;
    my $TMP = $tmp || $ENV{TMPDIR};
    my $tmprpmsrate = "$TMP/$name/rpmsrate";
    local *R; open R, ">$tmprpmsrate" or print "ERROR: cannot open temporary rpmsrate file $tmprpmsrate\n";
    my $rate = Mkcd::Tools::cleanrpmsrate($rpmsrate,*R,@$reps);
    close R;
    unlink "$rpmsrate" and copy "$tmprpmsrate", "$rpmsrate";
    local *R; open R, "$rpmsrate" or print "ERROR: cannot open rpmsrate file $rpmsrate\n";
    [$rate->[0],$rate->[1]];
}

sub list_hdlist{
    my (@hdlist) = @_;
    print "list_hdlist: hdlists @hdlist\n";
    foreach (@hdlist){
        my $packer = new packdrake($_);
        my $count = scalar keys %{$packer->{data}};
        print "$count files in archive, uncompression method is \"$packer->{uncompress}\"\n";
        foreach my $file (@{$packer->{files}}) {
            printf "l %13c %s -> %s\n", ' ', $file, $packer->{data}{$file}[1]
        }
    }
    1
}

sub getSize{
    my ($group,$config,$VERBOSE) = @_;
    my $max;
    my $redeps;
    foreach my $listnumber (keys %{$group->{list}}){
        print "getSize list $listnumber\n";
        my $repnb;
        #$group->{nodeps}{$listnumber} and next;
        ref $group->{rep}{$listnumber} or next;
        for (my $repnb; $repnb < @{$group->{rep}{$listnumber}}; $repnb++) {
            my $rep = $group->{rep}{$listnumber}[$repnb];
            
            foreach my $dir (keys %{$rep->{rpm}}){
                #$VERBOSE and print "getSize rep $dir\n";
                foreach (@{$rep->{rpm}{$dir}}){
                    my $rpm = $group->{urpm}{rpmkey}{key}{$_} or print "getSize ERROR: $_ has no key, ignored\n" and next; #return 2;
                    my $b = Mkcd::Tools::du("$dir/$_.rpm") if !$config->{list}[$listnumber]{nosize};
                    $b or print "WARNING getSize: $rpm has a zero size\n";
                    ref $group->{size}{$rpm}{$listnumber} and print "ERROR getSize: duplicate $rpm in list $listnumber, ignoring\n" and next;
                    $group->{size}{$rpm}{$listnumber} = [$b,$dir,$repnb];
                    push @{$group->{listrpm}{$listnumber}}, $rpm;
                    $group->{listsize}{$listnumber}{rpm} += $b;
                    $b > $max and $max = $b;
                }
            }
            foreach my $dir (keys %{$rep->{srpm}}){
                #$VERBOSE and print "getSize DIRECTORY $dir\n";
                foreach (@{$rep->{srpm}{$dir}}){
                    my ($srpm,$srpmname,$key);
                    if (($srpm,$srpmname) = /((.*)-[^-]*-[^-]*\.src)$/){
                        $key = $srpm;
                    }else {
                        ($key) = /(.*)\.rpm$/;
                        my %header;
                        tie %header, "RPM::Header", "$dir/$_.rpm" or print "ERROR getSize: $RPM::err" and next;
                        $header{'SOURCERPM'} eq "(none)" or next;
                        $srpmname = $header{'NAME'};
                        $srpm = "$srpmname-$header{'VERSION'}-$header{'RELEASE'}.src";
                    }
                    $group->{urpm}{rpmkey}{key}{$key} = $srpm; 
                    $group->{urpm}{rpmkey}{rpm}{$srpm} = $key; 
                    my $b = Mkcd::Tools::du("$dir/$_.rpm") if !$config->{list}[$listnumber]{nosize};
                    $b or print "WARNING getSize: $srpm has a zero size\n";
                    ref $group->{size}{$srpm}{$listnumber} and print "ERROR getSize: duplicate $srpm in list $listnumber, ignoring\n" and next;
                    $group->{size}{$srpm}{$listnumber} = [$b,$dir,$repnb];
                    $group->{srpmname}{$srpmname} = $srpm;
                }
            }
        }
    }
    $group->{maxsize} = $max;
    1
}

sub rpmVersionCompare{
    my ($pkg1, $pkg2) = @_;
    my ($n1,$v1,$a1) = $pkg1 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
    my ($n2,$v2,$a2) = $pkg2 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
    die "ERROR rpmVersionCompare: trying to compare version of two differently named packages ($pkg1,$pkg2)\n" if (!($n1 eq $n2)) ;
    my $ret = URPM::ranges_overlap("== $v1","> $v2");
    if ($ret){
        return $ret
    }else{
        $ret = URPM::ranges_overlap("== $v1","< $v2");
        if ($ret){
            return -$ret
        }
        if ($ARCH{$a1} < $ARCH{$a2}){
            return -1 
        }elsif ($ARCH{$a1} > $ARCH{$a2}){
            return 1
        }else{
            return 0
        }
    }
}


1

# Changelog
#
# 2002 06 01
#
# use perl-URPM
# add mkcd_build_hdlist function
#
# 2002 06 03
#
# new perl-URPM API