source: soft/build_system/build_system/upload/robot/trunk/process-obsoletes @ 1

Last change on this file since 1 was 1, checked in by fasma, 13 years ago

Initial Import from Mandriva's soft revision 224062 and package revision 45733

File size: 4.3 KB
Line 
1#!/usr/bin/perl
2#---------------------------------------------------------------
3# Project         : Mandrake Linux
4# Module          : robot
5# File            : process-obsoletes
6# Version         : $Id: process-obsoletes 926 2006-07-10 11:47:57Z mandrake $
7# Author          : Warly
8# Created On      : Tue Sep 04 16:55:00 2001
9# Purpose         : move obsoleted packages to another dir.
10#---------------------------------------------------------------
11use URPM;
12use strict;
13use File::NCopy qw(copy);
14
15my %flag = (
16    '<' => 2,
17    '>' => 4,
18    '==' => 8,
19    '<=' => 10,
20    '>=' => 12
21);
22
23
24@ARGV == 3 or print STDERR "usage: $0 <binary rpm> <top> <arch> <media1> <media2>\n" and exit 1;
25
26my $RPM=$ARGV[0];
27my $SRPMS=$ARGV[1];
28my $RPMS_DIR=$ARGV[2];
29
30my $OLDDIR="$ENV{HOME}/old";
31
32if (!-d $OLDDIR){
33    print STDERR "$0: invalid OLDDIR: $OLDDIR\n";
34    exit 1
35}
36
37my %header;
38get_rpm_header(\%header, $RPM) or die "Could not open $RPM: $!";
39
40ref $header{OBSOLETES} or exit;
41
42for (my $i; $i < @{$header{OBSOLETES}}; $i++){
43        my $obs = $header{OBSOLETES}[$i];
44        my $version = $header{OBSOLETEVERSION}[$i];
45        my $release = $header{OBSOLETEVERSION}[$i];
46        my $flag = $header{OBSOLETEFLAGS}[$i];
47        #print "Obsoletes $obs $version $flag\n";
48        opendir B, "$RPMS_DIR";
49        foreach (readdir B) {
50                -d or next;
51                my $RPMS = "$RPMS_DIR/$_";
52                opendir A, $RPMS;
53                foreach (readdir A){
54                        m/\Q$obs\E-[^-]+-[^-]+\.[^.]+\.rpm/ or next;
55                        my %oh;
56                        #print "Checking $_\n";
57                        get_rpm_header(\%oh, "$RPMS/$_") or die "Could not open $RPM: $!";
58                        if ($oh{NAME} eq $obs){
59                                my $ok = 0;
60                                #print "processing obsoletes for $RPM\n";
61                                if ($version){
62                                        my ($epoch, $ver) = $version =~ /(?:(\d+):)?([^-]+(?:-[^-]*)?)/;
63                                        $epoch ||= '0';
64                                        $oh{EPOCH} ||= '0';
65                                        my $over = "$oh{EPOCH}-$oh{VERSION}-$oh{RELEASE}";
66                                        #print "OVER $over ($epoch-$ver)\n";
67                                        my $flag = $header{OBSOLETEFLAGS}[$i];
68                                        if ($flag & 2){ if (URPM::ranges_overlap("> $over","== $epoch-$ver-$release")) { $ok = 1 } }           
69                                        if ($flag & 4){ if (URPM::ranges_overlap("< $over","== $epoch-$ver-$release")) { $ok = 1 } }           
70                                        if ($flag & 8){ if (URPM::ranges_overlap("== $over","== $epoch-$ver-$release")) { $ok = 1 }}           
71                                        $ok or next
72                                }
73                        }
74                        my $srpm=$oh{SOURCERPM};
75                        cp("$RPMS/$_","$OLDDIR/$_");
76                        if (-f "$SRPMS/$srpm") {
77                                cp("$SRPMS/$srpm","$OLDDIR/$srpm");
78                        }
79                }
80        }
81}
82
83sub cp {
84        my ($file,$dest) = @_;
85        print "$file -> $dest\n";
86        my $err = link "$file", "$dest";
87        if (!$err) {
88                $err = copy "$file", "$dest";
89                if (!$err) {
90                        print "ERROR: unable to copy $file to $dest: $!\n";
91                        return
92                }
93        } 
94        unlink "$file";
95}
96
97sub get_rpm_header {
98    my ($header, $rpm) = @_;
99    my $urpm = new URPM;
100    my $id = $urpm->parse_rpm($rpm, keep_all_tags => 1);
101    my $pkg = $urpm->{depslist}[$id] or print "ERROR get_rpm_header: could not parse $rpm\n" and return;
102    $header->{NAME} = $pkg->name;
103    $header->{EPOCH} = $pkg->epoch || '';
104    $header->{VERSION} = $pkg->version;
105    $header->{RELEASE} = $pkg->release;
106    $header->{GROUP} = $pkg->group;
107    $header->{ARCH} = $pkg->arch;
108    $header->{SOURCERPM} = $pkg->sourcerpm;
109    $header->{SUMMARY} = $pkg->summary;
110    foreach my $t (['requires', 'REQUIRE', 'REQUIRENAME'], ['provides', 'PROVIDES', 'PROVIDES'], ['obsoletes', 'OBSOLETE', 'OBSOLETES']) {
111        my ($func, $pref, $first) = @$t;
112        foreach my $r ($pkg->$func){
113            my ($name, $a_flag, $version) = $r =~ /([^[]*)(?:\[(.*) (.*)\])?/;
114            push @{$header->{$first}}, $name;
115            my $d_flag = $flag{$a_flag};
116            push @{$header->{"${pref}FLAGS"}}, $d_flag;
117            push @{$header->{"${pref}VERSION"}}, $version
118        }
119    }
120    my ($i, %dir);
121    foreach my $r ($pkg->files){
122        my ($dir, $name) = $r =~ m,(.*/)([^/]*),;
123        push @{$header->{BASENAMES}}, $name;
124        if (! defined $dir{$dir}) {
125            $dir{$dir} = $i++;
126            push @{$header->{DIRNAMES}}, $dir
127        }
128        push @{$header->{DIRINDEXES}}, $dir{$dir};
129    }
130    $header->{FILEUSERNAME} = [ $pkg->files_owner ];
131    $header->{CHANGELOGTIME} = [ $pkg->changelog_time ];
132    $header->{CHANGELOGNAME} = [ $pkg->changelog_name ];
133    $header->{CHANGELOGTEXT} = [ $pkg->changelog_text ];
134    $header->{BUILDTIME} = $pkg->buildtime;
135    1
136}                                   
137
138# process-obsoletes ends here
139#
140# changelog
141#
142# 2002 05 24
143#
144# warly: fix unitialised variable, fix cross device copying, add cp function, use File:NCopy
Note: See TracBrowser for help on using the repository browser.