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_binpackages.id)],
 230                       join => {bin =>
 231                               {bin_pkg =>
 232                                'bug_binpackages'
 233                               }},
 234                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 235                      },
 236                      )->all();
 237         # or a source association modified
 238         push @bugs,
 239             map {$_->{'bug_srcpackages.id'}}
 240             $s->resultset('SrcAssociation')->
 241             search_rs({'me.modified' => {'>=',$last_query_time},
 242                       },
 243                      {columns => [qw(bug_srcpackages.id)],
 244                       join => {source =>
 245                               {src_pkg =>
 246                                'bug_srcpackages'
 247                               }},
 248                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 249                      },
 250                      )->all();
 251         # or bugs which have been modified since we last ran
 252         push @bugs,
 253             map {$_->{id}}
 254             $s->resultset('Bug')->
 255             search_rs({-or => {'me.log_modified' => {'>=',$last_query_time},
 256                                'me.last_modified' => {'>=',$last_query_time},
 257                               },
 258                        archived => ! $options->{archived},
 259                       },
 260                      {columns => [qw(id)],
 261                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 262                      },
 263                      )->all();
 264         @bugs = uniq(@bugs);
 265
 266     } else {
 267         ## or just select all of them
 268         push @bugs,
 269             map {$_->{id}}
 270             $s->resultset('Bug')->
 271             search_rs({archived => ! $options->{archived}},
 272                      {columns => [qw(id)],
 273                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 274                      },
 275                      )->all();
 276     }
 277     my $update_bug =
 278         sub {
 279             my @b = @_;
 280             for my $bug (@b) {
 281                 my $status = read_bug(bug => $bug);
 282                 next unless defined $status;
 283                 for my $suite (@suites) {
 284                     my $presence =
 285                         bug_presence(bug => $bug,
 286                                      status => $status,
 287                                      dist => $suite->{suite_name},
 288                                     );
 289                     $s->resultset('BugStatusCache')->
 290                         update_bug_status($bug,
 291                                           $suite->{id},
 292                                           undef,
 293                                           $presence,
 294                                          );
 295                 }
 296             }
 297         };
 298     my $it = natatime 500,@bugs;
 299     my $page = 0;
 300     my $last_page = ceil(@bugs / 500);
 301     $p->target($last_page) if defined $p;
 302     while (my @b_sub = $it->()) {
 303         $s->txn_do($update_bug,
 304                    @b_sub);
 305         $page++;
 306         $p->update($page) if defined $p;
 307     }
 308     $p->remove() if $p;
 309 }
 310
 311
 312 sub handle_subcommand_arguments {
 313     my ($argv,$args) = @_;
 314     my $subopt = {};
 315     Getopt::Long::GetOptionsFromArray($argv,
 316                               $subopt,
 317                               keys %{$args},
 318                              );
 319     my @usage_errors;
 320     for my $arg  (keys %{$args}) {
 321         next unless $args->{$arg};
 322         my $r_arg = $arg; # real argument name
 323         $r_arg =~ s/[=\|].+//g;
 324         if (not defined $subopt->{$r_arg}) {
 325             push @usage_errors, "You must give a $r_arg option";
 326         }
 327     }
 328     pod2usage(join("\n",@usage_errors)) if @usage_errors;
 329     return $subopt;
 330 }
 331
 332 sub get_lock{
 333     my ($subcommand,$config,$options) = @_;
 334     if (not lockpid($config->{spool_dir}.'/lock/debbugs-updatesqlcache-$subcommand')) {
 335         if ($options->{quick}) {
 336             # If this is a quick run, just exit
 337             print STDERR "Another debbugs-updatesqlcache is running; stopping\n" if $options->{verbose};
 338             exit 0;
 339         }
 340         print STDERR "Another debbugs-updatesqlcache is running; stopping\n";
 341         exit 1;
 342     }
 343 }
 344
 345 sub db_connect {
 346     my ($options) = @_;
 347     # connect to the database; figure out how to handle errors
 348     # properly here.
 349     my $s = Debbugs::DB->connect('dbi:Pg:service='.$options->{service}) or
 350         die "Unable to connect to database: ";
 351 }
 352
 353 sub walk_bugs {
 354     my ($dirs,$p,$what,$verbose,$sub) = @_;
 355     my @dirs = @{$dirs};
 356     my $tot_dirs = @dirs;
 357     my $done_dirs = 0;
 358     my $avg_subfiles = 0;
 359     my $completed_files = 0;
 360     while (my $dir = shift @dirs) {
 361         printf "Doing dir %s ...\n", $dir if $verbose;
 362
 363         opendir(DIR, "$dir/.") or die "opendir $dir: $!";
 364         my @subdirs = readdir(DIR);
 365         closedir(DIR);
 366
 367         my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
 368         $tot_dirs -= @dirs;
 369         push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
 370         $tot_dirs += @dirs;
 371         if ($avg_subfiles == 0) {
 372             $avg_subfiles = @list;
 373         }
 374
 375         $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
 376         $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
 377         $done_dirs += 1;
 378
 379         for my $bug (@list) {
 380             $completed_files++;
 381             $p->update($completed_files) if $p;
 382             print "Up to $completed_files bugs...\n" if ($completed_files % 100 == 0 && $verbose);
 383             $sub->($bug);
 384         }
 385     }
 386     $p->remove() if $p;
 387 }
 388
 389
 390
 391 __END__