bin/debbugs-updatesqlcache

   1 #! /usr/bin/perl
   2 # debbugs-updatesqlcache is part of debbugs, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2016 by Don Armstrong <don@donarmstrong.com>.
   6
   7
   8 use warnings;
   9 use strict;
  10
  11 use Getopt::Long qw(:config no_ignore_case);
  12 use Pod::Usage;
  13
  14 =head1 NAME
  15
  16 debbugs-updatesqlcache -- Update Debbugs SQL Cache
  17
  18 =head1 SYNOPSIS
  19
  20 debbugs-updatesqlcache [options]
  21
  22  Options:
  23   --quick, -q only load changed bugs
  24   --progress Show progress bar
  25   --service, -s service name
  26   --sysconfdir, -c postgresql service config dir
  27   --spool-dir debbugs spool directory
  28   --debug, -d debugging level (Default 0)
  29   --help, -h display this help
  30   --man, -m display manual
  31
  32 =head1 SUBCOMMANDS
  33
  34 =head2 help
  35
  36 Display this manual
  37
  38 =head2 update
  39
  40 Update SQL cache
  41
  42 =head1 OPTIONS
  43
  44 =over
  45
  46 =item B<--quick, -q>
  47
  48 Only update things which may have changed
  49
  50 =item B<--progress>
  51
  52 Show progress bar (requires Term::ProgressBar)
  53
  54 =item B<--service,-s>
  55
  56 Postgreql service to use; defaults to debbugs
  57
  58 =item B<--sysconfdir,-c>
  59
  60 System configuration directory to use; if not set, defaults to the
  61 postgresql default. [Operates by setting PGSYSCONFDIR]
  62
  63 =item B<--spool-dir>
  64
  65 Debbugs spool directory; defaults to the value configured in the
  66 debbugs configuration file.
  67
  68 =item B<--verbose>
  69
  70 Output more information about what is happening. Probably not useful
  71 if you also set --progress.
  72
  73 =item B<--debug, -d>
  74
  75 Debug verbosity.
  76
  77 =item B<--help, -h>
  78
  79 Display brief useage information.
  80
  81 =item B<--man, -m>
  82
  83 Display this manual.
  84
  85 =back
  86
  87
  88 =cut
  89
  90
  91 use vars qw($DEBUG);
  92
  93 use Debbugs::Common qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list getsourcemaintainers);
  94 use Debbugs::Config qw(:config);
  95 use Debbugs::Status qw(bug_presence read_bug);
  96 use Debbugs::DB;
  97 use DateTime;
  98 use File::stat;
  99 use List::MoreUtils qw(natatime);
 100 use POSIX qw(ceil);
 101
 102 my %options =
 103     (debug           => 0,
 104      help            => 0,
 105      man             => 0,
 106      verbose         => 0,
 107      quiet           => 0,
 108      quick           => 0,
 109      archived        => 0,
 110      service         => $config{debbugs_db},
 111      progress        => 0,
 112     );
 113
 114 Getopt::Long::Configure('pass_through');
 115 GetOptions(\%options,
 116            'quick|q!',
 117            'service|s=s',
 118            'sysconfdir|c=s',
 119            'progress!',
 120            'archived+',
 121            'spool_dir|spool-dir=s',
 122            'verbose|v+',
 123            'quiet+',
 124            'debug|d+','help|h|?','man|m');
 125 Getopt::Long::Configure('default');
 126
 127 pod2usage() if $options{help};
 128 pod2usage({verbose=>2}) if $options{man};
 129
 130 $DEBUG = $options{debug};
 131
 132 my %subcommands =
 133     ('update' => {function => \&update_cache,
 134                },
 135      'help' => {function => sub {pod2usage({verbose => 2});}}
 136     );
 137
 138 my @USAGE_ERRORS;
 139 $options{verbose} = $options{verbose} - $options{quiet};
 140
 141 if ($options{progress}) {
 142     eval "use Term::ProgressBar";
 143     push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
 144 }
 145
 146
 147 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 148
 149 if (exists $options{sysconfdir}) {
 150     if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
 151         delete $ENV{PGSYSCONFDIR};
 152     } else {
 153         $ENV{PGSYSCONFDIR} = $options{sysconfdir};
 154     }
 155 }
 156
 157 if (exists $options{spool_dir} and defined $options{spool_dir}) {
 158     $config{spool_dir} = $options{spool_dir};
 159 }
 160
 161 my $prog_bar;
 162 if ($options{progress}) {
 163     $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
 164     warn "Unable to initialize progress bar: $@" if not $prog_bar;
 165 }
 166
 167
 168 my ($subcommand) = shift @ARGV;
 169 if (not defined $subcommand) {
 170     $subcommand = 'help';
 171     print STDERR "You must provide a subcommand; displaying usage.\n";
 172     pod2usage();
 173 } elsif (not exists $subcommands{$subcommand}) {
 174     print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
 175     pod2usage();
 176 }
 177
 178 my $opts =
 179     handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
 180 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
 181
 182 sub update_cache {
 183     my ($options,$opts,$p,$config,$argv) = @_;
 184
 185     my $verbose = $options->{debug};
 186     # select bugs to update
 187
 188     # basically, if this is a quick run, we want any bug which has
 189     # been modified or any bug which belongs to a package which has a
 190     # new version; otherwise, walk every bug
 191     my $s = db_connect($options);
 192
 193     # get all of the possible architectures that we might care about
 194     # select distinct s.codename,a.arch from bin_associations ba join bin_ver bv on ba.bin=bv.id join suite s on ba.suite=s.id join arch a on bv.arch=a.id;
 195
 196     my @suites =
 197         $s->resultset('Suite')->
 198         search_rs({active => 1,
 199                   },
 200                  {result_class => 'DBIx::Class::ResultClass::HashRefInflator'}
 201                  )->all();
 202     my @bugs;
 203     my $bugs;
 204     if ($options->{quick}) {
 205         # identify the last time that we ran this query
 206         my $last_query_time =
 207             $s->resultset('BugStatusCache')->
 208             search_rs(undef,
 209                      {rows => 1,
 210                       order_by => { -desc => 'asof' },
 211                       columns => [qw(asof)],
 212                      }
 213                      )->first();
 214         my $dtf = $s->storage->datetime_parser;
 215         if (defined $last_query_time) {
 216             $last_query_time = $last_query_time->asof();
 217         } else {
 218             $last_query_time = DateTime->from_epoch(0);
 219         }
 220         # select last status update
 221         $last_query_time = $dtf->format_datetime($last_query_time);
 222         # select all bugs which are in packages which have had a binary
 223         # association modified
 224         push @bugs,
 225             map {$_->{'bug_binpackages.id'}}
 226             $s->resultset('BinAssociation')->
 227             search_rs({'me.modified' => {'>=',$last_query_time},
 228                       },
 229                      {columns => [qw(bug_binpackage.id)],
 230                       join => {bin =>
 231                               {bin_vers =>
 232                               {bin_pkg =>
 233                                'bug_binpackage'
 234                               }}},
 235                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 236                      },
 237                      )->all();
 238         # or a source association modified
 239         push @bugs,
 240             map {$_->{'bug_srcpackages.id'}}
 241             $s->resultset('SrcAssociation')->
 242             search_rs({'me.modified' => {'>=',$last_query_time},
 243                       },
 244                      {columns => [qw(bug_srcpackage.id)],
 245                       join => {source =>
 246                               {src_pkg =>
 247                                'bug_srcpackage'
 248                               }},
 249                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 250                      },
 251                      )->all();
 252         # or bugs which have been modified since we last ran
 253         push @bugs,
 254             map {$_->{id}}
 255             $s->resultset('Bug')->
 256             search_rs({-or => {'me.log_modified' => {'>=',$last_query_time},
 257                                'me.last_modified' => {'>=',$last_query_time},
 258                               },
 259                        archived => ! $options->{archived},
 260                       },
 261                      {columns => [qw(id)],
 262                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 263                      },
 264                      )->all();
 265         @bugs = uniq(@bugs);
 266
 267     } else {
 268         ## or just select all of them
 269         push @bugs,
 270             map {$_->{id}}
 271             $s->resultset('Bug')->
 272             search_rs({archived => ! $options->{archived}},
 273                      {columns => [qw(id)],
 274                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 275                      },
 276                      )->all();
 277     }
 278     my $update_bug =
 279         sub {
 280             my @b = @_;
 281             for my $bug (@b) {
 282                 my $status = read_bug(bug => $bug);
 283                 next unless defined $status;
 284                 for my $suite (@suites) {
 285                     my $presence =
 286                         bug_presence(bug => $bug,
 287                                      status => $status,
 288                                      dist => $suite->{suite_name},
 289                                     );
 290                     $s->resultset('BugStatusCache')->
 291                         update_bug_status($bug,
 292                                           $suite->{id},
 293                                           undef,
 294                                           $presence,
 295                                          );
 296                 }
 297             }
 298         };
 299     my $it = natatime 500,@bugs;
 300     my $page = 0;
 301     my $last_page = ceil(@bugs / 500);
 302     $p->target($last_page) if defined $p;
 303     while (my @b_sub = $it->()) {
 304         $s->txn_do($update_bug,
 305                    @b_sub);
 306         $page++;
 307         $p->update($page) if defined $p;
 308     }
 309     $p->remove() if $p;
 310 }
 311
 312
 313 sub handle_subcommand_arguments {
 314     my ($argv,$args) = @_;
 315     my $subopt = {};
 316     Getopt::Long::GetOptionsFromArray($argv,
 317                               $subopt,
 318                               keys %{$args},
 319                              );
 320     my @usage_errors;
 321     for my $arg  (keys %{$args}) {
 322         next unless $args->{$arg};
 323         my $r_arg = $arg; # real argument name
 324         $r_arg =~ s/[=\|].+//g;
 325         if (not defined $subopt->{$r_arg}) {
 326             push @usage_errors, "You must give a $r_arg option";
 327         }
 328     }
 329     pod2usage(join("\n",@usage_errors)) if @usage_errors;
 330     return $subopt;
 331 }
 332
 333 sub get_lock{
 334     my ($subcommand,$config,$options) = @_;
 335     if (not lockpid($config->{spool_dir}.'/lock/debbugs-updatesqlcache-$subcommand')) {
 336         if ($options->{quick}) {
 337             # If this is a quick run, just exit
 338             print STDERR "Another debbugs-updatesqlcache is running; stopping\n" if $options->{verbose};
 339             exit 0;
 340         }
 341         print STDERR "Another debbugs-updatesqlcache is running; stopping\n";
 342         exit 1;
 343     }
 344 }
 345
 346 sub db_connect {
 347     my ($options) = @_;
 348     # connect to the database; figure out how to handle errors
 349     # properly here.
 350     my $s = Debbugs::DB->connect('dbi:Pg:service='.$options->{service}) or
 351         die "Unable to connect to database: ";
 352 }
 353
 354 sub walk_bugs {
 355     my ($dirs,$p,$what,$verbose,$sub) = @_;
 356     my @dirs = @{$dirs};
 357     my $tot_dirs = @dirs;
 358     my $done_dirs = 0;
 359     my $avg_subfiles = 0;
 360     my $completed_files = 0;
 361     while (my $dir = shift @dirs) {
 362         printf "Doing dir %s ...\n", $dir if $verbose;
 363
 364         opendir(DIR, "$dir/.") or die "opendir $dir: $!";
 365         my @subdirs = readdir(DIR);
 366         closedir(DIR);
 367
 368         my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
 369         $tot_dirs -= @dirs;
 370         push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
 371         $tot_dirs += @dirs;
 372         if ($avg_subfiles == 0) {
 373             $avg_subfiles = @list;
 374         }
 375
 376         $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
 377         $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
 378         $done_dirs += 1;
 379
 380         for my $bug (@list) {
 381             $completed_files++;
 382             $p->update($completed_files) if $p;
 383             print "Up to $completed_files bugs...\n" if ($completed_files % 100 == 0 && $verbose);
 384             $sub->($bug);
 385         }
 386     }
 387     $p->remove() if $p;
 388 }
 389
 390
 391
 392 __END__