From 40ad413da912f3c71ad59c93bdc2a26708df44f8 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 7 Apr 2018 01:05:55 +1000 Subject: [PATCH 01/85] Add Travis file - it might even 'just work' --- .travis.yml | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..db11c1b --- /dev/null +++ b/.travis.yml @@ -0,0 +1,50 @@ +# not actually required, just because Archive::Zip tests fail +sudo: required +language: perl +os: + - linux +perl: + - 'blead' + - '5.26' + - '5.24' + - '5.22' + - '5.20' + - '5.18' + - '5.16' + - '5.14' + - '5.12' + - '5.10' + - '5.8' +env: + global: + - AUTHOR_TESTING=1 + - AUTOMATED_TESTING=1 + - RELEASE_TESTING=0 +matrix: + allow_failures: + - perl: 'blead' + - perl: '5.8' + fast_finish: true + include: + - perl: '5.26' + env: COVERAGE=1 +before_install: + - git config --global user.name "TravisCI" + - git config --global user.email $HOSTNAME":not-for-mail@travis-ci.org" + - git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers + - source ~/travis-perl-helpers/init + - build-perl + - perl -V + - build-dist + - cd $BUILD_DIR +install: + - perl -M5.014 -e1 2>/dev/null || cpan-install Dist::Zilla@5.047 + - cpan-install --deps + # - cpanm --quiet --notest --skip-satisfied Dist::Zilla + # - "dzil authordeps --missing | grep -vP '[^\\w:]' | xargs -n 5 -P 10 cpanm --quiet --notest" + # - "dzil listdeps --author --missing | grep -vP '[^\\w:]' | cpanm --verbose" +script: + - perl Build.PL + - ./Build + - prove -b -r -s -j1 $(test-files) + # - dzil smoke --release --author From da84a444a6e288cbc7f3e67a2650b06b5a25a9d6 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 8 Apr 2018 00:19:50 +1000 Subject: [PATCH 02/85] Have dzil also create ModuleBuild files --- dist.ini | 1 + 1 file changed, 1 insertion(+) diff --git a/dist.ini b/dist.ini index b00d82f..17c2b49 100755 --- a/dist.ini +++ b/dist.ini @@ -15,6 +15,7 @@ main_module = lib/RT/Client/REST.pm [@Basic] ; Stuff that generates files +[ModuleBuild] [CPANFile] [GithubMeta] [MetaJSON] From cf25a15d36ae3aa0b8f03896ce1574cc838a5e0d Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 23 Apr 2018 00:35:57 +1000 Subject: [PATCH 03/85] Expose AdminCCAddresses and CcAddresses --- lib/RT/Client/REST/Queue.pm | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/lib/RT/Client/REST/Queue.pm b/lib/RT/Client/REST/Queue.pm index 6585e86..082bf6c 100644 --- a/lib/RT/Client/REST/Queue.pm +++ b/lib/RT/Client/REST/Queue.pm @@ -100,6 +100,21 @@ sub _attributes {{ type => SCALAR, }, }, + + admin_cc_addresses => { + validation => { + type => SCALAR, + }, + rest_name => 'AdminCcAddresses', + }, + + cc_addresses => { + validation => { + type => SCALAR, + }, + rest_name => 'CcAddresses', + }, + }} =head1 ATTRIBUTES @@ -140,6 +155,14 @@ Final priority. Default due in. +=item B + +CC Addresses (comma delimited). + +=item B + +Admin CC Addresses (comma delimited). + =back =head1 DB METHODS From 303d89b46546164db877c768f55a9c1e35c67ef4 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 5 May 2018 23:08:50 +1000 Subject: [PATCH 04/85] Debian's vim has ignore vim: after the first 8 lines for some time now. Move them up --- t/01-use.t | 4 +++- t/10-core.t | 4 +++- t/20-object.t | 3 ++- t/21-user.t | 3 ++- t/22-ticket.t | 4 +++- t/23-attachment.t | 4 +++- t/24-transaction.t | 4 +++- t/25-queue.t | 4 +++- t/26-group.t | 4 +++- t/35-db.t | 2 +- t/40-search.t | 4 +++- t/80-timeout.t | 2 +- t/81-submit.t | 2 +- t/82-stringify.t | 2 +- 14 files changed, 32 insertions(+), 14 deletions(-) diff --git a/t/01-use.t b/t/01-use.t index 46f0d6e..a4cd98d 100644 --- a/t/01-use.t +++ b/t/01-use.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -8,4 +11,3 @@ BEGIN { use_ok ('RT::Client::REST', 0.06); } -# vim:ft=perl: diff --git a/t/10-core.t b/t/10-core.t index 98ea9e1..1b07ddd 100644 --- a/t/10-core.t +++ b/t/10-core.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -76,4 +79,3 @@ lives_ok { 1; -# vim:ft=perl: diff --git a/t/20-object.t b/t/20-object.t index a47d39d..5421733 100644 --- a/t/20-object.t +++ b/t/20-object.t @@ -1,4 +1,6 @@ package MyObject; +# vim:ft=perl: + # For testing purposes -- Object with 'id' attribute. @ISA = qw(RT::Client::REST::Object); @@ -98,4 +100,3 @@ for my $method (qw(store count search)) { "rt object is not correctly initialized"; } -# vim:ft=perl: diff --git a/t/21-user.t b/t/21-user.t index 51568c1..f12e646 100644 --- a/t/21-user.t +++ b/t/21-user.t @@ -1,3 +1,5 @@ +#!perl +# vim:ft=perl: use strict; use warnings; @@ -34,4 +36,3 @@ ok('user' eq $user->rt_type); done_testing; -# vim:ft=perl: diff --git a/t/22-ticket.t b/t/22-ticket.t index 95cbe2f..7b745ed 100644 --- a/t/22-ticket.t +++ b/t/22-ticket.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -217,4 +220,3 @@ throws_ok { $ticket->due_datetime(bless {}, 'foo'); } 'RT::Client::REST::Object::InvalidValueException'; -# vim:ft=perl: diff --git a/t/23-attachment.t b/t/23-attachment.t index c80e2b2..698eed7 100644 --- a/t/23-attachment.t +++ b/t/23-attachment.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -40,4 +43,3 @@ for my $method (qw(store search count)) { ok('attachment' eq $ticket->rt_type); -# vim:ft=perl: diff --git a/t/24-transaction.t b/t/24-transaction.t index ea155d8..7111e54 100644 --- a/t/24-transaction.t +++ b/t/24-transaction.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -36,4 +39,3 @@ for my $method (qw(store search count)) { ok('transaction' eq $tr->rt_type); -# vim:ft=perl: diff --git a/t/25-queue.t b/t/25-queue.t index a4ae2ac..5c767cd 100644 --- a/t/25-queue.t +++ b/t/25-queue.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -28,4 +31,3 @@ for my $method (METHODS) { ok('queue' eq $user->rt_type); -# vim:ft=perl: diff --git a/t/26-group.t b/t/26-group.t index e897362..4364f1a 100644 --- a/t/26-group.t +++ b/t/26-group.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -28,4 +31,3 @@ for my $method (METHODS) { ok('group' eq $user->rt_type, 'rt_type is ok'); -# vim:ft=perl: diff --git a/t/35-db.t b/t/35-db.t index f9287e5..dc71687 100644 --- a/t/35-db.t +++ b/t/35-db.t @@ -1,4 +1,5 @@ package MyObject; +# vim:ft=perl: # For testing purposes use base 'RT::Client::REST::Object'; @@ -87,4 +88,3 @@ $stored = $STORED; $obj->id(10); ok($stored == $STORED, "modifying 'id' did not trigger a store"); -# vim:ft=perl: diff --git a/t/40-search.t b/t/40-search.t index 3bd2cbe..1e42f60 100644 --- a/t/40-search.t +++ b/t/40-search.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -62,4 +65,3 @@ while (my $obj = &$iter) { ok(9 == $i, "Iterated 9 times (as expected)"); -# vim:ft=perl: diff --git a/t/80-timeout.t b/t/80-timeout.t index ac70af9..04e09ed 100644 --- a/t/80-timeout.t +++ b/t/80-timeout.t @@ -1,4 +1,5 @@ #!/usr/bin/perl +# vim:ft=perl: # # This script tests whether timeout actually works. @@ -52,4 +53,3 @@ for my $timeout (1, 2, 5, 10) { ok($t2 - $t1 >= $timeout, "Timed out after $timeout seconds"); } -# vim:ft=perl: diff --git a/t/81-submit.t b/t/81-submit.t index 1a6664e..3e6e1af 100644 --- a/t/81-submit.t +++ b/t/81-submit.t @@ -1,4 +1,5 @@ #!/usr/bin/perl +# vim:ft=perl: # # This script tests whether submited data looks good @@ -45,4 +46,3 @@ my $res = $rt->_submit("ticket/1", undef, { }); unlike($res->{_content}, qr/this is a fake successful response header/, "Make sure response content doesn't contain headers"); -# vim:ft=perl: diff --git a/t/82-stringify.t b/t/82-stringify.t index d46ae17..b9a09df 100644 --- a/t/82-stringify.t +++ b/t/82-stringify.t @@ -1,4 +1,5 @@ #!/usr/bin/perl +# vim:ft=perl: # # This script tests whether submited data looks good @@ -61,4 +62,3 @@ SKIP: { is($?, 0, "self-test: child process ran successfully"); }; -# vim:ft=perl: From 5b1a4aa95cbfc1ce60ac183567da92d066663e93 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 5 May 2018 23:23:58 +1000 Subject: [PATCH 05/85] Be pedantic about quotes --- lib/RT/Client/REST/Exception.pm | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/lib/RT/Client/REST/Exception.pm b/lib/RT/Client/REST/Exception.pm index ac036c1..03092fb 100644 --- a/lib/RT/Client/REST/Exception.pm +++ b/lib/RT/Client/REST/Exception.pm @@ -17,40 +17,40 @@ use Error; use Exception::Class ( 'RT::Client::REST::OddNumberOfArgumentsException' => { isa => __PACKAGE__, - description => "This means that we wanted name/value pairs", + description => 'This means that we wanted name/value pairs', }, 'RT::Client::REST::InvaildObjectTypeException' => { isa => __PACKAGE__, - description => "Invalid object type was specified", + description => 'Invalid object type was specified', }, 'RT::Client::REST::MalformedRTResponseException' => { isa => __PACKAGE__, - description => "Malformed RT response received from server", + description => 'Malformed RT response received from server', }, 'RT::Client::REST::InvalidParameterValueException' => { isa => __PACKAGE__, - description => "This happens when you feed me bad values", + description => 'This happens when you feed me bad values', }, 'RT::Client::REST::CannotReadAttachmentException' => { isa => __PACKAGE__, - description => "Cannot read attachment", + description => 'Cannot read attachment', }, 'RT::Client::REST::RequiredAttributeUnsetException' => { isa => __PACKAGE__, - description => "An operation failed because a required attribute " . - "was not set in the object", + description => 'An operation failed because a required attribute ' . + 'was not set in the object', }, 'RT::Client::REST::RTException' => { isa => __PACKAGE__, fields => ['code'], - description => "RT server returned an error code", + description => 'RT server returned an error code', }, 'RT::Client::REST::ObjectNotFoundException' => { @@ -65,7 +65,7 @@ use Exception::Class ( 'RT::Client::REST::AuthenticationFailureException' => { isa => 'RT::Client::REST::RTException', - description => "Incorrect username or password", + description => 'Incorrect username or password', }, 'RT::Client::REST::UpdateException' => { @@ -133,7 +133,7 @@ use Exception::Class ( 'RT::Client::REST::HTTPException' => { isa => __PACKAGE__, fields => ['code'], - description => "Error in the underlying protocol (HTTP)", + description => 'Error in the underlying protocol (HTTP)', }, ); From d32852a7398fbf135b5c146550737d8b2751cd25 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 5 May 2018 23:27:27 +1000 Subject: [PATCH 06/85] As each if statement returns, removing else's makes the code much simpler --- lib/RT/Client/REST/Exception.pm | 38 +++++++++++++++++++++------------ 1 file changed, 24 insertions(+), 14 deletions(-) diff --git a/lib/RT/Client/REST/Exception.pm b/lib/RT/Client/REST/Exception.pm index 03092fb..ce954eb 100644 --- a/lib/RT/Client/REST/Exception.pm +++ b/lib/RT/Client/REST/Exception.pm @@ -140,33 +140,43 @@ use Exception::Class ( sub _get_exception_class { my ($self, $content) = @_; - if ($content =~ /not found|\d+ does not exist|[Ii]nvalid attachment id/) { + if ($content =~ m/not found|\d+ does not exist|[Ii]nvalid attachment id/) { return 'RT::Client::REST::ObjectNotFoundException'; - } elsif ($content =~ /not create/) { + } + if ($content =~ m/not create/) { return 'RT::Client::REST::CouldNotCreateObjectException'; - } elsif ($content =~ /[Uu]nknown custom field/) { + } + if ($content =~ m/[Uu]nknown custom field/) { return 'RT::Client::REST::UnknownCustomFieldException'; - } elsif ($content =~ /[Ii]nvalid query/) { + } + if ($content =~ m/[Ii]nvalid query/) { return 'RT::Client::REST::InvalidQueryException'; - } elsif ($content =~ /could not be set to/) { + } + if ($content =~ m/could not be set to/) { return 'RT::Client::REST::CouldNotSetAttributeException'; - } elsif ($content =~ /not a valid email address/) { + } + if ($content =~ m/not a valid email address/) { return 'RT::Client::REST::InvalidEmailAddressException'; - } elsif ($content =~ /is already the current value/) { + } + if ($content =~ m/is already the current value/) { return 'RT::Client::REST::AlreadyCurrentValueException'; - } elsif ($content =~ /[Ii]mmutable field/) { + } + if ($content =~ m/[Ii]mmutable field/) { return 'RT::Client::REST::ImmutableFieldException'; - } elsif ($content =~ /[Ii]llegal value/) { + } + if ($content =~ m/[Ii]llegal value/) { return 'RT::Client::REST::IllegalValueException'; - } elsif ($content =~ /[Yy]ou are not allowed/) { + } + if ($content =~ m/[Yy]ou are not allowed/) { return 'RT::Client::REST::UnauthorizedActionException'; - } elsif ($content =~ /[Yy]ou already own this ticket/ || - $content =~ /[Tt]hat user already owns that ticket/) + } + if ($content =~ m/[Yy]ou already own this ticket/ || + $content =~ m/[Tt]hat user already owns that ticket/) { return 'RT::Client::REST::AlreadyTicketOwnerException'; - } else { - return 'RT::Client::REST::UnknownRTException'; } + + return 'RT::Client::REST::UnknownRTException'; } sub _rt_content_to_exception { From 17131b2e80bfc58df10fe70d97a1c431fc99a094 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 5 May 2018 23:29:17 +1000 Subject: [PATCH 07/85] No need to use and base the same module --- lib/RT/Client/REST/Group.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/RT/Client/REST/Group.pm b/lib/RT/Client/REST/Group.pm index 10d5ff7..a1445eb 100644 --- a/lib/RT/Client/REST/Group.pm +++ b/lib/RT/Client/REST/Group.pm @@ -7,12 +7,12 @@ use warnings; package RT::Client::REST::Group; +use base 'RT::Client::REST::Object'; + use Params::Validate qw(:types); use RT::Client::REST 0.14; -use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.01; use RT::Client::REST::SearchResult 0.02; -use base 'RT::Client::REST::Object'; =head1 SYNOPSIS From 704e6893489db272e94cd1bed82c7c205f28a9c9 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 5 May 2018 23:31:02 +1000 Subject: [PATCH 08/85] No need for use and base of the same module --- lib/RT/Client/REST/Ticket.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/RT/Client/REST/Ticket.pm b/lib/RT/Client/REST/Ticket.pm index 050172b..5557c75 100644 --- a/lib/RT/Client/REST/Ticket.pm +++ b/lib/RT/Client/REST/Ticket.pm @@ -7,15 +7,15 @@ use warnings; package RT::Client::REST::Ticket; +use base 'RT::Client::REST::Object'; + use Error qw(:try); use Params::Validate qw(:types); use RT::Client::REST 0.18; use RT::Client::REST::Attachment; -use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.04; use RT::Client::REST::SearchResult 0.02; use RT::Client::REST::Transaction; -use base 'RT::Client::REST::Object'; =head1 SYNOPSIS From 100f45f4fa81880fcdb0028300f3bae8e6450efe Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 5 May 2018 23:31:41 +1000 Subject: [PATCH 09/85] No need to use and base the same module --- lib/RT/Client/REST/Transaction.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/RT/Client/REST/Transaction.pm b/lib/RT/Client/REST/Transaction.pm index 3fe6510..134fc7a 100644 --- a/lib/RT/Client/REST/Transaction.pm +++ b/lib/RT/Client/REST/Transaction.pm @@ -7,10 +7,10 @@ use warnings; package RT::Client::REST::Transaction; +use base 'RT::Client::REST::Object'; + use Params::Validate qw(:types); -use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.03; -use base 'RT::Client::REST::Object'; sub _attributes {{ id => { From 6128db2cb988d06a5d324752c72b41ddbf4dde99 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 5 May 2018 23:32:17 +1000 Subject: [PATCH 10/85] No need to use and base the same module --- lib/RT/Client/REST/User.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/RT/Client/REST/User.pm b/lib/RT/Client/REST/User.pm index 3f3e631..8ebe73d 100644 --- a/lib/RT/Client/REST/User.pm +++ b/lib/RT/Client/REST/User.pm @@ -7,12 +7,12 @@ use warnings; package RT::Client::REST::User; +use base 'RT::Client::REST::Object'; + use Params::Validate qw(:types); use RT::Client::REST 0.14; -use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.01; use RT::Client::REST::SearchResult 0.02; -use base 'RT::Client::REST::Object'; =head1 SYNOPSIS From 4fd13764c8cdc02e1a6c4b5401927ea39a9b62bb Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 5 May 2018 23:50:45 +1000 Subject: [PATCH 11/85] Dont need to use and base a module --- lib/RT/Client/REST/Attachment.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/RT/Client/REST/Attachment.pm b/lib/RT/Client/REST/Attachment.pm index a16723d..90bc498 100644 --- a/lib/RT/Client/REST/Attachment.pm +++ b/lib/RT/Client/REST/Attachment.pm @@ -7,10 +7,10 @@ use warnings; package RT::Client::REST::Attachment; +use base 'RT::Client::REST::Object'; + use Params::Validate qw(:types); -use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.03; -use base 'RT::Client::REST::Object'; sub _attributes {{ id => { From 7cd38d6d5be1cfb1a499fecb8f7d3ca8291d2521 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Lund?= Date: Wed, 1 Aug 2018 16:04:11 +0200 Subject: [PATCH 12/85] Fix tests that were failing on Windows On some versions of Windows requests to localhost does not work. The simplest way to fix this is to use 127.0.0.1 instead, which should always work. This is part of the CPAN Pull Request Challenge, where I got RT::Client::REST as my July assignment. --- t/80-timeout.t | 2 +- t/81-submit.t | 2 +- t/82-stringify.t | 2 +- t/83-attachments.t | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/t/80-timeout.t b/t/80-timeout.t index 04e09ed..60e19b7 100644 --- a/t/80-timeout.t +++ b/t/80-timeout.t @@ -37,7 +37,7 @@ if (0 == $pid) { # Child plan tests => 8; # Parent for my $timeout (1, 2, 5, 10) { my $rt = RT::Client::REST->new( - server => "http://localhost:$port", + server => "http://127.0.0.1:$port", timeout => $timeout, ); my $t1 = time; diff --git a/t/81-submit.t b/t/81-submit.t index 3e6e1af..360bdd0 100644 --- a/t/81-submit.t +++ b/t/81-submit.t @@ -37,7 +37,7 @@ response text"); plan tests => 1; my $rt = RT::Client::REST->new( - server => "http://localhost:$port", + server => "http://127.0.0.1:$port", timeout => 2, ); my $res = $rt->_submit("ticket/1", undef, { diff --git a/t/82-stringify.t b/t/82-stringify.t index b9a09df..dca80bc 100644 --- a/t/82-stringify.t +++ b/t/82-stringify.t @@ -30,7 +30,7 @@ die "cannot fork: $!" unless defined $pid; if (0 == $pid) { # Child my $rt = RT::Client::REST->new( - server => "http://localhost:$port", + server => "http://127.0.0.1:$port", # This ensures that we die soon. When the client dies, the # while (<$client>) above stops looping. timeout => 2, diff --git a/t/83-attachments.t b/t/83-attachments.t index 4f7fd11..6e7b350 100644 --- a/t/83-attachments.t +++ b/t/83-attachments.t @@ -110,7 +110,7 @@ plan tests => 4; } my $rt = RT::Client::REST->new( - server => "http://localhost:$port", + server => "http://127.0.0.1:$port", timeout => 2, ); From 6b22fb0c21dc6bce66bdd8494f37023c5c872a53 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 5 Nov 2018 21:40:58 +1100 Subject: [PATCH 13/85] Tweak hashbang --- t/01-use.t | 2 +- t/11-server-name.t | 10 +++++----- t/20-object.t | 1 + t/35-db.t | 4 +++- t/50-forms.t | 2 ++ t/60-with-rt.t | 2 ++ t/80-timeout.t | 2 +- t/81-submit.t | 2 +- t/82-stringify.t | 2 +- t/83-attachments.t | 2 +- 10 files changed, 18 insertions(+), 11 deletions(-) diff --git a/t/01-use.t b/t/01-use.t index a4cd98d..a804e05 100644 --- a/t/01-use.t +++ b/t/01-use.t @@ -8,6 +8,6 @@ use Test::More tests => 2; BEGIN { use_ok ('RT::Client::REST'); - use_ok ('RT::Client::REST', 0.06); + use_ok ('RT::Client::REST', 0.53); } diff --git a/t/11-server-name.t b/t/11-server-name.t index 3a1ea0a..650d4a9 100644 --- a/t/11-server-name.t +++ b/t/11-server-name.t @@ -7,14 +7,14 @@ use RT::Client::REST; my $rt = RT::Client::REST->new(server => 'http://localhost/'); -is $rt->server, 'http://localhost', "Trailing slash stripped"; -is $rt->_rest, 'http://localhost/REST/1.0', "rest uri ok"; +is $rt->server, 'http://localhost', 'Trailing slash stripped'; +is $rt->_rest, 'http://localhost/REST/1.0', 'rest uri ok'; $rt = RT::Client::REST->new(server => 'http://localhost/bts/', timeout => '10/', # bogus ); -is $rt->server, 'http://localhost/bts', "Trailing slash stripped"; -is $rt->_rest, 'http://localhost/bts/REST/1.0', "rest uri ok"; -is $rt->timeout, '10/', "trailing slash on timeout preserved, even if bogus"; +is $rt->server, 'http://localhost/bts', 'Trailing slash stripped'; +is $rt->_rest, 'http://localhost/bts/REST/1.0', 'rest uri ok'; +is $rt->timeout, '10/', 'trailing slash on timeout preserved, even if bogus'; diff --git a/t/20-object.t b/t/20-object.t index 5421733..28764c3 100644 --- a/t/20-object.t +++ b/t/20-object.t @@ -1,3 +1,4 @@ +#!perl package MyObject; # vim:ft=perl: diff --git a/t/35-db.t b/t/35-db.t index dc71687..09b0a8a 100644 --- a/t/35-db.t +++ b/t/35-db.t @@ -1,5 +1,7 @@ -package MyObject; +#!perl # vim:ft=perl: + +package MyObject; # For testing purposes use base 'RT::Client::REST::Object'; diff --git a/t/50-forms.t b/t/50-forms.t index d820316..b40d96d 100644 --- a/t/50-forms.t +++ b/t/50-forms.t @@ -1,3 +1,5 @@ +#!perl + # Test form parsing. Taken out of 83-attachments.t as a special case, # just to make sure that the form parsing is performed correctly. diff --git a/t/60-with-rt.t b/t/60-with-rt.t index f3152f0..aa17e3c 100644 --- a/t/60-with-rt.t +++ b/t/60-with-rt.t @@ -1,3 +1,5 @@ +#!perl + # This test is for testing RT::Client::REST with a real instance of RT. # This is so that we can verify bug reports and compare functionality # (and bugs) between different versions of RT. diff --git a/t/80-timeout.t b/t/80-timeout.t index 60e19b7..a6e7ded 100644 --- a/t/80-timeout.t +++ b/t/80-timeout.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # vim:ft=perl: # # This script tests whether timeout actually works. diff --git a/t/81-submit.t b/t/81-submit.t index 360bdd0..9448183 100644 --- a/t/81-submit.t +++ b/t/81-submit.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # vim:ft=perl: # # This script tests whether submited data looks good diff --git a/t/82-stringify.t b/t/82-stringify.t index dca80bc..dbb048a 100644 --- a/t/82-stringify.t +++ b/t/82-stringify.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # vim:ft=perl: # # This script tests whether submited data looks good diff --git a/t/83-attachments.t b/t/83-attachments.t index 6e7b350..c29d88a 100644 --- a/t/83-attachments.t +++ b/t/83-attachments.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # # This script tests whether submited data looks good From dc887c68e5db62f2ee0e2c77545a50a1e43ae4a1 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 5 Nov 2018 21:41:38 +1100 Subject: [PATCH 14/85] Document release 0.53 --- CHANGES | 5 +++++ dist.ini | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index d2fa2d9..35d606a 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,10 @@ Revision history for Perl module RT::Client::REST +0.53 MOn Nov 05 2018 "Dean Hamstead" " + - Fix some tests on Windows + - Various coding changes internally + - Expose CC Addresses and Admin CC Addresses on Queues + 0.52 Fri Apr 06 2018 "Dean Hamstead" - Fix up lots of Pod Critic complaints - Fix up lots of Perl Critic complaints diff --git a/dist.ini b/dist.ini index 17c2b49..7fb26d0 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.52 +version = 0.53 author = Abhijit Menon-Sen author = Dmitri Tikhonov author = Damien "dams" Krotkine From dde1e13d11ed55446a7c26803f4095a0a05985d5 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Thu, 8 Nov 2018 18:06:21 +1100 Subject: [PATCH 15/85] Add some comment for RT#125802 --- lib/RT/Client/REST/Attachment.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/RT/Client/REST/Attachment.pm b/lib/RT/Client/REST/Attachment.pm index 90bc498..875d5cb 100644 --- a/lib/RT/Client/REST/Attachment.pm +++ b/lib/RT/Client/REST/Attachment.pm @@ -261,6 +261,12 @@ Returns 'attachment'. =back +=head1 CREATING ATTACHMENTS + +Currently RT does not allow creating attachments via their API. + +See L + =head1 SEE ALSO L, From dfefbe16173588bad72024b806d859483dca7137 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Thu, 8 Nov 2018 18:47:32 +1100 Subject: [PATCH 16/85] Add trivial example for 'logger' --- lib/RT/Client/REST.pm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 1b2ebc2..63c872e 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -963,6 +963,17 @@ A logger object. It should be able to debug(), info(), warn() and error(). It is not widely used in the code (yet), and so it is mostly useful for development. +Something like this will get you started: + + use Log::Dispatch; + my $log = Log::Dispatch->new( + outputs => [ [ 'Screen', min_level => 'debug' ] ], + ); + my $rt = RT::Client::REST->new( + server => ... etc ... + logger => $log + ); + =back =item login (username => 'root', password => 'password') From a89e19b35c71c60840d5bfb65324eae317020ec5 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 9 Nov 2018 10:00:25 +1100 Subject: [PATCH 17/85] Add some example for RT#125801 --- lib/RT/Client/REST/Queue.pm | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/lib/RT/Client/REST/Queue.pm b/lib/RT/Client/REST/Queue.pm index 082bf6c..9d26642 100644 --- a/lib/RT/Client/REST/Queue.pm +++ b/lib/RT/Client/REST/Queue.pm @@ -163,6 +163,23 @@ CC Addresses (comma delimited). Admin CC Addresses (comma delimited). +=item B + +Access custom fields. Inherited from L, where +you can read more details. + +Trivial example: + + my $queue = RT::Client::REST::Queue->new( + rt => $rt, id => $queue_id + )->retrieve(); + my @customfields = $queue->cf(); + for my $f (@customfields) { + my $v = $queue->cf($f); + say "field: $f"; + say "value: $v"; + } + =back =head1 DB METHODS From 53c09fde86df5a8fd796426826d8dec00cc2179b Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 16:17:00 +1100 Subject: [PATCH 18/85] Fix whitespace problems with attachments RT#127607 --- lib/RT/Client/REST.pm | 4 ++-- lib/RT/Client/REST/Forms.pm | 28 ++++++++++++---------------- t/data/spaces.txt | 4 ++++ 3 files changed, 18 insertions(+), 18 deletions(-) create mode 100644 t/data/spaces.txt diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 63c872e..0260ad9 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -616,7 +616,7 @@ sub _submit { message => "Incorrect username or password", ); } - elsif ($req->header("Cookie")) { + elsif ($req->header('Cookie')) { # We'll retry the request with credentials, unless # we only wanted to logout in the first place. #$session->delete; @@ -627,7 +627,7 @@ sub _submit { $res->decoded_content) ->throw( code => $res->code, - message => "RT server returned this error: " . + message => 'RT server returned this error: ' . $res->decoded_content, ); } diff --git a/lib/RT/Client/REST/Forms.pm b/lib/RT/Client/REST/Forms.pm index 8c52bd9..9ef8ee7 100644 --- a/lib/RT/Client/REST/Forms.pm +++ b/lib/RT/Client/REST/Forms.pm @@ -48,9 +48,9 @@ Returns a reference to an array of parsed forms. =cut sub form_parse { + my @lines = split /\n/, shift; my $state = 0; my @forms = (); - my @lines = split /\n/, $_[0]; my ($c, $o, $k, $e) = ('', [], {}, ''); LINE: @@ -79,26 +79,22 @@ sub form_parse { } $c .= "\n"; } - elsif ($state <= 1 && $line =~ m/^($field):(?:\s+(.*))?$/) { + elsif ($state <= 1 && $line =~ m/^($field:\s)(.*)?$/) { # Read a field: value specification. - my $f = $1; - my @v = ($2 || ()); + my $f = $1; + my $value = $2; + my $spaces = ' ' x length($f); + $f =~ s/:\s$//; # Read continuation lines, if any. - while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) { - push @v, shift @lines; + while (@lines && ($lines[0] eq '' || $lines[0] =~ m/^\s+/)) { + my $l = shift @lines; + $l =~ s/^$spaces//; + $value .= "\n" . $l } - pop @v while (@v && $v[-1] eq ''); - - # Strip longest common leading indent from text. - my $ws = ''; - for my $ls (map {/^(\s+)/} @v[1..$#v]) { - $ws = $ls if (!$ws || length($ls) < length($ws)); - } - s/^$ws// foreach @v; push(@$o, $f) unless exists $k->{$f}; - vpush($k, $f, join("\n", @v)); + vpush($k, $f, $value); $state = 1; } @@ -107,7 +103,7 @@ sub form_parse { # form parsed thus far, and add an error marker. (>>) $state = -1; $e = form_compose([[ '', $o, $k, '' ]]); - $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n"; + $e.= $line =~ m/^>>/ ? "$line\n" : ">> $line\n"; } } else { diff --git a/t/data/spaces.txt b/t/data/spaces.txt new file mode 100644 index 0000000..efaa78c --- /dev/null +++ b/t/data/spaces.txt @@ -0,0 +1,4 @@ + + + + From fc6dd9cd9c5ed179146e7cf0384af8e83c36e7aa Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 16:29:52 +1100 Subject: [PATCH 19/85] Typo in comment --- t/83-attachments.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/83-attachments.t b/t/83-attachments.t index c29d88a..a6df7e4 100644 --- a/t/83-attachments.t +++ b/t/83-attachments.t @@ -114,7 +114,7 @@ my $rt = RT::Client::REST->new( timeout => 2, ); -# avoid need ot login +# avoid need to login $rt->basic_auth_cb(sub { return }); { From e93d62cde22284ea51466ab52b76b4ae927dfc99 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 16:38:27 +1100 Subject: [PATCH 20/85] Catch random cases where 401's occured (see code sample in RT127288), changes to quotes --- lib/RT/Client/REST.pm | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 0260ad9..fb9c939 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -90,7 +90,7 @@ sub login { # server-side errors we bubble up and ignore all others. try { $self->_cookie(undef); # Start a new session. - $self->_submit("ticket/1", undef, \%opts); + $self->_submit('ticket/1', undef, \%opts); } catch RT::Client::REST::AuthenticationFailureException with { shift->rethrow; } catch RT::Client::REST::MalformedRTResponseException with { @@ -529,7 +529,7 @@ sub _submit { unless (ref $content) { # If it's just a string, make sure LWP handles it properly. # (By pretending that it's a file!) - $content = [ content => [undef, "", Content => $content] ]; + $content = [ content => [undef, q(), Content => $content] ]; } elsif (ref $content eq 'HASH') { my @data; @@ -550,7 +550,7 @@ sub _submit { unless ($self->_cookie || $self->basic_auth_cb) { unless (defined($auth)) { RT::Client::REST::RequiredAttributeUnsetException->throw( - "You must log in first", + 'You must log in first', ); } push @$data, %$auth; @@ -585,6 +585,7 @@ sub _submit { my ($status) = split /\n/, $head; # my ($status, @headers) = split /\n/, $head; $text =~ s/\n*$/\n/ if ($text); + # Example: # "RT/3.0.1 401 Credentials required" if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) { RT::Client::REST::MalformedRTResponseException->throw( @@ -613,7 +614,7 @@ sub _submit { if (exists $d{user}) { RT::Client::REST::AuthenticationFailureException->throw( code => $res->code, - message => "Incorrect username or password", + message => 'Incorrect username or password', ); } elsif ($req->header('Cookie')) { @@ -622,7 +623,14 @@ sub _submit { #$session->delete; #return submit(@_) unless $uri eq "$REST/logout"; } - } else { + else { + RT::Client::REST::AuthenticationFailureException->throw( + code => $res->code, + message => 'Server said: '. $res->message, + ); + } + } + else { RT::Client::REST::Exception->_rt_content_to_exception( $res->decoded_content) ->throw( @@ -636,10 +644,10 @@ sub _submit { 500 == $res->code && # Older versions of HTTP::Response populate 'message', newer # versions populate 'content'. This catches both cases. - ($res->decoded_content || $res->message) =~ /read timeout/ + ($res->decoded_content || $res->message) =~ m/read timeout/ ) { RT::Client::REST::RequestTimedOutException->throw( - "Your request to " . $self->server . " timed out", + 'Your request to ' . $self->server . ' timed out', ); } elsif (302 == $res->code && !$self->{'_redirected'}) { $self->{'_redirected'} = 1; # We only allow one redirection From 28e966e14dd245ed154f7d6cd31dac41c0584a54 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 16:42:00 +1100 Subject: [PATCH 21/85] Dont wildly remove whitespace at the end of the content RT127607 --- lib/RT/Client/REST.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index fb9c939..6a18a0b 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -583,7 +583,6 @@ sub _submit { my ($head, $text) = split /\n\n/, $res->decoded_content(charset => 'none'), 2; my ($status) = split /\n/, $head; # my ($status, @headers) = split /\n/, $head; - $text =~ s/\n*$/\n/ if ($text); # Example: # "RT/3.0.1 401 Credentials required" @@ -812,7 +811,7 @@ sub _valid_transaction_type { unless (grep { $type eq $_ } $self->_list_of_valid_transaction_types) { RT::Client::REST::InvalidParameterValueException->throw( "'$type' is not a valid transaction type. Allowed types: " . - join(", ", $self->_list_of_valid_transaction_types) + join(', ', $self->_list_of_valid_transaction_types) ); } From 05283d6ee0d03b10ad5d67cd75cb069a3e976b97 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 16:55:26 +1100 Subject: [PATCH 22/85] RT always has a white space after the field name when blank. For RT127607 --- t/50-forms.t | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/t/50-forms.t b/t/50-forms.t index b40d96d..d98cab6 100644 --- a/t/50-forms.t +++ b/t/50-forms.t @@ -21,17 +21,16 @@ close $fh; sub create_http_body { my $binary_string = shift; my $length = length($binary_string); - $binary_string =~ s/\n/\n /sg; + my $spaces = ' ' x length('Content: '); + $binary_string =~ s/\n/\n$spaces/sg; $binary_string .= "\n\n"; my $body = <<"EOF"; id: 873 -Subject: -Creator: 12 +Subject: \nCreator: 12 Created: 2013-11-06 07:15:36 Transaction: 1457 Parent: 871 -MessageId: -Filename: prova2.png +MessageId: \nFilename: prova2.png ContentType: image/png ContentEncoding: base64 From 515209550edc2ab2c54bbf52b368edd742e0a6c4 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 16:56:34 +1100 Subject: [PATCH 23/85] RT always has a white space after the field name when blank. For RT127607 --- t/83-attachments.t | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/t/83-attachments.t b/t/83-attachments.t index a6df7e4..0600e6b 100644 --- a/t/83-attachments.t +++ b/t/83-attachments.t @@ -31,13 +31,11 @@ my ($reply_header, $reply_body) = do { $binary_string =~ s/\n/\n /sg; my $body = <<"EOF"; id: 873 -Subject: -Creator: 12 +Subject: \nCreator: 12 Created: 2013-11-06 07:15:36 Transaction: 1457 Parent: 871 -MessageId: -Filename: prova2.png +MessageId: \nFilename: prova2.png ContentType: image/png ContentEncoding: base64 From 051042d54af3f7c4bc36cf50c82a91680e241f7a Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 17:18:26 +1100 Subject: [PATCH 24/85] Fix up pod --- lib/RT/Client/REST/HTTPClient.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/RT/Client/REST/HTTPClient.pm b/lib/RT/Client/REST/HTTPClient.pm index 7412e99..5284877 100644 --- a/lib/RT/Client/REST/HTTPClient.pm +++ b/lib/RT/Client/REST/HTTPClient.pm @@ -50,4 +50,6 @@ sub basic_auth_cb { =back +=cut + 1; From e23a3e8c8efd933cd9830d293431b70c52aa31b9 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 17:19:12 +1100 Subject: [PATCH 25/85] Avoid warning when developing (dzil inserts VERSION) --- lib/RT/Client/REST.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 6a18a0b..e1e6198 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -841,7 +841,7 @@ sub _uri { shift->_rest . '/' . shift } sub _ua_string { my $self = shift; - return ref($self) . '/' . $self->_version; + return ref($self) . '/' . ($self->_version || '???'); } sub _version { $RT::Client::REST::VERSION } From d8ce9df51a8a53fb1307166fa609951a070bd807 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 17:19:41 +1100 Subject: [PATCH 26/85] Test whitespace isnt shredded RT127607 --- t/84-attachments-rt127607.t | 132 ++++++++++++++++++++++++++++++++++++ 1 file changed, 132 insertions(+) create mode 100644 t/84-attachments-rt127607.t diff --git a/t/84-attachments-rt127607.t b/t/84-attachments-rt127607.t new file mode 100644 index 0000000..c94153e --- /dev/null +++ b/t/84-attachments-rt127607.t @@ -0,0 +1,132 @@ +#!perl +# +# This script tests whether submited data looks good + +use strict; +use warnings; + +use Test::More; + +use IO::File; +use IO::Pipe; +use RT::Client::REST; +use File::Spec::Functions; +use Encode; +use HTTP::Response; +use HTTP::Server::Simple; + +# this file, every line is just spaces +my $testfile = 'spaces.txt'; +my $testfile_path = catfile('t' => 'data' => $testfile); + +my $testfile_content = do { + my $fh = IO::File->new($testfile_path) + or die "Couldn't open $testfile_path $!"; + local $/; + <$fh>; +}; + +my ($reply_header, $reply_body) = do { + my $binary_string = $testfile_content; + my $length = length($binary_string); + my $spaces = ' ' x length('Content: '); + $binary_string =~ s/\n/\n$spaces/sg; + my $body = <<"EOF"; +id: 978678 +Subject: spaces.txt +Creator: 322136 +Created: 2018-11-10 05:23:01 +Transaction: 1818943 +Parent: 978676 +MessageId: \nFilename: spaces.txt +ContentType: text/plain +ContentEncoding: none + +Headers: MIME-Version: 1.0 + Subject: spaces.txt + X-Mailer: MIME-tools 5.504 (Entity 5.504) + Content-Type: text/plain; charset="utf-8"; name="spaces.txt" + Content-Disposition: inline; filename="spaces.txt" + Content-Transfer-Encoding: binary + X-RT-Original-Encoding: utf-8 + Content-Length: $length + +Content: $binary_string +EOF + ('RT/4.0.7 200 Ok', $body); +}; + +my $http_payload = + $reply_header . + "\n\n" . + $reply_body . + "\n\n" ; + +my $http_reply = + "HTTP/1.1 200 OK\r\n" . + "Content-Type: text/plain; charset=utf-8\r\n\r\n" . + $http_payload ; + +my $pipe = IO::Pipe->new; # Used to get port number +my $pid = fork; +die "cannot fork: $!" if not defined $pid; + +if (0 == $pid) { # Child + $pipe->writer; + { + package My::Web::Server; + use base qw(HTTP::Server::Simple::CGI); + sub handle_request { + print $http_reply; + } + # A hack to get HTTP::Server::Simple listen on ephemeral port. + # See RT#72987 + sub after_setup_listener { + use Socket; + my $sock = getsockname HTTP::Server::Simple::HTTPDaemon; + my ($port) = (sockaddr_in($sock))[0]; + $pipe->print("$port\n"); + $pipe->close; + } + } + my $server = My::Web::Server->new('00'); + alarm 120; # Just in case, don't hang people + $server->run; # Run until killed + die 'unreachable code'; +} + +$pipe->reader; +chomp(my $port = <$pipe>); +#diag("set up web server on port $port"); +$pipe->close; + +unless ($port && $port =~ /^\d+$/) { + kill 9, $pid; + waitpid $pid, 0; + plan skip_all => 'could not get port number from child, skipping all tests'; +} + +plan tests => 4; + +{ + my $res = HTTP::Response->parse( $http_reply ); + ok($res->content eq $http_payload, + 'self-test: HTTP::Response gives back correct payload'); +} + +my $rt = RT::Client::REST->new( + server => "http://127.0.0.1:$port", + timeout => 2, +); + +# avoid need to login +$rt->basic_auth_cb(sub { return }); + +{ + my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 1); + ok($res->{Content} eq $testfile_content, 'binary files match with undecoded option'); +} + +kill 9, $pid; +waitpid $pid, 0; +exit; From 3c1131590eb678a769890b7a5d007bab29c95414 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 17:25:53 +1100 Subject: [PATCH 27/85] Test data file with more than one line and no endline at EOF RT127607 --- t/data/nonewline.txt | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 t/data/nonewline.txt diff --git a/t/data/nonewline.txt b/t/data/nonewline.txt new file mode 100644 index 0000000..b99a5a5 --- /dev/null +++ b/t/data/nonewline.txt @@ -0,0 +1,2 @@ +no new line +nope \ No newline at end of file From 8bf0e5d521afab600e372aa615799d95bd63b160 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 10 Nov 2018 17:26:23 +1100 Subject: [PATCH 28/85] Tests for RT127607 --- t/84-attachments-rt127607.t | 12 ++-- t/85-attachments-rt127607.t | 136 ++++++++++++++++++++++++++++++++++++ 2 files changed, 144 insertions(+), 4 deletions(-) create mode 100644 t/85-attachments-rt127607.t diff --git a/t/84-attachments-rt127607.t b/t/84-attachments-rt127607.t index c94153e..153e6c5 100644 --- a/t/84-attachments-rt127607.t +++ b/t/84-attachments-rt127607.t @@ -32,12 +32,12 @@ my ($reply_header, $reply_body) = do { my $spaces = ' ' x length('Content: '); $binary_string =~ s/\n/\n$spaces/sg; my $body = <<"EOF"; -id: 978678 +id: 873 Subject: spaces.txt Creator: 322136 Created: 2018-11-10 05:23:01 Transaction: 1818943 -Parent: 978676 +Parent: 130 MessageId: \nFilename: spaces.txt ContentType: text/plain ContentEncoding: none @@ -106,7 +106,7 @@ unless ($port && $port =~ /^\d+$/) { plan skip_all => 'could not get port number from child, skipping all tests'; } -plan tests => 4; +plan tests => 3; { my $res = HTTP::Response->parse( $http_reply ); @@ -124,7 +124,11 @@ $rt->basic_auth_cb(sub { return }); { my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 1); - ok($res->{Content} eq $testfile_content, 'binary files match with undecoded option'); + ok($res->{Content} eq $testfile_content, 'files match with undecoded option'); +} +{ + my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 0); + ok($res->{Content} eq $testfile_content, 'files match w/o undecoded option'); } kill 9, $pid; diff --git a/t/85-attachments-rt127607.t b/t/85-attachments-rt127607.t new file mode 100644 index 0000000..483bf0f --- /dev/null +++ b/t/85-attachments-rt127607.t @@ -0,0 +1,136 @@ +#!perl +# +# This script tests whether submited data looks good + +use strict; +use warnings; + +use Test::More; + +use IO::File; +use IO::Pipe; +use RT::Client::REST; +use File::Spec::Functions; +use Encode; +use HTTP::Response; +use HTTP::Server::Simple; + +# this file, has more than one line but no endline on the last line +my $testfile = 'nonewline.txt'; +my $testfile_path = catfile('t' => 'data' => $testfile); + +my $testfile_content = do { + my $fh = IO::File->new($testfile_path) + or die "Couldn't open $testfile_path $!"; + local $/; + <$fh>; +}; + +my ($reply_header, $reply_body) = do { + my $binary_string = $testfile_content; + my $length = length($binary_string); + my $spaces = ' ' x length('Content: '); + $binary_string =~ s/\n/\n$spaces/sg; + my $body = <<"EOF"; +id: 873 +Subject: spaces.txt +Creator: 322136 +Created: 2018-11-10 05:23:01 +Transaction: 1818943 +Parent: 130 +MessageId: \nFilename: spaces.txt +ContentType: text/plain +ContentEncoding: none + +Headers: MIME-Version: 1.0 + Subject: spaces.txt + X-Mailer: MIME-tools 5.504 (Entity 5.504) + Content-Type: text/plain; charset="utf-8"; name="spaces.txt" + Content-Disposition: inline; filename="spaces.txt" + Content-Transfer-Encoding: binary + X-RT-Original-Encoding: utf-8 + Content-Length: $length + +Content: $binary_string +EOF + ('RT/4.0.7 200 Ok', $body); +}; + +my $http_payload = + $reply_header . + "\n\n" . + $reply_body . + "\n\n" ; + +my $http_reply = + "HTTP/1.1 200 OK\r\n" . + "Content-Type: text/plain; charset=utf-8\r\n\r\n" . + $http_payload ; + +my $pipe = IO::Pipe->new; # Used to get port number +my $pid = fork; +die "cannot fork: $!" if not defined $pid; + +if (0 == $pid) { # Child + $pipe->writer; + { + package My::Web::Server; + use base qw(HTTP::Server::Simple::CGI); + sub handle_request { + print $http_reply; + } + # A hack to get HTTP::Server::Simple listen on ephemeral port. + # See RT#72987 + sub after_setup_listener { + use Socket; + my $sock = getsockname HTTP::Server::Simple::HTTPDaemon; + my ($port) = (sockaddr_in($sock))[0]; + $pipe->print("$port\n"); + $pipe->close; + } + } + my $server = My::Web::Server->new('00'); + alarm 120; # Just in case, don't hang people + $server->run; # Run until killed + die 'unreachable code'; +} + +$pipe->reader; +chomp(my $port = <$pipe>); +#diag("set up web server on port $port"); +$pipe->close; + +unless ($port && $port =~ /^\d+$/) { + kill 9, $pid; + waitpid $pid, 0; + plan skip_all => 'could not get port number from child, skipping all tests'; +} + +plan tests => 3; + +{ + my $res = HTTP::Response->parse( $http_reply ); + ok($res->content eq $http_payload, + 'self-test: HTTP::Response gives back correct payload'); +} + +my $rt = RT::Client::REST->new( + server => "http://127.0.0.1:$port", + timeout => 2, +); + +# avoid need to login +$rt->basic_auth_cb(sub { return }); + +{ + my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 1); + ok($res->{Content} eq $testfile_content, 'files match with undecoded option'); +} +{ + my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 0); + ok($res->{Content} eq $testfile_content, 'files match w/o undecoded option'); +} + +kill 9, $pid; +waitpid $pid, 0; +exit; From f294d6fffaf5c433be994a4a2709fab0a50f6c6e Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 11 Nov 2018 18:47:29 +1100 Subject: [PATCH 29/85] Bump version to 0.54 --- CHANGES | 6 +++++- dist.ini | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/CHANGES b/CHANGES index 35d606a..62d5b07 100644 --- a/CHANGES +++ b/CHANGES @@ -1,6 +1,10 @@ Revision history for Perl module RT::Client::REST -0.53 MOn Nov 05 2018 "Dean Hamstead" " +0.54 Mon Nov 12 2018 "Dean Hanstead" + - Fixes for whitespace handling in attachments RT127607 + - Fix edgecase for handling 401's RT127288 + +0.53 Mon Nov 05 2018 "Dean Hamstead" - Fix some tests on Windows - Various coding changes internally - Expose CC Addresses and Admin CC Addresses on Queues diff --git a/dist.ini b/dist.ini index 7fb26d0..76b6a21 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.53 +version = 0.54 author = Abhijit Menon-Sen author = Dmitri Tikhonov author = Damien "dams" Krotkine From d0b79931f4484f5de871d3f63ea36eed12ba90ae Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 8 Dec 2018 23:22:13 +1100 Subject: [PATCH 30/85] Fix from GH#18 --- lib/RT/Client/REST/Forms.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/RT/Client/REST/Forms.pm b/lib/RT/Client/REST/Forms.pm index 9ef8ee7..8251a40 100644 --- a/lib/RT/Client/REST/Forms.pm +++ b/lib/RT/Client/REST/Forms.pm @@ -79,7 +79,7 @@ sub form_parse { } $c .= "\n"; } - elsif ($state <= 1 && $line =~ m/^($field:\s)(.*)?$/) { + elsif ($state <= 1 && $line =~ m/^($field:\s?)(.*)?$/) { # Read a field: value specification. my $f = $1; my $value = $2; From 063c23ec7a02c9330920065dd245b1fc93ad9349 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 10 Dec 2018 23:40:19 +1100 Subject: [PATCH 31/85] Pod spelling mistake --- lib/RT/Client/REST/Forms.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/RT/Client/REST/Forms.pm b/lib/RT/Client/REST/Forms.pm index 8251a40..4259304 100644 --- a/lib/RT/Client/REST/Forms.pm +++ b/lib/RT/Client/REST/Forms.pm @@ -227,7 +227,7 @@ sub vpush { =item vsplit -"Normalise" a hash key that's known to be multi-valued. +"Normalize" a hash key that's known to be multi-valued. =cut From 84da711e3ec16aeaeddb67b36b397f29e97f6370 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 10 Dec 2018 23:55:08 +1100 Subject: [PATCH 32/85] Version 0.55 --- CHANGES | 9 ++++++--- dist.ini | 2 +- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/CHANGES b/CHANGES index 62d5b07..9787497 100644 --- a/CHANGES +++ b/CHANGES @@ -1,15 +1,18 @@ Revision history for Perl module RT::Client::REST -0.54 Mon Nov 12 2018 "Dean Hanstead" +0.55 Sat Dec 08 2018 "Dean Hamstead" + - Fix for GH#18 + +0.54 Mon Nov 12 2018 "Dean Hanstead" - Fixes for whitespace handling in attachments RT127607 - Fix edgecase for handling 401's RT127288 -0.53 Mon Nov 05 2018 "Dean Hamstead" +0.53 Mon Nov 05 2018 "Dean Hamstead" - Fix some tests on Windows - Various coding changes internally - Expose CC Addresses and Admin CC Addresses on Queues -0.52 Fri Apr 06 2018 "Dean Hamstead" +0.52 Fri Apr 06 2018 "Dean Hamstead" - Fix up lots of Pod Critic complaints - Fix up lots of Perl Critic complaints - Use Dist-Zilla for releases diff --git a/dist.ini b/dist.ini index 76b6a21..5c5d741 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.54 +version = 0.55 author = Abhijit Menon-Sen author = Dmitri Tikhonov author = Damien "dams" Krotkine From a1bb8cfd44632f940173e7af2e3331d0923cf0d1 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 24 Dec 2018 21:55:45 +1100 Subject: [PATCH 33/85] Fix for GH#18 --- lib/RT/Client/REST/Forms.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/RT/Client/REST/Forms.pm b/lib/RT/Client/REST/Forms.pm index 4259304..64de26f 100644 --- a/lib/RT/Client/REST/Forms.pm +++ b/lib/RT/Client/REST/Forms.pm @@ -84,7 +84,7 @@ sub form_parse { my $f = $1; my $value = $2; my $spaces = ' ' x length($f); - $f =~ s/:\s$//; + $f =~ s/:\s?$//; # Read continuation lines, if any. while (@lines && ($lines[0] eq '' || $lines[0] =~ m/^\s+/)) { From 7e11c346f4c290f4db29920bb9a0186273221696 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 24 Dec 2018 21:57:26 +1100 Subject: [PATCH 34/85] Bump to v0.56 --- CHANGES | 3 +++ dist.ini | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 9787497..b873813 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,8 @@ Revision history for Perl module RT::Client::REST +0.56 Mon Dec 24 2018 "Dean Hamstead" + - Fix for GH#18 (more fixes) + 0.55 Sat Dec 08 2018 "Dean Hamstead" - Fix for GH#18 diff --git a/dist.ini b/dist.ini index 5c5d741..61dbe17 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.55 +version = 0.56 author = Abhijit Menon-Sen author = Dmitri Tikhonov author = Damien "dams" Krotkine From f30b9d5716179fd381b13a83f1cc249ecc7c19f8 Mon Sep 17 00:00:00 2001 From: Byron Ellacott Date: Tue, 28 Apr 2020 15:51:34 +1000 Subject: [PATCH 35/85] Add SLA and SLADisabled attributes --- lib/RT/Client/REST/Queue.pm | 7 +++++++ lib/RT/Client/REST/Ticket.pm | 7 +++++++ t/22-ticket.t | 4 ++-- t/25-queue.t | 4 ++-- 4 files changed, 18 insertions(+), 4 deletions(-) diff --git a/lib/RT/Client/REST/Queue.pm b/lib/RT/Client/REST/Queue.pm index 9d26642..336fd18 100644 --- a/lib/RT/Client/REST/Queue.pm +++ b/lib/RT/Client/REST/Queue.pm @@ -115,6 +115,13 @@ sub _attributes {{ rest_name => 'CcAddresses', }, + sla_disabled => { + validation => { + type => SCALAR, + }, + rest_name => 'SLADisabled', + }, + }} =head1 ATTRIBUTES diff --git a/lib/RT/Client/REST/Ticket.pm b/lib/RT/Client/REST/Ticket.pm index 5557c75..54372b6 100644 --- a/lib/RT/Client/REST/Ticket.pm +++ b/lib/RT/Client/REST/Ticket.pm @@ -221,6 +221,13 @@ sub _attributes {{ rest_name => 'LastUpdated', is_datetime => 1, }, + + sla => { + validation => { + type => SCALAR, + }, + }, + }} =head1 ATTRIBUTES diff --git a/t/22-ticket.t b/t/22-ticket.t index 7b745ed..11fe248 100644 --- a/t/22-ticket.t +++ b/t/22-ticket.t @@ -4,7 +4,7 @@ use strict; use warnings; -use Test::More tests => 113; +use Test::More tests => 114; use Test::Exception; use constant METHODS => ( @@ -15,7 +15,7 @@ use constant METHODS => ( 'id', 'queue', 'owner', 'creator', 'subject', 'status', 'priority', 'initial_priority', 'final_priority', 'requestors', 'cc', 'admin_cc', 'created', 'starts', 'started', 'due', 'resolved', 'told', - 'time_estimated', 'time_worked', 'time_left', 'last_updated', + 'time_estimated', 'time_worked', 'time_left', 'last_updated', 'sla', ); BEGIN { diff --git a/t/25-queue.t b/t/25-queue.t index 5c767cd..8ee43fc 100644 --- a/t/25-queue.t +++ b/t/25-queue.t @@ -4,7 +4,7 @@ use strict; use warnings; -use Test::More tests => 16; +use Test::More tests => 17; use Test::Exception; use constant METHODS => ( @@ -12,7 +12,7 @@ use constant METHODS => ( # attrubutes: 'id', 'name', 'description', 'correspond_address', 'comment_address', - 'initial_priority', 'final_priority', 'default_due_in', + 'initial_priority', 'final_priority', 'default_due_in', 'sla_disabled', ); BEGIN { From 5df3a033f46b8050980cfb3987fc882f580e9d10 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Wed, 29 Apr 2020 07:03:58 +1000 Subject: [PATCH 36/85] Release v0.57 --- CHANGES | 5 ++++- dist.ini | 4 ++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/CHANGES b/CHANGES index b873813..16af8f0 100644 --- a/CHANGES +++ b/CHANGES @@ -1,12 +1,15 @@ Revision history for Perl module RT::Client::REST +0.57 Tue Apr 28 2020 "Dean Hamstead" + - PR#21 Add SLA and SLADisabled attributes which appeared in RT 4.4.3 + 0.56 Mon Dec 24 2018 "Dean Hamstead" - Fix for GH#18 (more fixes) 0.55 Sat Dec 08 2018 "Dean Hamstead" - Fix for GH#18 -0.54 Mon Nov 12 2018 "Dean Hanstead" +0.54 Mon Nov 12 2018 "Dean Hamstead" - Fixes for whitespace handling in attachments RT127607 - Fix edgecase for handling 401's RT127288 diff --git a/dist.ini b/dist.ini index 61dbe17..9c37186 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.56 +version = 0.57 author = Abhijit Menon-Sen author = Dmitri Tikhonov author = Damien "dams" Krotkine @@ -9,7 +9,7 @@ author = JLMARTIN author = SRVSH license = Perl_5 copyright_holder = Dmitri Tikhonov -copyright_year = 2018 +copyright_year = 2020 main_module = lib/RT/Client/REST.pm [@Basic] From 2bc46976f75380fbbd1ebaf50ca74121231eb633 Mon Sep 17 00:00:00 2001 From: Marco Pessotto Date: Fri, 22 Feb 2019 12:52:22 +0100 Subject: [PATCH 37/85] Report the current URI on UA errors. This improves greatly the debugging, instead of an opaque message Also let the module handle the redirections. There is some code in place which checks the 302, and states that only one redirect is supported. This makes sense, at it gives us more control about what's happening. However, the user agent already handles the redirections, unless instructed otherwise, making such code unreachable. This commit addresses this. Fix tests --- lib/RT/Client/REST.pm | 5 +-- t/86-redirect.t | 84 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 87 insertions(+), 2 deletions(-) create mode 100644 t/86-redirect.t diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index e1e6198..3b47a96 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -588,7 +588,7 @@ sub _submit { # "RT/3.0.1 401 Credentials required" if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) { RT::Client::REST::MalformedRTResponseException->throw( - 'Malformed RT response received from ' . $self->server, + 'Malformed RT response received from ' . $self->_uri($uri) ); } @@ -662,7 +662,7 @@ sub _submit { } else { RT::Client::REST::HTTPException->throw( code => $res->code, - message => $res->message, + message => $res->message . ' fetching ' . $self->_uri($uri), ); } @@ -676,6 +676,7 @@ sub _ua { $self->{_ua} = RT::Client::REST::HTTPClient->new( agent => $self->_ua_string, env_proxy => 1, + max_redirect => 1, ); if ($self->timeout) { $self->{_ua}->timeout($self->timeout); diff --git a/t/86-redirect.t b/t/86-redirect.t new file mode 100644 index 0000000..65282c0 --- /dev/null +++ b/t/86-redirect.t @@ -0,0 +1,84 @@ +#!perl +# +use strict; +use warnings; + +use Test::More; +use Data::Dumper; +use Error qw(:try); +use IO::Socket; +use RT::Client::REST; +plan tests => 2; + +my $server = IO::Socket::INET->new( + Type => SOCK_STREAM, + Reuse => 1, + Listen => 10, +) or die "Could not set up TCP server: $@"; + +my $port = $server->sockport; + +my $pid = fork; +die "cannot fork: $!" unless defined $pid; + +if (0 == $pid) { # Child + { + my $response = + "HTTP/1.1 302 Redirect\r\n" . + "Location: http://127.0.0.1:$port\r\n" . + "Content-Type: text/plain; charset=utf-8\r\n\r\n" . + "RT/42foo 200 this is a fake successful response header +header line 1 +header line 2 + +response text"; + my $client = $server->accept; + $client->write($response); + } + { + my $response = + "HTTP/1.1 302 Redirect\r\n" . + "Location: http://127.0.0.1:$port\r\n" . + "Content-Type: text/plain; charset=utf-8\r\n\r\n" . + "random string"; + my $client = $server->accept; + $client->write($response); + } + exit; +} + + +my $rt = RT::Client::REST->new( + server => "http://127.0.0.1:$port", + timeout => 2, +); +eval { + my $res = $rt->_submit("ticket/1", undef, { + user => 'a', + pass => 'b', + }); +}; +like $@, qr{fetching .*/REST/1.0/ticket/1}, "Double redirect dies meaningfully"; + +$pid = fork; +die "cannot fork: $!" unless defined $pid; + +if (0 == $pid) { # Child + { + my $response = + "HTTP/1.1 200 OK\r\n" . + "Location: http://127.0.0.1:$port\r\n" . + "Content-Type: text/plain; charset=utf-8\r\n\r\n" . + "response text"; + my $client = $server->accept; + $client->write($response); + } + exit; +} +eval { + my $res = $rt->_submit("ticket/1", undef, { + user => 'a', + pass => 'b', + }); +}; +like $@, qr{Malformed.*/REST/1.0/ticket/1}, "Random data is reported correctly"; From 08db04ab5dae9a8bebc02ae3a7d20b75d3836fe7 Mon Sep 17 00:00:00 2001 From: Marco Pessotto Date: Fri, 22 Feb 2019 13:20:01 +0100 Subject: [PATCH 38/85] Show the start of the response in the error message --- lib/RT/Client/REST.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 3b47a96..7fe5ad0 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -588,7 +588,8 @@ sub _submit { # "RT/3.0.1 401 Credentials required" if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) { RT::Client::REST::MalformedRTResponseException->throw( - 'Malformed RT response received from ' . $self->_uri($uri) + 'Malformed RT response received from ' . $self->_uri($uri) . + " with this response: " . substr($text || '', 0, 200) . '....' ); } From 53029d1babcb5818852f7c1cb6ff4b553f481f99 Mon Sep 17 00:00:00 2001 From: Marco Pessotto Date: Mon, 4 Mar 2019 11:29:09 +0100 Subject: [PATCH 39/85] Opt-in for verbose errors and UA arguments --- lib/RT/Client/REST.pm | 32 ++++++++++++++++++++++++++------ t/86-redirect.t | 18 ++++++++++++++---- 2 files changed, 40 insertions(+), 10 deletions(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 7fe5ad0..082ef35 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -33,7 +33,7 @@ use RT::Client::REST::Forms; use RT::Client::REST::HTTPClient; # Generate accessors/mutators -for my $method (qw(server _cookie timeout)) { +for my $method (qw(server _cookie timeout verbose_errors user_agent_args)) { no strict 'refs'; ## no critic (ProhibitNoStrict) *{__PACKAGE__ . '::' . $method} = sub { my $self = shift; @@ -587,10 +587,12 @@ sub _submit { # Example: # "RT/3.0.1 401 Credentials required" if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) { - RT::Client::REST::MalformedRTResponseException->throw( - 'Malformed RT response received from ' . $self->_uri($uri) . - " with this response: " . substr($text || '', 0, 200) . '....' - ); + my $err_msg = 'Malformed RT response received from ' . $self->server; + if ($self->verbose_errors) { + $err_msg = "Malformed RT response received from " . $self->_uri($uri) . + " with this response: " . substr($text || '', 0, 200) . '....'; + } + RT::Client::REST::MalformedRTResponseException->throw($err_msg); } # Our caller can pretend that the server returned a custom HTTP @@ -661,9 +663,13 @@ sub _submit { $self->server($new_server); return $self->_submit($uri, $content, $auth); } else { + my $err_msg = $res->message; + if ($self->verbose_errors) { + $err_msg = $res->message . ' fetching ' . $self->_uri($uri); + }; RT::Client::REST::HTTPException->throw( code => $res->code, - message => $res->message . ' fetching ' . $self->_uri($uri), + message => $err_msg, ); } @@ -674,10 +680,14 @@ sub _ua { my $self = shift; unless (exists($self->{_ua})) { + + my $args = $self->user_agent_args || {}; + die "user_agent_args must be a hashref" unless ref($args) eq 'HASH'; $self->{_ua} = RT::Client::REST::HTTPClient->new( agent => $self->_ua_string, env_proxy => 1, max_redirect => 1, + %$args, ); if ($self->timeout) { $self->{_ua}->timeout($self->timeout); @@ -966,6 +976,11 @@ returns username and password: return ($username, $password); } +=item B + +A hashref which will be passed to the user agent's constructor for +maximum flexibility. + =item B A logger object. It should be able to debug(), info(), warn() and @@ -983,6 +998,11 @@ Something like this will get you started: logger => $log ); +=item B + +On user-agent errors, report some more information about what is going +wrong. Defaults are pretty laconic about the "Malformed RT response". + =back =item login (username => 'root', password => 'password') diff --git a/t/86-redirect.t b/t/86-redirect.t index 65282c0..6024dc7 100644 --- a/t/86-redirect.t +++ b/t/86-redirect.t @@ -8,7 +8,7 @@ use Data::Dumper; use Error qw(:try); use IO::Socket; use RT::Client::REST; -plan tests => 2; +plan tests => 5; my $server = IO::Socket::INET->new( Type => SOCK_STREAM, @@ -49,9 +49,19 @@ response text"; my $rt = RT::Client::REST->new( - server => "http://127.0.0.1:$port", - timeout => 2, -); + server => "http://127.0.0.1:$port", + timeout => 2, + verbose_errors => 1, + user_agent_args => { + agent => 'Secret agent', + max_redirect => 0, + }, + ); + +is $rt->_ua->agent, 'Secret agent', "Ua correctly initialized"; +is $rt->_ua->max_redirect, 0, "Ua correctly initialized with max redirect"; +ok $rt->verbose_errors, "Verbose errors set"; + eval { my $res = $rt->_submit("ticket/1", undef, { user => 'a', From 55d69bfe4ae9c612c19d2e7a9dfe7eafa943ec1f Mon Sep 17 00:00:00 2001 From: Marco Pessotto Date: Mon, 4 Mar 2019 15:50:51 +0100 Subject: [PATCH 40/85] Expose the user agent object to the API Rationale: for systems with custom code, it should be possible to set an header which should be passed at each request. --- lib/RT/Client/REST.pm | 9 +++++++++ t/86-redirect.t | 4 ++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 082ef35..a29c359 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -700,6 +700,11 @@ sub _ua { return $self->{_ua}; } +sub user_agent { + shift->_ua; +} + + sub basic_auth_cb { my $self = shift; @@ -981,6 +986,10 @@ returns username and password: A hashref which will be passed to the user agent's constructor for maximum flexibility. +=item B + +Accessor to the user_agent object. + =item B A logger object. It should be able to debug(), info(), warn() and diff --git a/t/86-redirect.t b/t/86-redirect.t index 6024dc7..666f631 100644 --- a/t/86-redirect.t +++ b/t/86-redirect.t @@ -58,8 +58,8 @@ my $rt = RT::Client::REST->new( }, ); -is $rt->_ua->agent, 'Secret agent', "Ua correctly initialized"; -is $rt->_ua->max_redirect, 0, "Ua correctly initialized with max redirect"; +is $rt->user_agent->agent, 'Secret agent', "Ua correctly initialized"; +is $rt->user_agent->max_redirect, 0, "Ua correctly initialized with max redirect"; ok $rt->verbose_errors, "Verbose errors set"; eval { From 35c657c55b4f74a5d5a66aaeaa9210adb665a3e3 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 5 May 2018 23:55:51 +1000 Subject: [PATCH 41/85] 'Not set' keyword is only relevant when reading dates (see rt's RT/Date.pm) --- lib/RT/Client/REST/Object.pm | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/lib/RT/Client/REST/Object.pm b/lib/RT/Client/REST/Object.pm index 586874e..4a8d087 100644 --- a/lib/RT/Client/REST/Object.pm +++ b/lib/RT/Client/REST/Object.pm @@ -419,11 +419,11 @@ sub to_form { my $value; if (exists($attributes->{$attr}{value2form})) { - $value = $attributes->{$attr}{value2form}($self->$attr); + $value = $attributes->{$attr}{value2form}($self->$attr) } elsif ($attributes->{$attr}{list}) { - $value = join(',', $self->$attr); + $value = join(',', $self->$attr) } else { - $value = (defined($self->$attr) ? $self->$attr : 'Not set'); + $value = (defined($self->$attr) ? $self->$attr : ''); } $hash{$rest_name} = $value; @@ -453,7 +453,7 @@ sub from_form { unless ('HASH' eq ref($hash)) { RT::Client::REST::Object::InvalidValueException->throw( - "Expecting a hash reference as argument to 'from_form'", + q|Expecting a hash reference as argument to 'from_form'|, ); } @@ -463,10 +463,10 @@ sub from_form { my $attributes = $self->_attributes; my %rest2attr; # Mapping of REST names to our attributes; - while (my ($attr, $value) = each(%$attributes)) { + while (my ($attr, $settings) = each(%$attributes)) { my $rest_name = (exists($attributes->{$attr}{rest_name}) ? lc($attributes->{$attr}{rest_name}) : $attr); - $rest2attr{$rest_name} = $attr; + $rest2attr{$rest_name} = [ $attr, $settings ]; } # Now set attributes: @@ -489,11 +489,12 @@ sub from_form { next; } - if ($value =~ m/not set/i) { + my ( $method, $settings) = @{$rest2attr{$key}}; + + if ($settings->{is_datetime} and $value eq 'Not set') { $value = undef; } - my $method = $rest2attr{$key}; if (exists($attributes->{$method}{form2value})) { $value = $attributes->{$method}{form2value}($value); } elsif ($attributes->{$method}{list}) { From 207da2b5c3facdb8d2d8654193b06eb61d37d9b7 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 1 May 2020 08:39:18 +1000 Subject: [PATCH 42/85] Add mailmap file so that CONTRIBUTORS is generated nicely --- .mailmap | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 .mailmap diff --git a/.mailmap b/.mailmap new file mode 100644 index 0000000..bbdf6c3 --- /dev/null +++ b/.mailmap @@ -0,0 +1,8 @@ +Dean Hamstead +Dean Hamstead +Dmitri Tikhonov +Dmitri Tikhonov +Dmitri Tikhonov +Marco Pessotto +Sarvesh D +Abhijit Menon-Sen From 724eac6af175c71861ea724dd9420fcf48928a9e Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 1 May 2020 08:39:35 +1000 Subject: [PATCH 43/85] Update README.md file to point to the CONTRIBUTORS file for Author info --- README.md | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 56c1dcc..a957019 100644 --- a/README.md +++ b/README.md @@ -19,10 +19,9 @@ To install: make install Author: - Dmitri Tikhonov + See CONTRIBUTORS file RT::Client::REST is based on 'rt' command-line utility distributed - with RT 3.x written by Abhijit Menon-Sen and - donated to RT project. + with RT 3.x License: This module is licensed under the same terms as perl itself. From d485b470d1b6bb7c004454387dc6312ae66f6c62 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 1 May 2020 08:40:02 +1000 Subject: [PATCH 44/85] Add info for v0.58 --- CHANGES | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGES b/CHANGES index 16af8f0..5895a52 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,9 @@ Revision history for Perl module RT::Client::REST +0.58 Thu Apr 30 2020 "Dean Hamstead" + - RT118729 correct bug when "not set" is in textA + - PR#19 Report UA, URI, and better errors when you opt in. Thanks @melmothx + 0.57 Tue Apr 28 2020 "Dean Hamstead" - PR#21 Add SLA and SLADisabled attributes which appeared in RT 4.4.3 From ec82b9db8758878b6c98062b1151ed2c671a97d7 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 1 May 2020 08:40:55 +1000 Subject: [PATCH 45/85] Correct mailmap for my emails --- .mailmap | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.mailmap b/.mailmap index bbdf6c3..1d11ced 100644 --- a/.mailmap +++ b/.mailmap @@ -1,5 +1,5 @@ Dean Hamstead -Dean Hamstead +Dean Hamstead Dmitri Tikhonov Dmitri Tikhonov Dmitri Tikhonov From 7fe15da8acf2af0221f80645e5762aa227a82022 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 1 May 2020 08:43:20 +1000 Subject: [PATCH 46/85] Have podweaver add the AUTHORS based on Git --- lib/RT/Client/REST.pm | 8 -------- 1 file changed, 8 deletions(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index a29c359..d077de1 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -1332,12 +1332,4 @@ Most likely. Please report. B does not (at the moment, see TODO file) retrieve forms from RT server, which is either good or bad, depending how you look at it. -=head1 AUTHORS - -Original /usr/bin/rt was written by Abhijit Menon-Sen . rt -was later converted to this module by Dmitri Tikhonov . -In January of 2008, Damien "dams" Krotkine joined as the -project's co-maintainer. JLMARTIN has become co-maintainer as of March 2010. -SRVSH became a co-maintainer in November 2015. - =cut From 3af5031a10e8e80c0bc5c38a5f632e0d79ec24fd Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 1 May 2020 08:44:18 +1000 Subject: [PATCH 47/85] Thats it for v0.58 --- dist.ini | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/dist.ini b/dist.ini index 9c37186..00e512f 100755 --- a/dist.ini +++ b/dist.ini @@ -1,12 +1,5 @@ name = RT-Client-REST -version = 0.57 -author = Abhijit Menon-Sen -author = Dmitri Tikhonov -author = Damien "dams" Krotkine -author = Dean Hamstead -author = Miquel Ruiz -author = JLMARTIN -author = SRVSH +version = 0.58 license = Perl_5 copyright_holder = Dmitri Tikhonov copyright_year = 2020 @@ -20,6 +13,7 @@ main_module = lib/RT/Client/REST.pm [GithubMeta] [MetaJSON] [MetaTests] +[ContributorsFile] ; [TravisYML] # use our own for now [Encoding] @@ -53,11 +47,13 @@ finder = :InstallModules ; prevents test inputs being flagged [PkgVersion] ; [PodVersion] ; PodWeaver does this and more [PodWeaver] +[CopyrightYearFromGit] ; Stuff that plays with Git [Git::CheckFor::CorrectBranch] ; ensure on master branch [Git::Remote::Check] [Git::Tag] +[Git::Contributors] ; Clear the travis.yml file when rolling a tarball [PruneCruft] From 86a1b8c478464458722f16c683ed42cf6e58d2b5 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 1 May 2020 08:58:16 +1000 Subject: [PATCH 48/85] Adjust markdown in README.md file --- README.md | 48 +++++++++++++++++++++++++++++++++--------------- 1 file changed, 33 insertions(+), 15 deletions(-) diff --git a/README.md b/README.md index a957019..cd2fbd5 100644 --- a/README.md +++ b/README.md @@ -1,27 +1,45 @@ -# This is README file for RT::Client::REST distribution. +RT::Client::REST +================ -RT::Client::REST is a set of object-oriented Perl modules designed to +`RT::Client::REST` is a set of object-oriented Perl modules designed to make communicating with RT using REST protocol easy. Most of the features have been implemented and tested with rt 3.6.0 and later. Please see POD for details on usage. -To build: - perl Makefile.PL - make +To build +-------- -To test, you will need Test::Exception -- as this is an object-oriented +Download the latest release from the CPAN, then extract and run: + +```shell +perl Makefile.PL +make +``` + +To test, you will need `Test::Exception` -- as this is an object-oriented distribution, a lot of tests deal with making sure that the exceptions that are thrown are correct, so I do not (and you do not) want to skip those: - make test -To install: - make install +```shell +make test +``` + +To install +---------- + +```shell +make install +``` + +Author +------ + +See **CONTRIBUTORS** file + +`RT::Client::REST` is based on 'rt' command-line utility distributed with RT 3.x -Author: - See CONTRIBUTORS file - RT::Client::REST is based on 'rt' command-line utility distributed - with RT 3.x +License +------- -License: - This module is licensed under the same terms as perl itself. +This module is licensed under the same terms as perl itself. From 7d13fac0e50d19e9115c6d90fbcbe3728173e3aa Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Thu, 30 Apr 2020 23:12:26 -0700 Subject: [PATCH 49/85] Add weaver.ini so we can add CONTRIBUTORS to pod --- weaver.ini | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 weaver.ini diff --git a/weaver.ini b/weaver.ini new file mode 100644 index 0000000..c70e6d0 --- /dev/null +++ b/weaver.ini @@ -0,0 +1,4 @@ +[@Default] +[-Transformer] +transformer = List +[Contributors] From 33be70e9430a19a3b69c7e6caeebc38dc8803531 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Thu, 30 Apr 2020 23:12:49 -0700 Subject: [PATCH 50/85] Adjust dist.ini to prune files better --- dist.ini | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/dist.ini b/dist.ini index 00e512f..00ff31e 100755 --- a/dist.ini +++ b/dist.ini @@ -2,7 +2,6 @@ name = RT-Client-REST version = 0.58 license = Perl_5 copyright_holder = Dmitri Tikhonov -copyright_year = 2020 main_module = lib/RT/Client/REST.pm [@Basic] @@ -48,6 +47,7 @@ finder = :InstallModules ; prevents test inputs being flagged ; [PodVersion] ; PodWeaver does this and more [PodWeaver] [CopyrightYearFromGit] +[AuthorsFromGit] ; Stuff that plays with Git [Git::CheckFor::CorrectBranch] ; ensure on master branch @@ -55,9 +55,9 @@ finder = :InstallModules ; prevents test inputs being flagged [Git::Tag] [Git::Contributors] -; Clear the travis.yml file when rolling a tarball +[PruneFiles] +filename = weaver.ini [PruneCruft] -except = ^\.travis.yml [Clean] From 97cf9465265dface51dfefd49274472846231643 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 1 May 2020 23:38:17 -0700 Subject: [PATCH 51/85] Add badge image thingies --- README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/README.md b/README.md index cd2fbd5..4b3078d 100644 --- a/README.md +++ b/README.md @@ -43,3 +43,6 @@ License ------- This module is licensed under the same terms as perl itself. + +[![Build Status](https://travis-ci.org/RT-Client-REST/RT-Client-REST.svg?branch=master)](https://travis-ci.org/RT-Client-REST/RT-Client-REST) +[![CPAN version](https://badge.fury.io/pl/RT-Client-REST.svg)](https://metacpan.org/pod/RT::Client::REST) From 28db5f63bd413de147f5884a656eebde0b57e0a3 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 1 May 2020 23:44:25 -0700 Subject: [PATCH 52/85] Adjust dist.ini so travis is ok --- dist.ini | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/dist.ini b/dist.ini index 00ff31e..8e9f223 100755 --- a/dist.ini +++ b/dist.ini @@ -25,7 +25,7 @@ critic_config = t/.perlcriticrc ;[PerlTidy] ;perltidyrc = t/.perltidyrc [Test::Compile] -[Test::Kwalitee] +[Test::Kwalitee::Extra] [Test::EOF] [Test::EOL] finder = :InstallModules ; prevents test inputs being flagged @@ -87,3 +87,6 @@ Test::Exception = 0 HTTP::Server::Simple = 0.44 HTTP::Server::Simple::CGI = 0 HTTP::Server::Simple::CGI::Environment = 0 + +[Prereqs / DevelopRequires] +Dist::Zilla::Plugin::Git::Contributors = 0 From c6a489cb8bb37e14a485126ffccbe0267edf5925 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 2 May 2020 00:09:59 -0700 Subject: [PATCH 53/85] Update dist.ini --- dist.ini | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/dist.ini b/dist.ini index 8e9f223..eb7fd33 100755 --- a/dist.ini +++ b/dist.ini @@ -88,5 +88,4 @@ HTTP::Server::Simple = 0.44 HTTP::Server::Simple::CGI = 0 HTTP::Server::Simple::CGI::Environment = 0 -[Prereqs / DevelopRequires] -Dist::Zilla::Plugin::Git::Contributors = 0 +; authurdep Dist::Zilla::Plugin::Git::Contributors = 0 From 3e811e9ce688b785799d08bb9c644b7976cd80e6 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 2 May 2020 00:14:40 -0700 Subject: [PATCH 54/85] Fix up authordeps --- dist.ini | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist.ini b/dist.ini index eb7fd33..a3089ee 100755 --- a/dist.ini +++ b/dist.ini @@ -88,4 +88,4 @@ HTTP::Server::Simple = 0.44 HTTP::Server::Simple::CGI = 0 HTTP::Server::Simple::CGI::Environment = 0 -; authurdep Dist::Zilla::Plugin::Git::Contributors = 0 +; authordep Pod::Weaver::Section::Contributors = 0 From 3cabfe64116a37b3d7fea610de8a5b7ee60824d8 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 2 May 2020 00:22:03 -0700 Subject: [PATCH 55/85] Add more authordeps for travis --- dist.ini | 1 + 1 file changed, 1 insertion(+) diff --git a/dist.ini b/dist.ini index a3089ee..4d4b13e 100755 --- a/dist.ini +++ b/dist.ini @@ -89,3 +89,4 @@ HTTP::Server::Simple::CGI = 0 HTTP::Server::Simple::CGI::Environment = 0 ; authordep Pod::Weaver::Section::Contributors = 0 +; authordep Pod::Elemental::Transformer::List = 0 From 74a7442c978610dfab0e43b93ba066d20276741d Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 2 May 2020 00:58:42 -0700 Subject: [PATCH 56/85] Add more Tests via dist.ini --- dist.ini | 3 +++ 1 file changed, 3 insertions(+) diff --git a/dist.ini b/dist.ini index 4d4b13e..00f9da7 100755 --- a/dist.ini +++ b/dist.ini @@ -28,11 +28,13 @@ critic_config = t/.perlcriticrc [Test::Kwalitee::Extra] [Test::EOF] [Test::EOL] +[Test::Legal] finder = :InstallModules ; prevents test inputs being flagged [Test::NoTabs] [Test::PAUSE::Permissions] [Test::Portability] [Test::PodSpelling] +[Test::Pod::No404s] [Test::ReportPrereqs] [Test::NoBreakpoints] [Test::UnusedVars] @@ -41,6 +43,7 @@ finder = :InstallModules ; prevents test inputs being flagged [PodSyntaxTests] [RunExtraTests] [CheckChangeLog] +[SchwartzRatio] ; Stuff that changes my code [PkgVersion] From ab7b5ff88f087b1f4a0fba464db8dbc4a43403bb Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 3 May 2020 08:45:35 -0700 Subject: [PATCH 57/85] Update travis for deprecated keys etc --- .travis.yml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index db11c1b..93ac6b0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,8 +1,7 @@ -# not actually required, just because Archive::Zip tests fail -sudo: required language: perl os: - linux +dist: xenial perl: - 'blead' - '5.26' @@ -20,7 +19,7 @@ env: - AUTHOR_TESTING=1 - AUTOMATED_TESTING=1 - RELEASE_TESTING=0 -matrix: +jobs: allow_failures: - perl: 'blead' - perl: '5.8' From fd0390852cb21c12406b5ddb04223016536b08ae Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 3 May 2020 08:49:10 -0700 Subject: [PATCH 58/85] Add new perl versions --- .travis.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.travis.yml b/.travis.yml index 93ac6b0..19cf188 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,6 +4,8 @@ os: dist: xenial perl: - 'blead' + - '5.30' + - '5.28' - '5.26' - '5.24' - '5.22' From 908d5d0909e9d7ada2b40192407123230513a5ea Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 3 May 2020 22:45:52 -0700 Subject: [PATCH 59/85] Sometimes PodCoverageTests think LOGGER_METHODS is a vanilla sub --- lib/RT/Client/REST.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index d077de1..1cced6e 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -721,6 +721,9 @@ sub basic_auth_cb { return $self->{_basic_auth_cb}; } +# Sometimes PodCoverageTests think LOGGER_METHODS is a vanilla sub +=for Pod::Coverage LOGGER_METHODS + use constant LOGGER_METHODS => (qw(debug warn info error)); sub logger { From 4ace16d7e79ee0d44aaa70d77a82df7c3fa899f3 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 3 May 2020 22:56:22 -0700 Subject: [PATCH 60/85] Fix pod --- lib/RT/Client/REST.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 1cced6e..a821443 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -724,6 +724,8 @@ sub basic_auth_cb { # Sometimes PodCoverageTests think LOGGER_METHODS is a vanilla sub =for Pod::Coverage LOGGER_METHODS +=cut + use constant LOGGER_METHODS => (qw(debug warn info error)); sub logger { From 4c051c9cc8123de141d10fe0ad716718dea668f6 Mon Sep 17 00:00:00 2001 From: DJ Stauffer Date: Wed, 6 May 2020 17:32:50 -0500 Subject: [PATCH 61/85] Fixes 'uninitialized value' message when calling get_attachments_metadata. I was getting "Use of uninitialized value $c[1] in string eq at /usr/share/perl5/RT/Client/REST.pm line 177." when calling get_attachments_metadata. This commit checks for the value to be defined first, thus preventing the unwanted message. --- lib/RT/Client/REST.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index a821443..16f4b98 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -174,7 +174,7 @@ sub get_attachments_metadata { return map { # Matches: '50008989: (Unnamed) (text/plain / 1.9k),' my @c = $_ =~ m/^\s*(\d+):\s+(.+)\s+\(([^\s]+)\s+\/\s+([^\s]+)\)\s*,\s*$/; - { id => $c[0], Filename => $c[1] eq '(Unnamed)' ? undef : $c[1], Type => $c[2], Size => $c[3] }; + { id => $c[0], Filename => ( defined($c[1]) && ( $c[1] eq '(Unnamed)' ) ) ? undef : $c[1], Type => $c[2], Size => $c[3] }; } split(/\n/, $k->{Attachments}); } From 069014eb3028423d817157352563c3bf925d89c5 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 4 May 2020 12:50:21 -0700 Subject: [PATCH 62/85] Update changelog --- CHANGES | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGES b/CHANGES index 5895a52..cb58eef 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,10 @@ Revision history for Perl module RT::Client::REST +0.69 Mon May 5 2020 "Dean Hamstead" + - Worked around what appears to be a bug in PodChecker in perl 5.20 + - Adjusted travis and dist.ini + - No functional changes + 0.58 Thu Apr 30 2020 "Dean Hamstead" - RT118729 correct bug when "not set" is in textA - PR#19 Report UA, URI, and better errors when you opt in. Thanks @melmothx From c2063362f5d4d5cff9ea08c23057b51082a9469a Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 4 May 2020 12:50:53 -0700 Subject: [PATCH 63/85] fix it --- CHANGES | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index cb58eef..3ef9461 100644 --- a/CHANGES +++ b/CHANGES @@ -1,6 +1,6 @@ Revision history for Perl module RT::Client::REST -0.69 Mon May 5 2020 "Dean Hamstead" +0.59 Mon May 5 2020 "Dean Hamstead" - Worked around what appears to be a bug in PodChecker in perl 5.20 - Adjusted travis and dist.ini - No functional changes From 7405515ded423d00dd47fcd1c375a794b63c71ab Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 4 May 2020 12:51:29 -0700 Subject: [PATCH 64/85] Version 0.59 --- dist.ini | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist.ini b/dist.ini index 00f9da7..764861e 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.58 +version = 0.59 license = Perl_5 copyright_holder = Dmitri Tikhonov main_module = lib/RT/Client/REST.pm From 7d81d8521489e07d735d4221f9d264bb5d3e0c40 Mon Sep 17 00:00:00 2001 From: DJ Stauffer Date: Wed, 6 May 2020 18:22:39 -0500 Subject: [PATCH 65/85] Fix get_attachments_metadata missing the last attachment's data when many exist. When calling get_attachments_metadata, data from the last attachment was being missed due to a parsing problem. --- lib/RT/Client/REST.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 16f4b98..fa482a6 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -173,7 +173,7 @@ sub get_attachments_metadata { } return map { # Matches: '50008989: (Unnamed) (text/plain / 1.9k),' - my @c = $_ =~ m/^\s*(\d+):\s+(.+)\s+\(([^\s]+)\s+\/\s+([^\s]+)\)\s*,\s*$/; + my @c = $_ =~ m/^\s*(\d+):\s+(.+)\s+\(([^\s]+)\s+\/\s+([^\s]+)\)\s*,?\s*$/; { id => $c[0], Filename => ( defined($c[1]) && ( $c[1] eq '(Unnamed)' ) ) ? undef : $c[1], Type => $c[2], Size => $c[3] }; } split(/\n/, $k->{Attachments}); } From f19e7edee411c29414d2338acf0f6865b89e0ff1 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Thu, 7 May 2020 00:01:25 -0700 Subject: [PATCH 66/85] Update changes for 0.60 --- CHANGES | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 3ef9461..087ddff 100644 --- a/CHANGES +++ b/CHANGES @@ -1,6 +1,10 @@ Revision history for Perl module RT::Client::REST -0.59 Mon May 5 2020 "Dean Hamstead" +0.60 Wed May 6 2020 "Dean Hamstead" + - PR#25 GH#23 Fix get_attachments_metadata + - PR#24 GH#22 Fix get_attachments_metadata + +0.59 Mon May 4 2020 "Dean Hamstead" - Worked around what appears to be a bug in PodChecker in perl 5.20 - Adjusted travis and dist.ini - No functional changes From 952fc314df2ffc3b8f9b9e4c0a7392db5281eede Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Thu, 7 May 2020 00:01:49 -0700 Subject: [PATCH 67/85] Bump version --- dist.ini | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist.ini b/dist.ini index 764861e..b4c8d10 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.59 +version = 0.60 license = Perl_5 copyright_holder = Dmitri Tikhonov main_module = lib/RT/Client/REST.pm From 43db86be26da849eed610b577c8768ca418d0e84 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 10 May 2020 18:25:40 -0700 Subject: [PATCH 68/85] Add kritika badge just for fun --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 4b3078d..2f3dbf7 100644 --- a/README.md +++ b/README.md @@ -46,3 +46,4 @@ This module is licensed under the same terms as perl itself. [![Build Status](https://travis-ci.org/RT-Client-REST/RT-Client-REST.svg?branch=master)](https://travis-ci.org/RT-Client-REST/RT-Client-REST) [![CPAN version](https://badge.fury.io/pl/RT-Client-REST.svg)](https://metacpan.org/pod/RT::Client::REST) +[![Kritika Analysis Status](https://kritika.io/users/djzort/repos/2034482163273651/heads/master/status.svg)](https://kritika.io/users/djzort/repos/2034482163273651/heads/master/) From 37c19dadd0a91561ea5f44af499efd68d7c72ec3 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Thu, 8 Sep 2022 23:20:40 -0700 Subject: [PATCH 69/85] Swap to gh issues --- dist.ini | 1 + 1 file changed, 1 insertion(+) diff --git a/dist.ini b/dist.ini index b4c8d10..9bbf187 100755 --- a/dist.ini +++ b/dist.ini @@ -10,6 +10,7 @@ main_module = lib/RT/Client/REST.pm [ModuleBuild] [CPANFile] [GithubMeta] +issues = 1 [MetaJSON] [MetaTests] [ContributorsFile] From 04618c9a426c1e64b1a6542981128161a2602e85 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Thu, 8 Sep 2022 23:23:06 -0700 Subject: [PATCH 70/85] Remove travis as its dead --- .travis.yml | 51 --------------------------------------------------- 1 file changed, 51 deletions(-) delete mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 19cf188..0000000 --- a/.travis.yml +++ /dev/null @@ -1,51 +0,0 @@ -language: perl -os: - - linux -dist: xenial -perl: - - 'blead' - - '5.30' - - '5.28' - - '5.26' - - '5.24' - - '5.22' - - '5.20' - - '5.18' - - '5.16' - - '5.14' - - '5.12' - - '5.10' - - '5.8' -env: - global: - - AUTHOR_TESTING=1 - - AUTOMATED_TESTING=1 - - RELEASE_TESTING=0 -jobs: - allow_failures: - - perl: 'blead' - - perl: '5.8' - fast_finish: true - include: - - perl: '5.26' - env: COVERAGE=1 -before_install: - - git config --global user.name "TravisCI" - - git config --global user.email $HOSTNAME":not-for-mail@travis-ci.org" - - git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers - - source ~/travis-perl-helpers/init - - build-perl - - perl -V - - build-dist - - cd $BUILD_DIR -install: - - perl -M5.014 -e1 2>/dev/null || cpan-install Dist::Zilla@5.047 - - cpan-install --deps - # - cpanm --quiet --notest --skip-satisfied Dist::Zilla - # - "dzil authordeps --missing | grep -vP '[^\\w:]' | xargs -n 5 -P 10 cpanm --quiet --notest" - # - "dzil listdeps --author --missing | grep -vP '[^\\w:]' | cpanm --verbose" -script: - - perl Build.PL - - ./Build - - prove -b -r -s -j1 $(test-files) - # - dzil smoke --release --author From 78a504e68d301bdd58a6e49bd01fc15615028afd Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 24 Sep 2022 16:43:05 -0700 Subject: [PATCH 71/85] Try to preserve newlines at the end of attachments --- lib/RT/Client/REST/Forms.pm | 46 ++++++++++++++++++------- t/50-forms.t | 67 ++++++++++++++++++++++++++++--------- 2 files changed, 86 insertions(+), 27 deletions(-) diff --git a/lib/RT/Client/REST/Forms.pm b/lib/RT/Client/REST/Forms.pm index 64de26f..c5413e1 100644 --- a/lib/RT/Client/REST/Forms.pm +++ b/lib/RT/Client/REST/Forms.pm @@ -16,6 +16,8 @@ use vars qw(@EXPORT @ISA); my $CF_name = q%[#\s\w:()?/-]+%; my $field = qr/[a-z][\w-]*|C(?:ustom)?F(?:ield)?-$CF_name|CF\.\{$CF_name}/i; +# always 9 https://rt-wiki.bestpractical.com/wiki/REST#Ticket_Attachments +my $spaces = ' ' x 9; =head2 METHODS @@ -48,7 +50,7 @@ Returns a reference to an array of parsed forms. =cut sub form_parse { - my @lines = split /\n/, shift; + my @lines = split /(?<=\n)/, shift; my $state = 0; my @forms = (); my ($c, $o, $k, $e) = ('', [], {}, ''); @@ -57,9 +59,9 @@ sub form_parse { while (@lines) { my $line = shift @lines; - next LINE if $line eq ''; + next LINE if $line eq "\n"; - if ($line eq '--') { + if ($line eq "--\n") { # We reached the end of one form. We'll ignore it if it was # empty, and store it otherwise, errors and all. if ($e || $c || @$o) { @@ -67,44 +69,64 @@ sub form_parse { $c = ''; $o = []; $k = {}; $e = ''; } $state = 0; + next LINE } - elsif ($state != -1) { + + if ($state != -1) { + if ($state == 0 && $line =~ m/^#/) { # Read an optional block of comments (only) at the start # of the form. $state = 1; $c = $line; while (@lines && $lines[0] =~ m/^#/) { - $c .= "\n" . shift @lines; + $c .= shift @lines; } - $c .= "\n"; + next LINE } - elsif ($state <= 1 && $line =~ m/^($field:\s?)(.*)?$/) { + + if ($state <= 1 && $line =~ m/^($field: )(.*)?$/s) { # Read a field: value specification. my $f = $1; my $value = $2; - my $spaces = ' ' x length($f); - $f =~ s/:\s?$//; + $f =~ s/: ?$//; # Read continuation lines, if any. - while (@lines && ($lines[0] eq '' || $lines[0] =~ m/^\s+/)) { + while (@lines && ($lines[0] eq "\n" || $lines[0] =~ m/^ +/)) { my $l = shift @lines; $l =~ s/^$spaces//; - $value .= "\n" . $l + $value .= $l + } + + # `Content` is always supposed to be followed by three new lines + # ... but this doesnt behave as documented + # https://rt-wiki.bestpractical.com/wiki/REST#Ticket_Attachments + if ($f eq 'Content') { + $value =~ s/\n\n\n?$//g + } + # Chomp everything else + else { + chomp $value } push(@$o, $f) unless exists $k->{$f}; vpush($k, $f, $value); $state = 1; + + next LINE } - elsif ($line !~ m/^#/) { + + if ($line !~ m/^#/) { # We've found a syntax error, so we'll reconstruct the # form parsed thus far, and add an error marker. (>>) $state = -1; $e = form_compose([[ '', $o, $k, '' ]]); $e.= $line =~ m/^>>/ ? "$line\n" : ">> $line\n"; + next LINE } + + # line will be ignored } else { # We saw a syntax error earlier, so we'll accumulate the diff --git a/t/50-forms.t b/t/50-forms.t index d98cab6..0ac13c1 100644 --- a/t/50-forms.t +++ b/t/50-forms.t @@ -6,24 +6,29 @@ use strict; use warnings; -use Test::More tests => 3; +use Test::More tests => 6; use RT::Client::REST::Forms qw(form_parse); -use File::Spec::Functions qw(catfile); +use File::Spec::Functions qw(catfile); -my $testfile = 'test.png'; -my $testfile_path = catfile('t' => 'data' => $testfile); +my $testfile = 'test.png'; +my $testfile_path = catfile( 't' => 'data' => $testfile ); -open (my $fh, '<', $testfile_path) or die "Couldn't open $testfile_path $!"; +open( my $fh, '<', $testfile_path ) or die "Couldn't open $testfile_path $!"; my $contents = do { local $/; <$fh>; }; close $fh; +sub dump_file { + open( my $out, '>', '/tmp/test.png' ); + print $out $_[0]; + close $out; +} + sub create_http_body { my $binary_string = shift; - my $length = length($binary_string); - my $spaces = ' ' x length('Content: '); + my $length = length($binary_string); + my $spaces = ' ' x length('Content: '); $binary_string =~ s/\n/\n$spaces/sg; - $binary_string .= "\n\n"; my $body = <<"EOF"; id: 873 Subject: \nCreator: 12 @@ -39,14 +44,46 @@ Headers: Content-Type: image/png; name="prova2.png" Content-Transfer-Encoding: base64 Content-Length: $length -Content: $binary_string +Content: $binary_string\n\n EOF return $body; } -my $body = create_http_body($contents); -my $form = form_parse($body); -is(ref($form), 'ARRAY', 'form is an array reference'); -my ($c, $o, $k, $e) = @{$$form[0]}; -is(ref($k), 'HASH', 'third element ($k) is a hash reference'); -ok($k->{Content} eq $contents, 'form parsed out contents correctly'); +{ + my $body = create_http_body($contents); + my $form = form_parse($body); + is( ref($form), 'ARRAY', 'form is an array reference' ); + my ( $c, $o, $k, $e ) = @{ $$form[0] }; + is( ref($k), 'HASH', 'third element ($k) is a hash reference' ); + ok( $k->{Content} eq $contents, 'form parsed out contents correctly' ); + dump_file( $k->{Content} ); +} + +{ +my $body = qq|id: 17217 +Subject: \nCreator: 12 +Created: 2022-09-24 21:26:55 +Transaction: 37112 +Parent: 17215 +MessageId: \nFilename: LG1kcpoxfV +ContentType: text/plain +ContentEncoding: none + +Headers: Content-Transfer-Encoding: binary + Content-Disposition: form-data; filename="LG1kcpoxfV"; name="attachment_1" + Content-Type: text/plain; charset="utf-8"; name="LG1kcpoxfV" + X-RT-Original-Encoding: ascii + Content-Length: 31 + +Content: dude this is a text attachment + + + +|; + my $form = form_parse($body); + is( ref($form), 'ARRAY', 'form is an array reference' ); + my ( $c, $o, $k, $e ) = @{ $$form[0] }; + is( ref($k), 'HASH', 'third element ($k) is a hash reference' ); + ok( $k->{Content} eq "dude this is a text attachment\n", + 'form parsed out contents correctly' ); +} From 62571c686732da51e7503cbba2a98009823d99ee Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 24 Sep 2022 16:52:48 -0700 Subject: [PATCH 72/85] Swap from Error's try to Try::Tiny, and from base->parent --- dist.ini | 14 +- lib/RT/Client/REST.pm | 76 +++++---- lib/RT/Client/REST/Attachment.pm | 6 +- lib/RT/Client/REST/Exception.pm | 7 +- lib/RT/Client/REST/Group.pm | 8 +- lib/RT/Client/REST/HTTPClient.pm | 2 +- lib/RT/Client/REST/Object.pm | 51 ++++-- lib/RT/Client/REST/Object/Exception.pm | 2 +- lib/RT/Client/REST/Queue.pm | 10 +- lib/RT/Client/REST/Ticket.pm | 27 ++- lib/RT/Client/REST/Transaction.pm | 4 +- lib/RT/Client/REST/User.pm | 8 +- t/01-use.t | 4 +- t/10-core.t | 50 ++++-- t/11-server-name.t | 18 +- t/20-object.t | 63 ++++--- t/21-user.t | 19 ++- t/22-ticket.t | 191 ++++++++++++--------- t/23-attachment.t | 17 +- t/24-transaction.t | 16 +- t/25-queue.t | 7 +- t/26-group.t | 9 +- t/35-db.t | 86 ++++++---- t/40-search.t | 31 ++-- t/60-with-rt.t | 226 +++++++++++++++++-------- t/80-timeout.t | 42 +++-- t/81-submit.t | 30 ++-- t/82-stringify.t | 53 +++--- t/83-attachments.t | 79 +++++---- t/84-attachments-rt127607.t | 74 ++++---- t/85-attachments-rt127607.t | 74 ++++---- t/86-redirect.t | 85 +++++----- 32 files changed, 831 insertions(+), 558 deletions(-) diff --git a/dist.ini b/dist.ini index 9bbf187..b865375 100755 --- a/dist.ini +++ b/dist.ini @@ -48,7 +48,6 @@ finder = :InstallModules ; prevents test inputs being flagged ; Stuff that changes my code [PkgVersion] -; [PodVersion] ; PodWeaver does this and more [PodWeaver] [CopyrightYearFromGit] [AuthorsFromGit] @@ -61,29 +60,30 @@ finder = :InstallModules ; prevents test inputs being flagged [PruneFiles] filename = weaver.ini +filename = dist.ini [PruneCruft] [Clean] [Prereqs] +DateTime = 0 +DateTime::Format::DateParse = 0 Encode = 0 -Error = 0 Exception::Class = 0 HTTP::Cookies = 0 HTTP::Request::Common = 0 LWP = 0 Params::Validate = 0 -DateTime = 0 -DateTime::Format::DateParse = 0 +Try::Tiny = 0 URI = 0 strict = 0 warnings = 0 constant = 0 Exporter = 0 -vars = 0 -base = 0 -perl = 5.004 +vars = 0 +parent = 0 +perl = 5.008 [Prereqs / BuildRequires] Test::More = 0 diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index fa482a6..45b96cc 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -1,4 +1,5 @@ #!perl +# vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST # ABSTRACT: Client for RT using REST API # @@ -25,10 +26,10 @@ use warnings; package RT::Client::REST; -use Error qw(:try); +use Try::Tiny; use HTTP::Cookies; use HTTP::Request::Common; -use RT::Client::REST::Exception 0.18; +use RT::Client::REST::Exception; use RT::Client::REST::Forms; use RT::Client::REST::HTTPClient; @@ -91,15 +92,22 @@ sub login { try { $self->_cookie(undef); # Start a new session. $self->_submit('ticket/1', undef, \%opts); - } catch RT::Client::REST::AuthenticationFailureException with { - shift->rethrow; - } catch RT::Client::REST::MalformedRTResponseException with { - shift->rethrow; - } catch RT::Client::REST::RequestTimedOutException with { - shift->rethrow; - } catch RT::Client::REST::HTTPException with { - shift->rethrow; - } catch Exception::Class::Base with { + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + + my $err = $_; + if (grep { $err->isa($_) } ( + 'RT::Client::REST::AuthenticationFailureException', + 'RT::Client::REST::MalformedRTResponseException', + 'RT::Client::REST::RequestTimedOutException', + 'RT::Client::REST::HTTPException', + )) { + shift->rethrow + } + if (! $err->isa('Exception::Class::Base')) { + die $err + } # ignore others. }; } @@ -228,14 +236,14 @@ sub get_links { } # Turn the links into id lists - foreach my $key (keys(%$k)) { + for my $key (keys(%$k)) { try { $self->_valid_link_type($key); my @list = split(/\s*,\s*/,$k->{$key}); #use Data::Dumper; #print STDERR Dumper(\@list); my @newlist = (); - foreach my $val (@list) { + for my $val (@list) { if ($val =~ /^fsck\.com-\w+\:\/\/(.*?)\/(.*?)\/(\d+)$/) { # We just want the ids, not the URI push(@newlist, {'type' => $2, 'instance' => $1, 'id' => $3 }); @@ -247,7 +255,13 @@ sub get_links { # Copy the newly created list $k->{$key} = (); $k->{$key} = \@newlist; - } catch RT::Client::REST::InvalidParameterValueException with { + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + + if (! $_->isa('RT::Client::REST::InvalidParameterValueException')) { + $_->rethrow; + } # Skip it because the keys are not always valid e.g., 'id' } } @@ -533,9 +547,9 @@ sub _submit { } elsif (ref $content eq 'HASH') { my @data; - foreach my $k (keys %$content) { + for my $k (keys %$content) { if (ref $content->{$k} eq 'ARRAY') { - foreach my $v (@{ $content->{$k} }) { + for my $v (@{ $content->{$k} }) { push @data, $k, $v; } } @@ -910,7 +924,7 @@ __END__ =head1 SYNOPSIS - use Error qw(:try); + use Try::Tiny; use RT::Client::REST; my $rt = RT::Client::REST->new( @@ -920,17 +934,24 @@ __END__ try { $rt->login(username => $user, password => $pass); - } catch Exception::Class::Base with { - die "problem logging in: ", shift->message; + } + catch { + if ($_->isa('Exception::Class::Base') { + die "problem logging in: ", shift->message; + } }; try { # Get ticket #10 $ticket = $rt->show(type => 'ticket', id => 10); - } catch RT::Client::REST::UnauthorizedActionException with { - print "You are not authorized to view ticket #10\n"; - } catch RT::Client::REST::Exception with { - # something went wrong. + } + catch { + if ($_->isa('RT::Client::REST::UnauthorizedActionException')) { + print "You are not authorized to view ticket #10\n"; + } + if ($_->isa('RT::Client::REST::Exception')) { + # something went wrong. + } }; =head1 DESCRIPTION @@ -1278,9 +1299,8 @@ already the ticket owner. =head1 EXCEPTIONS When an error occurs, this module will throw exceptions. I recommend -using Error.pm's B mechanism to catch them, but you may also use -simple B. The former will give you flexibility to catch just the -exceptions you want. +using L or L B mechanism to catch them, +but you may also use simple B. Please see L for the full listing and description of all the exceptions. @@ -1301,10 +1321,6 @@ The following modules are required: =item -Error - -=item - Exception::Class =item diff --git a/lib/RT/Client/REST/Attachment.pm b/lib/RT/Client/REST/Attachment.pm index 875d5cb..8122844 100644 --- a/lib/RT/Client/REST/Attachment.pm +++ b/lib/RT/Client/REST/Attachment.pm @@ -7,10 +7,10 @@ use warnings; package RT::Client::REST::Attachment; -use base 'RT::Client::REST::Object'; +use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); -use RT::Client::REST::Object::Exception 0.03; +use RT::Client::REST::Object::Exception; sub _attributes {{ id => { @@ -45,7 +45,7 @@ sub _attributes {{ validation => { type => SCALAR, }, - rest_name => "ContentType", + rest_name => 'ContentType', }, file_name => { diff --git a/lib/RT/Client/REST/Exception.pm b/lib/RT/Client/REST/Exception.pm index ce954eb..6b8793a 100644 --- a/lib/RT/Client/REST/Exception.pm +++ b/lib/RT/Client/REST/Exception.pm @@ -7,13 +7,11 @@ use warnings; package RT::Client::REST::Exception; -use base qw(Exception::Class); +use parent qw(Exception::Class); use vars qw($VERSION); $VERSION = '0.19'; -use Error; - use Exception::Class ( 'RT::Client::REST::OddNumberOfArgumentsException' => { isa => __PACKAGE__, @@ -194,10 +192,9 @@ sub _rt_content_to_exception { { no strict 'refs'; ## no critic (ProhibitNoStrict) push @{__PACKAGE__ . '::ISA'}, 'Exception::Class::Base'; - push @Exception::Class::Base::ISA, 'Error' - unless Exception::Class::Base->isa('Error'); } + 1; __END__ diff --git a/lib/RT/Client/REST/Group.pm b/lib/RT/Client/REST/Group.pm index a1445eb..350b892 100644 --- a/lib/RT/Client/REST/Group.pm +++ b/lib/RT/Client/REST/Group.pm @@ -7,12 +7,12 @@ use warnings; package RT::Client::REST::Group; -use base 'RT::Client::REST::Object'; +use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); -use RT::Client::REST 0.14; -use RT::Client::REST::Object::Exception 0.01; -use RT::Client::REST::SearchResult 0.02; +use RT::Client::REST; +use RT::Client::REST::Object::Exception; +use RT::Client::REST::SearchResult; =head1 SYNOPSIS diff --git a/lib/RT/Client/REST/HTTPClient.pm b/lib/RT/Client/REST/HTTPClient.pm index 5284877..9b3dcad 100644 --- a/lib/RT/Client/REST/HTTPClient.pm +++ b/lib/RT/Client/REST/HTTPClient.pm @@ -7,7 +7,7 @@ use warnings; package RT::Client::REST::HTTPClient; -use base 'LWP::UserAgent'; +use parent 'LWP::UserAgent'; =head1 METHODS diff --git a/lib/RT/Client/REST/Object.pm b/lib/RT/Client/REST/Object.pm index 4a8d087..32cb2de 100644 --- a/lib/RT/Client/REST/Object.pm +++ b/lib/RT/Client/REST/Object.pm @@ -1,4 +1,5 @@ #!perl +# vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST::Object # ABSTRACT: base class for RT objects @@ -12,7 +13,7 @@ package RT::Client::REST::Object; # Create a new type package RT::Client::REST::MyType; - use base qw(RT::Client::REST::Object); + use parent qw(RT::Client::REST::Object); sub _attributes {{ myattribute => { @@ -148,10 +149,10 @@ various DB-related methods and are especially relied upon by: =cut -use Error qw(:try); +use Try::Tiny; use Params::Validate; -use RT::Client::REST::Object::Exception 0.04; -use RT::Client::REST::SearchResult 0.02; +use RT::Client::REST::Object::Exception; +use RT::Client::REST::SearchResult; use DateTime; use DateTime::Format::DateParse; @@ -567,9 +568,17 @@ sub search { my $kw; try { $kw = $self->_attr2keyword($limit->{attribute}); - } catch RT::Clite::REST::Object::InvalidAttributeException with { - RT::Client::REST::Object::InvalidSearchParametersException - ->throw(shift->message); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + + if ($_->isa('RT::Clite::REST::Object::InvalidAttributeException')) { + RT::Client::REST::Object::InvalidSearchParametersException + ->throw(shift->message); + } + else { + $_->rethrow + } }; my $op = $limit->{operator}; my $val = $limit->{value}; @@ -588,10 +597,18 @@ sub search { # implementation may change! $orderby = (delete($opts{reverseorder}) ? '-' : '+') . ($self->_attr2keyword(delete($opts{orderby}) || 'id')); - } catch RT::Clite::REST::Object::InvalidAttributeException with { - RT::Client::REST::Object::InvalidSearchParametersException->throw( - shift->message, - ); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + + if ($_->isa('RT::Client::REST::Object::InvalidAttributeException')) { + RT::Client::REST::Object::InvalidSearchParametersException->throw( + shift->message, + ) + } + else { + $_->rethrow; + } }; my $rt = $self->rt; @@ -602,8 +619,16 @@ sub search { query => $query, orderby => $orderby, ); - } catch RT::Client::REST::InvalidQueryException with { - RT::Client::REST::Object::InvalidSearchParametersException->throw; + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + + if ($_->isa('RT::Client::REST::InvalidQueryException')) { + RT::Client::REST::Object::InvalidSearchParametersException->throw; + } + else { + $_->rethrow; + } }; return RT::Client::REST::SearchResult->new( diff --git a/lib/RT/Client/REST/Object/Exception.pm b/lib/RT/Client/REST/Object/Exception.pm index 2e0c770..ea9502b 100644 --- a/lib/RT/Client/REST/Object/Exception.pm +++ b/lib/RT/Client/REST/Object/Exception.pm @@ -6,7 +6,7 @@ use warnings; package RT::Client::REST::Object::Exception; -use base qw(RT::Client::REST::Exception); +use parent qw(RT::Client::REST::Exception); use RT::Client::REST::Exception ( 'RT::Client::REST::Object::OddNumberOfArgumentsException' => { diff --git a/lib/RT/Client/REST/Queue.pm b/lib/RT/Client/REST/Queue.pm index 336fd18..562d79c 100644 --- a/lib/RT/Client/REST/Queue.pm +++ b/lib/RT/Client/REST/Queue.pm @@ -8,12 +8,12 @@ use warnings; package RT::Client::REST::Queue; use Params::Validate qw(:types); -use RT::Client::REST 0.20; -use RT::Client::REST::Object 0.01; -use RT::Client::REST::Object::Exception 0.01; -use RT::Client::REST::SearchResult 0.02; +use RT::Client::REST; +use RT::Client::REST::Object; +use RT::Client::REST::Object::Exception; +use RT::Client::REST::SearchResult; use RT::Client::REST::Ticket; -use base 'RT::Client::REST::Object'; +use parent 'RT::Client::REST::Object'; =head1 SYNOPSIS diff --git a/lib/RT/Client/REST/Ticket.pm b/lib/RT/Client/REST/Ticket.pm index 54372b6..eefc42a 100644 --- a/lib/RT/Client/REST/Ticket.pm +++ b/lib/RT/Client/REST/Ticket.pm @@ -1,4 +1,5 @@ #!perl +# vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST::Ticket # ABSTRACT: ticket object representation. @@ -7,14 +8,14 @@ use warnings; package RT::Client::REST::Ticket; -use base 'RT::Client::REST::Object'; +use parent 'RT::Client::REST::Object'; -use Error qw(:try); +use Try::Tiny; use Params::Validate qw(:types); -use RT::Client::REST 0.18; +use RT::Client::REST; use RT::Client::REST::Attachment; -use RT::Client::REST::Object::Exception 0.04; -use RT::Client::REST::SearchResult 0.02; +use RT::Client::REST::Object::Exception; +use RT::Client::REST::SearchResult; use RT::Client::REST::Transaction; =head1 SYNOPSIS @@ -518,10 +519,18 @@ for my $method (qw(take untake steal)) { try { $self->rt->$method(id => $self->id); - } catch RT::Client::REST::AlreadyTicketOwnerException with { - # Rename the exception. - RT::Client::REST::Object::NoopOperationException - ->throw(shift->message); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + + if ($_->isa('RT::Client::REST::AlreadyTicketOwnerException')) { + # Rename the exception. + RT::Client::REST::Object::NoopOperationException + ->throw(shift->message); + } + else { + $_->rethrow; + } }; return; diff --git a/lib/RT/Client/REST/Transaction.pm b/lib/RT/Client/REST/Transaction.pm index 134fc7a..247202e 100644 --- a/lib/RT/Client/REST/Transaction.pm +++ b/lib/RT/Client/REST/Transaction.pm @@ -7,10 +7,10 @@ use warnings; package RT::Client::REST::Transaction; -use base 'RT::Client::REST::Object'; +use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); -use RT::Client::REST::Object::Exception 0.03; +use RT::Client::REST::Object::Exception; sub _attributes {{ id => { diff --git a/lib/RT/Client/REST/User.pm b/lib/RT/Client/REST/User.pm index 8ebe73d..22da041 100644 --- a/lib/RT/Client/REST/User.pm +++ b/lib/RT/Client/REST/User.pm @@ -7,12 +7,12 @@ use warnings; package RT::Client::REST::User; -use base 'RT::Client::REST::Object'; +use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); -use RT::Client::REST 0.14; -use RT::Client::REST::Object::Exception 0.01; -use RT::Client::REST::SearchResult 0.02; +use RT::Client::REST; +use RT::Client::REST::Object::Exception; +use RT::Client::REST::SearchResult; =head1 SYNOPSIS diff --git a/t/01-use.t b/t/01-use.t index a804e05..5e98de8 100644 --- a/t/01-use.t +++ b/t/01-use.t @@ -7,7 +7,7 @@ use warnings; use Test::More tests => 2; BEGIN { - use_ok ('RT::Client::REST'); - use_ok ('RT::Client::REST', 0.53); + use_ok('RT::Client::REST'); + use_ok( 'RT::Client::REST', 0.53 ); } diff --git a/t/10-core.t b/t/10-core.t index 1b07ddd..596ea92 100644 --- a/t/10-core.t +++ b/t/10-core.t @@ -8,11 +8,17 @@ use Test::More tests => 28; use Test::Exception; use constant METHODS => ( - 'new', 'server', 'show', 'edit', 'login', - 'create', 'comment', 'correspond', 'merge_tickets', 'link_tickets', - 'unlink_tickets', 'search', 'get_attachment_ids', 'get_attachment', - 'get_transaction_ids', 'get_transaction', 'take', 'untake', 'steal', - 'timeout', 'basic_auth_cb', + 'new', 'server', + 'show', 'edit', + 'login', 'create', + 'comment', 'correspond', + 'merge_tickets', 'link_tickets', + 'unlink_tickets', 'search', + 'get_attachment_ids', 'get_attachment', + 'get_transaction_ids', 'get_transaction', + 'take', 'untake', + 'steal', 'timeout', + 'basic_auth_cb', ); use RT::Client::REST; @@ -21,30 +27,35 @@ my $rt; lives_ok { $rt = RT::Client::REST->new; -} 'RT::Client::REST instance created'; +} +'RT::Client::REST instance created'; for my $method (METHODS) { - can_ok($rt, $method); + can_ok( $rt, $method ); } throws_ok { $rt->login; -} 'RT::Client::REST::InvalidParameterValueException', - "requires 'username' and 'password' parameters"; +} +'RT::Client::REST::InvalidParameterValueException', + "requires 'username' and 'password' parameters"; throws_ok { $rt->basic_auth_cb(1); -} 'RT::Client::REST::InvalidParameterValueException'; +} +'RT::Client::REST::InvalidParameterValueException'; throws_ok { - $rt->basic_auth_cb({}); -} 'RT::Client::REST::InvalidParameterValueException'; + $rt->basic_auth_cb( {} ); +} +'RT::Client::REST::InvalidParameterValueException'; lives_ok { - $rt->basic_auth_cb(sub {}); + $rt->basic_auth_cb( sub { } ); }; { + package BadLogger; sub new { bless \my $logger } for my $method (qw(debug me elmo)) { @@ -57,11 +68,13 @@ lives_ok { } throws_ok { - RT::Client::REST->new(logger => BadLogger->new); -} 'RT::Client::REST::InvalidParameterValueException', - 'bad logger results in exception being thrown'; + RT::Client::REST->new( logger => BadLogger->new ); +} +'RT::Client::REST::InvalidParameterValueException', + 'bad logger results in exception being thrown'; { + package GoodLogger; sub new { bless \my $logger } for my $method (qw(debug info warn error)) { @@ -74,8 +87,9 @@ throws_ok { } lives_ok { - RT::Client::REST->new(logger => GoodLogger->new); -} 'good logger, no exception thrown'; + RT::Client::REST->new( logger => GoodLogger->new ); +} +'good logger, no exception thrown'; 1; diff --git a/t/11-server-name.t b/t/11-server-name.t index 650d4a9..710e068 100644 --- a/t/11-server-name.t +++ b/t/11-server-name.t @@ -5,16 +5,16 @@ use warnings; use Test::More tests => 5; use RT::Client::REST; -my $rt = RT::Client::REST->new(server => 'http://localhost/'); +my $rt = RT::Client::REST->new( server => 'http://localhost/' ); -is $rt->server, 'http://localhost', 'Trailing slash stripped'; -is $rt->_rest, 'http://localhost/REST/1.0', 'rest uri ok'; +is $rt->server, 'http://localhost', 'Trailing slash stripped'; +is $rt->_rest, 'http://localhost/REST/1.0', 'rest uri ok'; +$rt = RT::Client::REST->new( + server => 'http://localhost/bts/', + timeout => '10/', # bogus +); -$rt = RT::Client::REST->new(server => 'http://localhost/bts/', - timeout => '10/', # bogus - ); - -is $rt->server, 'http://localhost/bts', 'Trailing slash stripped'; -is $rt->_rest, 'http://localhost/bts/REST/1.0', 'rest uri ok'; +is $rt->server, 'http://localhost/bts', 'Trailing slash stripped'; +is $rt->_rest, 'http://localhost/bts/REST/1.0', 'rest uri ok'; is $rt->timeout, '10/', 'trailing slash on timeout preserved, even if bogus'; diff --git a/t/20-object.t b/t/20-object.t index 28764c3..c0ed717 100644 --- a/t/20-object.t +++ b/t/20-object.t @@ -1,5 +1,6 @@ #!perl package MyObject; + # vim:ft=perl: # For testing purposes -- Object with 'id' attribute. @@ -16,9 +17,9 @@ sub id { sub rt_type { 'myobject' } -sub _attributes {{ - id => {}, -}} +sub _attributes { + { id => {}, } +} package main; @@ -29,10 +30,16 @@ use Test::More tests => 38; use Test::Exception; use constant METHODS => ( - 'new', 'to_form', 'from_form', '_generate_methods', 'store', 'retrieve', - 'param', 'rt', 'cf', 'search', 'count', 'use_single_rt', - 'use_autostore', 'use_autoget', 'use_autosync', 'be_transparent', - 'autostore', 'autosync', 'autoget', + 'new', 'to_form', + 'from_form', '_generate_methods', + 'store', 'retrieve', + 'param', 'rt', + 'cf', 'search', + 'count', 'use_single_rt', + 'use_autostore', 'use_autoget', + 'use_autosync', 'be_transparent', + 'autostore', 'autosync', + 'autoget', ); BEGIN { @@ -43,10 +50,11 @@ my $obj; lives_ok { $obj = RT::Client::REST::Object->new; -} 'Object can get successfully created'; +} +'Object can get successfully created'; for my $method (METHODS) { - can_ok($obj, $method); + can_ok( $obj, $method ); } use RT::Client::REST; @@ -57,26 +65,31 @@ for my $method (qw(retrieve)) { throws_ok { $obj->$method; - } 'RT::Client::REST::Object::RequiredAttributeUnsetException', - "won't go on without 'rt' set"; + } + 'RT::Client::REST::Object::RequiredAttributeUnsetException', + "won't go on without 'rt' set"; lives_ok { $obj->rt($rt) - } "Successfully set 'rt'"; + } + "Successfully set 'rt'"; throws_ok { $obj->$method; - } 'RT::Client::REST::Object::RequiredAttributeUnsetException', - "won't go on without 'id' set"; + } + 'RT::Client::REST::Object::RequiredAttributeUnsetException', + "won't go on without 'id' set"; lives_ok { $obj->id(1); - } "Successfully set 'id' to 1"; + } + "Successfully set 'id' to 1"; throws_ok { $obj->$method; - } 'RT::Client::REST::RequiredAttributeUnsetException', - "rt object is not correctly initialized"; + } + 'RT::Client::REST::RequiredAttributeUnsetException', + "rt object is not correctly initialized"; } for my $method (qw(store count search)) { @@ -84,20 +97,24 @@ for my $method (qw(store count search)) { throws_ok { $obj->$method; - } 'RT::Client::REST::Object::RequiredAttributeUnsetException', - "won't go on without 'rt' set"; + } + 'RT::Client::REST::Object::RequiredAttributeUnsetException', + "won't go on without 'rt' set"; lives_ok { $obj->rt($rt) - } "Successfully set 'rt'"; + } + "Successfully set 'rt'"; lives_ok { $obj->id(1); - } "Successfully set 'id' to 1"; + } + "Successfully set 'id' to 1"; throws_ok { $obj->$method; - } 'RT::Client::REST::RequiredAttributeUnsetException', - "rt object is not correctly initialized"; + } + 'RT::Client::REST::RequiredAttributeUnsetException', + "rt object is not correctly initialized"; } diff --git a/t/21-user.t b/t/21-user.t index f12e646..233e94b 100644 --- a/t/21-user.t +++ b/t/21-user.t @@ -7,15 +7,15 @@ use Test::More; use Test::Exception; use constant METHODS => ( - 'new', 'to_form', 'from_form', + 'new', 'to_form', 'from_form', 'rt_type', 'id', # attributes: - 'name', 'password', 'real_name', 'gecos', - 'privileged', 'email_address', 'comments', 'organization', - 'address_one', 'address_two', 'city', 'state', 'zip', 'country', - 'home_phone', 'work_phone', 'cell_phone', 'pager', 'disabled', - 'nickname', 'lang', 'contactinfo', 'signature' + 'name', 'password', 'real_name', 'gecos', + 'privileged', 'email_address', 'comments', 'organization', + 'address_one', 'address_two', 'city', 'state', 'zip', 'country', + 'home_phone', 'work_phone', 'cell_phone', 'pager', 'disabled', + 'nickname', 'lang', 'contactinfo', 'signature' ); BEGIN { @@ -26,13 +26,14 @@ my $user; lives_ok { $user = RT::Client::REST::User->new; -} 'User can get successfully created'; +} +'User can get successfully created'; for my $method (METHODS) { - can_ok($user, $method); + can_ok( $user, $method ); } -ok('user' eq $user->rt_type); +ok( 'user' eq $user->rt_type ); done_testing; diff --git a/t/22-ticket.t b/t/22-ticket.t index 11fe248..11c9177 100644 --- a/t/22-ticket.t +++ b/t/22-ticket.t @@ -8,14 +8,14 @@ use Test::More tests => 114; use Test::Exception; use constant METHODS => ( - 'new', 'to_form', 'from_form', 'rt_type', 'comment', 'correspond', - 'attachments', 'transactions', 'take', 'untake', 'steal', + 'new', 'to_form', 'from_form', 'rt_type', 'comment', 'correspond', + 'attachments', 'transactions', 'take', 'untake', 'steal', # attributes: 'id', 'queue', 'owner', 'creator', 'subject', 'status', 'priority', 'initial_priority', 'final_priority', 'requestors', 'cc', 'admin_cc', - 'created', 'starts', 'started', 'due', 'resolved', 'told', - 'time_estimated', 'time_worked', 'time_left', 'last_updated', 'sla', + 'created', 'starts', 'started', 'due', 'resolved', 'told', + 'time_estimated', 'time_worked', 'time_left', 'last_updated', 'sla', ); BEGIN { @@ -26,197 +26,230 @@ my $ticket; lives_ok { $ticket = RT::Client::REST::Ticket->new; -} 'Ticket can get successfully created'; +} +'Ticket can get successfully created'; for my $method (METHODS) { - can_ok($ticket, $method); + can_ok( $ticket, $method ); } for my $method (qw(comment correspond)) { + # Need local copy. my $ticket = RT::Client::REST::Ticket->new; throws_ok { $ticket->$method(1); - } 'RT::Client::REST::Exception'; # Make sure exception inheritance works + } + 'RT::Client::REST::Exception'; # Make sure exception inheritance works throws_ok { $ticket->$method(1); - } 'RT::Client::REST::Object::OddNumberOfArgumentsException'; + } + 'RT::Client::REST::Object::OddNumberOfArgumentsException'; throws_ok { $ticket->$method; - } 'RT::Client::REST::Object::RequiredAttributeUnsetException', - "won't go on without RT object"; + } + 'RT::Client::REST::Object::RequiredAttributeUnsetException', + "won't go on without RT object"; throws_ok { $ticket->rt('anc'); - } 'RT::Client::REST::Object::InvalidValueException', - "'rt' expects an actual RT object"; + } + 'RT::Client::REST::Object::InvalidValueException', + "'rt' expects an actual RT object"; lives_ok { - $ticket->rt(RT::Client::REST->new); - } "RT object successfully set"; + $ticket->rt( RT::Client::REST->new ); + } + "RT object successfully set"; throws_ok { $ticket->$method; - } 'RT::Client::REST::Object::RequiredAttributeUnsetException', - "won't go on without 'id' attribute"; + } + 'RT::Client::REST::Object::RequiredAttributeUnsetException', + "won't go on without 'id' attribute"; lives_ok { $ticket->id(1); - } "'id' successfully set to a numeric value"; + } + "'id' successfully set to a numeric value"; throws_ok { $ticket->$method; - } 'RT::Client::REST::Object::InvalidValueException'; + } + 'RT::Client::REST::Object::InvalidValueException'; lives_ok { $ticket->id(1); - } "'id' successfully set to a numeric value"; + } + "'id' successfully set to a numeric value"; throws_ok { $ticket->$method; - } 'RT::Client::REST::Object::InvalidValueException', - "Need 'message' to $method"; + } + 'RT::Client::REST::Object::InvalidValueException', + "Need 'message' to $method"; throws_ok { - $ticket->$method(message => 'abc'); - } 'RT::Client::REST::RequiredAttributeUnsetException'; + $ticket->$method( message => 'abc' ); + } + 'RT::Client::REST::RequiredAttributeUnsetException'; throws_ok { $ticket->$method( - message => 'abc', + message => 'abc', attachments => ['- this file does not exist -'], ); - } 'RT::Client::REST::CannotReadAttachmentException'; + } + 'RT::Client::REST::CannotReadAttachmentException'; } for my $method (qw(attachments transactions)) { + # Need local copy. my $ticket = RT::Client::REST::Ticket->new; throws_ok { $ticket->$method; - } 'RT::Client::REST::Object::RequiredAttributeUnsetException', - "won't go on without RT object"; + } + 'RT::Client::REST::Object::RequiredAttributeUnsetException', + "won't go on without RT object"; throws_ok { $ticket->rt('anc'); - } 'RT::Client::REST::Object::InvalidValueException', - "'rt' expects an actual RT object"; + } + 'RT::Client::REST::Object::InvalidValueException', + "'rt' expects an actual RT object"; lives_ok { - $ticket->rt(RT::Client::REST->new); - } "RT object successfully set"; + $ticket->rt( RT::Client::REST->new ); + } + "RT object successfully set"; throws_ok { $ticket->$method; - } 'RT::Client::REST::Object::RequiredAttributeUnsetException', - "won't go on without 'id' attribute"; + } + 'RT::Client::REST::Object::RequiredAttributeUnsetException', + "won't go on without 'id' attribute"; lives_ok { $ticket->id(1); - } "'id' successfully set to a numeric value"; + } + "'id' successfully set to a numeric value"; throws_ok { $ticket->$method; - } 'RT::Client::REST::RequiredAttributeUnsetException'; + } + 'RT::Client::REST::RequiredAttributeUnsetException'; } for my $method (qw(take untake steal)) { + # Need local copy. my $ticket = RT::Client::REST::Ticket->new; throws_ok { $ticket->$method; - } 'RT::Client::REST::Object::RequiredAttributeUnsetException', - "won't go on without RT object"; + } + 'RT::Client::REST::Object::RequiredAttributeUnsetException', + "won't go on without RT object"; throws_ok { $ticket->rt('anc'); - } 'RT::Client::REST::Object::InvalidValueException', - "'rt' expects an actual RT object"; + } + 'RT::Client::REST::Object::InvalidValueException', + "'rt' expects an actual RT object"; lives_ok { - $ticket->rt(RT::Client::REST->new); - } "RT object successfully set"; + $ticket->rt( RT::Client::REST->new ); + } + "RT object successfully set"; throws_ok { $ticket->$method; - } 'RT::Client::REST::Object::RequiredAttributeUnsetException', - "won't go on without 'id' attribute"; + } + 'RT::Client::REST::Object::RequiredAttributeUnsetException', + "won't go on without 'id' attribute"; lives_ok { $ticket->id(1); - } "'id' successfully set to a numeric value"; + } + "'id' successfully set to a numeric value"; throws_ok { $ticket->$method; - } 'RT::Client::REST::RequiredAttributeUnsetException'; + } + 'RT::Client::REST::RequiredAttributeUnsetException'; } # Test list attributes: my @emails = qw(dmitri@localhost dude@localhost); throws_ok { $ticket->requestors(@emails); -} 'RT::Client::REST::Object::InvalidValueException', - 'List attributes (requestors) only accept array reference'; +} +'RT::Client::REST::Object::InvalidValueException', + 'List attributes (requestors) only accept array reference'; lives_ok { - $ticket->requestors(\@emails); -} 'Set requestors to list of two values'; + $ticket->requestors( \@emails ); +} +'Set requestors to list of two values'; -ok(2 == $ticket->requestors, 'There are 2 requestors'); +ok( 2 == $ticket->requestors, 'There are 2 requestors' ); lives_ok { $ticket->add_requestors(qw(xyz@localhost root pgsql)); -} 'Added three more requestors'; +} +'Added three more requestors'; -ok(5 == $ticket->requestors, 'There are now 5 requestors'); +ok( 5 == $ticket->requestors, 'There are now 5 requestors' ); lives_ok { $ticket->delete_requestors('root'); -} 'Deleted a requestor (root)'; +} +'Deleted a requestor (root)'; -ok(4 == $ticket->requestors, 'There are now 4 requestors'); +ok( 4 == $ticket->requestors, 'There are now 4 requestors' ); -ok('ticket' eq $ticket->rt_type); +ok( 'ticket' eq $ticket->rt_type ); # Test time parsing $ticket->due('Thu Jan 12 11:14:31 2012'); my $dt = $ticket->due_datetime(); -is($dt->year, 2012); -is($dt->month, 1); -is($dt->day, 12); -is($dt->hour, 11); -is($dt->minute, 14); -is($dt->second, 31); -is($dt->time_zone->name, 'UTC'); +is( $dt->year, 2012 ); +is( $dt->month, 1 ); +is( $dt->day, 12 ); +is( $dt->hour, 11 ); +is( $dt->minute, 14 ); +is( $dt->second, 31 ); +is( $dt->time_zone->name, 'UTC' ); $dt = DateTime->new( - year => 1983, - month => 9, - day => 1, - hour => 1, - minute => 2, - second => 3, + year => 1983, + month => 9, + day => 1, + hour => 1, + minute => 2, + second => 3, time_zone => 'EST' ); -$dt=$ticket->due_datetime($dt); +$dt = $ticket->due_datetime($dt); -is($dt->year, 1983); -is($dt->month, 9); -is($dt->day, 1); -is($dt->hour, 6); -is($dt->minute, 2); -is($dt->second, 3); -is($dt->time_zone->name, 'UTC'); +is( $dt->year, 1983 ); +is( $dt->month, 9 ); +is( $dt->day, 1 ); +is( $dt->hour, 6 ); +is( $dt->minute, 2 ); +is( $dt->second, 3 ); +is( $dt->time_zone->name, 'UTC' ); -is($ticket->due, 'Thu Sep 01 01:02:03 1983'); +is( $ticket->due, 'Thu Sep 01 01:02:03 1983' ); throws_ok { - $ticket->due_datetime(bless {}, 'foo'); -} 'RT::Client::REST::Object::InvalidValueException'; + $ticket->due_datetime( bless {}, 'foo' ); +} +'RT::Client::REST::Object::InvalidValueException'; diff --git a/t/23-attachment.t b/t/23-attachment.t index 698eed7..cbe851b 100644 --- a/t/23-attachment.t +++ b/t/23-attachment.t @@ -13,7 +13,7 @@ use constant METHODS => ( # attrubutes: 'id', 'creator_id', 'subject', 'created', 'message_id', 'parent_id', 'content_type', 'file_name', 'transaction_id', 'content', 'headers', - 'parent', 'content_encoding', + 'parent', 'content_encoding', ); BEGIN { @@ -21,25 +21,28 @@ BEGIN { } for my $method (METHODS) { - can_ok('RT::Client::REST::Attachment', $method); + can_ok( 'RT::Client::REST::Attachment', $method ); } my $ticket; lives_ok { $ticket = RT::Client::REST::Attachment->new; -} 'Ticket can get successfully created'; +} +'Ticket can get successfully created'; for my $method (qw(store search count)) { throws_ok { $ticket->$method; - } 'RT::Client::REST::Exception'; # make sure exception inheritance works + } + 'RT::Client::REST::Exception'; # make sure exception inheritance works throws_ok { $ticket->$method; - } 'RT::Client::REST::Object::IllegalMethodException', - "method '$method' should throw an exception"; + } + 'RT::Client::REST::Object::IllegalMethodException', + "method '$method' should throw an exception"; } -ok('attachment' eq $ticket->rt_type); +ok( 'attachment' eq $ticket->rt_type ); diff --git a/t/24-transaction.t b/t/24-transaction.t index 7111e54..b418f3c 100644 --- a/t/24-transaction.t +++ b/t/24-transaction.t @@ -11,8 +11,8 @@ use constant METHODS => ( 'new', 'to_form', 'from_form', 'rt_type', # attrubutes: - 'id', 'creator', 'type', 'old_value', 'new_value', 'parent_id', - 'attachments', 'time_taken', 'field', 'content', 'created', + 'id', 'creator', 'type', 'old_value', 'new_value', 'parent_id', + 'attachments', 'time_taken', 'field', 'content', 'created', 'description', 'data', ); @@ -21,21 +21,23 @@ BEGIN { } for my $method (METHODS) { - can_ok('RT::Client::REST::Transaction', $method); + can_ok( 'RT::Client::REST::Transaction', $method ); } my $tr; lives_ok { $tr = RT::Client::REST::Transaction->new; -} 'Transaction can get successfully instantiated'; +} +'Transaction can get successfully instantiated'; for my $method (qw(store search count)) { throws_ok { $tr->$method; - } 'RT::Client::REST::Object::IllegalMethodException', - "method '$method' should throw an exception"; + } + 'RT::Client::REST::Object::IllegalMethodException', + "method '$method' should throw an exception"; } -ok('transaction' eq $tr->rt_type); +ok( 'transaction' eq $tr->rt_type ); diff --git a/t/25-queue.t b/t/25-queue.t index 8ee43fc..fca96fc 100644 --- a/t/25-queue.t +++ b/t/25-queue.t @@ -23,11 +23,12 @@ my $user; lives_ok { $user = RT::Client::REST::Queue->new; -} 'Queue can get successfully created'; +} +'Queue can get successfully created'; for my $method (METHODS) { - can_ok($user, $method); + can_ok( $user, $method ); } -ok('queue' eq $user->rt_type); +ok( 'queue' eq $user->rt_type ); diff --git a/t/26-group.t b/t/26-group.t index 4364f1a..78a844c 100644 --- a/t/26-group.t +++ b/t/26-group.t @@ -8,7 +8,7 @@ use Test::More tests => 11; use Test::Exception; use constant METHODS => ( - 'new', 'to_form', 'from_form', + 'new', 'to_form', 'from_form', 'rt_type', 'id', # attributes: @@ -23,11 +23,12 @@ my $user; lives_ok { $user = RT::Client::REST::Group->new; -} 'User can get successfully created'; +} +'User can get successfully created'; for my $method (METHODS) { - can_ok($user, $method); + can_ok( $user, $method ); } -ok('group' eq $user->rt_type, 'rt_type is ok'); +ok( 'group' eq $user->rt_type, 'rt_type is ok' ); diff --git a/t/35-db.t b/t/35-db.t index 09b0a8a..6fef3bc 100644 --- a/t/35-db.t +++ b/t/35-db.t @@ -2,30 +2,34 @@ # vim:ft=perl: package MyObject; + # For testing purposes -use base 'RT::Client::REST::Object'; +use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); sub rt_type { 'myobject' } -sub _attributes {{ - id => {}, - abc => { - validation => { - type => SCALAR, +sub _attributes { + { + id => {}, + abc => { + validation => { + type => SCALAR, + }, }, - }, -}} + } +} sub retrieve { my $self = shift; - $self->abc($self->id); + $self->abc( $self->id ); $self->{__dirty} = {}; return $self; } my $i = 0; + sub store { my $self = shift; $::STORED = ++$i; @@ -43,50 +47,58 @@ use vars qw($STORED); use Test::More tests => 20; use Test::Exception; -my $obj = MyObject->new(id => 1); -ok(!defined($obj->abc), "retrieve has not been called"); +my $obj = MyObject->new( id => 1 ); +ok( !defined( $obj->abc ), "retrieve has not been called" ); $obj->retrieve; -ok(defined($obj->abc), "retrieve has been called"); +ok( defined( $obj->abc ), "retrieve has been called" ); $obj->abc(1); -ok(1 == $obj->abc, "attribute 'abc' set correctly"); -ok(1 == $obj->_dirty, "one dirty attribute"); -ok('abc' eq ($obj->_dirty)[0], "and that attribute is 'abc'"); +ok( 1 == $obj->abc, "attribute 'abc' set correctly" ); +ok( 1 == $obj->_dirty, "one dirty attribute" ); +ok( 'abc' eq ( $obj->_dirty )[0], "and that attribute is 'abc'" ); -ok(!defined(MyObject->autostore), "autostore is disabled by default"); -ok(!defined(MyObject->autosync), "autosync is disabled by default"); -ok(!defined(MyObject->autoget), "autoget is disabled by default"); +ok( !defined( MyObject->autostore ), "autostore is disabled by default" ); +ok( !defined( MyObject->autosync ), "autosync is disabled by default" ); +ok( !defined( MyObject->autoget ), "autoget is disabled by default" ); throws_ok { MyObject->be_transparent(3); -} 'RT::Client::REST::Object::InvalidValueException'; +} +'RT::Client::REST::Object::InvalidValueException'; use RT::Client::REST; my $rt = RT::Client::REST->new; lives_ok { MyObject->be_transparent($rt); -} "made MyObject transparent"; - -ok(!defined(MyObject->autostore), "autostore is still disabled"); -ok(MyObject->autosync, "autosync is now enabled"); -ok(MyObject->autoget, "autoget is now enabled"); -ok($rt == MyObject->rt, "the class keeps track of rt object"); - -ok(!defined(RT::Client::REST::Object->autostore), - "autostore is disabled in the parent class"); -ok(!defined(RT::Client::REST::Object->autosync), - "autosync is disabled in the parent class"); -ok(!defined(RT::Client::REST::Object->autoget), - "autoget is disabled in the parent class"); - -$obj = MyObject->new(id => 4); -ok($obj->abc == 4, "object auto-retrieved"); +} +"made MyObject transparent"; + +ok( !defined( MyObject->autostore ), "autostore is still disabled" ); +ok( MyObject->autosync, "autosync is now enabled" ); +ok( MyObject->autoget, "autoget is now enabled" ); +ok( $rt == MyObject->rt, "the class keeps track of rt object" ); + +ok( + !defined( RT::Client::REST::Object->autostore ), + "autostore is disabled in the parent class" +); +ok( + !defined( RT::Client::REST::Object->autosync ), + "autosync is disabled in the parent class" +); +ok( + !defined( RT::Client::REST::Object->autoget ), + "autoget is disabled in the parent class" +); + +$obj = MyObject->new( id => 4 ); +ok( $obj->abc == 4, "object auto-retrieved" ); my $stored = $STORED; $obj->abc(5); -ok($stored + 1 == $STORED, "object is stored"); +ok( $stored + 1 == $STORED, "object is stored" ); $stored = $STORED; $obj->id(10); -ok($stored == $STORED, "modifying 'id' did not trigger a store"); +ok( $stored == $STORED, "modifying 'id' did not trigger a store" ); diff --git a/t/40-search.t b/t/40-search.t index 1e42f60..f8e39dc 100644 --- a/t/40-search.t +++ b/t/40-search.t @@ -5,7 +5,7 @@ use strict; use warnings; package Mock; -use base 'RT::Client::REST::Object'; +use parent 'RT::Client::REST::Object'; sub new { my $class = shift; @@ -21,47 +21,46 @@ package main; use Test::More tests => 20; use Test::Exception; -use constant METHODS => ( - 'new', 'count', 'get_iterator', -); +use constant METHODS => ( 'new', 'count', 'get_iterator', ); BEGIN { use_ok('RT::Client::REST::SearchResult'); } for my $method (METHODS) { - can_ok('RT::Client::REST::SearchResult', $method); + can_ok( 'RT::Client::REST::SearchResult', $method ); } my $search; -my @ids = (1 .. 9); +my @ids = ( 1 .. 9 ); lives_ok { $search = RT::Client::REST::SearchResult->new( - ids => \@ids, - object => sub { Mock->new(id => shift) }, + ids => \@ids, + object => sub { Mock->new( id => shift ) }, ); }; -ok($search->count == 9); +ok( $search->count == 9 ); my $iter; lives_ok { $iter = $search->get_iterator; -} "'get_iterator' call OK"; +} +"'get_iterator' call OK"; -ok('CODE' eq ref($iter), "'get_iterator' returns a coderef"); +ok( 'CODE' eq ref($iter), "'get_iterator' returns a coderef" ); my @results = &$iter; -ok(9 == @results, "Got 9 results in list context"); +ok( 9 == @results, "Got 9 results in list context" ); @results = &$iter; -ok(0 == @results, "Got 0 results in list context second time around"); +ok( 0 == @results, "Got 0 results in list context second time around" ); $iter = $search->get_iterator; my $i = 0; -while (my $obj = &$iter) { +while ( my $obj = &$iter ) { ++$i; - ok($i == $obj->id, "id as expected"); + ok( $i == $obj->id, "id as expected" ); } -ok(9 == $i, "Iterated 9 times (as expected)"); +ok( 9 == $i, "Iterated 9 times (as expected)" ); diff --git a/t/60-with-rt.t b/t/60-with-rt.t index aa17e3c..67fcacd 100644 --- a/t/60-with-rt.t +++ b/t/60-with-rt.t @@ -10,23 +10,24 @@ use warnings; use Test::More; BEGIN { - unless ($ENV{RELEASE_TESTING}) { - plan(skip_all => 'these tests are for release candidate testing'); + unless ( $ENV{RELEASE_TESTING} ) { + plan( skip_all => 'these tests are for release candidate testing' ); } - if (grep { not defined $ENV{$_} } (qw(RTSERVER RTPASS RTUSER))) { - plan(skip_all => 'one of RTSERVER, RTPASS, or RTUSER is not set'); + if ( grep { not defined $ENV{$_} } (qw(RTSERVER RTPASS RTUSER)) ) { + plan( skip_all => 'one of RTSERVER, RTPASS, or RTUSER is not set' ); } } { # We will only use letters, because this string may be used for names of # queues and users in RT and we don't want to fail because of RT rules. - my @chars = ('a' .. 'z', 'A' .. 'Z'); + my @chars = ( 'a' .. 'z', 'A' .. 'Z' ); + sub random_string { my $retval = ''; - for (1 .. 10) { - $retval .= $chars[ int(rand(scalar(@chars))) ]; + for ( 1 .. 10 ) { + $retval .= $chars[ int( rand( scalar(@chars) ) ) ]; } return $retval; } @@ -34,75 +35,108 @@ BEGIN { plan 'no_plan'; -use Error qw(:try); +use Try::Tiny; use File::Temp qw(tempfile); use RT::Client::REST; use RT::Client::REST::Queue; use RT::Client::REST::User; -my $rt = RT::Client::REST->new( - server => $ENV{RTSERVER}, -); -ok($rt, "RT instance is created"); +my $rt = RT::Client::REST->new( server => $ENV{RTSERVER}, ); +ok( $rt, "RT instance is created" ); # Log in with wrong credentials and see that we get expected error { my $e; try { - $rt->login(username => $ENV{RTUSER}, password => "WRONG" . $ENV{RTPASS}); - } catch RT::Client::REST::AuthenticationFailureException with { - $e = shift; + $rt->login( + username => $ENV{RTUSER}, + password => "WRONG" . $ENV{RTPASS} + ); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('RT::Client::REST::AuthenticationFailureException') ) { + $e = $_; + } + else { + $_->rethrow; + } }; - ok(defined($e), "Logging in with wrong credentials throws expected error"); + ok( defined($e), + "Logging in with wrong credentials throws expected error" ); } # Now log in successfully { my $e; try { - $rt->login(username => $ENV{RTUSER}, password => $ENV{RTPASS}); - } catch RT::Client::REST::Exception with { - $e = shift; + $rt->login( username => $ENV{RTUSER}, password => $ENV{RTPASS} ); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('RT::Client::REST::Exception') ) { + $e = $_; + } + else { + $_->rethrow; + } }; - ok(!defined($e), "login is successful"); + ok( !defined($e), "login is successful" ); } # Create a user my $user_id; my %user_props = ( - name => random_string, - password => random_string, - comments => random_string, - real_name => random_string, + name => random_string, + password => random_string, + comments => random_string, + real_name => random_string, ); { - my ($user, $e); + my ( $user, $e ); try { $user = RT::Client::REST::User->new( - rt => $rt, %user_props, + rt => $rt, + %user_props, )->store; - } catch RT::Client::REST::CouldNotCreateObjectException with { - $e = shift; + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('RT::Client::REST::CouldNotCreateObjectException') ) { + $e = $_; + } + else { + $_->rethrow; + } }; - ok(defined($user), "user $user_props{name} created successfully, id: " . $user->id); - ok(!defined($e), "...and no exception was thrown"); + ok( defined($user), + "user $user_props{name} created successfully, id: " + . ( defined $user ? $user->id : 'UNDEF' ) ); + ok( !defined($e), "...and no exception was thrown" ); $user_id = $user->id; } # Retrieve the user we just created and verify its properties { - my $user = RT::Client::REST::User->new(rt => $rt, id => $user_id); + my $user = RT::Client::REST::User->new( rt => $rt, id => $user_id ); my $e; try { $user->retrieve; - } catch Exception::Class::Base with { - $e = shift; - diag("fetching user threw $e"); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("fetching user threw $e"); + } + else { + $_->rethrow; + } }; - ok(!defined($e), "fetched user without exception being thrown"); - while (my ($prop, $val) = each(%user_props)) { + ok( !defined($e), "fetched user without exception being thrown" ); + while ( my ( $prop, $val ) = each(%user_props) ) { next if $prop eq 'password'; # This property comes back obfuscated - is($user->$prop, $val, "user property `$prop' matches"); + is( $user->$prop, $val, "user property `$prop' matches" ); } } @@ -110,84 +144,132 @@ my %user_props = ( my $queue_name = random_string; my $queue_id; { - my ($queue, $e); + my ( $queue, $e ); try { $queue = RT::Client::REST::Queue->new( - rt => $rt, name => $queue_name, + rt => $rt, + name => $queue_name, )->store; $queue_id = $queue->id; - } catch Exception::Class::Base with { - $e = shift; - diag("queue store: $e"); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("queue store: $e"); + } + else { + $_->rethrow; + } }; - ok($queue, "Create queue $queue_name"); - ok(!defined($e), "created queue without exception being thrown"); + ok( $queue, "Create queue $queue_name" ); + ok( !defined($e), "created queue without exception being thrown" ); +} +{ + my ( $queue, $e ); try { $queue = RT::Client::REST::Queue->new( - rt => $rt, id => $queue_id, + rt => $rt, + id => $queue_id, )->retrieve; - } catch Exception::Class::Base with { - $e = shift; - diag("queue retrieve $e"); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("queue retrieve $e"); + } + else { + $_->rethrow; + } }; - is($queue->name, $queue_name, "queue name matches"); + is( $queue->name, $queue_name, "queue name matches" ); + # TODO: with 4.2.3, warning "Unknown key: disabled" is printed } # Create a ticket my $ticket_id; { - my ($ticket, $e); + my ( $ticket, $e ); try { $ticket = RT::Client::REST::Ticket->new( - rt => $rt, queue => $queue_id, subject => random_string, - )->store(text => random_string); - } catch Exception::Class::Base with { - $e = shift; - diag("ticket store: $e"); + rt => $rt, + queue => $queue_id, + subject => random_string, + )->store( text => random_string ); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("ticket store: $e"); + } + else { + $_->rethrow; + } }; - ok(defined($ticket), "Created ticket " . $ticket->id); - ok(!defined($e), "No exception thrown when ticket created"); + ok( defined($ticket), + "Created ticket " . ( defined $ticket ? $ticket->id : 'UNDEF' ) ); + ok( !defined($e), "No exception thrown when ticket created" ); $ticket_id = $ticket->id; } # Attach something to the ticket and verify its count and contents { my $att_contents = "dude this is a text attachment\n"; - my ($fh, $filename) = tempfile; + my ( $fh, $filename ) = tempfile; $fh->print($att_contents); $fh->close; my $e; try { RT::Client::REST::Ticket->new( - rt => $rt, id => $ticket_id, + rt => $rt, + id => $ticket_id, )->comment( message => random_string, - attachments => [ $filename ], + attachments => [$filename], ); - } catch Exception::Class::Base with { - diag("attach to ticket: $e"); - $e = shift; + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("attach to ticket: $e"); + } + else { + $_->rethrow; + } }; - ok(!defined($e), "create attachment and no exception thrown"); + ok( !defined($e), "create attachment and no exception thrown" ); unlink $filename; + $e = undef; try { my $ticket = RT::Client::REST::Ticket->new( - rt => $rt, id => $ticket_id, + rt => $rt, + id => $ticket_id, ); my $atts = $ticket->attachments; + # XXX With RT 4.2.3, the count is 4. Is it the same with previous # versions or is this a change in behavior? - is($atts->count, 1, "There is one attachment to ticket $ticket_id"); + is( $atts->count, 1, "There is one attachment to ticket $ticket_id" ); my $att_iter = $atts->get_iterator; - while (my $att = &$att_iter) { - is($att->content, $att_contents, "Attachment content matches"); + while ( my $att = &$att_iter ) { + is( $att->content, $att_contents, "Attachment content matches" ); + } + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("attach to ticket: $e"); + } + else { + $_->rethrow; } - } catch Exception::Class::Base with { - diag("attach to ticket: $e"); - $e = shift; }; - ok(!defined($e), "listed attachments and no exception thrown"); + ok( !defined($e), "listed attachments and no exception thrown" ); } # TODO: RT 90112: Attachment retrieval returns wrongly decoded files diff --git a/t/80-timeout.t b/t/80-timeout.t index a6e7ded..20cc839 100644 --- a/t/80-timeout.t +++ b/t/80-timeout.t @@ -8,48 +8,56 @@ use warnings; use Test::More; -use Error qw(:try); +use Try::Tiny; use IO::Socket; use RT::Client::REST; use LWP::UserAgent; -plan( skip_all => "LWP::UserAgent 6.04 does not know how to time out, ". - "see RT #81799" ) if $LWP::UserAgent::VERSION eq '6.04'; +plan( skip_all => "LWP::UserAgent 6.04 does not know how to time out, " + . "see RT #81799" ) + if $LWP::UserAgent::VERSION eq '6.04'; my $server = IO::Socket::INET->new( - Type => SOCK_STREAM, - Reuse => 1, + Type => SOCK_STREAM, + Reuse => 1, Listen => 10, ) or die "Could not set up TCP server: $@"; my $port = $server->sockport; -my $pid = fork; # Fork +my $pid = fork; # Fork die "Could not fork: $!" unless defined $pid; -if (0 == $pid) { # Child +if ( 0 == $pid ) { # Child my $buf; my $client = $server->accept; - 1 while ($client->read($buf, 1024)); + 1 while ( $client->read( $buf, 1024 ) ); exit; } -plan tests => 8; # Parent -for my $timeout (1, 2, 5, 10) { +plan tests => 8; # Parent +for my $timeout ( 1, 2, 5, 10 ) { my $rt = RT::Client::REST->new( - server => "http://127.0.0.1:$port", + server => "http://127.0.0.1:$port", timeout => $timeout, ); my $t1 = time; - my ($e, $t2); + my ( $e, $t2 ); try { $rt->login(qw(username a password b)); - } catch Exception::Class::Base with { - $t2 = time; - $e = shift; + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $t2 = time; + $e = $_; + } + else { + $_->rethrow; + } }; - isa_ok($e, 'RT::Client::REST::RequestTimedOutException'); - ok($t2 - $t1 >= $timeout, "Timed out after $timeout seconds"); + isa_ok( $e, 'RT::Client::REST::RequestTimedOutException' ); + ok( $t2 - $t1 >= $timeout, "Timed out after $timeout seconds" ); } diff --git a/t/81-submit.t b/t/81-submit.t index 9448183..eb69f21 100644 --- a/t/81-submit.t +++ b/t/81-submit.t @@ -8,13 +8,12 @@ use warnings; use Test::More; -use Error qw(:try); use IO::Socket; use RT::Client::REST; my $server = IO::Socket::INET->new( - Type => SOCK_STREAM, - Reuse => 1, + Type => SOCK_STREAM, + Reuse => 1, Listen => 10, ) or die "Could not set up TCP server: $@"; @@ -23,26 +22,35 @@ my $port = $server->sockport; my $pid = fork; die "cannot fork: $!" unless defined $pid; -if (0 == $pid) { # Child +if ( 0 == $pid ) { # Child my $buf; my $client = $server->accept; $client->write( -"RT/42foo 200 this is a fake successful response header + "RT/42foo 200 this is a fake successful response header header line 1 header line 2 -response text"); +response text" + ); exit; } plan tests => 1; my $rt = RT::Client::REST->new( - server => "http://127.0.0.1:$port", - timeout => 2, + server => "http://127.0.0.1:$port", + timeout => 2, ); -my $res = $rt->_submit("ticket/1", undef, { +my $res = $rt->_submit( + 'ticket/1', + undef, + { user => 'a', pass => 'b', - }); -unlike($res->{_content}, qr/this is a fake successful response header/, "Make sure response content doesn't contain headers"); + } +); +unlike( + $res->{_content}, + qr/this is a fake successful response header/, + 'Make sure response content doesn\'t contain headers' +); diff --git a/t/82-stringify.t b/t/82-stringify.t index dbb048a..bc121b1 100644 --- a/t/82-stringify.t +++ b/t/82-stringify.t @@ -8,18 +8,18 @@ use warnings; use Test::More; -use Error qw(:try); +use Try::Tiny; use IO::Socket; use RT::Client::REST; # apply the same rule as for 80-timeout.t -plan( skip_all => "LWP::UserAgent 6.04 does not know how to time out, ". - "see RT #81799" ) if $LWP::UserAgent::VERSION eq '6.04'; - +plan( skip_all => "LWP::UserAgent 6.04 does not know how to time out, " + . "see RT #81799" ) + if $LWP::UserAgent::VERSION eq '6.04'; my $server = IO::Socket::INET->new( - Type => SOCK_STREAM, - Reuse => 1, + Type => SOCK_STREAM, + Reuse => 1, Listen => 10, ) or die "Could not set up TCP server: $@"; @@ -28,20 +28,33 @@ my $port = $server->sockport; my $pid = fork; die "cannot fork: $!" unless defined $pid; -if (0 == $pid) { # Child +if ( 0 == $pid ) { # Child my $rt = RT::Client::REST->new( - server => "http://127.0.0.1:$port", - # This ensures that we die soon. When the client dies, the - # while (<$client>) above stops looping. - timeout => 2, + server => "http://127.0.0.1:$port", + + # This ensures that we die soon. When the client dies, the + # while (<$client>) above stops looping. + timeout => 2, ); try { - $rt->_submit("ticket/1", "aaaa", { + $rt->_submit( + "ticket/1", + "aaaa", + { user => 'a', pass => 'b', - }); - } catch RT::Client::REST::RequestTimedOutException with { - # This is what we expect, so we ignore this exception + } + ); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('RT::Client::REST::RequestTimedOutException') ) { + + # This is what we expect, so we ignore this exception + } + else { + $_->rethrow; + } }; exit 0; } @@ -53,12 +66,12 @@ my $data; while (<$client>) { $data .= $_; } -unlike($data, qr/ARRAY\(/, "Avoid stringify objects when sending a request"); +unlike( $data, qr/ARRAY\(/, "Avoid stringify objects when sending a request" ); SKIP: { skip "Self-tests only for release testing", 2 - unless $ENV{RELEASE_TESTING}; + unless $ENV{RELEASE_TESTING}; my $kid = waitpid $pid, 0; - is($kid, $pid, "self-test: we reaped process correctly"); - is($?, 0, "self-test: child process ran successfully"); -}; + is( $kid, $pid, "self-test: we reaped process correctly" ); + is( $?, 0, "self-test: child process ran successfully" ); +} diff --git a/t/83-attachments.t b/t/83-attachments.t index 0600e6b..aa1d7fa 100644 --- a/t/83-attachments.t +++ b/t/83-attachments.t @@ -15,19 +15,19 @@ use Encode; use HTTP::Response; use HTTP::Server::Simple; -my $testfile = 'test.png'; -my $testfile_path = catfile('t' => 'data' => $testfile); +my $testfile = 'test.png'; +my $testfile_path = catfile( 't' => 'data' => $testfile ); my $testfile_content = do { my $fh = IO::File->new($testfile_path) - or die "Couldn't open $testfile_path $!"; + or die "Couldn't open $testfile_path $!"; local $/; <$fh>; }; -my ($reply_header, $reply_body) = do { +my ( $reply_header, $reply_body ) = do { my $binary_string = $testfile_content; - my $length = length($binary_string); + my $length = length($binary_string); $binary_string =~ s/\n/\n /sg; my $body = <<"EOF"; id: 873 @@ -46,54 +46,54 @@ Headers: Content-Type: image/png; name="prova2.png" Content: $binary_string EOF - ('RT/4.0.7 200 Ok', $body); + ( 'RT/4.0.7 200 Ok', $body ); }; -my $http_payload = - $reply_header . - "\n\n" . - $reply_body . - "\n\n" ; +my $http_payload = $reply_header . "\n\n" . $reply_body . "\n\n"; my $http_reply = - "HTTP/1.1 200 OK\r\n" . - "Content-Type: text/plain; charset=utf-8\r\n\r\n" . - $http_payload ; + "HTTP/1.1 200 OK\r\n" + . "Content-Type: text/plain; charset=utf-8\r\n\r\n" + . $http_payload; -my $pipe = IO::Pipe->new; # Used to get port number -my $pid = fork; +my $pipe = IO::Pipe->new; # Used to get port number +my $pid = fork; die "cannot fork: $!" if not defined $pid; -if (0 == $pid) { # Child +if ( 0 == $pid ) { # Child $pipe->writer; { + package My::Web::Server; - use base qw(HTTP::Server::Simple::CGI); + use parent qw(HTTP::Server::Simple::CGI); + sub handle_request { print $http_reply; } + # A hack to get HTTP::Server::Simple listen on ephemeral port. # See RT#72987 sub after_setup_listener { use Socket; my $sock = getsockname HTTP::Server::Simple::HTTPDaemon; - my ($port) = (sockaddr_in($sock))[0]; + my ($port) = ( sockaddr_in($sock) )[0]; $pipe->print("$port\n"); $pipe->close; } } my $server = My::Web::Server->new('00'); - alarm 120; # Just in case, don't hang people - $server->run; # Run until killed + alarm 120; # Just in case, don't hang people + $server->run; # Run until killed die 'unreachable code'; } $pipe->reader; -chomp(my $port = <$pipe>); +chomp( my $port = <$pipe> ); + #diag("set up web server on port $port"); $pipe->close; -unless ($port && $port =~ /^\d+$/) { +unless ( $port && $port =~ /^\d+$/ ) { kill 9, $pid; waitpid $pid, 0; plan skip_all => 'could not get port number from child, skipping all tests'; @@ -102,30 +102,39 @@ unless ($port && $port =~ /^\d+$/) { plan tests => 4; { - my $res = HTTP::Response->parse( $http_reply ); - ok($res->content eq $http_payload, - 'self-test: HTTP::Response gives back correct payload'); + my $res = HTTP::Response->parse($http_reply); + ok( $res->content eq $http_payload, + 'self-test: HTTP::Response gives back correct payload' ); } my $rt = RT::Client::REST->new( - server => "http://127.0.0.1:$port", + server => "http://127.0.0.1:$port", timeout => 2, ); # avoid need to login -$rt->basic_auth_cb(sub { return }); +$rt->basic_auth_cb( sub { return } ); { - my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 1); - ok($res->{Content} eq $testfile_content, 'binary files match with undecoded option'); + my $res = + $rt->get_attachment( parent_id => 130, id => 873, undecoded => 1 ); + ok( + $res->{Content} eq $testfile_content, + 'binary files match with undecoded option' + ); } { - my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 0); - ok($res->{Content} ne encode('latin1', $testfile_content), - q|binary files don't match when decoded to latin1|); - ok($res->{Content} ne encode('utf-8', $testfile_content), - q|binary files don't match when decoded to utf8|); + my $res = + $rt->get_attachment( parent_id => 130, id => 873, undecoded => 0 ); + ok( + $res->{Content} ne encode( 'latin1', $testfile_content ), + q|binary files don't match when decoded to latin1| + ); + ok( + $res->{Content} ne encode( 'utf-8', $testfile_content ), + q|binary files don't match when decoded to utf8| + ); } kill 9, $pid; diff --git a/t/84-attachments-rt127607.t b/t/84-attachments-rt127607.t index 153e6c5..5f746ee 100644 --- a/t/84-attachments-rt127607.t +++ b/t/84-attachments-rt127607.t @@ -16,20 +16,20 @@ use HTTP::Response; use HTTP::Server::Simple; # this file, every line is just spaces -my $testfile = 'spaces.txt'; -my $testfile_path = catfile('t' => 'data' => $testfile); +my $testfile = 'spaces.txt'; +my $testfile_path = catfile( 't' => 'data' => $testfile ); my $testfile_content = do { my $fh = IO::File->new($testfile_path) - or die "Couldn't open $testfile_path $!"; + or die "Couldn't open $testfile_path $!"; local $/; <$fh>; }; -my ($reply_header, $reply_body) = do { +my ( $reply_header, $reply_body ) = do { my $binary_string = $testfile_content; - my $length = length($binary_string); - my $spaces = ' ' x length('Content: '); + my $length = length($binary_string); + my $spaces = ' ' x length('Content: '); $binary_string =~ s/\n/\n$spaces/sg; my $body = <<"EOF"; id: 873 @@ -53,54 +53,54 @@ Headers: MIME-Version: 1.0 Content: $binary_string EOF - ('RT/4.0.7 200 Ok', $body); + ( 'RT/4.0.7 200 Ok', $body ); }; -my $http_payload = - $reply_header . - "\n\n" . - $reply_body . - "\n\n" ; +my $http_payload = $reply_header . "\n\n" . $reply_body . "\n\n"; my $http_reply = - "HTTP/1.1 200 OK\r\n" . - "Content-Type: text/plain; charset=utf-8\r\n\r\n" . - $http_payload ; + "HTTP/1.1 200 OK\r\n" + . "Content-Type: text/plain; charset=utf-8\r\n\r\n" + . $http_payload; -my $pipe = IO::Pipe->new; # Used to get port number -my $pid = fork; +my $pipe = IO::Pipe->new; # Used to get port number +my $pid = fork; die "cannot fork: $!" if not defined $pid; -if (0 == $pid) { # Child +if ( 0 == $pid ) { # Child $pipe->writer; { + package My::Web::Server; - use base qw(HTTP::Server::Simple::CGI); + use parent qw(HTTP::Server::Simple::CGI); + sub handle_request { print $http_reply; } + # A hack to get HTTP::Server::Simple listen on ephemeral port. # See RT#72987 sub after_setup_listener { use Socket; my $sock = getsockname HTTP::Server::Simple::HTTPDaemon; - my ($port) = (sockaddr_in($sock))[0]; + my ($port) = ( sockaddr_in($sock) )[0]; $pipe->print("$port\n"); $pipe->close; } } my $server = My::Web::Server->new('00'); - alarm 120; # Just in case, don't hang people - $server->run; # Run until killed + alarm 120; # Just in case, don't hang people + $server->run; # Run until killed die 'unreachable code'; } $pipe->reader; -chomp(my $port = <$pipe>); +chomp( my $port = <$pipe> ); + #diag("set up web server on port $port"); $pipe->close; -unless ($port && $port =~ /^\d+$/) { +unless ( $port && $port =~ /^\d+$/ ) { kill 9, $pid; waitpid $pid, 0; plan skip_all => 'could not get port number from child, skipping all tests'; @@ -109,26 +109,34 @@ unless ($port && $port =~ /^\d+$/) { plan tests => 3; { - my $res = HTTP::Response->parse( $http_reply ); - ok($res->content eq $http_payload, - 'self-test: HTTP::Response gives back correct payload'); + my $res = HTTP::Response->parse($http_reply); + ok( $res->content eq $http_payload, + 'self-test: HTTP::Response gives back correct payload' ); } my $rt = RT::Client::REST->new( - server => "http://127.0.0.1:$port", + server => "http://127.0.0.1:$port", timeout => 2, ); # avoid need to login -$rt->basic_auth_cb(sub { return }); +$rt->basic_auth_cb( sub { return } ); { - my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 1); - ok($res->{Content} eq $testfile_content, 'files match with undecoded option'); + my $res = + $rt->get_attachment( parent_id => 130, id => 873, undecoded => 1 ); + ok( + $res->{Content} eq $testfile_content, + 'files match with undecoded option' + ); } { - my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 0); - ok($res->{Content} eq $testfile_content, 'files match w/o undecoded option'); + my $res = + $rt->get_attachment( parent_id => 130, id => 873, undecoded => 0 ); + ok( + $res->{Content} eq $testfile_content, + 'files match w/o undecoded option' + ); } kill 9, $pid; diff --git a/t/85-attachments-rt127607.t b/t/85-attachments-rt127607.t index 483bf0f..be53c84 100644 --- a/t/85-attachments-rt127607.t +++ b/t/85-attachments-rt127607.t @@ -16,20 +16,20 @@ use HTTP::Response; use HTTP::Server::Simple; # this file, has more than one line but no endline on the last line -my $testfile = 'nonewline.txt'; -my $testfile_path = catfile('t' => 'data' => $testfile); +my $testfile = 'nonewline.txt'; +my $testfile_path = catfile( 't' => 'data' => $testfile ); my $testfile_content = do { my $fh = IO::File->new($testfile_path) - or die "Couldn't open $testfile_path $!"; + or die "Couldn't open $testfile_path $!"; local $/; <$fh>; }; -my ($reply_header, $reply_body) = do { +my ( $reply_header, $reply_body ) = do { my $binary_string = $testfile_content; - my $length = length($binary_string); - my $spaces = ' ' x length('Content: '); + my $length = length($binary_string); + my $spaces = ' ' x length('Content: '); $binary_string =~ s/\n/\n$spaces/sg; my $body = <<"EOF"; id: 873 @@ -53,54 +53,54 @@ Headers: MIME-Version: 1.0 Content: $binary_string EOF - ('RT/4.0.7 200 Ok', $body); + ( 'RT/4.0.7 200 Ok', $body ); }; -my $http_payload = - $reply_header . - "\n\n" . - $reply_body . - "\n\n" ; +my $http_payload = $reply_header . "\n\n" . $reply_body . "\n\n"; my $http_reply = - "HTTP/1.1 200 OK\r\n" . - "Content-Type: text/plain; charset=utf-8\r\n\r\n" . - $http_payload ; + "HTTP/1.1 200 OK\r\n" + . "Content-Type: text/plain; charset=utf-8\r\n\r\n" + . $http_payload; -my $pipe = IO::Pipe->new; # Used to get port number -my $pid = fork; +my $pipe = IO::Pipe->new; # Used to get port number +my $pid = fork; die "cannot fork: $!" if not defined $pid; -if (0 == $pid) { # Child +if ( 0 == $pid ) { # Child $pipe->writer; { + package My::Web::Server; - use base qw(HTTP::Server::Simple::CGI); + use parent qw(HTTP::Server::Simple::CGI); + sub handle_request { print $http_reply; } + # A hack to get HTTP::Server::Simple listen on ephemeral port. # See RT#72987 sub after_setup_listener { use Socket; my $sock = getsockname HTTP::Server::Simple::HTTPDaemon; - my ($port) = (sockaddr_in($sock))[0]; + my ($port) = ( sockaddr_in($sock) )[0]; $pipe->print("$port\n"); $pipe->close; } } my $server = My::Web::Server->new('00'); - alarm 120; # Just in case, don't hang people - $server->run; # Run until killed + alarm 120; # Just in case, don't hang people + $server->run; # Run until killed die 'unreachable code'; } $pipe->reader; -chomp(my $port = <$pipe>); +chomp( my $port = <$pipe> ); + #diag("set up web server on port $port"); $pipe->close; -unless ($port && $port =~ /^\d+$/) { +unless ( $port && $port =~ /^\d+$/ ) { kill 9, $pid; waitpid $pid, 0; plan skip_all => 'could not get port number from child, skipping all tests'; @@ -109,26 +109,34 @@ unless ($port && $port =~ /^\d+$/) { plan tests => 3; { - my $res = HTTP::Response->parse( $http_reply ); - ok($res->content eq $http_payload, - 'self-test: HTTP::Response gives back correct payload'); + my $res = HTTP::Response->parse($http_reply); + ok( $res->content eq $http_payload, + 'self-test: HTTP::Response gives back correct payload' ); } my $rt = RT::Client::REST->new( - server => "http://127.0.0.1:$port", + server => "http://127.0.0.1:$port", timeout => 2, ); # avoid need to login -$rt->basic_auth_cb(sub { return }); +$rt->basic_auth_cb( sub { return } ); { - my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 1); - ok($res->{Content} eq $testfile_content, 'files match with undecoded option'); + my $res = + $rt->get_attachment( parent_id => 130, id => 873, undecoded => 1 ); + ok( + $res->{Content} eq $testfile_content, + 'files match with undecoded option' + ); } { - my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 0); - ok($res->{Content} eq $testfile_content, 'files match w/o undecoded option'); + my $res = + $rt->get_attachment( parent_id => 130, id => 873, undecoded => 0 ); + ok( + $res->{Content} eq $testfile_content, + 'files match w/o undecoded option' + ); } kill 9, $pid; diff --git a/t/86-redirect.t b/t/86-redirect.t index 666f631..b5edd85 100644 --- a/t/86-redirect.t +++ b/t/86-redirect.t @@ -5,14 +5,13 @@ use warnings; use Test::More; use Data::Dumper; -use Error qw(:try); use IO::Socket; use RT::Client::REST; plan tests => 5; my $server = IO::Socket::INET->new( - Type => SOCK_STREAM, - Reuse => 1, + Type => SOCK_STREAM, + Reuse => 1, Listen => 10, ) or die "Could not set up TCP server: $@"; @@ -21,13 +20,13 @@ my $port = $server->sockport; my $pid = fork; die "cannot fork: $!" unless defined $pid; -if (0 == $pid) { # Child +if ( 0 == $pid ) { # Child { my $response = - "HTTP/1.1 302 Redirect\r\n" . - "Location: http://127.0.0.1:$port\r\n" . - "Content-Type: text/plain; charset=utf-8\r\n\r\n" . - "RT/42foo 200 this is a fake successful response header + "HTTP/1.1 302 Redirect\r\n" + . "Location: http://127.0.0.1:$port\r\n" + . "Content-Type: text/plain; charset=utf-8\r\n\r\n" + . "RT/42foo 200 this is a fake successful response header header line 1 header line 2 @@ -37,58 +36,66 @@ response text"; } { my $response = - "HTTP/1.1 302 Redirect\r\n" . - "Location: http://127.0.0.1:$port\r\n" . - "Content-Type: text/plain; charset=utf-8\r\n\r\n" . - "random string"; + "HTTP/1.1 302 Redirect\r\n" + . "Location: http://127.0.0.1:$port\r\n" + . "Content-Type: text/plain; charset=utf-8\r\n\r\n" + . "random string"; my $client = $server->accept; $client->write($response); } exit; } - my $rt = RT::Client::REST->new( - server => "http://127.0.0.1:$port", - timeout => 2, - verbose_errors => 1, - user_agent_args => { - agent => 'Secret agent', - max_redirect => 0, - }, - ); + server => "http://127.0.0.1:$port", + timeout => 2, + verbose_errors => 1, + user_agent_args => { + agent => 'Secret agent', + max_redirect => 0, + }, +); -is $rt->user_agent->agent, 'Secret agent', "Ua correctly initialized"; -is $rt->user_agent->max_redirect, 0, "Ua correctly initialized with max redirect"; -ok $rt->verbose_errors, "Verbose errors set"; +is $rt->user_agent->agent, 'Secret agent', 'Ua correctly initialized'; +is $rt->user_agent->max_redirect, 0, + 'Ua correctly initialized with max redirect'; +ok $rt->verbose_errors, 'Verbose errors set'; eval { - my $res = $rt->_submit("ticket/1", undef, { - user => 'a', - pass => 'b', - }); + my $res = $rt->_submit( + 'ticket/1', + undef, + { + user => 'a', + pass => 'b', + } + ); }; -like $@, qr{fetching .*/REST/1.0/ticket/1}, "Double redirect dies meaningfully"; +like $@, qr{fetching .*/REST/1.0/ticket/1}, 'Double redirect dies meaningfully'; $pid = fork; die "cannot fork: $!" unless defined $pid; -if (0 == $pid) { # Child +if ( 0 == $pid ) { # Child { my $response = - "HTTP/1.1 200 OK\r\n" . - "Location: http://127.0.0.1:$port\r\n" . - "Content-Type: text/plain; charset=utf-8\r\n\r\n" . - "response text"; + "HTTP/1.1 200 OK\r\n" + . "Location: http://127.0.0.1:$port\r\n" + . "Content-Type: text/plain; charset=utf-8\r\n\r\n" + . 'response text'; my $client = $server->accept; $client->write($response); } exit; } eval { - my $res = $rt->_submit("ticket/1", undef, { - user => 'a', - pass => 'b', - }); + my $res = $rt->_submit( + 'ticket/1', + undef, + { + user => 'a', + pass => 'b', + } + ); }; -like $@, qr{Malformed.*/REST/1.0/ticket/1}, "Random data is reported correctly"; +like $@, qr{Malformed.*/REST/1.0/ticket/1}, 'Random data is reported correctly'; From d1946d055d6492e906ba79d732382d6ff4847e26 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 24 Sep 2022 21:05:17 -0700 Subject: [PATCH 73/85] Allow Queues to be disabled --- lib/RT/Client/REST/Queue.pm | 16 ++++++-- t/60-with-rt.t | 82 ++++++++++++++++++++++++++----------- 2 files changed, 70 insertions(+), 28 deletions(-) diff --git a/lib/RT/Client/REST/Queue.pm b/lib/RT/Client/REST/Queue.pm index 562d79c..1ce3cff 100644 --- a/lib/RT/Client/REST/Queue.pm +++ b/lib/RT/Client/REST/Queue.pm @@ -99,6 +99,7 @@ sub _attributes {{ validation => { type => SCALAR, }, + rest_name => 'Disabled', }, admin_cc_addresses => { @@ -162,14 +163,22 @@ Final priority. Default due in. -=item B +=item B -CC Addresses (comma delimited). +Queue is disabled =item B Admin CC Addresses (comma delimited). +=item B + +CC Addresses (comma delimited). + +=item B + +Queue SLA is disabled + =item B Access custom fields. Inherited from L, where @@ -178,7 +187,8 @@ you can read more details. Trivial example: my $queue = RT::Client::REST::Queue->new( - rt => $rt, id => $queue_id + rt => $rt, + id => $queue_id )->retrieve(); my @customfields = $queue->cf(); for my $f (@customfields) { diff --git a/t/60-with-rt.t b/t/60-with-rt.t index 67fcacd..047e401 100644 --- a/t/60-with-rt.t +++ b/t/60-with-rt.t @@ -1,4 +1,5 @@ #!perl +# vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # This test is for testing RT::Client::REST with a real instance of RT. # This is so that we can verify bug reports and compare functionality @@ -8,6 +9,7 @@ use strict; use warnings; use Test::More; +use File::Spec::Functions qw/ splitpath /; BEGIN { unless ( $ENV{RELEASE_TESTING} ) { @@ -42,7 +44,7 @@ use RT::Client::REST::Queue; use RT::Client::REST::User; my $rt = RT::Client::REST->new( server => $ENV{RTSERVER}, ); -ok( $rt, "RT instance is created" ); +ok( $rt, 'RT instance is created' ); # Log in with wrong credentials and see that we get expected error { @@ -50,7 +52,7 @@ ok( $rt, "RT instance is created" ); try { $rt->login( username => $ENV{RTUSER}, - password => "WRONG" . $ENV{RTPASS} + password => 'WRONG' . $ENV{RTPASS} ); } catch { @@ -63,7 +65,7 @@ ok( $rt, "RT instance is created" ); } }; ok( defined($e), - "Logging in with wrong credentials throws expected error" ); + 'Logging in with wrong credentials throws expected error' ); } # Now log in successfully @@ -81,16 +83,16 @@ ok( $rt, "RT instance is created" ); $_->rethrow; } }; - ok( !defined($e), "login is successful" ); + ok( !defined($e), 'login is successful' ); } # Create a user my $user_id; my %user_props = ( - name => random_string, - password => random_string, - comments => random_string, - real_name => random_string, + name => random_string(), + password => random_string(), + comments => random_string(), + real_name => random_string(), ); { my ( $user, $e ); @@ -112,7 +114,7 @@ my %user_props = ( ok( defined($user), "user $user_props{name} created successfully, id: " . ( defined $user ? $user->id : 'UNDEF' ) ); - ok( !defined($e), "...and no exception was thrown" ); + ok( !defined($e), '...and no exception was thrown' ); $user_id = $user->id; } @@ -133,7 +135,7 @@ my %user_props = ( $_->rethrow; } }; - ok( !defined($e), "fetched user without exception being thrown" ); + ok( !defined($e), 'fetched user without exception being thrown' ); while ( my ( $prop, $val ) = each(%user_props) ) { next if $prop eq 'password'; # This property comes back obfuscated is( $user->$prop, $val, "user property `$prop' matches" ); @@ -141,10 +143,11 @@ my %user_props = ( } # Create a queue -my $queue_name = random_string; +my $queue_name = 'A queue named ' . random_string(); my $queue_id; +my $queue; { - my ( $queue, $e ); + my $e; try { $queue = RT::Client::REST::Queue->new( rt => $rt, @@ -156,17 +159,17 @@ my $queue_id; die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { $e = $_; - diag("queue store: $e"); + diag("test queue store: $e"); } else { $_->rethrow; } }; - ok( $queue, "Create queue $queue_name" ); - ok( !defined($e), "created queue without exception being thrown" ); + ok( $queue, "Create test queue '$queue_name'" ); + ok( !defined($e), 'created test queue without exception being thrown' ); } { - my ( $queue, $e ); + my $e; try { $queue = RT::Client::REST::Queue->new( rt => $rt, @@ -183,7 +186,7 @@ my $queue_id; $_->rethrow; } }; - is( $queue->name, $queue_name, "queue name matches" ); + is( $queue->name, $queue_name, 'test queue name matches' ); # TODO: with 4.2.3, warning "Unknown key: disabled" is printed } @@ -196,8 +199,8 @@ my $ticket_id; $ticket = RT::Client::REST::Ticket->new( rt => $rt, queue => $queue_id, - subject => random_string, - )->store( text => random_string ); + subject => 'This is a subject ' . random_string(), + )->store( text => 'Some random text ' . random_string() ); } catch { die $_ unless blessed $_ && $_->can('rethrow'); @@ -221,13 +224,14 @@ my $ticket_id; my ( $fh, $filename ) = tempfile; $fh->print($att_contents); $fh->close; + my $message = 'This is a message ' . random_string(), my $e; try { RT::Client::REST::Ticket->new( rt => $rt, id => $ticket_id, )->comment( - message => random_string, + message => $message, attachments => [$filename], ); } @@ -241,7 +245,7 @@ my $ticket_id; $_->rethrow; } }; - ok( !defined($e), "create attachment and no exception thrown" ); + ok( !defined($e), 'create attachment and no exception thrown' ); unlink $filename; $e = undef; try { @@ -251,13 +255,20 @@ my $ticket_id; ); my $atts = $ticket->attachments; - # XXX With RT 4.2.3, the count is 4. Is it the same with previous + # XXX With RT 4.2.3, the count is 4. Is it the same with previous # versions or is this a change in behavior? - is( $atts->count, 1, "There is one attachment to ticket $ticket_id" ); + is( $atts->count, 4, "There are 4 attachment to ticket $ticket_id" ); my $att_iter = $atts->get_iterator; - while ( my $att = &$att_iter ) { + my $basename = (splitpath($filename))[2]; + my ($att) = grep { $_->file_name eq $basename } &$att_iter; + if ($att) { + ok(1, "Found attachment with filename: $basename"); is( $att->content, $att_contents, "Attachment content matches" ); } + else { + ok(0, "Found attachment with filename: $basename"); + } + } catch { die $_ unless blessed $_ && $_->can('rethrow'); @@ -269,7 +280,28 @@ my $ticket_id; $_->rethrow; } }; - ok( !defined($e), "listed attachments and no exception thrown" ); + ok( !defined($e), 'listed attachments and no exception thrown' ); } # TODO: RT 90112: Attachment retrieval returns wrongly decoded files + +# Disable the queue +{ + my $e; + try { + $queue->disabled(1); + $queue->store; + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("disable test queue: $e"); + } + else { + $_->rethrow; + } + }; + ok( !defined($e), 'disabled queue without exception being thrown' ); +} + From 241d1b2495745e0f9a0935d921b9ce171fd356fd Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 24 Sep 2022 21:24:06 -0700 Subject: [PATCH 74/85] Add ticket status as a method and test it against the server --- lib/RT/Client/REST/Ticket.pm | 1 + t/60-with-rt.t | 43 +++++++++++++++++++++++------------- 2 files changed, 29 insertions(+), 15 deletions(-) diff --git a/lib/RT/Client/REST/Ticket.pm b/lib/RT/Client/REST/Ticket.pm index eefc42a..8df5396 100644 --- a/lib/RT/Client/REST/Ticket.pm +++ b/lib/RT/Client/REST/Ticket.pm @@ -101,6 +101,7 @@ sub _attributes {{ # custom statuses. type => SCALAR, }, + rest_name => 'Status', }, priority => { diff --git a/t/60-with-rt.t b/t/60-with-rt.t index 047e401..f79fd2f 100644 --- a/t/60-with-rt.t +++ b/t/60-with-rt.t @@ -192,14 +192,15 @@ my $queue; } # Create a ticket -my $ticket_id; +my $ticket; { - my ( $ticket, $e ); + my $e; + my $subject = 'This is a subject ' . random_string(); try { $ticket = RT::Client::REST::Ticket->new( rt => $rt, queue => $queue_id, - subject => 'This is a subject ' . random_string(), + subject => $subject, )->store( text => 'Some random text ' . random_string() ); } catch { @@ -213,9 +214,8 @@ my $ticket_id; } }; ok( defined($ticket), - "Created ticket " . ( defined $ticket ? $ticket->id : 'UNDEF' ) ); - ok( !defined($e), "No exception thrown when ticket created" ); - $ticket_id = $ticket->id; + "Created ticket '$subject' ID " . ( defined $ticket ? $ticket->id : 'UNDEF' ) ); + ok( !defined($e), 'No exception thrown when ticket created' ); } # Attach something to the ticket and verify its count and contents @@ -227,10 +227,7 @@ my $ticket_id; my $message = 'This is a message ' . random_string(), my $e; try { - RT::Client::REST::Ticket->new( - rt => $rt, - id => $ticket_id, - )->comment( + $ticket->comment( message => $message, attachments => [$filename], ); @@ -249,15 +246,11 @@ my $ticket_id; unlink $filename; $e = undef; try { - my $ticket = RT::Client::REST::Ticket->new( - rt => $rt, - id => $ticket_id, - ); my $atts = $ticket->attachments; # XXX With RT 4.2.3, the count is 4. Is it the same with previous # versions or is this a change in behavior? - is( $atts->count, 4, "There are 4 attachment to ticket $ticket_id" ); + is( $atts->count, 4, "There are 4 attachment to ticket " . $ticket->id ); my $att_iter = $atts->get_iterator; my $basename = (splitpath($filename))[2]; my ($att) = grep { $_->file_name eq $basename } &$att_iter; @@ -283,6 +276,26 @@ my $ticket_id; ok( !defined($e), 'listed attachments and no exception thrown' ); } +# Delete the ticket +{ + my $e; + try { + $ticket->status('deleted'); + $ticket->store; + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("delete ticket: $e"); + } + else { + $_->rethrow; + } + }; + ok( !defined($e), 'ticket deleted and no exception thrown' ); +} + # TODO: RT 90112: Attachment retrieval returns wrongly decoded files # Disable the queue From 915b519fc73ede2db1a9453b6bdbacd14c9cbbe9 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 24 Sep 2022 21:51:32 -0700 Subject: [PATCH 75/85] GH#20 Allow HTML in comments --- lib/RT/Client/REST.pm | 35 +++++++++++++++++++-- lib/RT/Client/REST/Attachment.pm | 1 + lib/RT/Client/REST/Object.pm | 3 +- t/60-with-rt.t | 52 ++++++++++++++++++++++++++++++-- 4 files changed, 84 insertions(+), 7 deletions(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 45b96cc..293575e 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -425,6 +425,14 @@ sub comment { Text => $msg, ); + if (exists($opts{html})) { + if ($opts{html}) { + push @objects, 'Content-Type'; + $values{'Content-Type'} = 'text/html'; + } + delete($opts{html}); + } + if (exists($opts{cc})) { push @objects, 'Cc'; $values{Cc} = delete($opts{cc}); @@ -1118,9 +1126,24 @@ using C method: =for stopwords bcc Comment on a ticket with ID B<$id>. -Optionally takes arguments B and B which are references to lists -of e-mail addresses and B which is a list of filenames to -be attached to the ticket. + +Optionally takes arguments: + +=over 2 + +=item B and B + +References to lists of e-mail addresses + +=item B + +A list of filenames to be attached to the ticket + +=item B + +When true, indicates to RT that the message is html + +=back $rt->comment( ticket_id => 5, @@ -1128,6 +1151,12 @@ be attached to the ticket. cc => [qw(dmitri@localhost some@otherdude.com)], ); + $rt->comment( + ticket_id => 5, + message => "Wild thing, you make my heart sing", + html => 1 + ); + =item correspond (ticket_id => $id, message => $message, %opts) Add correspondence to ticket ID B<$id>. Takes optional B, diff --git a/lib/RT/Client/REST/Attachment.pm b/lib/RT/Client/REST/Attachment.pm index 8122844..3602724 100644 --- a/lib/RT/Client/REST/Attachment.pm +++ b/lib/RT/Client/REST/Attachment.pm @@ -1,4 +1,5 @@ #!perl +# vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST::Attachment # ABSTRACT: attachment object representation. diff --git a/lib/RT/Client/REST/Object.pm b/lib/RT/Client/REST/Object.pm index 32cb2de..096510d 100644 --- a/lib/RT/Client/REST/Object.pm +++ b/lib/RT/Client/REST/Object.pm @@ -536,7 +536,8 @@ sub store { id => $self->id, set => $self->to_form, ); - } else { + } + else { my $id = $rt->create( type => $self->rt_type, set => $self->to_form, diff --git a/t/60-with-rt.t b/t/60-with-rt.t index f79fd2f..7368d36 100644 --- a/t/60-with-rt.t +++ b/t/60-with-rt.t @@ -242,7 +242,7 @@ my $ticket; $_->rethrow; } }; - ok( !defined($e), 'create attachment and no exception thrown' ); + ok( !defined($e), 'Create attachment and no exception thrown' ); unlink $filename; $e = undef; try { @@ -250,13 +250,13 @@ my $ticket; # XXX With RT 4.2.3, the count is 4. Is it the same with previous # versions or is this a change in behavior? - is( $atts->count, 4, "There are 4 attachment to ticket " . $ticket->id ); + is( $atts->count, 4, 'There are 4 attachment to ticket ' . $ticket->id ); my $att_iter = $atts->get_iterator; my $basename = (splitpath($filename))[2]; my ($att) = grep { $_->file_name eq $basename } &$att_iter; if ($att) { ok(1, "Found attachment with filename: $basename"); - is( $att->content, $att_contents, "Attachment content matches" ); + is( $att->content, $att_contents, 'Attachment content matches' ); } else { ok(0, "Found attachment with filename: $basename"); @@ -275,6 +275,52 @@ my $ticket; }; ok( !defined($e), 'listed attachments and no exception thrown' ); } +# Comment with HTML +{ + my $message = sprintf('Some html message text
%s
', random_string()); + my $e; + try { + $ticket->comment( + message => $message, + html => 1 + ); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("attach to ticket: $e"); + } + else { + $_->rethrow; + } + }; + ok( !defined($e), 'Add html comment and no exception thrown' ); + try { + my $atts = $ticket->attachments; + my $att_iter = $atts->get_iterator; + my $att = (&$att_iter)[-1]; + if ($att) { + ok(1, 'Retrieved final attachment'); + is( $att->content_type, 'text/html', 'Content-Type is text/html' ); + } + else { + ok(0, 'Retrieved final attachment'); + } + + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("attach to ticket: $e"); + } + else { + $_->rethrow; + } + }; + ok( !defined($e), 'listed attachments and no exception thrown' ); +} # Delete the ticket { From 9b38b9bdf7b2ba00e4e72e8b9b8c3b32cc629326 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 24 Sep 2022 21:54:42 -0700 Subject: [PATCH 76/85] Update README.md --- README.md | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/README.md b/README.md index 2f3dbf7..87a7562 100644 --- a/README.md +++ b/README.md @@ -42,8 +42,6 @@ See **CONTRIBUTORS** file License ------- -This module is licensed under the same terms as perl itself. +This module is licensed under both the Aristic 1.0 and GPL 1.0, the same terms as Perl itself. -[![Build Status](https://travis-ci.org/RT-Client-REST/RT-Client-REST.svg?branch=master)](https://travis-ci.org/RT-Client-REST/RT-Client-REST) [![CPAN version](https://badge.fury.io/pl/RT-Client-REST.svg)](https://metacpan.org/pod/RT::Client::REST) -[![Kritika Analysis Status](https://kritika.io/users/djzort/repos/2034482163273651/heads/master/status.svg)](https://kritika.io/users/djzort/repos/2034482163273651/heads/master/) From 4eaeabf7799d09c7a588fcea186d95b5bbb7c9b8 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 25 Sep 2022 22:14:24 -0700 Subject: [PATCH 77/85] RT#120077 Fetch ticket subjects with a single API call --- lib/RT/Client/REST.pm | 31 +++++++++++++++++++++++++++--- lib/RT/Client/REST/SearchResult.pm | 25 +++++++++++++----------- t/60-with-rt.t | 25 ++++++++++++++++++++++++ 3 files changed, 67 insertions(+), 14 deletions(-) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 293575e..a624331 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -351,12 +351,26 @@ sub search { my $type = $self->_valid_type(delete($opts{type})); my $query = delete($opts{query}); my $orderby = delete($opts{orderby}); + my $format = delete($opts{format}); + if (defined($format)) { + $format = undef if $format ne 's' + } my $r = $self->_submit("search/$type", { query => $query, (defined($orderby) ? (orderby => $orderby) : ()), + (defined($format) ? (format => $format) : ()), }); + if (defined($format) and $format eq 's') { + my @results; + # while() never stops if the method is used in the regex + my $text = $r->decoded_content; + while ($text =~ m/^(\d+): (.*)/gm) { + push @results, [$1, $2] + } + return @results + } return $r->decoded_content =~ m/^(\d+):/gm; } @@ -1076,7 +1090,7 @@ text of the ticket. Returns numeric ID of the new object. If numeric ID cannot be parsed from the response, B is thrown. -=item search (type => $type, query => $query, %opts) +=item search (type => $type, query => $query, format => $format, %opts) Search for object of type C<$type> by using query C<$query>. For example: @@ -1108,7 +1122,7 @@ order (minus). For example: =back -C returns the list of numeric IDs of objects that matched +By default, C returns the list of numeric IDs of objects that matched your query. You can then use these to retrieve object information using C method: @@ -1118,7 +1132,18 @@ using C method: ); for my $id (@ids) { my ($ticket) = $rt->show(type => 'ticket', id => $id); - print "Subject: ", $ticket->{Subject}, "\n"; + say "Subject: ", $ticket->{Subject} + } + +C can return a list of lists of ID and Subject when asked for format 's'. + + my @results = $rt->search( + type => 'ticket', + query => "Status = 'stalled'", + format => 's', + ); + for my $result (@results) { + say "ID: $result[0], Subject: $result[1]" } =item comment (ticket_id => $id, message => $message, %opts) diff --git a/lib/RT/Client/REST/SearchResult.pm b/lib/RT/Client/REST/SearchResult.pm index a7c8185..47b8ddd 100644 --- a/lib/RT/Client/REST/SearchResult.pm +++ b/lib/RT/Client/REST/SearchResult.pm @@ -1,4 +1,5 @@ #!perl +# vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST::SearchResult # ABSTRACT: search results object. @@ -16,17 +17,17 @@ sub new { # FIXME: add validation. $self->{_object} = $opts{object}; - $self->{_ids} = $opts{ids} || []; + $self->{_ids} = $opts{ids} || []; return $self; } -sub count { scalar(@{shift->{_ids}}) } +sub count { scalar( @{ shift->{_ids} } ) } sub _retrieve { - my ($self, $obj) = @_; + my ( $self, $obj ) = @_; - unless ($obj->autoget) { + unless ( $obj->autoget ) { $obj->retrieve; } @@ -34,8 +35,8 @@ sub _retrieve { } sub get_iterator { - my $self = shift; - my @ids = @{$self->{_ids}}; + my $self = shift; + my @ids = @{ $self->{_ids} }; my $object = $self->{_object}; return sub { @@ -43,11 +44,13 @@ sub get_iterator { my @tomap = @ids; @ids = (); - return map { $self->_retrieve($object->($_)) } @tomap; - } elsif (@ids) { - return $self->_retrieve($object->(shift(@ids))); - } else { - return; # This signifies the end of the iterations + return map { $self->_retrieve( $object->($_) ) } @tomap; + } + elsif (@ids) { + return $self->_retrieve( $object->( shift(@ids) ) ); + } + else { + return; # This signifies the end of the iterations } }; } diff --git a/t/60-with-rt.t b/t/60-with-rt.t index 7368d36..03014e1 100644 --- a/t/60-with-rt.t +++ b/t/60-with-rt.t @@ -322,6 +322,31 @@ my $ticket; ok( !defined($e), 'listed attachments and no exception thrown' ); } +# Search for tickets (with format s) +{ + my (@results, $e); + try { + @results = $rt->search( + type => 'ticket', + query => "Queue='$queue_name'", + format => 's' + ) + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + $e = $_; + diag("searching for tickets (with format s): $e"); + } + else { + $_->rethrow; + } + }; + ok( scalar @results > 0, 'Found some results (with format s)' ); + is_deeply( \@results, [[ $ticket->id, $ticket->subject ]], 'Search results as expected (with format s)' ); + ok( !defined($e), 'No exception thrown when searching tickets (with format s)' ); +} + # Delete the ticket { my $e; From 70970263432bccc4b0493eafb485cec3331115d3 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 25 Sep 2022 22:15:55 -0700 Subject: [PATCH 78/85] Bump to 0.70 --- CHANGES | 11 +++++++++++ dist.ini | 2 +- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 087ddff..6206d89 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,16 @@ Revision history for Perl module RT::Client::REST +0.70 Sun Sep 25 2022 "Dean Hamstead" + - GH#26 Swap from Error's try to Try::Tiny + - GH#26 Remove Error entirely + - Swap from base to parent + - Attempt to resolve issues with trailing endlines on attachments + - Allow queues to be disabled (or enabled) + - Add status as a method for Tickets + - GH#20 Allow HTML in comments + - Point MetaCPAN at Github for issues + - RT#120077 fetch ticket subjects with a single API call + 0.60 Wed May 6 2020 "Dean Hamstead" - PR#25 GH#23 Fix get_attachments_metadata - PR#24 GH#22 Fix get_attachments_metadata diff --git a/dist.ini b/dist.ini index b865375..2e42f37 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.60 +version = 0.70 license = Perl_5 copyright_holder = Dmitri Tikhonov main_module = lib/RT/Client/REST.pm From 3ee83ea38d9df4e6aeb87448d10e95e6dad5f300 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sun, 25 Sep 2022 22:21:25 -0700 Subject: [PATCH 79/85] Add words for pod spelling --- lib/RT/Client/REST.pm | 2 ++ lib/RT/Client/REST/Queue.pm | 2 ++ 2 files changed, 4 insertions(+) diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index a624331..d32a09e 100644 --- a/lib/RT/Client/REST.pm +++ b/lib/RT/Client/REST.pm @@ -1164,6 +1164,8 @@ References to lists of e-mail addresses A list of filenames to be attached to the ticket +=for stopwords html + =item B When true, indicates to RT that the message is html diff --git a/lib/RT/Client/REST/Queue.pm b/lib/RT/Client/REST/Queue.pm index 1ce3cff..f3b73ae 100644 --- a/lib/RT/Client/REST/Queue.pm +++ b/lib/RT/Client/REST/Queue.pm @@ -175,6 +175,8 @@ Admin CC Addresses (comma delimited). CC Addresses (comma delimited). +=for stopwords SLA + =item B Queue SLA is disabled From 5cd0408245e8e170b88c366c306fab93d4dfffb9 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 26 Sep 2022 12:24:02 -0700 Subject: [PATCH 80/85] Update examples to use Try::Tiny --- examples/comment_on_ticket.pl | 31 +++++++++++++------------ examples/create_ticket.pl | 18 +++++++-------- examples/create_user.pl | 27 ++++++++++++---------- examples/edit_custom_field.pl | 31 +++++++++++++------------ examples/edit_group.pl | 16 ++++++------- examples/edit_ticket.pl | 16 ++++++------- examples/edit_user.pl | 16 ++++++------- examples/list_attachments.pl | 27 ++++++++++++---------- examples/list_tickets.pl | 29 +++++++++++++----------- examples/list_transactions.pl | 29 +++++++++++++----------- examples/list_transactions_rt.pl | 28 ++++++++++++----------- examples/report-bug-to-cpan.pl | 32 ++++++++++++++------------ examples/search_tickets.pl | 33 ++++++++++++++------------- examples/show_attachment.pl | 27 ++++++++++++---------- examples/show_group.pl | 16 ++++++------- examples/show_links.pl | 39 +++++++++++++++++--------------- examples/show_queue.pl | 27 ++++++++++++---------- examples/show_ticket.pl | 34 +++++++++++++++------------- examples/show_transaction.pl | 29 +++++++++++++----------- examples/show_user.pl | 27 ++++++++++++---------- examples/take_ticket.pl | 27 ++++++++++++---------- 21 files changed, 302 insertions(+), 257 deletions(-) diff --git a/examples/comment_on_ticket.pl b/examples/comment_on_ticket.pl index bdbf30f..3fb3ff3 100644 --- a/examples/comment_on_ticket.pl +++ b/examples/comment_on_ticket.pl @@ -5,36 +5,39 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; -unless (@ARGV >= 4) { +unless ( @ARGV >= 4 ) { die "Usage: $0 username password ticket_id comment\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); my $ticket = RT::Client::REST::Ticket->new( - rt => $rt, - id => shift(@ARGV), + rt => $rt, + id => shift(@ARGV), ); try { $ticket->comment( message => shift(@ARGV), - cc => [qw(dmitri@abc.com dmitri@localhost)], - bcc => [qw(dmitri@localhost)], + cc => [qw(dmitri@abc.com dmitri@localhost)], + bcc => [qw(dmitri@localhost)], ); -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; use Data::Dumper; diff --git a/examples/create_ticket.pl b/examples/create_ticket.pl index ec215c9..96efcd7 100644 --- a/examples/create_ticket.pl +++ b/examples/create_ticket.pl @@ -8,26 +8,26 @@ use RT::Client::REST; use RT::Client::REST::Ticket; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password queue subject\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); print "Please enter the text of the ticket:\n"; -my $text = join('', ); +my $text = join( '', ); my $ticket = RT::Client::REST::Ticket->new( - rt => $rt, + rt => $rt, queue => shift(@ARGV), subject => shift(@ARGV), -)->store(text => $text); +)->store( text => $text ); use Data::Dumper; print Dumper($ticket); diff --git a/examples/create_user.pl b/examples/create_user.pl index 01c389a..59b9bce 100644 --- a/examples/create_user.pl +++ b/examples/create_user.pl @@ -5,32 +5,35 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::User; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password user password\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); my $user; try { $user = RT::Client::REST::User->new( - rt => $rt, - name => shift(@ARGV), + rt => $rt, + name => shift(@ARGV), password => shift(@ARGV), )->store; -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; print "User created. Id: ", $user->id, "\n"; diff --git a/examples/edit_custom_field.pl b/examples/edit_custom_field.pl index 2302d20..d9fe90d 100644 --- a/examples/edit_custom_field.pl +++ b/examples/edit_custom_field.pl @@ -5,37 +5,40 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id [key-value pairs]\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); my $ticket = RT::Client::REST::Ticket->new( - rt => $rt, - id => shift(@ARGV), + rt => $rt, + id => shift(@ARGV), ); my %opts = @ARGV; -while (my ($cf, $value) = each(%opts)) { - $ticket->cf($cf, $value); +while ( my ( $cf, $value ) = each(%opts) ) { + $ticket->cf( $cf, $value ); } try { $ticket->store; -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; use Data::Dumper; diff --git a/examples/edit_group.pl b/examples/edit_group.pl index b3a605d..349f202 100644 --- a/examples/edit_group.pl +++ b/examples/edit_group.pl @@ -8,21 +8,21 @@ use RT::Client::REST; use RT::Client::REST::Group; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password group_id [key-value pairs]\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); my $group = RT::Client::REST::Group->new( - rt => $rt, - id => shift(@ARGV), + rt => $rt, + id => shift(@ARGV), @ARGV )->store; diff --git a/examples/edit_ticket.pl b/examples/edit_ticket.pl index fa23c32..c421085 100644 --- a/examples/edit_ticket.pl +++ b/examples/edit_ticket.pl @@ -8,23 +8,23 @@ use RT::Client::REST; use RT::Client::REST::Ticket; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id attribute value1, value2..\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); RT::Client::REST::Ticket->be_transparent($rt); -my ($id, $attr, @vals) = @ARGV; +my ( $id, $attr, @vals ) = @ARGV; my $ticket = RT::Client::REST::Ticket->new( - id => $id, + id => $id, $attr, 1 == @vals ? @vals : \@vals, ); diff --git a/examples/edit_user.pl b/examples/edit_user.pl index 48badc6..13bf6c9 100644 --- a/examples/edit_user.pl +++ b/examples/edit_user.pl @@ -8,21 +8,21 @@ use RT::Client::REST; use RT::Client::REST::User; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password user_id [key-value pairs]\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); my $user = RT::Client::REST::User->new( - rt => $rt, - id => shift(@ARGV), + rt => $rt, + id => shift(@ARGV), @ARGV, )->store; diff --git a/examples/list_attachments.pl b/examples/list_attachments.pl index f595927..972aa97 100644 --- a/examples/list_attachments.pl +++ b/examples/list_attachments.pl @@ -5,37 +5,40 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Attachment; use RT::Client::REST::Ticket; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); -my $ticket = RT::Client::REST::Ticket->new(rt => $rt, id => shift(@ARGV)); +my $ticket = RT::Client::REST::Ticket->new( rt => $rt, id => shift(@ARGV) ); my $results; try { $results = $ticket->attachments; -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; my $count = $results->count; print "There are $count results that matched your query\n"; my $iterator = $results->get_iterator; -while (my $att = &$iterator) { +while ( my $att = &$iterator ) { print "Id: ", $att->id, "; Subject: ", $att->subject, "\n"; } diff --git a/examples/list_tickets.pl b/examples/list_tickets.pl index 5563901..f8ceea3 100644 --- a/examples/list_tickets.pl +++ b/examples/list_tickets.pl @@ -5,38 +5,41 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Queue; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password queue_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); -my $queue = RT::Client::REST::Queue->new(rt => $rt, id => shift(@ARGV)); +my $queue = RT::Client::REST::Queue->new( rt => $rt, id => shift(@ARGV) ); my $results; try { $results = $queue->tickets; -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; my $count = $results->count; print "There are $count tickets\n"; my $iterator = $results->get_iterator; -while (my $t = &$iterator) { +while ( my $t = &$iterator ) { print "Id: ", $t->id, "; Status: ", $t->status, - "; Subject ", $t->subject, "\n"; + "; Subject ", $t->subject, "\n"; } diff --git a/examples/list_transactions.pl b/examples/list_transactions.pl index db8fe4c..88e812d 100644 --- a/examples/list_transactions.pl +++ b/examples/list_transactions.pl @@ -5,40 +5,43 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Transaction; use RT::Client::REST::Ticket; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); RT::Client::REST::Object->be_transparent($rt); -my $ticket = RT::Client::REST::Ticket->new(id => shift(@ARGV)); +my $ticket = RT::Client::REST::Ticket->new( id => shift(@ARGV) ); my $results; try { - $results = $ticket->transactions;#(type => 'Comment'); -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message; + $results = $ticket->transactions; #(type => 'Comment'); +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; my $count = $results->count; print "There are $count transactions\n"; my $iterator = $results->get_iterator; -while (my $tr = &$iterator) { +while ( my $tr = &$iterator ) { print "Id: ", $tr->id, "; Type: ", $tr->type, "\n"; } diff --git a/examples/list_transactions_rt.pl b/examples/list_transactions_rt.pl index cbdaa18..ca5ae5c 100644 --- a/examples/list_transactions_rt.pl +++ b/examples/list_transactions_rt.pl @@ -6,35 +6,37 @@ use warnings; use Data::Dumper; -use Error qw(:try); use RT::Client::REST; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); -my $id = shift(@ARGV); +my $id = shift(@ARGV); my @types = @ARGV; my @ids = $rt->get_transaction_ids( parent_id => $id, - (@types ? - (1 == @types ? - (transaction_type => shift(@types)) - : (transaction_type => \@types)) + ( + @types + ? ( + 1 == @types + ? ( transaction_type => shift(@types) ) + : ( transaction_type => \@types ) + ) : () ), ); for my $tid (@ids) { - my $t = $rt->get_transaction(parent_id => $id, id => $tid); + my $t = $rt->get_transaction( parent_id => $id, id => $tid ); print Dumper($t); } diff --git a/examples/report-bug-to-cpan.pl b/examples/report-bug-to-cpan.pl index 4406b9a..c7692a7 100644 --- a/examples/report-bug-to-cpan.pl +++ b/examples/report-bug-to-cpan.pl @@ -5,23 +5,23 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; use Term::ReadKey; -my $rt = RT::Client::REST->new(server => 'http://rt.cpan.org'); +my $rt = RT::Client::REST->new( server => 'http://rt.cpan.org' ); my $dist = 'RT-Client-REST'; # This is the name of the queue. -my ($username, $password); +my ( $username, $password ); print "RT Username: "; -chomp($username = <>); +chomp( $username = <> ); print "RT Password: "; ReadMode 2; -chomp($password = <>); +chomp( $password = <> ); ReadMode 0; $| = 1; @@ -29,14 +29,17 @@ print "\nAuthenticating..."; try { - $rt->login(username => $username, password => $password); -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; + $rt->login( username => $username, password => $password ); +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; print "\nShort description of the problem (one line):\n"; -chomp(my $subject = <>); +chomp( my $subject = <> ); print "Long description (lone period or Ctrl-D to end):\n"; my $description = ''; @@ -49,12 +52,13 @@ my $ticket; try { $ticket = RT::Client::REST::Ticket->new( - rt => $rt, + rt => $rt, subject => $subject, - queue => $dist, + queue => $dist, )->store; - $ticket->correspond(message => $description); -} catch Exception::Class::Base with { + $ticket->correspond( message => $description ); +} +catch Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; diff --git a/examples/search_tickets.pl b/examples/search_tickets.pl index 8e1005d..f65015a 100644 --- a/examples/search_tickets.pl +++ b/examples/search_tickets.pl @@ -5,42 +5,43 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; -unless (@ARGV >= 2) { +unless ( @ARGV >= 2 ) { die "Usage: $0 username password\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); -my $ticket = RT::Client::REST::Ticket->new(rt => $rt); +my $ticket = RT::Client::REST::Ticket->new( rt => $rt ); my $results; try { $results = $ticket->search( - limits => [ - { attribute => 'id', operator => '>=', value => '1' }, - ], + limits => [ { attribute => 'id', operator => '>=', value => '1' }, ], orderby => 'subject', ); -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; my $count = $results->count; print "There are $count results that matched your query\n"; my $iterator = $results->get_iterator; -while (my $ticket = &$iterator) { +while ( my $ticket = &$iterator ) { print "Id: ", $ticket->id, "; owner: ", $ticket->owner, - "; Subject: ", $ticket->subject, "\n"; + "; Subject: ", $ticket->subject, "\n"; } diff --git a/examples/show_attachment.pl b/examples/show_attachment.pl index 87f2b69..1afcab3 100644 --- a/examples/show_attachment.pl +++ b/examples/show_attachment.pl @@ -5,32 +5,35 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Attachment; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id attachment_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); RT::Client::REST::Object->be_transparent($rt); my $att; try { $att = RT::Client::REST::Attachment->new( - id => shift(@ARGV), - parent_id => shift(@ARGV), + id => shift(@ARGV), + parent_id => shift(@ARGV), ); -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; use Data::Dumper; diff --git a/examples/show_group.pl b/examples/show_group.pl index 57b70e1..a994b7b 100644 --- a/examples/show_group.pl +++ b/examples/show_group.pl @@ -8,21 +8,21 @@ use RT::Client::REST; use RT::Client::REST::Group; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password group_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); my $group = RT::Client::REST::Group->new( - rt => $rt, - id => shift(@ARGV), + rt => $rt, + id => shift(@ARGV), )->retrieve; use Data::Dumper; diff --git a/examples/show_links.pl b/examples/show_links.pl index 8e6b9c9..1636deb 100644 --- a/examples/show_links.pl +++ b/examples/show_links.pl @@ -5,20 +5,21 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; -unless (@ARGV >= 4) { - die "Usage: $0 username password type_of_object ticket_id\n Example: $0 user pass ticket 888\n"; +unless ( @ARGV >= 4 ) { + die +"Usage: $0 username password type_of_object ticket_id\n Example: $0 user pass ticket 888\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); RT::Client::REST::Object->use_single_rt($rt); @@ -27,19 +28,21 @@ my $ticket; my $type = shift(@ARGV); -my $id = shift(@ARGV); +my $id = shift(@ARGV); try { - $ticket = RT::Client::REST::Ticket->new( - id => $id, - ); -} catch RT::Client::REST::UnauthorizedActionException with { - die "You are not authorized to view ticket #$id\n"; -} catch RT::Client::REST::Exception with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; + $ticket = RT::Client::REST::Ticket->new( id => $id, ); +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('RT::Client::REST::UnauthorizedActionException') ) { + die "You are not authorized to view ticket #$id\n"; + } + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; use Data::Dumper; -print Dumper($rt->get_links('type' => $type, 'id' => $id)); +print Dumper( $rt->get_links( 'type' => $type, 'id' => $id ) ); diff --git a/examples/show_queue.pl b/examples/show_queue.pl index 385e6af..94d61ca 100644 --- a/examples/show_queue.pl +++ b/examples/show_queue.pl @@ -5,31 +5,34 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Queue; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password queue_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); my $queue; try { $queue = RT::Client::REST::Queue->new( - rt => $rt, - id => shift(@ARGV), + rt => $rt, + id => shift(@ARGV), )->retrieve; -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; use Data::Dumper; diff --git a/examples/show_ticket.pl b/examples/show_ticket.pl index 22a2a6f..2e90130 100644 --- a/examples/show_ticket.pl +++ b/examples/show_ticket.pl @@ -5,20 +5,20 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); RT::Client::REST::Object->use_single_rt($rt); @@ -28,19 +28,21 @@ my $ticket; my $id = shift(@ARGV); try { - $ticket = RT::Client::REST::Ticket->new( - id => $id, - ); -} catch RT::Client::REST::UnauthorizedActionException with { - die "You are not authorized to view ticket #$id\n"; -} catch RT::Client::REST::Exception with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; + $ticket = RT::Client::REST::Ticket->new( id => $id, ); +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('RT::Client::REST::UnauthorizedActionException') ) { + die "You are not authorized to view ticket #$id\n"; + } + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; use Data::Dumper; print Dumper($ticket); -for my $cf (sort $ticket->cf) { +for my $cf ( sort $ticket->cf ) { print "Custom field '$cf'=", $ticket->cf($cf), "\n"; } diff --git a/examples/show_transaction.pl b/examples/show_transaction.pl index 568d049..56bc0f1 100644 --- a/examples/show_transaction.pl +++ b/examples/show_transaction.pl @@ -5,32 +5,35 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Transaction; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id transaction_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); my $tr; try { $tr = RT::Client::REST::Transaction->new( - rt => $rt, - parent_id => shift(@ARGV), - id => shift(@ARGV), + rt => $rt, + parent_id => shift(@ARGV), + id => shift(@ARGV), )->retrieve; -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; use Data::Dumper; diff --git a/examples/show_user.pl b/examples/show_user.pl index 365b101..a5cf40a 100644 --- a/examples/show_user.pl +++ b/examples/show_user.pl @@ -5,31 +5,34 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::User; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password user_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); my $user; try { $user = RT::Client::REST::User->new( - rt => $rt, - id => shift(@ARGV), + rt => $rt, + id => shift(@ARGV), )->retrieve; -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; use Data::Dumper; diff --git a/examples/take_ticket.pl b/examples/take_ticket.pl index 144e7ad..9b912df 100644 --- a/examples/take_ticket.pl +++ b/examples/take_ticket.pl @@ -5,28 +5,31 @@ use strict; use warnings; -use Error qw(:try); +use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; -unless (@ARGV >= 3) { +unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } -my $rt = RT::Client::REST->new( - server => ($ENV{RTSERVER} || 'http://rt.cpan.org'), -); +my $rt = + RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), + ); $rt->login( - username=> shift(@ARGV), - password=> shift(@ARGV), + username => shift(@ARGV), + password => shift(@ARGV), ); try { RT::Client::REST::Ticket->new( - rt => $rt, - id => shift(@ARGV), + rt => $rt, + id => shift(@ARGV), )->take; -} catch Exception::Class::Base with { - my $e = shift; - die ref($e), ": ", $e->message || $e->description, "\n"; +} +catch { + die $_ unless blessed $_ && $_->can('rethrow'); + if ( $_->isa('Exception::Class::Base') ) { + die ref($_), ": ", $_->message || $_->description, "\n"; + } }; From feca96872c3ca5077b4020ac0aad72a7a5898987 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Sat, 19 Nov 2022 09:59:41 -0800 Subject: [PATCH 81/85] Correctly parse empty fields. GH#27 --- lib/RT/Client/REST/Forms.pm | 17 ++++++++-- t/50-forms.t | 63 +++++++++++++++++++++++++++++++++++-- 2 files changed, 76 insertions(+), 4 deletions(-) diff --git a/lib/RT/Client/REST/Forms.pm b/lib/RT/Client/REST/Forms.pm index c5413e1..4969275 100644 --- a/lib/RT/Client/REST/Forms.pm +++ b/lib/RT/Client/REST/Forms.pm @@ -85,11 +85,24 @@ sub form_parse { next LINE } - if ($state <= 1 && $line =~ m/^($field: )(.*)?$/s) { + if ($state <= 1 && $line =~ m/^($field:) ?$/s) { + # Empty field + my $f = $1; + $f =~ s/:?$//; + + push(@$o, $f) unless exists $k->{$f}; + vpush($k, $f, undef); + + $state = 1; + + next LINE + } + + if ($state <= 1 && $line =~ m/^($field:) (.*)?$/s) { # Read a field: value specification. my $f = $1; my $value = $2; - $f =~ s/: ?$//; + $f =~ s/:?$//; # Read continuation lines, if any. while (@lines && ($lines[0] eq "\n" || $lines[0] =~ m/^ +/)) { diff --git a/t/50-forms.t b/t/50-forms.t index 0ac13c1..d2c379e 100644 --- a/t/50-forms.t +++ b/t/50-forms.t @@ -6,7 +6,7 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More tests => 9; use RT::Client::REST::Forms qw(form_parse); use File::Spec::Functions qw(catfile); @@ -49,6 +49,64 @@ EOF return $body; } +{ + my $body = qq| +id: ticket/971216 +Queue: whatever +Owner: Nobody +Creator: someone\@example.com +Subject: Problems +Status: new +Priority: 10 +InitialPriority: 10 +FinalPriority: 50 +Requestors: someone\@example.com\nCc:\nAdminCc:\nCreated: Fri Nov 04 15:38:18 2022 +Starts: Not set +Started: Not set +Due: Sun Nov 06 15:38:18 2022 +Resolved: Not set +Told: Not set +LastUpdated: Fri Nov 04 16:19:43 2022 +TimeEstimated: 0 +TimeWorked: 0 +TimeLeft: 0 +CF.{AdminURI}: \n +|; + my $form = form_parse($body); + is( ref($form), 'ARRAY', 'form is an array reference' ); + my ( $c, $o, $k, $e ) = @{ $$form[0] }; + is( ref($k), 'HASH', 'third element ($k) is a hash reference' ); + is_deeply( + $k, + { + 'id' => 'ticket/971216', + 'Queue' => 'whatever', + 'Owner' => 'Nobody', + 'Creator' => 'someone@example.com', + 'Subject' => 'Problems', + 'Status' => 'new', + 'Priority' => '10', + 'InitialPriority' => '10', + 'FinalPriority' => '50', + 'Requestors' => 'someone@example.com', + 'Cc' => undef, + 'AdminCc' => undef, + 'Created' => 'Fri Nov 04 15:38:18 2022', + 'Starts' => 'Not set', + 'Started' => 'Not set', + 'Due' => 'Sun Nov 06 15:38:18 2022', + 'Resolved' => 'Not set', + 'Told' => 'Not set', + 'LastUpdated' => 'Fri Nov 04 16:19:43 2022', + 'TimeEstimated' => '0', + 'TimeWorked' => '0', + 'TimeLeft' => '0', + 'CF.{AdminURI}' => undef, + }, + 'Empty fields undertood' + ); +} + { my $body = create_http_body($contents); my $form = form_parse($body); @@ -60,7 +118,7 @@ EOF } { -my $body = qq|id: 17217 + my $body = qq|id: 17217 Subject: \nCreator: 12 Created: 2022-09-24 21:26:55 Transaction: 37112 @@ -87,3 +145,4 @@ Content: dude this is a text attachment ok( $k->{Content} eq "dude this is a text attachment\n", 'form parsed out contents correctly' ); } + From bc93ab3854202eb863fb4bd5a42297a67234b2d0 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 5 Dec 2022 09:36:32 -0800 Subject: [PATCH 82/85] Version 0.71 --- CHANGES | 3 +++ dist.ini | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 6206d89..9708781 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,8 @@ Revision history for Perl module RT::Client::REST +0.71 Mon Dec 5 2022 "Dean Hamstead" + - Fixed GH#27 Missing fields + 0.70 Sun Sep 25 2022 "Dean Hamstead" - GH#26 Swap from Error's try to Try::Tiny - GH#26 Remove Error entirely diff --git a/dist.ini b/dist.ini index 2e42f37..80564f8 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.70 +version = 0.71 license = Perl_5 copyright_holder = Dmitri Tikhonov main_module = lib/RT/Client/REST.pm From 410d951247170c747205869eff503fa86f08af71 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 27 Feb 2023 11:04:06 -0800 Subject: [PATCH 83/85] Improve handling of empty fields and eliminate warnings for GH#27 --- lib/RT/Client/REST/Object.pm | 18 +++++++++++------- t/22-ticket.t | 15 ++++++++++++++- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/lib/RT/Client/REST/Object.pm b/lib/RT/Client/REST/Object.pm index 096510d..4f213a9 100644 --- a/lib/RT/Client/REST/Object.pm +++ b/lib/RT/Client/REST/Object.pm @@ -267,7 +267,8 @@ sub _generate_methods { if ($settings->{list}) { my $retval = $self->{'_' . $method} || []; return @$retval; - } else { + } + else { return $self->{'_' . $method}; } }; @@ -472,17 +473,18 @@ sub from_form { # Now set attributes: while (my ($key, $value) = each(%$hash)) { + # Handle custom fields, ideally /(?(1)})/ would be appened to RE if ( $key =~ m%^(?:cf|customfield)(?:-|\.\{)([#\s\w_:()?/-]+)% ){ $key = $1; # XXX very sketchy. Will fail on long form data e.g; wiki CF - if ($value =~ /,/) { + if (defined $value and $value =~ /,/) { $value = [ split(/\s*,\s*/, $value) ]; } $self->cf($key, $value); - next; + next } unless (exists($rest2attr{$key})) { @@ -490,17 +492,19 @@ sub from_form { next; } - my ( $method, $settings) = @{$rest2attr{$key}}; + my ($method, $settings) = @{$rest2attr{$key}}; if ($settings->{is_datetime} and $value eq 'Not set') { - $value = undef; + $value = undef } if (exists($attributes->{$method}{form2value})) { $value = $attributes->{$method}{form2value}($value); - } elsif ($attributes->{$method}{list}) { - $value = [split(/\s*,\s*/, $value)], } + elsif ($attributes->{$method}{list}) { + $value = defined $value ? [split(/\s*,\s*/, $value)] : [] + } + $self->$method($value); } diff --git a/t/22-ticket.t b/t/22-ticket.t index 11c9177..be27ac1 100644 --- a/t/22-ticket.t +++ b/t/22-ticket.t @@ -4,7 +4,7 @@ use strict; use warnings; -use Test::More tests => 114; +use Test::More tests => 117; use Test::Exception; use constant METHODS => ( @@ -185,6 +185,12 @@ for my $method (qw(take untake steal)) { } # Test list attributes: +throws_ok { + $ticket->requestors(undef); +} +'RT::Client::REST::Object::InvalidValueException', + 'List attributes (requestors) only accept array reference'; + my @emails = qw(dmitri@localhost dude@localhost); throws_ok { $ticket->requestors(@emails); @@ -192,6 +198,13 @@ throws_ok { 'RT::Client::REST::Object::InvalidValueException', 'List attributes (requestors) only accept array reference'; +lives_ok { + $ticket->requestors( [] ); +} +'Set requestors to empty values'; + +ok( 0 == $ticket->requestors, 'There are 0 requestors' ); + lives_ok { $ticket->requestors( \@emails ); } From c995861780004864121d9e70b9d60a0181f7e93d Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Mon, 27 Feb 2023 11:05:52 -0800 Subject: [PATCH 84/85] Bump to v0.72 --- CHANGES | 3 +++ dist.ini | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 9708781..1a1c496 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,8 @@ Revision history for Perl module RT::Client::REST +0.72 Mon Feb 27 2023 "Deean Hamstead" + - More fixes for GH#27 to eliminate warnings and handle empty list fields + 0.71 Mon Dec 5 2022 "Dean Hamstead" - Fixed GH#27 Missing fields diff --git a/dist.ini b/dist.ini index 80564f8..8e92685 100755 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = RT-Client-REST -version = 0.71 +version = 0.72 license = Perl_5 copyright_holder = Dmitri Tikhonov main_module = lib/RT/Client/REST.pm From d201756baabda64692a93ba3f7ca61388a47df46 Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Fri, 13 Mar 2026 14:48:29 +1100 Subject: [PATCH 85/85] Update README file --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index 87a7562..bd498dd 100644 --- a/README.md +++ b/README.md @@ -6,6 +6,8 @@ make communicating with RT using REST protocol easy. Most of the features have been implemented and tested with rt 3.6.0 and later. Please see POD for details on usage. +'REST' is used loosely, the API is described [here](https://rt-wiki.bestpractical.com/wiki/REST). + To build --------