From 3125be67ab9780051794aaa042db6900774e65fd Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Thu, 29 Mar 2018 14:16:03 -0700 Subject: [PATCH] add maintainer index file for source and binary packages --- Debbugs/Common.pm | 64 ++++++++++---- scripts/maintainer-indices | 169 +++++++++++++++++++++++++++++++++++++ 2 files changed, 215 insertions(+), 18 deletions(-) create mode 100755 scripts/maintainer-indices diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm index e892d70..39f1de6 100644 --- a/Debbugs/Common.pm +++ b/Debbugs/Common.pm @@ -73,6 +73,8 @@ use Mail::Address; use Cwd qw(cwd); use Storable qw(dclone); use Time::HiRes qw(usleep); +use MLDBM qw(DB_File Storable); +$MLDBM::DumpMeth='portable'; use Params::Validate qw(validate_with :types); @@ -395,32 +397,58 @@ sub package_maintainer { not defined $_source_maintainer_rev) { $_source_maintainer = {}; $_source_maintainer_rev = {}; - for my $fn (@config{('source_maintainer_file', - 'source_maintainer_file_override', - 'pseudo_maint_file')}) { - next unless defined $fn and length $fn; - if (not -e $fn) { - warn "Missing source maintainer file '$fn'"; - next; + if (-e $config{spool_dir}.'/source_maintainers.idx' and + -e $config{spool_dir}.'/source_maintainers_reverse.idx' + ) { + tie %{$_source_maintainer}, + MLDBM => $config{spool_dir}.'/source_maintainers.idx', + O_RDONLY or + die "Unable to tie source maintainers: $!"; + tie %{$_source_maintainer_rev}, + MLDBM => $config{spool_dir}.'/source_maintainers_reverse.idx', + O_RDONLY or + die "Unable to tie source maintainers reverse: $!"; + } else { + for my $fn (@config{('source_maintainer_file', + 'source_maintainer_file_override', + 'pseudo_maint_file')}) { + next unless defined $fn and length $fn; + if (not -e $fn) { + warn "Missing source maintainer file '$fn'"; + next; + } + __add_to_hash($fn,$_source_maintainer, + $_source_maintainer_rev); } - __add_to_hash($fn,$_source_maintainer, - $_source_maintainer_rev); } } if (not defined $_maintainer or not defined $_maintainer_rev) { $_maintainer = {}; $_maintainer_rev = {}; - for my $fn (@config{('maintainer_file', - 'maintainer_file_override', - 'pseudo_maint_file')}) { - next unless defined $fn and length $fn; - if (not -e $fn) { - warn "Missing maintainer file '$fn'"; - next; - } - __add_to_hash($fn,$_maintainer, + if (-e $config{spool_dir}.'/maintainers.idx' and + -e $config{spool_dir}.'/maintainers_reverse.idx' + ) { + tie %{$_maintainer}, + MLDBM => $config{spool_dir}.'/binary_maintainers.idx', + O_RDONLY or + die "Unable to tie binary maintainers: $!"; + tie %{$_maintainer_rev}, + MLDBM => $config{spool_dir}.'/binary_maintainers_reverse.idx', + O_RDONLY or + die "Unable to binary maintainers reverse: $!"; + } else { + for my $fn (@config{('maintainer_file', + 'maintainer_file_override', + 'pseudo_maint_file')}) { + next unless defined $fn and length $fn; + if (not -e $fn) { + warn "Missing maintainer file '$fn'"; + next; + } + __add_to_hash($fn,$_maintainer, $_maintainer_rev); + } } } my @return; diff --git a/scripts/maintainer-indices b/scripts/maintainer-indices new file mode 100755 index 0000000..2255aac --- /dev/null +++ b/scripts/maintainer-indices @@ -0,0 +1,169 @@ +#!/usr/bin/perl +# maintainer-indices generates Maintainer.idx and Source.idx files +# and is released under the terms of the GNU GPL version 3, or any +# later version, at your option. See the file README and COPYING for +# more information. +# Copyright 2018 by Don Armstrong . + + +use warnings; +use strict; + +use Getopt::Long; +use Pod::Usage; + +=head1 NAME + +maintainer-indices - generates Maintainer.idx and Source.idx files + +=head1 SYNOPSIS + +maintainer-indices [options] + +Options: +--debug, -d debugging level (Default 0) +--help, -h display this help +--man, -m display manual + +=head1 OPTIONS + +=over + +=item B<--debug, -d> + +Debug verbosity. (Default 0) + +=item B<--help, -h> + +Display brief usage information. + +=item B<--man, -m> + +Display this manual. + +=back + +=head1 EXAMPLES + +C + +=cut + + +use vars qw($DEBUG); +use File::Copy; +use MLDBM qw(DB_File Storable); +$MLDBM::DumpMeth='portable'; +use Fcntl; + +use Debbugs::Config qw(:config); +use Debbugs::Common qw(lockpid getparsedaddrs); + +my %options = (debug => 0, + help => 0, + man => 0, + ); + +GetOptions(\%options, + 'debug|d+','help|h|?','man|m'); + +pod2usage() if $options{help}; +pod2usage({verbose=>2}) if $options{man}; + +$DEBUG = $options{debug}; + +my @USAGE_ERRORS; + +pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS; + + +my $indexes = + {source => {index => $config{spool_dir}.'/'.'source_maintainers.idx', + index_reverse => $config{spool_dir}.'/'.'source_maintainers_reverse.idx', + files => + [@config{('source_maintainer_file', + 'source_maintainer_file_override', + 'pseudo_maint_file')}], + }, + binary => {index => $config{spool_dir}.'/'.'binary_maintainers.idx', + index_reverse => $config{spool_dir}.'/'.'binary_maintainers_reverse.idx', + files => + [@config{('maintainer_file', + 'maintainer_file_override', + 'pseudo_maint_file')}], + }, + }; + +if (not lockpid($config{spool_dir}.'/lock/maintainer-indices')) { + print STDERR "Another maintainer-indices is running; stopping\n"; + exit 1; +} + +# tie new maint/source maint indexes for forward and reverse +for my $idx (keys %{$indexes}) { + for my $fr ('','_reverse') { + tie %{$indexes->{$idx}{"tie$fr"}}, + MLDBM => $indexes->{$idx}{"index$fr"}.'-new', + O_CREAT|O_TRUNC|O_RDWR, 0644 or + die qq(Unable to tie $indexes->{$idx}{"index$fr"}-new: $!); + } +} +for my $idx (keys %{$indexes}) { + for my $fn (@{$indexes->{$idx}{files}}) { + next unless defined $fn and length $fn; + if (not -e $fn) { + warn "Missing $idx maintainer file '$fn'"; + next; + } + add_to_index($fn,$indexes->{$idx}{tie}, + $indexes->{$idx}{tie_reverse} + ); + } +} + +for my $idx (keys %{$indexes}) { + for my $fr ('','_reverse') { + move($indexes->{$idx}{"index$fr"}.'-new', + $indexes->{$idx}{"index$fr"} + ); + } +} + + +sub add_to_index { + my ($fn,$forward,$reverse,$type) = @_; + $type //= 'address'; + my $fh; + open($fh,'<',$fn) or + die "Unable to open $fn for reading: $!"; + binmode($fh,':encoding(UTF-8)') or + die "Unable to set UTF-8 encoding: $!"; + while (<$fh>) { + chomp; + next unless m/^(\S+)\s+(\S.*\S)\s*$/; + my ($key,$value) = ($1,$2); + $key = lc($key); + $forward->{$key} = $value; + my @values = $value; + if ($type eq 'address') { + @values = map {lc($_->address)} + getparsedaddrs($value); + } + for my $m (@values) { + # this is to work around a bug in tied hashes. + my $r = $reverse->{$m} // []; + push @{$r},$key; + $reverse->{$m} = $r; + } + } + close($fh) or + die "Unable to close $fn filehandle: $!"; +} + + + +__END__ +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: -- 2.39.2