examples/debian/misc/split_index.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use Debbugs::Config qw(:config);
   7
   8 my $index_db = IO::File->new("$config{spool}/index.db",'r') or
   9      die "Unable to open $config{spool}/index.db for reading: $!";
  10
  11 my %severity_fh;
  12
  13 for my $severity  (@{$config{severity_list}}) {
  14      my $temp_fh = IO::File->new("$config{spool}/index-${severity}.db",'w') or
  15           die "Unable to open $config{spool}/index-${severity}.db for writing: $!";
  16      $severity_fh{$severity} = $temp_fh;
  17 }
  18
  19 while (<$index_db>) {
  20      my $line = $_;
  21      next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
  22      my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
  23      print {$severity_fh{$severity}} $line if exists $severity_fh{$severity};
  24 }
  25
  26 for my $severity (@{$config{severity_list}}) {
  27      close $severity_fh{$severity};
  28      system('gzip','-f',"$config{spool}/index-${severity}.db") == 0 or
  29           die "Failure while compressing $config{spool}/index-${severity}.db";
  30 }