mirror_cleaner/files/orphans_cleaner.pl

#!/usr/bin/perl

# this script will look at the list of rpm, and move orphan to a directory, if they are too old
# another script should take care of cleaning this directory ( or puppet )

use strict;
use RPM4;
use File::stat;
use File::Basename;
use File::Copy;
use File::Path qw(make_path);

my @arches = ('i586','x86_64');
my @sections = ('core','nonfree','tainted');
my @medias = ('backports', 'backports_testing', 'release',  'updates',  'updates_testing');
my $move_delay = 60*60*24*14;

my ($path, $dest_path) = @ARGV;

my $qf = "%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}.rpm %{SOURCERPM}";

my %hash ;
my ($filename, $srpm, $dest_rpm);


my ($source_hdlist, $binary_hdlist, $rpm_path, $srpm_path);

foreach my $a ( @arches ) {
        foreach my $s ( @sections ) {
                foreach my $m ( @medias ) {

                        $rpm_path = "$path/$a/media/$s/$m";
                        $srpm_path = "$path/SRPMS/$s/$m";
                        $binary_hdlist = "$rpm_path/media_info/hdlist.cz";
                        $source_hdlist = "$srpm_path/media_info/hdlist.cz";

                        next if not -f $source_hdlist;
                        next if not -f $binary_hdlist;

                        next if stat($source_hdlist)->size() <= 64;
                        next if stat($binary_hdlist)->size() <= 64;

                        open(my $hdfh, "zcat '$binary_hdlist' 2>/dev/null |") or die "Can't open $_";
                        while (my $hdr = stream2header($hdfh)) {
                                ($filename, $srpm) = split(/ /,$hdr->queryformat($qf));
                                push(@{$hash{$srpm}}, $filename);
                        }
                        close($hdfh);


                        open($hdfh, "zcat '$source_hdlist' 2>/dev/null |") or die "Can't open $_";
                        while (my $hdr = stream2header($hdfh)) {
                                $srpm = $hdr->queryformat("%{NAME}-%{VERSION}-%{RELEASE}.src.rpm");
                                delete $hash{$srpm}; 
                        }
                        close($hdfh);

                        foreach my $s ( keys %hash )
                        {
                                # Be safe, maybe hdlists were not in sync
                                next if -f "$srpm_path/$s";
                                foreach my $rpm ( @{$hash{$s}} ) {
                                        $rpm = "$rpm_path/$rpm";
                                        # sometimes, packages are removed without hdlist to be updated
                                        next if not -f "$rpm";
                                        if (time() > $move_delay + stat("$rpm")->ctime()) {
                                                ( $dest_rpm = $rpm ) =~ s/$path/$dest_path/;
                                                my $dir = dirname $dest_rpm;
                                                make_path $dir if not -d $dir;
                                                move($rpm, $dest_rpm)
                                        }
                                }
                        }
                }
        }
}
1	#!/usr/bin/perl
2
3	# this script will look at the list of rpm, and move orphan to a directory, if they are too old
4	# another script should take care of cleaning this directory ( or puppet )
5
6	use strict;
7	use RPM4;
8	use File::stat;
9	use File::Basename;
10	use File::Copy;
11	use File::Path qw(make_path);
12
13	my @arches = ('i586','x86_64');
14	my @sections = ('core','nonfree','tainted');
15	my @medias = ('backports', 'backports_testing', 'release', 'updates', 'updates_testing');
16	my $move_delay = 606024*14;
17
18	my ($path, $dest_path) = @ARGV;
19
20	my $qf = "%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}.rpm %{SOURCERPM}";
21
22	my %hash ;
23	my ($filename, $srpm, $dest_rpm);
24
25
26	my ($source_hdlist, $binary_hdlist, $rpm_path, $srpm_path);
27
28	foreach my $a ( @arches ) {
29	foreach my $s ( @sections ) {
30	foreach my $m ( @medias ) {
31
32	$rpm_path = "$path/$a/media/$s/$m";
33	$srpm_path = "$path/SRPMS/$s/$m";
34	$binary_hdlist = "$rpm_path/media_info/hdlist.cz";
35	$source_hdlist = "$srpm_path/media_info/hdlist.cz";
36
37	next if not -f $source_hdlist;
38	next if not -f $binary_hdlist;
39
40	next if stat($source_hdlist)->size() <= 64;
41	next if stat($binary_hdlist)->size() <= 64;
42
43	open(my $hdfh, "zcat '$binary_hdlist' 2>/dev/null \|") or die "Can't open $_";
44	while (my $hdr = stream2header($hdfh)) {
45	($filename, $srpm) = split(/ /,$hdr->queryformat($qf));
46	push(@{$hash{$srpm}}, $filename);
47	}
48	close($hdfh);
49
50
51	open($hdfh, "zcat '$source_hdlist' 2>/dev/null \|") or die "Can't open $_";
52	while (my $hdr = stream2header($hdfh)) {
53	$srpm = $hdr->queryformat("%{NAME}-%{VERSION}-%{RELEASE}.src.rpm");
54	delete $hash{$srpm};
55	}
56	close($hdfh);
57
58	foreach my $s ( keys %hash )
59	{
60	# Be safe, maybe hdlists were not in sync
61	next if -f "$srpm_path/$s";
62	foreach my $rpm ( @{$hash{$s}} ) {
63	$rpm = "$rpm_path/$rpm";
64	# sometimes, packages are removed without hdlist to be updated
65	next if not -f "$rpm";
66	if (time() > $move_delay + stat("$rpm")->ctime()) {
67	( $dest_rpm = $rpm ) =~ s/$path/$dest_path/;
68	my $dir = dirname $dest_rpm;
69	make_path $dir if not -d $dir;
70	move($rpm, $dest_rpm)
71	}
72	}
73	}
74	}
75	}
76	}