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::AllUtils qw(natatime uniq);
 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{database},
 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                   arguments => {'suites|suite=s@' => 0,
 135                                },
 136                },
 137      'help' => {function => sub {pod2usage({verbose => 2});}}
 138     );
 139
 140 my @USAGE_ERRORS;
 141 $options{verbose} = $options{verbose} - $options{quiet};
 142
 143 if ($options{progress}) {
 144     eval "use Term::ProgressBar";
 145     push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
 146 }
 147
 148
 149 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 150
 151 if (exists $options{sysconfdir}) {
 152     if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
 153         delete $ENV{PGSYSCONFDIR};
 154     } else {
 155         $ENV{PGSYSCONFDIR} = $options{sysconfdir};
 156     }
 157 }
 158
 159 if (exists $options{spool_dir} and defined $options{spool_dir}) {
 160     $config{spool_dir} = $options{spool_dir};
 161 }
 162
 163 my $prog_bar;
 164 if ($options{progress}) {
 165     $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
 166     warn "Unable to initialize progress bar: $@" if not $prog_bar;
 167 }
 168
 169
 170 my ($subcommand) = shift @ARGV;
 171 if (not defined $subcommand) {
 172     $subcommand = 'help';
 173     print STDERR "You must provide a subcommand; displaying usage.\n";
 174     pod2usage();
 175 } elsif (not exists $subcommands{$subcommand}) {
 176     print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
 177     pod2usage();
 178 }
 179
 180 my $opts =
 181     handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
 182 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
 183
 184 sub update_cache {
 185     my ($options,$opts,$p,$config,$argv) = @_;
 186
 187     my $verbose = $options->{debug};
 188     # select bugs to update
 189
 190     # basically, if this is a quick run, we want any bug which has
 191     # been modified or any bug which belongs to a package which has a
 192     # new version; otherwise, walk every bug
 193     my $s = db_connect($options);
 194
 195     # get all of the possible architectures that we might care about
 196     # 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;
 197
 198     my @suites;
 199     if (exists $opts->{suites}) {
 200         @suites =
 201             $s->resultset('Suite')->
 202             search_rs({active => 1,
 203                        -or => {codename => [make_list($opts->{suites})],
 204                                suite_name => [make_list($opts->{suites})],
 205                               },
 206                       },
 207                      {result_class => 'DBIx::Class::ResultClass::HashRefInflator'}
 208                      )->all();
 209      } else {
 210         @suites =
 211             $s->resultset('Suite')->
 212             search_rs({active => 1,
 213                       },
 214                      {result_class => 'DBIx::Class::ResultClass::HashRefInflator'}
 215                      )->all();
 216     }
 217     my @bugs;
 218     my $bugs;
 219     if ($options->{quick}) {
 220         # identify the last time that we ran this query
 221         my $last_query_time =
 222             $s->resultset('BugStatusCache')->
 223             search_rs(undef,
 224                      {rows => 1,
 225                       order_by => { -desc => 'asof' },
 226                       columns => [qw(asof)],
 227                      }
 228                      )->first();
 229         my $dtf = $s->storage->datetime_parser;
 230         if (defined $last_query_time) {
 231             $last_query_time = $last_query_time->asof();
 232         } else {
 233             $last_query_time = DateTime->from_epoch(0);
 234         }
 235         # select last status update
 236         $last_query_time = $dtf->format_datetime($last_query_time);
 237         # select all bugs which are in packages which have had a binary
 238         # association modified
 239         push @bugs,
 240             map {$_->{bug_binpackages}{bug}}
 241             $s->resultset('BinAssociation')->
 242             search_rs({'me.modified' => {'>=',$last_query_time},
 243                       },
 244                      {columns => [qw(bug_binpackages.bug)],
 245                       join => {bin =>
 246                               {bin_pkg =>
 247                                'bug_binpackages'
 248                               }},
 249                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 250                      },
 251                      )->all();
 252         # or a source association modified
 253         push @bugs,
 254             map {$_->{bug_srcpackages}{bug}}
 255             $s->resultset('SrcAssociation')->
 256             search_rs({'me.modified' => {'>=',$last_query_time},
 257                       },
 258                      {columns => [qw(bug_srcpackages.bug)],
 259                       join => {source =>
 260                               {src_pkg =>
 261                                'bug_srcpackages'
 262                               }},
 263                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 264                      },
 265                      )->all();
 266         # or bugs which have been modified since we last ran
 267         push @bugs,
 268             map {$_->{id}}
 269             $s->resultset('Bug')->
 270             search_rs({-or => {'me.log_modified' => {'>=',$last_query_time},
 271                                'me.last_modified' => {'>=',$last_query_time},
 272                               },
 273                        archived => ! $options->{archived},
 274                       },
 275                      {columns => [qw(id)],
 276                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 277                      },
 278                      )->all();
 279         @bugs = uniq(@bugs);
 280
 281     } else {
 282         ## or just select all of them
 283         push @bugs,
 284             map {$_->{id}}
 285             $s->resultset('Bug')->
 286             search_rs({archived => ! $options->{archived}},
 287                      {columns => [qw(id)],
 288                       result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 289                      },
 290                      )->all();
 291     }
 292     my $update_bug =
 293         sub {
 294             my @b = @_;
 295             for my $bug (@b) {
 296                 my $status = read_bug(bug => $bug);
 297                 next unless defined $status;
 298                 for my $suite (@suites) {
 299                     my $presence =
 300                         bug_presence(bug => $bug,
 301                                      status => $status,
 302                                      dist => $suite->{suite_name},
 303                                     );
 304                     $s->resultset('BugStatusCache')->
 305                         update_bug_status($bug,
 306                                           $suite->{id},
 307                                           undef,
 308                                           $presence,
 309                                          );
 310                 }
 311             }
 312         };
 313     my $it = natatime 500,@bugs;
 314     my $page = 0;
 315     my $last_page = ceil(@bugs / 500);
 316     $p->target($last_page) if defined $p;
 317     while (my @b_sub = $it->()) {
 318         $s->txn_do($update_bug,
 319                    @b_sub);
 320         $page++;
 321         $p->update($page) if defined $p;
 322     }
 323     $p->remove() if $p;
 324 }
 325
 326
 327 sub handle_subcommand_arguments {
 328     my ($argv,$args) = @_;
 329     my $subopt = {};
 330     Getopt::Long::GetOptionsFromArray($argv,
 331                               $subopt,
 332                               keys %{$args},
 333                              );
 334     my @usage_errors;
 335     for my $arg  (keys %{$args}) {
 336         next unless $args->{$arg};
 337         my $r_arg = $arg; # real argument name
 338         $r_arg =~ s/[=\|].+//g;
 339         if (not defined $subopt->{$r_arg}) {
 340             push @usage_errors, "You must give a $r_arg option";
 341         }
 342     }
 343     pod2usage(join("\n",@usage_errors)) if @usage_errors;
 344     return $subopt;
 345 }
 346
 347 sub get_lock{
 348     my ($subcommand,$config,$options) = @_;
 349     if (not lockpid($config->{spool_dir}.'/lock/debbugs-updatesqlcache-$subcommand')) {
 350         if ($options->{quick}) {
 351             # If this is a quick run, just exit
 352             print STDERR "Another debbugs-updatesqlcache is running; stopping\n" if $options->{verbose};
 353             exit 0;
 354         }
 355         print STDERR "Another debbugs-updatesqlcache is running; stopping\n";
 356         exit 1;
 357     }
 358 }
 359
 360 sub db_connect {
 361     my ($options) = @_;
 362     # connect to the database; figure out how to handle errors
 363     # properly here.
 364     my $s = Debbugs::DB->connect('dbi:Pg:service='.$options->{service}) or
 365         die "Unable to connect to database: ";
 366 }
 367
 368 sub walk_bugs {
 369     my ($dirs,$p,$what,$verbose,$sub) = @_;
 370     my @dirs = @{$dirs};
 371     my $tot_dirs = @dirs;
 372     my $done_dirs = 0;
 373     my $avg_subfiles = 0;
 374     my $completed_files = 0;
 375     while (my $dir = shift @dirs) {
 376         printf "Doing dir %s ...\n", $dir if $verbose;
 377
 378         opendir(DIR, "$dir/.") or die "opendir $dir: $!";
 379         my @subdirs = readdir(DIR);
 380         closedir(DIR);
 381
 382         my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
 383         $tot_dirs -= @dirs;
 384         push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
 385         $tot_dirs += @dirs;
 386         if ($avg_subfiles == 0) {
 387             $avg_subfiles = @list;
 388         }
 389
 390         $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
 391         $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
 392         $done_dirs += 1;
 393
 394         for my $bug (@list) {
 395             $completed_files++;
 396             $p->update($completed_files) if $p;
 397             print "Up to $completed_files bugs...\n" if ($completed_files % 100 == 0 && $verbose);
 398             $sub->($bug);
 399         }
 400     }
 401     $p->remove() if $p;
 402 }
 403
 404
 405
 406 __END__