rt_cpan_org_export - a program to export an rt.cpan.org queue to JSON

rt_cpan_org_export

use v5.26;
use warnings;

=encoding utf8

=head1 NAME

rt_cpan_org_export - grab the tickets for an rt.cpan.org queue

=head1 SYNOPSIS

	% export PAUSE_USER=...
	% export PAUSE_PASSWORD=...
	% rt_cpan_org_export QUEUE-NAME > queue.json

For example, with the Net::SSH::Perl module:

	% rt_cpan_org_export Net-SSH-Perl > net-ssh-perl.json

Beware letting the output go to the terminal. This output contains the
attachments for the tickets, which might be large blobs.

=head1 DESCRIPTION

This program grabs the tickets and related info from rt.cpan.org and turns
it into JSON.

Many CPAN distributions have moved from RT.cpan.org, the free bug tracker
that was the default place to report issues, to GitHub. When I take
over a CPAN module, I want to capture all of that and import it into
GitHub. Once I have the JSON, I can goof around with that. I can, for
example, use that JSON as the input to a GitHub issue importer.

=head2 JSON format

There are two top level keys:

	{
	meta: { ... }
	tickets: { ... }
	}

The C<tickets> object has the ticket id as the key and an object as its
value:

	{
	"1234": {
		date
		subject:
		transactions: [
			{ ... }
			{ ... }
			];
		}
	}

Try it on something small and look at what you get.

=head2 PAUSE credentials

You need a PAUSE login to use the RT REST API. See L<http://pause.perl.org>.
I<rt.cpan.org> uses the same credentials. Set the PAUSE_USER and PAUSE_PASSWORD
environment variables before you run the program.

=head1 AUTHOR

Copyright © 2023, brian d foy, bdfoy@cpan.org

=head1 LICENSE

You can use this code under the terms of the Artistic License 2.

=cut

use RT::Client::REST;
use RT::Client::REST::Ticket;

use Mojo::Util qw(dumper);
use Mojo::JSON qw(encode_json);

BEGIN {
require RT::Client::REST::Forms;
package RT::Client::REST::Forms;

no warnings;

# this warns for a reason I don't know, and $^W can't turn it off.
sub form_compose {
    my ($forms) = @_;
    my @text;

    for my $form (@$forms) {
        my ($c, $o, $k, $e) = @$form;
        my $text = '';

        if ($c) {
            $c =~ s/\n*$/\n/;
            $text = "$c\n";
        }
        if ($e) {
            $text .= $e;
        }
        elsif ($o) {
            my @lines;

            for my $key (@$o) {
                my ($line, $sp);
                my @values = (ref $k->{$key} eq 'ARRAY') ?
                               @{ $k->{$key} } :
                                  $k->{$key};

                $sp = " "x(length("$key: "));
                $sp = " "x4 if length($sp) > 16;

                for my $v (@values) {
                    if ($v =~ /\n/) {
                        $v =~ s/^/$sp/gm;
                        $v =~ s/^$sp//;

                        if ($line) {
                            push @lines, "$line\n\n";
                            $line = '';
                        }
                        elsif (@lines && $lines[-1] !~ m/\n\n$/) {
                            $lines[-1] .= "\n";
                        }
                        push @lines, "$key: $v\n\n";
                    }
                    elsif ($line &&
                           length($line)+length($v)-rindex($line, "\n") >= 70)
                    {
                        $line .= ",\n$sp$v";
                    }
                    else {
                        $line = $line ? "$line, $v" : "$key: $v";
                    }
                }

                $line = "$key:" unless @values;
                if ($line) {
                    if ($line =~ m/\n/) {
                        if (@lines && $lines[-1] !~ m/\n\n$/) {
                            $lines[-1] .= "\n";
                        }
                        $line .= "\n";
                    }
                    push @lines, "$line\n";
                }
            }

            $text .= join '', @lines;
        }
        else {
            chomp $text;
        }
        push @text, $text;
    }

    return join "\n--\n\n", @text;
}

}

my $rt_dist = $ARGV[0];
$rt_dist =~ s/::/-/g; # just in case they used a namespace

my $rt_user     = $ENV{PAUSE_USER};
my $rt_password = $ENV{PAUSE_PASSWORD};

my $rt = RT::Client::REST->new( server => 'https://rt.cpan.org/' );
my $result = eval { $rt->login(
    username => $rt_user,
    password => $rt_password
	) };
unless( $result ) {
	warn <<~"HERE";
	Could not login to RT: $@\n"

	Set the PAUSE_USER and PAUSE_PASSWORD environment variables
	to set the login credentials.
	HERE

	exit 1;
	}

my @rt_ticket_ids = $rt->search(
    type  => 'ticket',
    query => qq{Queue = '$rt_dist'},
	);
say STDERR "There are " . @rt_ticket_ids . " tickets in $rt_dist";

my %tickets = (
	meta => {
		queue => $rt_dist,
		run_date => time,
		},
	tickets => {},
	);

foreach my $ticket_id ( sort { $a <=> $b } @rt_ticket_ids ) {
	local $^W = 0;

	my $ticket = RT::Client::REST::Ticket->new(
		rt => $rt,
		id => $ticket_id,
		);

	my $hash = $tickets{tickets}{$ticket_id} = {};

	$ticket->retrieve;
	printf STDERR "%s: %s\n", $ticket->id, $ticket->subject // '';

	$hash->{subject}  = $ticket->subject;
	$hash->{date}     = $ticket->created;
	$hash->{url}      = "https://rt.cpan.org/Ticket/Display.html?id=$ticket_id";
	$hash->{attachments}  = [];

	{
	my $search = $ticket->attachments()->get_iterator;
	while( defined(my $obj = $search->() ) ) {
		$obj->retrieve;
		# this is insane. Anything on the ticket is an "attachment",
		# so all comments and correspondences are "attachments". Those
		# non-attachment attachments have no file name. This might be
		# something that makes sense to RT, but why would this make
		# sense to users when they see the web UI only lists the uploaded
		# files as attachments. Want to see more insanity? Look at one
		# of the response bodies. They are so bad I'd rather have XML.
		# And why isn't the parent ID the one for the comment that
		# added it?
		next unless $obj->file_name;

		my %t_hash = map { $_, $obj->$_() } qw(
			id
			content_type
			file_name
			transaction_id
			message_id
			parent
			content_encoding
			content
			);

		push $hash->{attachments}->@*, \%t_hash
		}
	}

	# The first transaction should be the original report
	my $iterator = $ticket->transactions()->get_iterator;

	$hash->{transactions} = [];

	while( defined(my $obj = $iterator->() ) ) {
		my %t_hash = map { $_, $obj->$_() } qw(
			id
			parent_id
			type
			creator
			created
			content
			old_value
			new_value
			description
			);

		$t_hash{content} = '' if(
			! defined $t_hash{content}
				or
			$t_hash{content} eq "This transaction appears to have no content\n"
			);
		push $hash->{transactions}->@*, \%t_hash
		}
	}

say encode_json( \%tickets );