]> git.deb.at Git - deb/packages.git/blob - bin/newpkg_info
Merge branch 'master' into ubuntu-master
[deb/packages.git] / bin / newpkg_info
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use DB_File;
7
8 use lib './lib';
9
10 use Packages::Config qw( $TOPDIR $DBDIR );
11 use Packages::Search qw( :all );
12 &Packages::Config::init( './' );
13
14 my $suite = $ARGV[0] or die "Fatal Error: No suite given";
15 my $start_time = time;
16 my $debug = 1;
17
18 tie my %packages, 'DB_File', "$DBDIR/packages_small.db",
19     O_RDONLY, 0666, $DB_BTREE
20     or die "Fatal Error: Couldn't tie DB $DBDIR/packages_small.db: $!\n";
21
22 sub get_iso_date {
23     my ($age) = @_;
24
25     my ($day, $month, $year) = (gmtime($start_time - ($age*86_400)))[3..5];
26     $month++;
27     $year += 1900;
28     return sprintf( "%04s-%02s-%02s", $year, $month, $day );
29 }
30
31 my $packagesdir = "$TOPDIR/files/packages";
32 open CHANGES, '>', "$packagesdir/newpkg_info_$suite.new"
33     or die "Fatal Error: Couldn't open CHANGES file: $!";
34 my (%add, %del);
35 my $lastday;
36 for (my $age = 7; $age >= 0; $age--) {
37     my (%old);
38     my $newday = get_iso_date( $age );
39     my $oldday = get_iso_date( $age+1 );
40     -d "$packagesdir/$oldday" or do {
41         warn "Warning: No information available for $oldday\n";
42         next unless $lastday;
43         $oldday = $lastday;
44     };
45     -d "$packagesdir/$newday" or do {
46         warn "Warning: No information available for $newday\n";
47         next;
48     };
49     $lastday = $newday;
50     warn "Process: age=$age oldday=$oldday newday=$newday\n" if $debug;
51     open OLD, '<', "$packagesdir/$oldday/package_names_$suite"
52         or die "Error: Couldn't open OLD file $packagesdir/$oldday/package_names_$suite: $!\n";
53     open NEW, '<', "$packagesdir/$newday/package_names_$suite"
54         or die "Error: Couldn't open NEW file $packagesdir/$newday/package_names_$suite: $!\n";
55     while (<OLD>) {
56         chomp;
57         $old{$_} = 1;
58     }
59     close OLD;
60     while (<NEW>) {
61         chomp;
62         if ($old{$_}) {
63             # we assume here that the input contains no dupes!
64             delete $old{$_};
65         } else {
66             if (exists $del{$_}) {
67                 delete $del{$_};
68                 warn "Re-Added: $_\n" if $debug;
69             } else {
70                 $add{$_} = $age;
71                 warn "Added: $_ (age $age)\n" if $debug;
72             }
73         }
74     }
75     close NEW;
76     foreach (keys %old) {
77         if (exists $add{$_}) {
78             delete $add{$_};
79             warn "Deleted again: $_\n" if $debug;
80         } else {
81             $del{$_} = $age;
82             warn "Deleted: $_ (age $age)\n" if $debug;
83         }
84     }
85
86 }
87 my %archives = map { $_ => 1 } qw( us security );
88 foreach (sort (keys %add, keys %del)) {
89     my $entry = [];
90     my $age = 0;
91     if (exists $add{$_}) {
92         $entry = read_entry_simple( \%packages, $_, \%archives, $suite);
93         die "Fatal Error: Can't find entry for package $_\n"
94             unless @$entry;
95         shift @$entry; # remove virtual pkg info
96         $age = $add{$_};
97     } else {
98         $age = $del{$_};
99     }
100     print CHANGES join(" ", $_, $age, @$entry)."\n";
101     print "Wrote entry: ".join(" ", $_, $age, @$entry)."\n";
102 }
103 close CHANGES;
104
105 rename("$packagesdir/newpkg_info_$suite.new",
106        "$packagesdir/newpkg_info_$suite");