File: split_index.pl

package info (click to toggle)
debbugs 2.6.4
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,800 kB
  • sloc: perl: 19,270; makefile: 81; sh: 75
file content (30 lines) | stat: -rw-r--r-- 1,001 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
#!/usr/bin/perl

use warnings;
use strict;

use Debbugs::Config qw(:config);

my $index_db = IO::File->new("$config{spool}/index.db",'r') or
     die "Unable to open $config{spool}/index.db for reading: $!";

my %severity_fh;

for my $severity  (@{$config{severity_list}}) {
     my $temp_fh = IO::File->new("$config{spool}/index-${severity}.db",'w') or
	  die "Unable to open $config{spool}/index-${severity}.db for writing: $!";
     $severity_fh{$severity} = $temp_fh;
}

while (<$index_db>) {
     my $line = $_;
     next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
     my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
     print {$severity_fh{$severity}} $line if exists $severity_fh{$severity};
}

for my $severity (@{$config{severity_list}}) {
     close $severity_fh{$severity};
     system('gzip','-f',"$config{spool}/index-${severity}.db") == 0 or
	  die "Failure while compressing $config{spool}/index-${severity}.db";
}