bin/debbugs-loadsql

   1 #! /usr/bin/perl
   2 # debbugs-loadsql 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 2012 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-loadsql -- load debbugs sql database
  17
  18 =head1 SYNOPSIS
  19
  20 debbugs-loadsql [options]
  21
  22  Options:
  23   --quick, -q only load changed bugs
  24   --service, -s service name
  25   --sysconfdir, -c postgresql service config dir
  26   --spool-dir debbugs spool directory
  27   --debug, -d debugging level (Default 0)
  28   --help, -h display this help
  29   --man, -m display manual
  30
  31 =head1 OPTIONS
  32
  33 =over
  34
  35 =item B<--quick, -q>
  36
  37 Only load changed bugs
  38
  39 =item B<--service,-s>
  40
  41 Postgreql service to use; defaults to debbugs
  42
  43 =item B<--sysconfdir,-c>
  44
  45 System configuration directory to use; if not set, defaults to the
  46 postgresql default. [Operates by setting PGSYSCONFDIR]
  47
  48 =item B<--spool-dir>
  49
  50 Debbugs spool directory; defaults to the value configured in the
  51 debbugs configuration file.
  52
  53 =item B<--debug, -d
  54
  55 Debug verbosity.
  56
  57 =item B<--help, -h>
  58
  59 Display brief useage information.
  60
  61 =item B<--man, -m>
  62
  63 Display this manual.
  64
  65 =back
  66
  67
  68 =cut
  69
  70
  71 use vars qw($DEBUG);
  72
  73 use Debbugs::Common qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list);
  74 use Debbugs::Config qw(:config);
  75 use Debbugs::Status qw(read_bug split_status_fields);
  76 use Debbugs::Log;
  77 use Debbugs::DB;
  78 use DateTime;
  79 use File::stat;
  80
  81
  82 my %options = (debug           => 0,
  83                help            => 0,
  84                man             => 0,
  85                verbose         => 0,
  86                quiet           => 0,
  87                quick           => 0,
  88                service         => 'debbugs',
  89               );
  90
  91
  92 GetOptions(\%options,
  93            'quick|q',
  94            'service|s',
  95            'sysconfdir|c',
  96            'spool_dir|spool-dir=s',
  97            'debug|d+','help|h|?','man|m');
  98
  99 pod2usage() if $options{help};
 100 pod2usage({verbose=>2}) if $options{man};
 101
 102 $DEBUG = $options{debug};
 103
 104 my @USAGE_ERRORS;
 105 $options{verbose} = $options{verbose} - $options{quiet};
 106
 107 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 108
 109 if (exists $options{sysconfdir}) {
 110     if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
 111         delete $ENV{PGSYSCONFDIR};
 112     } else {
 113         $ENV{PGSYSCONFDIR} = $options{sysconfdir};
 114     }
 115 }
 116
 117 if (exists $options{spool_dir} and defined $options{spool_dir}) {
 118     $config{spool_dir} = $options{spool_dir};
 119 }
 120 chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
 121
 122 my $verbose = $options{debug};
 123
 124 my $initialdir = "db-h";
 125
 126 if (defined $ARGV[0] and $ARGV[0] eq "archive") {
 127     $initialdir = "archive";
 128 }
 129
 130 if (not lockpid($config{spool_dir}.'/lock/debbugs-loadsql')) {
 131      if ($options{quick}) {
 132           # If this is a quick run, just exit
 133           print STDERR "Another debbugs-loadsql is running; stopping\n" if $verbose;
 134           exit 0;
 135      }
 136      print STDERR "Another debbugs-loadsql is running; stopping\n";
 137      exit 1;
 138 }
 139
 140 # connect to the database; figure out how to handle errors properly
 141 # here.
 142 my $schema = Debbugs::DB->connect('dbi:Pg:service='.$options{service}) or
 143     die "Unable to connect to database: ";
 144
 145 my $time = 0;
 146 my $start_time = time;
 147
 148
 149 my @dirs = ($initialdir);
 150 my $cnt = 0;
 151 my %tags;
 152 my %queue;
 153 while (my $dir = shift @dirs) {
 154     printf "Doing dir %s ...\n", $dir if $verbose;
 155
 156     opendir(DIR, "$dir/.") or die "opendir $dir: $!";
 157     my @subdirs = readdir(DIR);
 158     closedir(DIR);
 159
 160     my @list = map { m/^(\d+)\.summary$/?($1):() } @subdirs;
 161     push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
 162
 163     for my $bug (@list) {
 164         print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
 165         my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
 166         if (not defined $stat) {
 167             print STDERR "Unable to stat $bug $!\n";
 168             next;
 169         }
 170         next if $stat->mtime < $time;
 171         my $data = read_bug(bug => $bug,
 172                             location => $initialdir);
 173         load_bug($schema,split_status_fields($data),\%tags,\%queue);
 174     }
 175 }
 176 hanlde_queue($schema,\%queue);
 177
 178 sub load_bug {
 179     my ($s,$data,$tags,$queue) = @_;
 180     my $s_data = split_status_fields($data);
 181     my @tags;
 182     for my $tag (make_list($s_data->{keywords})) {
 183         next unless defined $tag and length $tag;
 184         # this allows for invalid tags. But we'll use this to try to
 185         # find those bugs and clean them up
 186         if (not exists $tags->{$tag}) {
 187             $tags->{$tag} = $s->resultset('Tag')->find_or_create({tag => $tag});
 188         }
 189         push @tags, $tags->{$tag};
 190     }
 191     my $bug = {id => $data->{bug_num},
 192                creation => DateTime->from_epoch(epoch => $data->{date}),
 193                log_modified => DateTime->from_epoch(epoch => $data->{log_modified}),
 194                last_modified => DateTime->from_epoch(epoch => $data->{last_modified}),
 195                archived => $data->{archived},
 196                (defined $data->{unarchived} and length($data->{unarchived}))?(unarchived => DateTime->from_epoch(epoch => $data->{unarchived})):(),
 197                forwarded => $data->{forwarded} // '',
 198                summary => $data->{summary} // '',
 199                outlook => $data->{outlook} // '',
 200                subject => $data->{subject} // '',
 201                done => $data->{done} // '',
 202                owner => $data->{owner} // '',
 203                severity => length($data->{severity}) ? $data->{severity} : $config{default_severity},
 204               };
 205     $s->resultset('Bug')->update_or_create($bug);
 206     $s->txn_do(sub {
 207                    for my $ff (qw(found fixed)) {
 208                        my @elements = $s->resultset('BugVer')->search({bug_id => $data->{bug_num},
 209                                                                        found  => $ff eq 'found'?1:0,
 210                                                                       });
 211                        my %elements_to_delete = map {($elements[$_]->ver_string(),$_)} 0..$#elements;
 212                        my @elements_to_add;
 213                        for my $version (@{$data->{"${ff}_versions"}}) {
 214                            if (exists $elements_to_delete{$version}) {
 215                                delete $elements_to_delete{$version};
 216                            } else {
 217                                push @elements_to_add,$version;
 218                            }
 219                        }
 220                        for my $element (keys %elements_to_delete) {
 221                            $elements_to_delete{$element}->delete();
 222                        }
 223                        for my $element (@elements_to_add) {
 224                            # find source package and source version id
 225                            my $ne = $s->resultset('BugVer')->new_result({bug_id => $data->{bug_num},
 226                                                                          ver_string => $element,
 227                                                                          found => $ff eq 'found'?1:0,
 228                                                                         }
 229                                                                        );
 230                            if (my ($src_pkg,$src_ver) = $element =~ m{^([^\/]+)/(.+)$}) {
 231                                my $src_pkg_e = $s->resultset('SrcPkg')->single({pkg => $src_pkg});
 232                                if (defined $src_pkg_e) {
 233                                    $ne->src_pkg_id($src_pkg_e->id());
 234                                    my $src_ver_e = $s->resultset('SrcVer')->single({src_pkg_id => $src_pkg_e->id(),
 235                                                                                     ver => $src_ver
 236                                                                                    });
 237                                    $ne->src_ver_id($src_ver_e->id()) if defined $src_ver_e;
 238                                }
 239                            }
 240                            $ne->insert();
 241                        }
 242                    }
 243                });
 244     $s->txn_do(sub {
 245                    $s->resultset('BugTag')->search({bug_id => $data->{bug_num}})->delete();
 246                    $s->populate(BugTag => [[qw(bug_id tag_id)], map {[$data->{bug_num}, $_->id()]} @tags]);
 247                });
 248     # because these bugs reference other bugs which might not exist
 249     # yet, we can't handle them until we've loaded all bugs. queue
 250     # them up.
 251     $queue->{merged}{$data->{bug_num}} = [@{$data->{mergedwith}}];
 252     $queue->{blocks}{$data->{bug_num}} = [@{$data->{blocks}}];
 253
 254     print STDERR "Handled $data->{bug_num}\n";
 255     # still need to handle merges, versions, etc.
 256 }
 257
 258 sub handle_queue{
 259     my ($s,$queue) = @_;
 260     my %queue_types =
 261         (merged => {set => 'BugMerged',
 262                     columns => [qw(bug_id merged)],
 263                     bug_id => 'bug_id',
 264                    },
 265          blocks => {set => 'BugBlock',
 266                     columns => [qw(bug_id blocks)],
 267                     bug_id => 'bug_id',
 268                    },
 269         );
 270     for my $queue_type (keys %queue_types) {
 271         for my $bug (%{$queue->{$queue_type}}) {
 272             my $qt = $queue_types{$queue_type};
 273             $s->txn_do(sub {
 274                            $s->resultset($qt->{set})->search({$qt->{bug_id},$bug})->delete();
 275                            $s->populate($qt->{set},[[@{$qt->{columns}}],map {[$bug,$_]} @{$queue->{$queue_type}{$bug}}]) if
 276                                @{$queue->{$queue_type}{$bug}};
 277                        }
 278                       );
 279         }
 280     }
 281 }
 282
 283
 284 __END__