File Coverage

blib/lib/RT/ClientX/GrabBugs.pm

Criterion	Covered	Total	%
statement	52	110	47.2
branch	0	8	0.0
condition	0	3	0.0
subroutine	18	27	66.6
pod	2	2	100.0
total	72	150	48.0

use 5.010;
use strict;
use warnings;
use utf8;

package RT::ClientX::GrabBugs;

BEGIN {
	$RT::ClientX::GrabBugs::AUTHORITY = 'cpan:TOBYINK';
	$RT::ClientX::GrabBugs::VERSION   = '0.005';
}

use Moose;
use namespace::autoclean;

use Try::Tiny                qw(try catch finally);
use Types::Standard          qw(-types);
use Getopt::ArgvFile         qw(argvFile);
use Getopt::Long             qw(GetOptionsFromArray);
use RDF::Trine               qw(literal blank iri);
use RT::Client::REST         qw();
use RT::Client::REST::Queue  qw();
use Cwd                      qw(cwd);
use Path::FindDev            qw(find_dev);
use Digest::SHA1             qw(sha1_hex);

use RDF::Trine::Namespace qw/rdf rdfs owl xsd/;
my $dbug   = RDF::Trine::Namespace->new('http://ontologi.es/doap-bugs#');
my $dc     = RDF::Trine::Namespace->new('http://purl.org/dc/terms/');
my $doap   = RDF::Trine::Namespace->new('http://usefulinc.com/ns/doap#');
my $foaf   = RDF::Trine::Namespace->new('http://xmlns.com/foaf/0.1/');
my $status = RDF::Trine::Namespace->new('http://purl.org/NET/cpan-uri/rt/status/');
my $prio   = RDF::Trine::Namespace->new('http://purl.org/NET/cpan-uri/rt/priority/');

has [qw/user pass/] => (
	is       => 'ro',
	isa      => Str,
	required => 1,
);

has server => (
	is       => 'ro',
	isa      => Str,
	default  => 'https://rt.cpan.org',
);

has project_uri => (
	is       => 'ro',
	isa      => Str,
	lazy     => 1,
	builder  => '_build_project_uri',
);

has queue => (
	is       => 'ro',
	isa      => Str,
	lazy     => 1,
	builder  => '_build_queue',
);

has queue_model => (
	is       => 'ro',
	isa      => InstanceOf['RDF::Trine::Model'],
	lazy     => 1,
	builder  => '_build_queue_model',
);

has dest => (
	is       => 'ro',
	isa      => Str | InstanceOf['Path::Tiny'],
	default  => sub { find_dev(cwd)->child('meta/rt-bugs.ttl') },
);

sub main
{
	my ($class, @argv) = @_;

	argvFile(
		array           => \@argv,
		startupFilename => '.rt-grabbugs',
		current         => 1,
		home            => 1,
	);

	my %opts;
	GetOptionsFromArray(
		\@argv,
		\%opts,
		qw/
			queue=s
			dest=s
			user=s
			pass=s
			server=s
			project_uri=s
		/,
	);

	$class->new(%opts)->process;
}

sub _build_queue
{
	my $self = shift;
	my $root = find_dev(cwd);

	my $ini = $root->child('dist.ini');
	if ($ini)
	{
		my @ini = grep /^;;/, do { my $fh = $ini->openr; <$fh> };
		chomp @ini;
		my %config = map {
			s/(?:^;;\s*)|(?:\s*$)//g;
			my ($key, $value) = split /\s*=\s*/, $_, 2;
			$key => scalar(eval($value));
		} @ini;
		return $config{name} if $config{name};
	}

	confess "Unable to determine RT queue. Please specify manually.";
}

sub _build_project_uri
{
	my $self  = shift;
	sprintf('http://purl.org/NET/cpan-uri/dist/%s/project', $self->queue);
}

sub _build_queue_model
{
	my $self  = shift;
	my $model = RDF::Trine::Model->new;

	warn sprintf "Logging in to %s\n", $self->server;

	my $rt;
	try
	{
		$rt = RT::Client::REST->new(
			server   => $self->server,
			timeout  => 60,
		);
		push @{ $rt->_ua->{requests_redirectable} }, 'POST';
		$rt->login(
			username => $self->user,
			password => $self->pass,
		);
	}
	catch
	{
		require Data::Dumper;
		die Data::Dumper::Dumper($_);
	};

	warn sprintf "Retrieving queue for %s\n", $self->queue;

	my $queue = RT::Client::REST::Queue->new(
		rt       => $rt,
		id       => $self->queue,
	)->retrieve;
	my $tickets = $queue->tickets->get_iterator;

	while (my $ticket = $tickets->())
	{
		$self->_process_ticket($model, $queue, $ticket);
	}

	return $model;
}

