Options:
--quick, -q only load changed bugs
+ --progress Show progress bar
--service, -s service name
--sysconfdir, -c postgresql service config dir
--spool-dir debbugs spool directory
--help, -h display this help
--man, -m display manual
+=head1 SUBCOMMANDS
+
+=head2 help
+
+Display this manual
+
+=head2 bugs
+
+Add bugs
+
+=head2 versions
+
+Add versions
+
+=head2 maintainers
+
+Add source maintainers
+
=head1 OPTIONS
=over
Only load changed bugs
+=item B<--progress>
+
+Show progress bar (requires Term::ProgressBar)
+
=item B<--service,-s>
Postgreql service to use; defaults to debbugs
Debbugs spool directory; defaults to the value configured in the
debbugs configuration file.
-=item B<--debug, -d
+=item B<--verbose>
+
+Output more information about what is happening. Probably not useful
+if you also set --progress.
+
+=item B<--debug, -d>
Debug verbosity.
use vars qw($DEBUG);
-use Debbugs::Common qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list);
+use Debbugs::Common qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list getsourcemaintainers);
use Debbugs::Config qw(:config);
use Debbugs::Status qw(read_bug split_status_fields);
use Debbugs::Log;
use Debbugs::DB;
+use Debbugs::DB::Load qw(load_bug handle_load_bug_queue);
+use Debbugs::BugWalker;
use DateTime;
use File::stat;
-my %options = (debug => 0,
- help => 0,
- man => 0,
- verbose => 0,
- quiet => 0,
- quick => 0,
- service => 'debbugs',
- );
-
+my %options =
+ (debug => 0,
+ help => 0,
+ man => 0,
+ verbose => 0,
+ quiet => 0,
+ quick => 0,
+ service => $config{debbugs_db},
+ progress => 0,
+ );
+Getopt::Long::Configure('pass_through');
GetOptions(\%options,
- 'quick|q',
- 'service|s',
- 'sysconfdir|c',
- 'spool_dir|spool-dir=s',
- 'debug|d+','help|h|?','man|m');
+ 'quick|q',
+ 'service|s=s',
+ 'sysconfdir|c=s',
+ 'progress!',
+ 'spool_dir|spool-dir=s',
+ 'verbose|v+',
+ 'quiet+',
+ 'debug|d+','help|h|?','man|m');
+Getopt::Long::Configure('default');
pod2usage() if $options{help};
pod2usage({verbose=>2}) if $options{man};
$DEBUG = $options{debug};
+my %subcommands =
+ ('bugs' => {function => \&add_bugs,
+ },
+ 'versions' => {function => \&add_versions,
+ },
+ 'debinfo' => {function => \&add_debinfo,
+ },
+ 'maintainers' => {function => \&add_maintainers,
+ },
+ 'configuration' => {function => \&add_configuration,
+ },
+ 'logs' => {function => \&add_logs,
+ },
+ 'help' => {function => sub {pod2usage({verbose => 2});}}
+ );
+
my @USAGE_ERRORS;
$options{verbose} = $options{verbose} - $options{quiet};
+if ($options{progress}) {
+ eval "use Term::ProgressBar";
+ push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
+}
+
+
pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
if (exists $options{sysconfdir}) {
if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
- delete $ENV{PGSYSCONFDIR};
+ delete $ENV{PGSYSCONFDIR};
} else {
- $ENV{PGSYSCONFDIR} = $options{sysconfdir};
+ $ENV{PGSYSCONFDIR} = $options{sysconfdir};
}
}
if (exists $options{spool_dir} and defined $options{spool_dir}) {
$config{spool_dir} = $options{spool_dir};
}
-chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
-my $verbose = $options{debug};
+my $prog_bar;
+if ($options{progress}) {
+ $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
+ warn "Unable to initialize progress bar: $@" if not $prog_bar;
+}
-my $initialdir = "db-h";
-if (defined $ARGV[0] and $ARGV[0] eq "archive") {
- $initialdir = "archive";
+my ($subcommand) = shift @ARGV;
+if (not defined $subcommand) {
+ $subcommand = 'help';
+ print STDERR "You must provide a subcommand; displaying usage.\n";
+ pod2usage();
+} elsif (not exists $subcommands{$subcommand}) {
+ print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
+ pod2usage();
}
-if (not lockpid($config{spool_dir}.'/lock/debbugs-loadsql')) {
- if ($options{quick}) {
- # If this is a quick run, just exit
- print STDERR "Another debbugs-loadsql is running; stopping\n" if $verbose;
- exit 0;
- }
- print STDERR "Another debbugs-loadsql is running; stopping\n";
- exit 1;
+my $opts =
+ handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
+$subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
+
+sub add_bugs {
+ my ($options,$opts,$p,$config,$argv) = @_;
+ chdir($config->{spool_dir}) or
+ die "chdir $config->{spool_dir} failed: $!";
+
+ my $verbose = $options->{debug};
+
+ my $initialdir = "db-h";
+
+ if (defined $argv->[0] and $argv->[0] eq "archive") {
+ $initialdir = "archive";
+ }
+ my $s = db_connect($options);
+
+
+ my $time = 0;
+ my $start_time = time;
+
+
+ my @dirs = (@{$argv}?@{$argv} : $initialdir);
+ my $cnt = 0;
+ my %tags;
+ my %severities;
+ my %queue;
+ my $w = Debbugs::BugWalker->new(dir => [@dirs],
+ defined $p ? (progress => $p):(),
+ what => 'bug',
+ );
+ my $bug;
+ while (defined($bug = $w->get_next())) {
+ print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
+ my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
+ if (not defined $stat) {
+ print STDERR "Unable to stat $bug $!\n";
+ next;
+ }
+ if ($options{quick}) {
+ my $rs = $s->resultset('Bug')->search({bug=>$bug})->single();
+ next if defined $rs and $stat->mtime < $rs->last_modified()->epoch();
+ }
+ my $data = read_bug(bug => $bug,
+ location => $initialdir);
+ eval {
+ load_bug(db => $s,
+ data => split_status_fields($data),
+ tags => \%tags,
+ severities => \%severities,
+ queue => \%queue);
+ };
+ if ($@) {
+ use Data::Dumper;
+ print STDERR Dumper($data) if $DEBUG;
+ die "failure while trying to load bug $bug\n$@";
+ }
+ }
+ $p->remove() if $p;
+ handle_load_bug_queue(db => $s,
+ queue => \%queue);
}
-# connect to the database; figure out how to handle errors properly
-# here.
-my $schema = Debbugs::DB->connect('dbi:Pg:service='.$options{service}) or
- die "Unable to connect to database: ";
-
-my $time = 0;
-my $start_time = time;
-
-
-my @dirs = ($initialdir);
-my $cnt = 0;
-my %tags;
-my %queue;
-while (my $dir = shift @dirs) {
- printf "Doing dir %s ...\n", $dir if $verbose;
-
- opendir(DIR, "$dir/.") or die "opendir $dir: $!";
- my @subdirs = readdir(DIR);
- closedir(DIR);
-
- my @list = map { m/^(\d+)\.summary$/?($1):() } @subdirs;
- push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
-
- for my $bug (@list) {
- print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
- my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
- if (not defined $stat) {
- print STDERR "Unable to stat $bug $!\n";
- next;
- }
- next if $stat->mtime < $time;
- my $data = read_bug(bug => $bug,
- location => $initialdir);
- load_bug($schema,split_status_fields($data),\%tags,\%queue);
+sub add_versions {
+ my ($options,$opts,$p,$config,$argv) = @_;
+
+ my $s = db_connect($options);
+
+ my @files = @{$argv};
+ $p->target(scalar @files) if $p;
+ for my $file (@files) {
+ my $fh = IO::File->new($file,'r') or
+ die "Unable to open $file for reading: $!";
+ my @versions;
+ my %src_pkgs;
+ while (<$fh>) {
+ chomp;
+ next unless length $_;
+ if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
+ push @versions, [$1,$2];
+ }
+ }
+ close($fh);
+ my $ancestor_sv;
+ for my $i (reverse 0..($#versions)) {
+ my $sp;
+ if (not defined $src_pkgs{$versions[$i][0]}) {
+ $src_pkgs{$versions[$i][0]} =
+ $s->resultset('SrcPkg')->find_or_create({pkg => $versions[$i][0]});
+ }
+ $sp = $src_pkgs{$versions[$i][0]};
+ # There's probably something wrong if the source package
+ # doesn't exist, but we'll skip it for now
+ next unless defined $sp;
+ my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp->id(),
+ ver => $versions[$i][1],
+ });
+ if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
+ $sv->update({based_on => $ancestor_sv->id()})
+ }
+ $ancestor_sv = $sv;
+ }
+ $p->update() if $p;
}
+ $p->remove() if $p;
}
-handle_queue($schema,\%queue);
-
-sub load_bug {
- my ($s,$data,$tags,$queue) = @_;
- my $s_data = split_status_fields($data);
- my @tags;
- for my $tag (make_list($s_data->{keywords})) {
- next unless defined $tag and length $tag;
- # this allows for invalid tags. But we'll use this to try to
- # find those bugs and clean them up
- if (not exists $tags->{$tag}) {
- $tags->{$tag} = $s->resultset('Tag')->find_or_create({tag => $tag});
- }
- push @tags, $tags->{$tag};
+
+sub add_debinfo {
+ my ($options,$opts,$p,$config,$argv) = @_;
+
+ my @files = @{$argv};
+ return unless @files;
+ my $s = db_connect($options);
+ my %arch;
+ $p->target(scalar @files) if $p;
+ for my $file (@files) {
+ my $fh = IO::File->new($file,'r') or
+ die "Unable to open $file for reading: $!";
+ my $f_stat = stat($file);
+ while (<$fh>) {
+ chomp;
+ next unless length $_;
+ my ($binname, $binver, $binarch, $srcname, $srcver) = split;
+ # if $srcver is not defined, this is probably a broken
+ # .debinfo file [they were causing #686106, see commit
+ # 49c85ab8 in dak.] Basically, $binarch didn't get put into
+ # the file, so we'll fudge it from the filename.
+ if (not defined $srcver) {
+ ($srcname,$srcver) = ($binarch,$srcname);
+ ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
+ }
+ my $sp = $s->resultset('SrcPkg')->find_or_create({pkg => $srcname});
+ my $sv = $s->resultset('SrcVer')->find_or_create({src_pkg =>$sp->id(),
+ ver => $srcver});
+ my $arch;
+ if (defined $arch{$binarch}) {
+ $arch = $arch{$binarch};
+ } else {
+ $arch = $s->resultset('Arch')->find_or_create({arch => $binarch});
+ $arch{$binarch} = $arch;
+ }
+ my $bp = $s->resultset('BinPkg')->find_or_create({pkg => $binname});
+ $s->resultset('BinVer')->find_or_create({bin_pkg => $bp->id(),
+ src_ver => $sv->id(),
+ arch => $arch->id(),
+ ver => $binver,
+ });
+ }
+ $p->update() if $p;
}
- my $bug = {id => $data->{bug_num},
- creation => DateTime->from_epoch(epoch => $data->{date}),
- log_modified => DateTime->from_epoch(epoch => $data->{log_modified}),
- last_modified => DateTime->from_epoch(epoch => $data->{last_modified}),
- archived => $data->{archived},
- (defined $data->{unarchived} and length($data->{unarchived}))?(unarchived => DateTime->from_epoch(epoch => $data->{unarchived})):(),
- forwarded => $data->{forwarded} // '',
- summary => $data->{summary} // '',
- outlook => $data->{outlook} // '',
- subject => $data->{subject} // '',
- done => $data->{done} // '',
- owner => $data->{owner} // '',
- severity => length($data->{severity}) ? $data->{severity} : $config{default_severity},
- };
- $s->resultset('Bug')->update_or_create($bug);
- $s->txn_do(sub {
- for my $ff (qw(found fixed)) {
- my @elements = $s->resultset('BugVer')->search({bug_id => $data->{bug_num},
- found => $ff eq 'found'?1:0,
- });
- my %elements_to_delete = map {($elements[$_]->ver_string(),$_)} 0..$#elements;
- my @elements_to_add;
- for my $version (@{$data->{"${ff}_versions"}}) {
- if (exists $elements_to_delete{$version}) {
- delete $elements_to_delete{$version};
- } else {
- push @elements_to_add,$version;
- }
- }
- for my $element (keys %elements_to_delete) {
- $elements_to_delete{$element}->delete();
- }
- for my $element (@elements_to_add) {
- # find source package and source version id
- my $ne = $s->resultset('BugVer')->new_result({bug_id => $data->{bug_num},
- ver_string => $element,
- found => $ff eq 'found'?1:0,
- }
- );
- if (my ($src_pkg,$src_ver) = $element =~ m{^([^\/]+)/(.+)$}) {
- my $src_pkg_e = $s->resultset('SrcPkg')->single({pkg => $src_pkg});
- if (defined $src_pkg_e) {
- $ne->src_pkg_id($src_pkg_e->id());
- my $src_ver_e = $s->resultset('SrcVer')->single({src_pkg_id => $src_pkg_e->id(),
- ver => $src_ver
- });
- $ne->src_ver_id($src_ver_e->id()) if defined $src_ver_e;
- }
- }
- $ne->insert();
- }
- }
- });
- $s->txn_do(sub {
- $s->resultset('BugTag')->search({bug_id => $data->{bug_num}})->delete();
- $s->populate(BugTag => [[qw(bug_id tag_id)], map {[$data->{bug_num}, $_->id()]} @tags]);
- });
- # because these bugs reference other bugs which might not exist
- # yet, we can't handle them until we've loaded all bugs. queue
- # them up.
- $queue->{merged}{$data->{bug_num}} = [@{$data->{mergedwith}}];
- $queue->{blocks}{$data->{bug_num}} = [@{$data->{blocks}}];
-
- print STDERR "Handled $data->{bug_num}\n";
- # still need to handle merges, versions, etc.
+ $p->remove() if $p;
}
-sub handle_queue{
- my ($s,$queue) = @_;
- my %queue_types =
- (merged => {set => 'BugMerged',
- columns => [qw(bug_id merged)],
- bug_id => 'bug_id',
- },
- blocks => {set => 'BugBlock',
- columns => [qw(bug_id blocks)],
- bug_id => 'bug_id',
- },
- );
- for my $queue_type (keys %queue_types) {
- for my $bug (%{$queue->{$queue_type}}) {
- my $qt = $queue_types{$queue_type};
- $s->txn_do(sub {
- $s->resultset($qt->{set})->search({$qt->{bug_id},$bug})->delete();
- $s->populate($qt->{set},[[@{$qt->{columns}}],map {[$bug,$_]} @{$queue->{$queue_type}{$bug}}]) if
- @{$queue->{$queue_type}{$bug}};
- }
- );
- }
+sub add_maintainers {
+ my ($options,$opts,$p,$config,$argv) = @_;
+
+ my $s = db_connect($options);
+ my $maintainers = getsourcemaintainers();
+ $p->target(scalar keys %{$maintainers}) if $p;
+ for my $pkg (keys %{$maintainers}) {
+ my $maint = $maintainers->{$pkg};
+ # see if a maintainer already exists; if so, we don't do
+ # anything here
+ my $maint_r = $s->resultset('Maintainer')->
+ find({name => $maint});
+ if (not defined $maint_r) {
+ # get e-mail address of maintainer
+ my $addr = getparsedaddrs($maint);
+ my $e_mail = $addr->address();
+ my $full_name = $addr->phrase();
+ $full_name =~ s/^\"|\"$//g;
+ $full_name =~ s/^\s+|\s+$//g;
+ # find correspondent
+ my $correspondent = $s->resultset('Correspondent')->
+ find_or_create({addr => $e_mail});
+ if (length $full_name) {
+ my $c_full_name = $correspondent->find_or_create_related('correspondent_full_names',
+ {full_name => $full_name}) if length $full_name;
+ $c_full_name->update({last_seen => 'NOW()'});
+ }
+ $maint_r =
+ $s->resultset('Maintainer')->
+ find_or_create({name => $maint,
+ correspondent => $correspondent,
+ });
+ }
+ # add the maintainer to the source package for packages with
+ # no maintainer
+ $s->txn_do(sub {
+ $s->resultset('SrcPkg')->search({pkg => $pkg})->
+ search_related_rs('src_vers',{ maintainer => undef})->
+ update_all({maintainer => $maint_r->id()});
+ });
+ $p->update() if $p;
}
+ $p->remove() if $p;
+}
+
+sub add_configuration {
+ my ($options,$opts,$p,$config,$argv) = @_;
+}
+
+sub add_logs {
+ my ($options,$opts,$p,$config,$argv) = @_;
}
+sub handle_subcommand_arguments {
+ my ($argv,$args) = @_;
+ my $subopt = {};
+ Getopt::Long::GetOptionsFromArray($argv,
+ $subopt,
+ keys %{$args},
+ );
+ my @usage_errors;
+ for my $arg (keys %{$args}) {
+ next unless $args->{$arg};
+ my $r_arg = $arg; # real argument name
+ $r_arg =~ s/[=\|].+//g;
+ if (not defined $subopt->{$r_arg}) {
+ push @usage_errors, "You must give a $r_arg option";
+ }
+ }
+ pod2usage(join("\n",@usage_errors)) if @usage_errors;
+ return $subopt;
+}
+
+sub get_lock{
+ my ($subcommand,$config,$options) = @_;
+ if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
+ if ($options->{quick}) {
+ # If this is a quick run, just exit
+ print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
+ exit 0;
+ }
+ print STDERR "Another debbugs-loadsql is running; stopping\n";
+ exit 1;
+ }
+}
+
+sub db_connect {
+ my ($options) = @_;
+ # connect to the database; figure out how to handle errors
+ # properly here.
+ my $s = Debbugs::DB->connect('dbi:Pg:service='.$options->{service}) or
+ die "Unable to connect to database: ";
+}
+
+
__END__
projects / debbugs.git / blobdiff