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>.
11 use Getopt::Long qw(:config no_ignore_case);
16 debbugs-loadsql -- load debbugs sql database
20 debbugs-loadsql [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
48 Add source maintainers
56 Only load changed bugs
60 Show progress bar (requires Term::ProgressBar)
64 Postgreql service to use; defaults to debbugs
66 =item B<--sysconfdir,-c>
68 System configuration directory to use; if not set, defaults to the
69 postgresql default. [Operates by setting PGSYSCONFDIR]
73 Debbugs spool directory; defaults to the value configured in the
74 debbugs configuration file.
78 Output more information about what is happening. Probably not useful
79 if you also set --progress.
87 Display brief useage information.
101 use Debbugs::Common qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list getsourcemaintainers);
102 use Debbugs::Config qw(:config);
103 use Debbugs::Status qw(read_bug split_status_fields);
106 use Debbugs::DB::Load qw(load_bug handle_load_bug_queue);
107 use Debbugs::BugWalker;
119 service => $config{debbugs_db},
123 Getopt::Long::Configure('pass_through');
124 GetOptions(\%options,
129 'spool_dir|spool-dir=s',
132 'debug|d+','help|h|?','man|m');
133 Getopt::Long::Configure('default');
135 pod2usage() if $options{help};
136 pod2usage({verbose=>2}) if $options{man};
138 $DEBUG = $options{debug};
141 ('bugs' => {function => \&add_bugs,
143 'versions' => {function => \&add_versions,
145 'debinfo' => {function => \&add_debinfo,
147 'maintainers' => {function => \&add_maintainers,
149 'configuration' => {function => \&add_configuration,
151 'logs' => {function => \&add_logs,
153 'help' => {function => sub {pod2usage({verbose => 2});}}
157 $options{verbose} = $options{verbose} - $options{quiet};
159 if ($options{progress}) {
160 eval "use Term::ProgressBar";
161 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
165 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
167 if (exists $options{sysconfdir}) {
168 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
169 delete $ENV{PGSYSCONFDIR};
171 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
175 if (exists $options{spool_dir} and defined $options{spool_dir}) {
176 $config{spool_dir} = $options{spool_dir};
180 if ($options{progress}) {
181 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
182 warn "Unable to initialize progress bar: $@" if not $prog_bar;
186 my ($subcommand) = shift @ARGV;
187 if (not defined $subcommand) {
188 $subcommand = 'help';
189 print STDERR "You must provide a subcommand; displaying usage.\n";
191 } elsif (not exists $subcommands{$subcommand}) {
192 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
197 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
198 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
201 my ($options,$opts,$p,$config,$argv) = @_;
202 chdir($config->{spool_dir}) or
203 die "chdir $config->{spool_dir} failed: $!";
205 my $verbose = $options->{debug};
207 my $initialdir = "db-h";
209 if (defined $argv->[0] and $argv->[0] eq "archive") {
210 $initialdir = "archive";
212 my $s = db_connect($options);
216 my $start_time = time;
219 my @dirs = (@{$argv}?@{$argv} : $initialdir);
224 my $w = Debbugs::BugWalker->new(dir => [@dirs],
225 defined $p ? (progress => $p):(),
229 while (defined($bug = $w->get_next())) {
230 print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
231 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
232 if (not defined $stat) {
233 print STDERR "Unable to stat $bug $!\n";
236 if ($options{quick}) {
237 my $rs = $s->resultset('Bug')->search({bug=>$bug})->single();
238 next if defined $rs and $stat->mtime < $rs->last_modified()->epoch();
240 my $data = read_bug(bug => $bug,
241 location => $initialdir);
244 data => split_status_fields($data),
246 severities => \%severities,
251 print STDERR Dumper($data) if $DEBUG;
252 die "failure while trying to load bug $bug\n$@";
256 handle_load_bug_queue(db => $s,
261 my ($options,$opts,$p,$config,$argv) = @_;
263 my $s = db_connect($options);
265 my @files = @{$argv};
266 $p->target(scalar @files) if $p;
267 for my $file (@files) {
268 my $fh = IO::File->new($file,'r') or
269 die "Unable to open $file for reading: $!";
274 next unless length $_;
275 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
276 push @versions, [$1,$2];
281 for my $i (reverse 0..($#versions)) {
283 if (not defined $src_pkgs{$versions[$i][0]}) {
284 $src_pkgs{$versions[$i][0]} =
285 $s->resultset('SrcPkg')->find_or_create({pkg => $versions[$i][0]});
287 $sp = $src_pkgs{$versions[$i][0]};
288 # There's probably something wrong if the source package
289 # doesn't exist, but we'll skip it for now
290 next unless defined $sp;
291 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp->id(),
292 ver => $versions[$i][1],
294 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
295 $sv->update({based_on => $ancestor_sv->id()})
305 my ($options,$opts,$p,$config,$argv) = @_;
307 my @files = @{$argv};
308 return unless @files;
309 my $s = db_connect($options);
311 $p->target(scalar @files) if $p;
312 for my $file (@files) {
313 my $fh = IO::File->new($file,'r') or
314 die "Unable to open $file for reading: $!";
315 my $f_stat = stat($file);
318 next unless length $_;
319 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
320 # if $srcver is not defined, this is probably a broken
321 # .debinfo file [they were causing #686106, see commit
322 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
323 # the file, so we'll fudge it from the filename.
324 if (not defined $srcver) {
325 ($srcname,$srcver) = ($binarch,$srcname);
326 ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
328 my $sp = $s->resultset('SrcPkg')->find_or_create({pkg => $srcname});
329 my $sv = $s->resultset('SrcVer')->find_or_create({src_pkg =>$sp->id(),
332 if (defined $arch{$binarch}) {
333 $arch = $arch{$binarch};
335 $arch = $s->resultset('Arch')->find_or_create({arch => $binarch});
336 $arch{$binarch} = $arch;
338 my $bp = $s->resultset('BinPkg')->find_or_create({pkg => $binname});
339 $s->resultset('BinVer')->find_or_create({bin_pkg => $bp->id(),
340 src_ver => $sv->id(),
350 sub add_maintainers {
351 my ($options,$opts,$p,$config,$argv) = @_;
353 my $s = db_connect($options);
354 my $maintainers = getsourcemaintainers();
355 $p->target(scalar keys %{$maintainers}) if $p;
356 for my $pkg (keys %{$maintainers}) {
357 my $maint = $maintainers->{$pkg};
358 # see if a maintainer already exists; if so, we don't do
360 my $maint_r = $s->resultset('Maintainer')->
361 find({name => $maint});
362 if (not defined $maint_r) {
363 # get e-mail address of maintainer
364 my $addr = getparsedaddrs($maint);
365 my $e_mail = $addr->address();
366 my $full_name = $addr->phrase();
367 $full_name =~ s/^\"|\"$//g;
368 $full_name =~ s/^\s+|\s+$//g;
370 my $correspondent = $s->resultset('Correspondent')->
371 find_or_create({addr => $e_mail});
372 if (length $full_name) {
373 my $c_full_name = $correspondent->find_or_create_related('correspondent_full_names',
374 {full_name => $full_name}) if length $full_name;
375 $c_full_name->update({last_seen => 'NOW()'});
378 $s->resultset('Maintainer')->
379 find_or_create({name => $maint,
380 correspondent => $correspondent,
383 # add the maintainer to the source package for packages with
386 $s->resultset('SrcPkg')->search({pkg => $pkg})->
387 search_related_rs('src_vers',{ maintainer => undef})->
388 update_all({maintainer => $maint_r->id()});
395 sub add_configuration {
396 my ($options,$opts,$p,$config,$argv) = @_;
400 my ($options,$opts,$p,$config,$argv) = @_;
403 sub handle_subcommand_arguments {
404 my ($argv,$args) = @_;
406 Getopt::Long::GetOptionsFromArray($argv,
411 for my $arg (keys %{$args}) {
412 next unless $args->{$arg};
413 my $r_arg = $arg; # real argument name
414 $r_arg =~ s/[=\|].+//g;
415 if (not defined $subopt->{$r_arg}) {
416 push @usage_errors, "You must give a $r_arg option";
419 pod2usage(join("\n",@usage_errors)) if @usage_errors;
424 my ($subcommand,$config,$options) = @_;
425 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
426 if ($options->{quick}) {
427 # If this is a quick run, just exit
428 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
431 print STDERR "Another debbugs-loadsql is running; stopping\n";
438 # connect to the database; figure out how to handle errors
440 my $s = Debbugs::DB->connect('dbi:Pg:service='.$options->{service}) or
441 die "Unable to connect to database: ";