examples/debian/postpa/21bugclosers

   1 #! /usr/bin/perl -w
   2
   3 use warnings;
   4 use strict;
   5
   6 use Debbugs::Config qw(:globals);
   7
   8 use Debbugs::Bugs qw(count_bugs);
   9 use Debbugs::Status qw(get_bug_status);
  10
  11 require '/org/bugs.debian.org/cgi-bin/common.pl';
  12
  13 package main;
  14
  15 my $startdate = time;
  16 die "failed to get time: $!" unless defined $startdate;
  17
  18 # check the ctime of '/org/bugs.debian.org/www/stats/bugclosers.txt'
  19 use File::stat;
  20 my $ob = stat '/org/bugs.debian.org/www/stats/bugclosers.txt';
  21 if (defined $ob and (time - $ob->ctime) < 60*60*12) {
  22      # If less than 12 hours have passed since we last ran this file,
  23      # don't rebuild it.
  24      exit 0;
  25 }
  26
  27
  28 my %bugclosers = count_bugs(function => sub {
  29     my %d = @_;
  30     return () unless $d{status} eq 'done';
  31
  32     my $status = get_bug_status(bug => $d{bug});
  33     return () unless %$status;
  34     my @merged = sort split ' ', $status->{mergedwith};
  35     return () if @merged and $merged[0] < $d{bug};
  36
  37     return ($status->{done});
  38 });
  39
  40 open BUGCLOSERS, '> /org/bugs.debian.org/www/stats/bugclosers.txt.new'
  41     or die "can't open bugclosers.txt.new: $!";
  42 binmode(BUGCLOSERS,':raw:encoding(UTF-8)');
  43 for my $closer (sort { $bugclosers{$a} <=> $bugclosers{$b} } keys %bugclosers) {
  44     printf BUGCLOSERS "%4d %s\n", $bugclosers{$closer}, $closer
  45         or die "can't write to bugclosers.txt.new: $!";
  46 }
  47 close BUGCLOSERS or die "can't close bugclosers.txt.new: $!";
  48 rename '/org/bugs.debian.org/www/stats/bugclosers.txt.new',
  49        '/org/bugs.debian.org/www/stats/bugclosers.txt'
  50     or die "can't rename bugclosers.txt.new to bugclosers.txt: $!";