#
#===============================================================================
#
# DESCRIPTION: plugin for LIMS::Local::IssueTracker
# requires two trello boards. 'RFCs' and 'Test' both containing 'Backlog' and
# 'Completed' lists
#
# WWW::Trello::Lite v1.00 requires force-install - tests 3 & 4 fail because:
# Role::REST::Client returns '1' for failure not '' (WWW-Trello-Lite.t test #3),
# and response->content string 'invalid key' does not have a new-line (test #4)
# tests pass OK if amended to:
# is( $response->failed, 1, 'Verified connection to Trello' );
# is( $response->response->content, 'invalid key', 'Reported invalid board' );
#===============================================================================
package LIMS::Local::IssueTracker::Plugin::Trello;
our $VERSION = "0.01";
use Modern::Perl;
use utf8;
use Carp;
use WWW::Trello::Lite;
use Moose::Role;
use namespace::autoclean;
use Data::Printer;
use JSON;
has 'trello' => (
is => 'ro',
isa => 'WWW::Trello::Lite',
lazy => '1',
builder => '_build_trello'
);
with 'LIMS::Local::Role::Trackable';
sub _build_trello {
my $self = shift;
my $key = $self->config->{key};
my $token = $self->config->{token};
return WWW::Trello::Lite->new( key => $key, token => $token );
}
sub check_config {
my $self = shift;
my $config = $self->config;
# mandatory config fields
my @mandatory_issue_lists = qw/new complete rejected/;
if (
( grep { not exists $config->{$_} } qw(key token) )
or ( grep { not exists $config->{board}->{lists}->{$_}->{name} }
@mandatory_issue_lists )
or ( grep { not exists $config->{board}->{lists}->{$_}->{id} }
@mandatory_issue_lists )
)
{
return 0;
}
else {
return 1;
}
}
sub create_issue {
my $self = shift;
my $args = shift;
my $trello = $self->trello;
my $new_cards_list = $self->config->{board}->{lists}->{new}->{id};
my $res = $trello->post(
"cards",
{
idList => $new_cards_list,
name => $args->{name},
desc => $args->{desc}
}
);
croak "Trello error posting new card: $!" if $res->code != 200;
my $json = JSON->new->allow_nonref;
my $json_data = $json->decode( $res->{response}->{_content} );
my $card_id = $json_data->{id};
my $colour = $self->config->{colours}->{ $args->{reason} };
$res = $trello->post( "cards/$card_id/labels", { color => $colour } );
croak "Trello error adding label to card: $!" if $res->code != 200;
return $json_data->{id};
}
# returns raw status from trello (not the config list names)
sub get_status {
my $self = shift;
my $id = shift;
croak "no id" unless $id;
my $trello = $self->trello;
my $res = $trello->get("cards/$id");
croak "Trello error: can't get card $id :$!" if $res->code != 200;
my $json = JSON->new->allow_nonref;
my $json_data = $json->decode( $res->{response}->{_content} );
my $list_id = $json_data->{idList};
$res = $trello->get("lists/$list_id/name");
croak "Trello error: can't get list name from id $list_id :$!"
if $res->code != 200;
my $json_listdata = $json->decode( $res->{response}->{_content} );
return $json_listdata->{_value};
}
# convert back to generic list name from config
sub get_status_config_name {
my $self = shift;
my $card_id = shift;
my $list = $self->get_status($card_id);
my ($key) =
grep { $self->config->{board}->{lists}->{$_}->{name} eq $list }
keys $self->config->{board}->{lists};
return $key;
}
# have we finished with it?
sub is_complete_or_rejected {
my $self = shift;
my $id = shift;
my @list_names = qw/complete rejected/;
my $status = grep { $self->is_status( $_, $id ) } @list_names;
if ($status) {
return 1;
}
else { return 0; }
}
# boolean check if card is in list
sub is_status {
my $self = shift;
my $list_name = shift;
my $id = shift;
my $list = $self->config->{board}->{lists}->{$list_name}->{name};
my $status = $self->get_status($id);
if ( $status eq $list ) {
return 1;
}
else { return 0; }
}
# takes ArrayRef of ids and returns a ArrayRef of ids in Completed list
sub list_complete {
my $self = shift;
my $ids = shift;
my @complete = grep { $self->is_status( 'complete', $_ ) } @$ids;
return \@complete;
}
# takes ArrayRef of ids and returns a ArrayRef of ids in Rejected list
sub list_rejected {
my $self = shift;
my $ids = shift;
my @rejected = grep { $self->is_status( 'rejected', $_ ) } @$ids;
return \@rejected;
}
sub move_card {
my $self = shift;
my $trello = $self->trello;
my $card_id = shift;
my $destination = shift || croak "requires destination: $!";
my $list_id = $self->config->{board}->{lists}->{$destination}->{id};
my $res = $trello->put( "cards/$card_id", { idList => $list_id } );
croak "Trello error: can't move card $card_id :$!"
if $res->code != 200;
}
# change status of card from closed: True to closed:False
# needed for #RfC::recreate_issue
sub unarchive_card {
my $self = shift;
my $trello = $self->trello;
my $card_id = shift;
my $res = $trello->put( "cards/$card_id", { closed => 'false' } );
croak "Trello error: can't unarchive card $card_id :$!"
if $res->code != 200;
}
# archive_issues archives all cards from a given list
# @ARGS "listname" looks up list name from config and uses that id in api
sub archive_issues {
my $self = shift;
my $trello = $self->trello;
my $list = shift || croak "requires list name $!";
my $list_id = $self->config->{board}->{lists}->{$list}->{id};
#carp $list;
#carp $list_id;
my $res = $trello->post( "lists/$list_id/ArchiveAllCards" );
croak "Trello error: can't archive cards from list $list :$!"
if $res->code != 200;
}
1;
=head1 NAME
LIMS::Local::IssueTracker::Plugin::Trello
=head1 VERSION
$VERSION
=head1 SYNOPSIS
use LIMS::Local::IssueTracker;
$self->load_plugin( LIMS::Local::IssueTracker::Plugin::Trello );
croak "not trackable" unless $self->does("LIMS::Local::Role::Trackable");
=head1 DESCRIPTION
Plugin for LIMS::Local::IssueTracker. Implements LIMS::Local::Role::Trackable
=head1 DIAGNOSTICS
=over 12
=item C<archive_issues>
removes cards from list
param Str listname (from yaml)
=item C<check_config>
validates config is usable
=item C<create_issue>
adds a card to the new Trello list
params: { {name} , {desc} }
=item C<get_status>
returns raw list name from issue tracker
=item C<get_status_config_name>
returns config mapped list name if mapping exists
=item C<is_status>
boolean check if card is in list
=item C<list_complete>
takes ArrayRef of ids and returns a ArrayRef of ids in complete list
=item C<list_rejected>
takes ArrayRef of ids and returns a ArrayRef of ids in Rejected list
=item C<move_card>
transfer cards between lists
params cardid, listname
listname is from config list names
can only transfer to valid lists from config (no long_grass)
=item C<unarchive_card>
reinstate card that has been archived
=back
=head1 CONFIGURATION AND ENVIRONMENT
Yaml configuration
---
plugin: Trello
user: hilis1
key: 9b06292374140f6a3d5286c4c1a793b8
token: bcf4986d275f9ea3dd8acf0e98a752f2a8b79d9bc53904192590399aa973e03c
colours:
new feature: green
modification: yellow
fix error: red
change menu: blue
board:
live:
name: RFCs
id: 59f363276bc164d702084859
lists:
new:
name: Backlog
id: 59f36340b83960f54a5f0ed3
complete:
name: Completed
id: 59f3636231f832f37b38a418
rejected:
name: Rejected
id: 59f363662a7a191c28e2027c
test:
id: 59f3611fae00c3065645e689
lists:
new:
name: Backlog
id: 59f9ba943b5d56ce4b512ad5
complete:
name: Completed
id: 59f9bd8963d7817d02661832
rejected:
name: Rejected
id: 59f9d831d9438d79b78d82aa
=head1 DEPENDENCIES
WWW::Trello::Lite
Moose::Role
=head1 INCOMPATIBILITIES
=head1 BUGS AND LIMITATIONS
Its a pain to get all the ids for lists and boards etc.
to get ids from trello api use REPL and inspect the response
See: https://developers.trello.com/reference/
$trello->get("members/garry222/boards");
my $res =$trello->get("lists/59f36340b83960f54a5f0ed3/cards");
$trello->get("lists/59f36340b83960f54a5f0ed3/cards");
48> my $res =$trello->post("cards", {idList => '59f9ba943b5d56ce4b512ad', name =>"xxxxxxxxx" , desc =>"1 2 3 4"});
53> $trello->get("cards/59f9c79b61a559aba10d4dd5")
etc...
You can also export JSON via the Trello menus
There are no known bugs in this module.
Please report problems to Garry Quested (garry.quested@nhs.net)
Patches are welcome.
=head1 AUTHOR
Garry Quested (garry.quested@nhs.net)
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2017 Garry Quested (garry.quested@nhs.net). All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
=cut
