1 |
#!/usr/bin/perl -w |
2 |
# |
3 |
# Copyright (c) 2005 Gormand Pty Ltd. All rights reserved. This program |
4 |
# is free software; you can redistribute it and/or modify it under the |
5 |
# same terms as Perl itself. |
6 |
# |
7 |
# $Id: update_rpms_dir,v 1.15 2006/12/02 17:19:10 slords Exp $ |
8 |
# |
9 |
# Update RPMS directory with the latest from a given list of directories |
10 |
|
11 |
use RPM2; |
12 |
use Getopt::Long; |
13 |
|
14 |
my $rpm_flags = RPM2->vsf_nodsa; # Deal with missing DSA keys |
15 |
|
16 |
GetOptions(\%opt, "verbose", "debug", "rpms_dir=s", "target_dir=s"); |
17 |
|
18 |
# XXX - FIXME - These will be command line options |
19 |
|
20 |
my $rpms_dir = $opt{rpms_dir} || "/builds/RPMS"; |
21 |
|
22 |
my $target_dir = $opt{target_dir} || $rpms_dir; |
23 |
|
24 |
warn "Using $rpms_dir\n" if $opt{verbose}; |
25 |
|
26 |
my @repositories = qw( |
27 |
/builds/rpms/RPMS/i386/ |
28 |
/builds/rpms/RPMS/i586/ |
29 |
/builds/rpms/RPMS/i686/ |
30 |
/builds/rpms/RPMS/noarch/ |
31 |
/mirrors/centos/4/fasttrack/i386/RPMS/ |
32 |
/mirrors/centos/4/updates/i386/RPMS/ |
33 |
/mirrors/centos/4/os/i386/CentOS/RPMS/ |
34 |
); |
35 |
|
36 |
chdir $rpms_dir or die "Couldn't chdir $rpms_dir"; |
37 |
|
38 |
opendir RPMS, '.' or die "Couldn't opendir $rpms_dir"; |
39 |
|
40 |
for my $file ( sort grep { /.rpm$/ } readdir RPMS ) |
41 |
{ |
42 |
warn "Checking $file:\n" if $opt{verbose}; |
43 |
|
44 |
my $rpm = RPM2->open_package($file, $rpm_flags); |
45 |
|
46 |
for my $dir ( @repositories ) |
47 |
{ |
48 |
my $newest = find_newest($rpm, $dir); |
49 |
|
50 |
if ($newest) |
51 |
{ |
52 |
# XXX - FIXME - Should we try other repos, or stop here? |
53 |
print "rm $target_dir/$file; cp -p $dir/$newest $target_dir\n" |
54 |
} |
55 |
} |
56 |
} |
57 |
|
58 |
sub find_newest |
59 |
{ |
60 |
my ($rpm, $dir) = @_; |
61 |
|
62 |
# XXX - FIXME - Need to cater for multiple architectures |
63 |
|
64 |
my $name = $rpm->name; |
65 |
$name =~ s/\+/\\+/g; # libstdc++ and friends |
66 |
|
67 |
unless (opendir DIR, $dir) |
68 |
{ |
69 |
warn "Couldn't opendir $dir"; |
70 |
return; |
71 |
} |
72 |
|
73 |
my @rpms = sort grep { /^${name}-.*.rpm$/ } readdir DIR; |
74 |
closedir DIR; |
75 |
|
76 |
my $newest_file = undef; |
77 |
my $newest_hdr = undef; |
78 |
|
79 |
for my $file (@rpms) |
80 |
{ |
81 |
warn "\tExamining $dir/$file\n" if $opt{debug}; |
82 |
|
83 |
my $candidate = RPM2->open_package("$dir/$file", $rpm_flags); |
84 |
|
85 |
if ($candidate->name ne $name) |
86 |
{ |
87 |
warn "\tIgnoring $file - name doesn't match\n" if $opt{debug}; |
88 |
next; |
89 |
} |
90 |
|
91 |
if ($candidate->arch ne $rpm->arch) |
92 |
{ |
93 |
warn "\tIgnoring $file - arch " |
94 |
. $candidate->arch . " want " . $rpm->arch . "\n" |
95 |
if $opt{debug}; |
96 |
next; |
97 |
} |
98 |
|
99 |
if ( ($candidate cmp $rpm) <= 0) |
100 |
{ |
101 |
warn "\tIgnoring $file - older or same version\n" if $opt{debug}; |
102 |
next; |
103 |
} |
104 |
|
105 |
if (not defined $newest_hdr or ($candidate cmp $newest_hdr) > 0) |
106 |
{ |
107 |
warn "\tNewest is $file\n" if $opt{debug}; |
108 |
$newest_file = $file; |
109 |
$newest_hdr = $candidate; |
110 |
} |
111 |
} |
112 |
|
113 |
return $newest_file; |
114 |
} |