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