#
#===============================================================================
#
# 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'
);
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};
}
sub check_status {
my $self = shift;
my $id = shift;
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} );
# convert back to generic list name from config
my ($key) =
grep {
$self->config->{board}->{lists}->{$_}->{name} eq
$json_listdata->{_value}
}
keys $self->config->{board}->{lists};
return $key;
}
# 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->check_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;
}
# 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;
__END__
---
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
#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...