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