#=============================================================================== # # 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; use Try::Tiny; 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}; my $t = WWW::Trello::Lite->new( key => $key, token => $token ); if ( $HTTP::Tiny::VERSION > '0.012' and not $Net::SSLeay::VERSION > '1.49' ) { die "SSL version problem. Preload HTTP::Tiny <= '0.012'"; } return $t; } 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} }; croak "1st Trello error adding label to card: $!" unless $colour; $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 removes cards from list param Str listname (from yaml) =item C validates config is usable =item C adds a card to the new Trello list params: { {name} , {desc} } =item C returns raw list name from issue tracker =item C returns config mapped list name if mapping exists =item C boolean check if card is in list =item C takes ArrayRef of ids and returns a ArrayRef of ids in complete list =item C takes ArrayRef of ids and returns a ArrayRef of ids in Rejected list =item C 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 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. 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