my %EMAIL;
sub _process_ticket
{
	my $self = shift;
	my ($model, $queue, $ticket) = @_;

	warn sprintf("Processing RT#%d\n", $ticket->id);

	my $P = iri $self->project_uri;
	my $T = iri sprintf('http://purl.org/NET/cpan-uri/rt/ticket/%d', $ticket->id);

	$model->add_statement($_) for (
		RDF::Trine::Statement->new($P, $dbug->issue, $T),
		RDF::Trine::Statement->new($T, $rdf->type, $dbug->Issue),
		RDF::Trine::Statement->new($T, $dbug->id, literal($ticket->id)),
		RDF::Trine::Statement->new($T, $dbug->page, iri sprintf('https://rt.cpan.org/Public/Bug/Display.html?id=%d', $ticket->id)),
		RDF::Trine::Statement->new($T, $dbug->status, $status->${\ $ticket->status }),
		RDF::Trine::Statement->new($T, $dc->created, literal($ticket->created, undef, $xsd->dateTime)),
		RDF::Trine::Statement->new($T, $rdfs->label, literal($ticket->subject)),
	);

	for my $email ($ticket->requestors) {
		my $R = ($email =~ /\A(\w+)\@cpan.org\z/i)
			? iri(sprintf 'http://purl.org/NET/cpan-uri/person/%s', uc $1)
			: ( $EMAIL{$email} ||= blank() );
		$model->add_statement($_) for (
			RDF::Trine::Statement->new($T, $dc->reporter, $R),
			RDF::Trine::Statement->new($R, $rdf->type, $foaf->Agent),
			RDF::Trine::Statement->new($R, $foaf->mbox_sha1sum, literal(sha1_hex(sprintf('mailto:%s', $email)))),
		);
		try {
			RDF::Trine::Statement->new($R, $foaf->mbox, iri sprintf('mailto:%s', $email)),
		};
	}
}

sub process
{
	my $self = shift;

	my $model = $self->queue_model;

	my $ser = eval { require RDF::TrineX::Serializer::MockTurtleSoup }
		? 'RDF::TrineX::Serializer::MockTurtleSoup'
		: 'RDF::Trine::Serializer::Turtle';

	warn sprintf("Writing to %s using %s\n", $self->dest, $ser);

	open my $fh, '>:encoding(UTF-8)', $self->dest;

	$ser->new(namespaces => {
		dbug   => 'http://ontologi.es/doap-bugs#',
		dc     => 'http://purl.org/dc/terms/',
		doap   => 'http://usefulinc.com/ns/doap#',
		foaf   => 'http://xmlns.com/foaf/0.1/',
		rdfs   => 'http://www.w3.org/2000/01/rdf-schema#',
		rt     => 'http://purl.org/NET/cpan-uri/rt/ticket/',
		status => 'http://purl.org/NET/cpan-uri/rt/status/',
		prio   => 'http://purl.org/NET/cpan-uri/rt/priority/',
		xsd    => 'http://www.w3.org/2001/XMLSchema#',
	})->serialize_model_to_file($fh, $model);

	$self;
}

__PACKAGE__
__END__

=head1 NAME

RT::ClientX::GrabBugs - download bugs from an RT queue and dump them as RDF

=head1 SYNOPSIS

 RT::ClientX::GrabBugs
   ->new({
     user      => $rt_username,
     pass      => $rt_password,
     queue     => $rt_queue,
     dest      => './output_file.ttl',
     })
   ->process;

=head1 DESCRIPTION

This module downloads bugs from an RT queue and dumps them as RDF.

=head2 Constructor

=over

=item C<< new(%attrs) >>

Fairly standard Moosey C<new> constructor, accepting a hash of named
parameters.

=item C<< main(@argv) >>

Alternative constructor. Processes C<< @argv >> like command-line arguments.
e.g.

 RT::ClientX::GrabBugs->main('--user=foo', '--pass=bar',
                             '--queue=My-Module');

This constructor uses L<Getopt::ArgvFile> to read additional options from
C<< ~/.rt-grabbugs >> and C<< ./.rt-grabbugs >>.

The constructor supports the options "--user", "--pass", "--queue" and
"--dest".

=back

=head2 Attributes

=over

=item * C<server>, C<user>, C<pass>

Details for logging into RT.

=item * C<dest>

The file name where you want to save the data. This defaults to
"./meta/rt-bugs.ttl".

=item * C<queue>

Queue to grab bugs for. Assuming that you're grabbing from rt.cpan.org, this
corresponds to a CPAN distribution (e.g. "RT-ClientX-GrabBugs").

If not provided, this module will try to guess which queue you want. It does
this by looking for a file called "dist.ini" in the project directory. Within
this file, it looks for a line with the following format:

	;; name="Foo-Bar"

This type of line is commonly found in dist.ini files designed for
L<Dist::Inkt>. If you're using L<Dist::Zilla> it should be possible to add
such a line without breaking anything. (Dist::Zilla sees lines beginning with
a semicolon as comments.)

=item * C<project_uri>

URI to use for doap:Project in output.

=item * C<queue_model>

An RDF::Trine::Model generated by calling the C<add_to_model> method on each
bug in the C<queue_table> list. Here you probably want to rely on the default
model that the class builds.

=back

=head2 Methods

=over

=item * C<< process >>

Saves the model from C<queue_model> to the destination C<dest> as Turtle.

Returns C<$self>.

=back

=head1 BUGS

Please report any bugs to
L<http://rt.cpan.org/Dist/Display.html?Queue=RT-ClientX-GrabBugs>.

=head1 SEE ALSO

L<RDF::DOAP>.

=head1 AUTHOR

Toby Inkster E<lt>[e-mail]<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2012, 2014 by Toby Inkster.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.