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");