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
  17 tie my %packages, 'DB_File', "$DBDIR/packages_small.db",
  18     O_RDONLY, 0666, $DB_BTREE
  19     or die "Fatal Error: Couldn't tie DB $DBDIR/packages_small.db: $!\n";
  20
  21 sub get_iso_date {
  22     my ($age) = @_;
  23
  24     my ($day, $month, $year) = (gmtime($start_time - ($age*86_400)))[3..5];
  25     $month++;
  26     $year += 1900;
  27     return sprintf( "%04s-%02s-%02s", $year, $month, $day );
  28 }
  29
  30 open CHANGES, '>', "$TOPDIR/files/packages/newpkg_info.new"
  31     or die "Fatal Error: Couldn't open CHANGES file: $!";
  32 for (my $age = 0; $age < 7; $age++) {
  33     my (%old, %changes);
  34     my $newday = get_iso_date( $age );
  35     my $oldday = get_iso_date( $age+1 );
  36     open OLD, '<', "$TOPDIR/files/packages/package_names_$suite.$oldday"
  37         or do {
  38             warn "Warning: Couldn't open OLD file $TOPDIR/files/packages/package_names_$suite.$oldday: $!\n";
  39             next;
  40         };
  41     open NEW, '<', "$TOPDIR/files/packages/package_names_$suite.$newday"
  42         or do {
  43             warn "Warning: Couldn't open NEW file $TOPDIR/files/packages/package_names_$suite.$newday: $!\n";
  44             next;
  45         };
  46     while (<OLD>) {
  47         chomp;
  48         $old{$_} = 1;
  49     }
  50     close OLD;
  51     while (<NEW>) {
  52         chomp;
  53         if ($old{$_}) {
  54             # we assume here that the input contains no dupes!
  55             delete $old{$_};
  56         } else {
  57             $changes{$_} = 1;
  58         }
  59     }
  60     close NEW;
  61     foreach (keys %old) {
  62         $changes{$_} = -1;
  63     }
  64
  65     my %archives = map { $_ => 1 } qw( us security non-US );
  66     foreach (sort keys %changes) {
  67         my $entry = read_entry_simple( \%packages, $_, \%archives, $suite)
  68             or die "Fatal Error: Can't find entry for package $_\n";
  69         shift @$entry; # remove virtual pkg info
  70         print CHANGES join(" ", $_, $age, @$entry)."\n";
  71         print "Wrote entry: ".join(" ", $_, $age, @$entry)."\n";
  72     }
  73 }
  74 close CHANGES;
  75
  76 rename("$TOPDIR/files/packages/newpkg_info.new",
  77        "$TOPDIR/files/packages/newpkg_info");