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 "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 "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 "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"Couldn't open OLD file $TOPDIR/files/packages/package_names_$suite.$oldday: $!\n";
  39             last;
  40         };
  41     while (<OLD>) {
  42         chomp;
  43         $old{$_} = 1;
  44     }
  45     close OLD;
  46     open NEW, '<', "$TOPDIR/files/packages/package_names_$suite.$newday"
  47         or die "Couldn't open NEW file $TOPDIR/files/packages/package_names_$suite.$newday: $!\n";
  48     while (<NEW>) {
  49         chomp;
  50         if ($old{$_}) {
  51             # we assume here that the input contains no dupes!
  52             delete $old{$_};
  53         } else {
  54             $changes{$_} = 1;
  55         }
  56     }
  57     close NEW;
  58     foreach (keys %old) {
  59         $changes{$_} = -1;
  60     }
  61
  62     my %archives = map { $_ => 1 } qw( us security non-US );
  63     foreach (sort keys %changes) {
  64         my $entry = read_entry_simple( \%packages, $_, \%archives, $suite)
  65             or die "Can't find entry for package $_\n";
  66         shift @$entry; # remove virtual pkg info
  67         print CHANGES join(" ", $_, $age, @$entry)."\n";
  68         print "Wrote entry: ".join(" ", $_, $age, @$entry)."\n";
  69     }
  70 }
  71 close CHANGES;
  72
  73 rename("$TOPDIR/files/packages/newpkg_info.new",
  74        "$TOPDIR/files/packages/newpkg_info");