| CC: | mst [...] shadowcat.co.uk |
| Subject: | Importing external bug tracker information into rt.cpan.org |
Hi Peeps,
Please see the attached git diff for the addition of external bug
tracking information to the rt.cpan.org database.
Commit message as follows:
This patch adds the queue Attribute 'DistributionBugtracker' which is
populated using data from the MetaCPAN API.
A two parse approach is taken, one to set or update the information from
MetaCPAN into the RT database and a second that removes the information
from queues that no longer require it.
It also includes a fix to correctly parse the skip options at the CLI.
Please let me know if you require any further information or changes.
This work has been sponsored by Shadowcat Systems.
Thanks, Ian.
| Subject: | cpan2rt-external-bugtracker.patch |
diff --git a/bin/cpan2rt b/bin/cpan2rt
index b334258..9cc172b 100755
--- a/bin/cpan2rt
+++ b/bin/cpan2rt
@@ -81,7 +81,7 @@ $commands{ $command }->();
sub cmd_update {
my %opt = ( sync => 1, force => 0, debug => 0, skip => [] );
GetOptions( \%opt, 'sync!', 'force!', 'debug!', 'home=s', 'datadir=s', 'mirror=s', 'skip=s@' );
- $opt{'skip'} = { map $_ => 1, @{$opt{'skip'}} };
+ $opt{'skip'} = { map { $_ => 1 } @{$opt{'skip'}} };
my $importer = CPAN2RT->new( %opt );
$importer->sync_files( $opt{'mirror'} ) if $opt{'sync'};
@@ -89,6 +89,7 @@ sub cmd_update {
$importer->sync_distributions( $opt{'force'} ) unless $opt{'skip'}{'distributions'};
$importer->sync_versions( $opt{'force'} ) unless $opt{'skip'}{'versions'};
$importer->sync_maintainers( $opt{'force'} ) unless $opt{'skip'}{'maintainers'};
+ $importer->sync_bugtracker( $opt{'force'} ) unless $opt{'skip'}{'bugtrackers'};
}
sub usage {
diff --git a/lib/CPAN2RT.pm b/lib/CPAN2RT.pm
index 1f39c69..4262e4d 100644
--- a/lib/CPAN2RT.pm
+++ b/lib/CPAN2RT.pm
@@ -150,6 +150,82 @@ sub fetch_file {
return 1;
}
+=head2 fetch_bugtracker
+
+Retrieve bugtracker information from the meta CPAN API.
+
+=cut
+
+sub fetch_bugtracker {
+ my $self = shift;
+
+ my $url = "http://api.metacpan.org/v0/";
+ require MetaCPAN::API;
+ my $mcpan = MetaCPAN::API->new(
+ base_url => $url,
+ );
+
+ # Pull the details of distribution bugtrackers
+ my $result = $mcpan->post(
+ 'release/_search', {
+ query => { match_all => {} },
+ size => 5000,
+ fields => [ "distribution" , "resources.bugtracker" ],
+ filter => {
+ and => [{
+ or => [
+ { exists => { field => "resources.bugtracker.email" }},
+ { exists => { field => "resources.bugtracker.web" }},
+ ]},
+ { term => { "release.status" => "latest" }},
+ { term => { "release.maturity" => "released" }},
+ ],
+ },
+ },
+ );
+
+ unless ( defined($result) ) {
+ print STDERR "Request to '$url' failed.\n";
+ return undef;
+ }
+
+ debug { "Fetched '$url'\n" };
+
+ my $data = {};
+
+ # Iterate the results from MetaCPAN
+ foreach my $dist (@{$result->{hits}->{hits}}) {
+ my $distribution = $dist->{fields}->{distribution};
+
+ # Email based alternative
+ if(defined($dist->{"fields"}->{"resources.bugtracker"}->{"email"})) {
+ my $email = $dist->{"fields"}->{"resources.bugtracker"}->{"email"};
+
+ # We don't care if this is rt.cpan.org
+ if($email =~ m/rt.cpan.org/) {
+ next;
+ }
+
+ $data->{$distribution}->{"email"} = $email;
+ }
+
+ # Web based alternative
+ if(defined($dist->{"fields"}->{"resources.bugtracker"}->{"web"})) {
+ my $web = $dist->{"fields"}->{"resources.bugtracker"}->{"web"};
+
+ # We don't care if this is rt.cpan.org
+ if($web =~ m/rt.cpan.org/) {
+ next;
+ }
+
+ $data->{$distribution}->{"web"} = $web;
+ }
+ }
+
+ return $data;
+}
+
+
{ my $cache;
sub authors {
my $self = shift;
@@ -293,6 +369,106 @@ sub sync_authors {
return (1);
}
+sub sync_bugtracker {
+ my $self = shift;
+
+ my $data = $self->fetch_bugtracker();
+ $self->_sync_bugtracker_cpan2rt({ data => $data });
+
+ $self->_sync_bugtracker_rt2cpan({ data => $data });
+
+}
+
+=head2 _sync_bugtracker_cpan2rt
+
+Sync DistributionBugtracker info from CPAN to RT.
+This updates and adds to existing queues.
+
+=cut
+
+sub _sync_bugtracker_cpan2rt {
+ my $self = shift;
+ my $args = shift;
+
+ my $data = $args->{"data"};
+
+ # Iterate through the ditributions.
+ foreach my $dist (keys(%{$data})) {
+ my $text = "";
+
+ # Build the text to set in the queue attribute.
+ foreach my $method (keys(%{$data->{$dist}})) {
+ my $uri = $data->{$dist}->{$method};
+
+ if( $method eq "email" ) {
+ $text .= "<div>Please email the <a href=\"mailto:$uri\">alternative bug tracker</a> to report your issue.</div>";
+ }
+
+ elsif( $method eq "web" ) {
+ $text .= "<div>Please visit the <a href=\"$uri\">alternative bug tracker</a> to report your issue.</div>";
+ }
+ }
+
+ # Fetch the queue
+ my $queue = $self->load_queue( $dist );
+ unless( $queue ) {
+ debug { "No queue for dist '$dist'" };
+ next;
+ }
+
+ my $name = "DistributionBugtracker";
+
+ # Get the existing attribute from the queue and log if it's changing
+ my $attr = $queue->FirstAttribute( $name );
+
+ if(defined($attr)) {
+ unless($attr->Content eq $text) {
+ debug { "Changing DistributionBugtracker for $dist from '" . $attr->Content . "' to '$text'\n" };
+ }
+ }
+
+ else {
+ debug { "Changing DistributionBugtracker for $dist from nothing to '$text'\n" };
+ }
+
+ # Set the queue attribute
+ $queue->SetAttribute(
+ Name => $name,
+ Content => $text,
+ );
+ }
+}
+
+=head2 _sync_bugtracker_rt2cpan
+
+Sync DistributionBugtracker info from RT to CPAN.
+This deletes records that are no longer needed or missing in the source.
+
+=cut
+
+sub _sync_bugtracker_rt2cpan {
+ my $self = shift;
+ my $args = shift;
+
+ my $data = $args->{"data"};
+ my $name = "DistributionBugtracker";
+
+ my $queues = RT::Queues->new( $RT::SystemUser );
+ $queues->LimitAttribute( NAME => $name );
+
+ # Iterate over queues from RT
+ while(my $queue = $queues->Next()) {
+
+ my $dist = $queue->Name();
+
+ # Check that the source defines this queue as having an external tracker
+ unless(defined($data->{$dist})) {
+ # Delete the attribute, it's no longer needed.
+ $queue->DeleteAttribute( $name );
+ }
+ }
+}
+
sub sync_distributions {
my $self = shift;
my $force = shift;