use Packages::Search qw( :all );
&Packages::Config::init( './' );
-my $suite = $ARGV[0] or die "No suite given";
+my $suite = $ARGV[0] or die "Fatal Error: No suite given";
my $start_time = time;
+my $debug = 1;
tie my %packages, 'DB_File', "$DBDIR/packages_small.db",
O_RDONLY, 0666, $DB_BTREE
- or die "couldn't tie DB $DBDIR/packages_small.db: $!\n";
+ or die "Fatal Error: Couldn't tie DB $DBDIR/packages_small.db: $!\n";
sub get_iso_date {
my ($age) = @_;
return sprintf( "%04s-%02s-%02s", $year, $month, $day );
}
-open CHANGES, '>', "$TOPDIR/files/packages/newpkg_info.new"
- or die "Couldn't open CHANGES file: $!";
-for (my $age = 0; $age < 7; $age++) {
- my (%old, %changes);
+my $packagesdir = "$TOPDIR/files/packages";
+open CHANGES, '>', "$packagesdir/newpkg_info_$suite.new"
+ or die "Fatal Error: Couldn't open CHANGES file: $!";
+my (%add, %del);
+my $lastday;
+for (my $age = 7; $age >= 0; $age--) {
+ my (%old);
my $newday = get_iso_date( $age );
my $oldday = get_iso_date( $age+1 );
- open OLD, '<', "$TOPDIR/files/packages/package_names_$suite.$oldday"
- or do {
- warn"Couldn't open OLD file $TOPDIR/files/packages/package_names_$suite.$oldday: $!\n";
- last;
- };
+ -d "$packagesdir/$oldday" or do {
+ warn "Warning: No information available for $oldday\n";
+ next unless $lastday;
+ $oldday = $lastday;
+ };
+ -d "$packagesdir/$newday" or do {
+ warn "Warning: No information available for $newday\n";
+ next;
+ };
+ $lastday = $newday;
+ warn "Process: age=$age oldday=$oldday newday=$newday\n" if $debug;
+ open OLD, '<', "$packagesdir/$oldday/package_names_$suite"
+ or die "Error: Couldn't open OLD file $packagesdir/$oldday/package_names_$suite: $!\n";
+ open NEW, '<', "$packagesdir/$newday/package_names_$suite"
+ or die "Error: Couldn't open NEW file $packagesdir/$newday/package_names_$suite: $!\n";
while (<OLD>) {
chomp;
$old{$_} = 1;
}
close OLD;
- open NEW, '<', "$TOPDIR/files/packages/package_names_$suite.$newday"
- or die "Couldn't open NEW file $TOPDIR/files/packages/package_names_$suite.$newday: $!\n";
while (<NEW>) {
chomp;
if ($old{$_}) {
# we assume here that the input contains no dupes!
delete $old{$_};
} else {
- $changes{$_} = 1;
+ if (exists $del{$_}) {
+ delete $del{$_};
+ warn "Re-Added: $_\n" if $debug;
+ } else {
+ $add{$_} = $age;
+ warn "Added: $_ (age $age)\n" if $debug;
+ }
}
}
close NEW;
foreach (keys %old) {
- $changes{$_} = -1;
+ if (exists $add{$_}) {
+ delete $add{$_};
+ warn "Deleted again: $_\n" if $debug;
+ } else {
+ $del{$_} = $age;
+ warn "Deleted: $_ (age $age)\n" if $debug;
+ }
}
- my %archives = map { $_ => 1 } qw( us security non-US );
- foreach (sort keys %changes) {
- my $entry = read_entry_simple( \%packages, $_, \%archives, $suite)
- or die "Can't find entry for package $_\n";
+}
+my %archives = map { $_ => 1 } qw( us security );
+foreach (sort (keys %add, keys %del)) {
+ my $entry = [];
+ my $age = 0;
+ if (exists $add{$_}) {
+ $entry = read_entry_simple( \%packages, $_, \%archives, $suite);
+ die "Fatal Error: Can't find entry for package $_\n"
+ unless @$entry;
shift @$entry; # remove virtual pkg info
- print CHANGES join(" ", $_, $age, @$entry)."\n";
- print "Wrote entry: ".join(" ", $_, $age, @$entry)."\n";
+ $age = $add{$_};
+ } else {
+ $age = $del{$_};
}
+ print CHANGES join(" ", $_, $age, @$entry)."\n";
+ print "Wrote entry: ".join(" ", $_, $age, @$entry)."\n";
}
close CHANGES;
-rename("$TOPDIR/files/packages/newpkg_info.new",
- "$TOPDIR/files/packages/newpkg_info");
+rename("$packagesdir/newpkg_info_$suite.new",
+ "$packagesdir/newpkg_info_$suite");