diff --git a/.mailmap b/.mailmap new file mode 100644 index 0000000..1d11ced --- /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 diff --git a/CHANGES b/CHANGES index d2fa2d9..1a1c496 100644 --- a/CHANGES +++ b/CHANGES @@ -1,6 +1,54 @@ Revision history for Perl module RT::Client::REST -0.52 Fri Apr 06 2018 "Dean Hamstead" +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 + +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 + +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 + +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 + +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 Hamstead" + - 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 + +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/README.md b/README.md index 56c1dcc..bd498dd 100644 --- a/README.md +++ b/README.md @@ -1,28 +1,49 @@ -# 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 +'REST' is used loosely, the API is described [here](https://rt-wiki.bestpractical.com/wiki/REST). -To test, you will need Test::Exception -- as this is an object-oriented +To build +-------- + +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 + +License +------- -Author: - Dmitri Tikhonov - 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. +This module is licensed under both the Aristic 1.0 and GPL 1.0, the same terms as Perl itself. -License: - This module is licensed under the same terms as perl itself. +[![CPAN version](https://badge.fury.io/pl/RT-Client-REST.svg)](https://metacpan.org/pod/RT::Client::REST) diff --git a/dist.ini b/dist.ini index b00d82f..8e92685 100755 --- a/dist.ini +++ b/dist.ini @@ -1,24 +1,19 @@ name = RT-Client-REST -version = 0.52 -author = Abhijit Menon-Sen -author = Dmitri Tikhonov -author = Damien "dams" Krotkine -author = Dean Hamstead -author = Miquel Ruiz -author = JLMARTIN -author = SRVSH +version = 0.72 license = Perl_5 copyright_holder = Dmitri Tikhonov -copyright_year = 2018 main_module = lib/RT/Client/REST.pm [@Basic] ; Stuff that generates files +[ModuleBuild] [CPANFile] [GithubMeta] +issues = 1 [MetaJSON] [MetaTests] +[ContributorsFile] ; [TravisYML] # use our own for now [Encoding] @@ -31,14 +26,16 @@ critic_config = t/.perlcriticrc ;[PerlTidy] ;perltidyrc = t/.perltidyrc [Test::Compile] -[Test::Kwalitee] +[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] @@ -47,42 +44,46 @@ finder = :InstallModules ; prevents test inputs being flagged [PodSyntaxTests] [RunExtraTests] [CheckChangeLog] +[SchwartzRatio] ; Stuff that changes my code [PkgVersion] -; [PodVersion] ; PodWeaver does this and more [PodWeaver] +[CopyrightYearFromGit] +[AuthorsFromGit] ; 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 +[PruneFiles] +filename = weaver.ini +filename = dist.ini [PruneCruft] -except = ^\.travis.yml [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 @@ -90,3 +91,6 @@ Test::Exception = 0 HTTP::Server::Simple = 0.44 HTTP::Server::Simple::CGI = 0 HTTP::Server::Simple::CGI::Environment = 0 + +; authordep Pod::Weaver::Section::Contributors = 0 +; authordep Pod::Elemental::Transformer::List = 0 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"; + } }; diff --git a/lib/RT/Client/REST.pm b/lib/RT/Client/REST.pm index 1b2ebc2..d32a09e 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,15 +26,15 @@ 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; # 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; @@ -90,16 +91,23 @@ 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); - } 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 { + $self->_submit('ticket/1', undef, \%opts); + } + 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. }; } @@ -173,8 +181,8 @@ 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] }; + 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}); } @@ -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' } } @@ -337,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; } @@ -411,6 +439,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}); @@ -529,13 +565,13 @@ 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; - 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; } } @@ -550,7 +586,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; @@ -583,13 +619,16 @@ 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" if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) { - RT::Client::REST::MalformedRTResponseException->throw( - 'Malformed RT response received from ' . $self->server, - ); + 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 @@ -613,21 +652,28 @@ 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")) { + elsif ($req->header('Cookie')) { # We'll retry the request with credentials, unless # we only wanted to logout in the first place. #$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( code => $res->code, - message => "RT server returned this error: " . + message => 'RT server returned this error: ' . $res->decoded_content, ); } @@ -636,10 +682,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 @@ -653,9 +699,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, + message => $err_msg, ); } @@ -666,9 +716,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); @@ -681,6 +736,11 @@ sub _ua { return $self->{_ua}; } +sub user_agent { + shift->_ua; +} + + sub basic_auth_cb { my $self = shift; @@ -697,6 +757,11 @@ sub basic_auth_cb { return $self->{_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 { @@ -804,7 +869,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) ); } @@ -834,7 +899,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 } @@ -881,7 +946,7 @@ __END__ =head1 SYNOPSIS - use Error qw(:try); + use Try::Tiny; use RT::Client::REST; my $rt = RT::Client::REST->new( @@ -891,17 +956,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 @@ -957,12 +1029,37 @@ 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 + +Accessor to the user_agent object. + =item B 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 + ); + +=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') @@ -993,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: @@ -1025,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: @@ -1035,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) @@ -1043,9 +1151,26 @@ 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 + +=for stopwords html + +=item B + +When true, indicates to RT that the message is html + +=back $rt->comment( ticket_id => 5, @@ -1053,6 +1178,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, @@ -1224,9 +1355,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. @@ -1247,10 +1377,6 @@ The following modules are required: =item -Error - -=item - Exception::Class =item @@ -1283,12 +1409,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 diff --git a/lib/RT/Client/REST/Attachment.pm b/lib/RT/Client/REST/Attachment.pm index a16723d..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. @@ -7,10 +8,10 @@ use warnings; package RT::Client::REST::Attachment; +use parent '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'; +use RT::Client::REST::Object::Exception; sub _attributes {{ id => { @@ -45,7 +46,7 @@ sub _attributes {{ validation => { type => SCALAR, }, - rest_name => "ContentType", + rest_name => 'ContentType', }, file_name => { @@ -261,6 +262,12 @@ Returns 'attachment'. =back +=head1 CREATING ATTACHMENTS + +Currently RT does not allow creating attachments via their API. + +See L + =head1 SEE ALSO L, diff --git a/lib/RT/Client/REST/Exception.pm b/lib/RT/Client/REST/Exception.pm index ac036c1..6b8793a 100644 --- a/lib/RT/Client/REST/Exception.pm +++ b/lib/RT/Client/REST/Exception.pm @@ -7,50 +7,48 @@ 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__, - 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 +63,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,40 +131,50 @@ 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)', }, ); 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 { @@ -184,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/Forms.pm b/lib/RT/Client/REST/Forms.pm index 8c52bd9..4969275 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,18 +50,18 @@ 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: 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,48 +69,77 @@ 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 + } + + 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 } - elsif ($state <= 1 && $line =~ m/^($field):(?:\s+(.*))?$/) { + + if ($state <= 1 && $line =~ m/^($field:) (.*)?$/s) { # Read a field: value specification. - my $f = $1; - my @v = ($2 || ()); + my $f = $1; + my $value = $2; + $f =~ s/:?$//; # Read continuation lines, if any. - while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) { - push @v, shift @lines; + while (@lines && ($lines[0] eq "\n" || $lines[0] =~ m/^ +/)) { + my $l = shift @lines; + $l =~ s/^$spaces//; + $value .= $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)); + # `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 } - s/^$ws// foreach @v; push(@$o, $f) unless exists $k->{$f}; - vpush($k, $f, join("\n", @v)); + 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 =~ /^>>/ ? "$line\n" : ">> $line\n"; + $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 @@ -231,7 +262,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 diff --git a/lib/RT/Client/REST/Group.pm b/lib/RT/Client/REST/Group.pm index 10d5ff7..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 parent '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'; +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 7412e99..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 @@ -50,4 +50,6 @@ sub basic_auth_cb { =back +=cut + 1; diff --git a/lib/RT/Client/REST/Object.pm b/lib/RT/Client/REST/Object.pm index 586874e..4f213a9 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; @@ -266,7 +267,8 @@ sub _generate_methods { if ($settings->{list}) { my $retval = $self->{'_' . $method} || []; return @$retval; - } else { + } + else { return $self->{'_' . $method}; } }; @@ -419,11 +421,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 +455,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,25 +465,26 @@ 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: 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})) { @@ -489,16 +492,19 @@ sub from_form { next; } - if ($value =~ m/not set/i) { - $value = undef; + 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}) { - $value = [split(/\s*,\s*/, $value)], } + elsif ($attributes->{$method}{list}) { + $value = defined $value ? [split(/\s*,\s*/, $value)] : [] + } + $self->$method($value); } @@ -534,7 +540,8 @@ sub store { id => $self->id, set => $self->to_form, ); - } else { + } + else { my $id = $rt->create( type => $self->rt_type, set => $self->to_form, @@ -566,9 +573,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}; @@ -587,10 +602,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; @@ -601,8 +624,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 6585e86..f3b73ae 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 @@ -99,7 +99,30 @@ sub _attributes {{ validation => { type => SCALAR, }, + rest_name => 'Disabled', }, + + admin_cc_addresses => { + validation => { + type => SCALAR, + }, + rest_name => 'AdminCcAddresses', + }, + + cc_addresses => { + validation => { + type => SCALAR, + }, + rest_name => 'CcAddresses', + }, + + sla_disabled => { + validation => { + type => SCALAR, + }, + rest_name => 'SLADisabled', + }, + }} =head1 ATTRIBUTES @@ -140,6 +163,42 @@ Final priority. Default due in. +=item B + +Queue is disabled + +=item B + +Admin CC Addresses (comma delimited). + +=item B + +CC Addresses (comma delimited). + +=for stopwords SLA + +=item B + +Queue SLA is disabled + +=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 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/lib/RT/Client/REST/Ticket.pm b/lib/RT/Client/REST/Ticket.pm index 050172b..8df5396 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,15 +8,15 @@ use warnings; package RT::Client::REST::Ticket; -use Error qw(:try); +use parent 'RT::Client::REST::Object'; + +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 0.01; -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; -use base 'RT::Client::REST::Object'; =head1 SYNOPSIS @@ -100,6 +101,7 @@ sub _attributes {{ # custom statuses. type => SCALAR, }, + rest_name => 'Status', }, priority => { @@ -221,6 +223,13 @@ sub _attributes {{ rest_name => 'LastUpdated', is_datetime => 1, }, + + sla => { + validation => { + type => SCALAR, + }, + }, + }} =head1 ATTRIBUTES @@ -511,10 +520,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 3fe6510..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 parent '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'; +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 3f3e631..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 parent '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'; +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 46f0d6e..5e98de8 100644 --- a/t/01-use.t +++ b/t/01-use.t @@ -1,11 +1,13 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; use Test::More tests => 2; BEGIN { - use_ok ('RT::Client::REST'); - use_ok ('RT::Client::REST', 0.06); + use_ok('RT::Client::REST'); + use_ok( 'RT::Client::REST', 0.53 ); } -# vim:ft=perl: diff --git a/t/10-core.t b/t/10-core.t index 98ea9e1..596ea92 100644 --- a/t/10-core.t +++ b/t/10-core.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -5,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; @@ -18,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)) { @@ -54,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)) { @@ -71,9 +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; -# vim:ft=perl: diff --git a/t/11-server-name.t b/t/11-server-name.t index 3a1ea0a..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->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 a47d39d..c0ed717 100644 --- a/t/20-object.t +++ b/t/20-object.t @@ -1,4 +1,8 @@ +#!perl package MyObject; + +# vim:ft=perl: + # For testing purposes -- Object with 'id' attribute. @ISA = qw(RT::Client::REST::Object); @@ -13,9 +17,9 @@ sub id { sub rt_type { 'myobject' } -sub _attributes {{ - id => {}, -}} +sub _attributes { + { id => {}, } +} package main; @@ -26,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 { @@ -40,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; @@ -54,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)) { @@ -81,21 +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"; } -# vim:ft=perl: diff --git a/t/21-user.t b/t/21-user.t index 51568c1..233e94b 100644 --- a/t/21-user.t +++ b/t/21-user.t @@ -1,3 +1,5 @@ +#!perl +# vim:ft=perl: use strict; use warnings; @@ -5,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 { @@ -24,14 +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; -# vim:ft=perl: diff --git a/t/22-ticket.t b/t/22-ticket.t index 95cbe2f..be27ac1 100644 --- a/t/22-ticket.t +++ b/t/22-ticket.t @@ -1,18 +1,21 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; -use Test::More tests => 113; +use Test::More tests => 117; 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', + 'created', 'starts', 'started', 'due', 'resolved', 'told', + 'time_estimated', 'time_worked', 'time_left', 'last_updated', 'sla', ); BEGIN { @@ -23,198 +26,243 @@ 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: +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); -} '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( [] ); +} +'Set requestors to empty values'; + +ok( 0 == $ticket->requestors, 'There are 0 requestors' ); + +lives_ok { + $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'; -# vim:ft=perl: diff --git a/t/23-attachment.t b/t/23-attachment.t index c80e2b2..cbe851b 100644 --- a/t/23-attachment.t +++ b/t/23-attachment.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -10,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 { @@ -18,26 +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 ); -# vim:ft=perl: diff --git a/t/24-transaction.t b/t/24-transaction.t index ea155d8..b418f3c 100644 --- a/t/24-transaction.t +++ b/t/24-transaction.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -8,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', ); @@ -18,22 +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 ); -# vim:ft=perl: diff --git a/t/25-queue.t b/t/25-queue.t index a4ae2ac..fca96fc 100644 --- a/t/25-queue.t +++ b/t/25-queue.t @@ -1,7 +1,10 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; -use Test::More tests => 16; +use Test::More tests => 17; use Test::Exception; use constant METHODS => ( @@ -9,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 { @@ -20,12 +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 ); -# vim:ft=perl: diff --git a/t/26-group.t b/t/26-group.t index e897362..78a844c 100644 --- a/t/26-group.t +++ b/t/26-group.t @@ -1,3 +1,6 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; @@ -5,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: @@ -20,12 +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' ); -# vim:ft=perl: diff --git a/t/35-db.t b/t/35-db.t index f9287e5..6fef3bc 100644 --- a/t/35-db.t +++ b/t/35-db.t @@ -1,28 +1,35 @@ +#!perl +# 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; @@ -40,51 +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" ); -# vim:ft=perl: diff --git a/t/40-search.t b/t/40-search.t index 3bd2cbe..f8e39dc 100644 --- a/t/40-search.t +++ b/t/40-search.t @@ -1,8 +1,11 @@ +#!perl +# vim:ft=perl: + use strict; use warnings; package Mock; -use base 'RT::Client::REST::Object'; +use parent 'RT::Client::REST::Object'; sub new { my $class = shift; @@ -18,48 +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)" ); -# vim:ft=perl: diff --git a/t/50-forms.t b/t/50-forms.t index d820316..d2c379e 100644 --- a/t/50-forms.t +++ b/t/50-forms.t @@ -1,35 +1,41 @@ +#!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. use strict; use warnings; -use Test::More tests => 3; +use Test::More tests => 9; 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); - $binary_string =~ s/\n/\n /sg; - $binary_string .= "\n\n"; + my $length = length($binary_string); + my $spaces = ' ' x length('Content: '); + $binary_string =~ s/\n/\n$spaces/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 @@ -38,14 +44,105 @@ 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 = 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); + 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' ); +} + diff --git a/t/60-with-rt.t b/t/60-with-rt.t index f3152f0..03014e1 100644 --- a/t/60-with-rt.t +++ b/t/60-with-rt.t @@ -1,3 +1,6 @@ +#!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 # (and bugs) between different versions of RT. @@ -6,25 +9,27 @@ use strict; use warnings; use Test::More; +use File::Spec::Functions qw/ splitpath /; 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; } @@ -32,160 +37,355 @@ 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" ); } } # 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, 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("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 $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, 'test queue name matches' ); + # TODO: with 4.2.3, warning "Unknown key: disabled" is printed } # 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 => random_string, - )->store(text => random_string); - } catch Exception::Class::Base with { - $e = shift; - diag("ticket store: $e"); + rt => $rt, + queue => $queue_id, + subject => $subject, + )->store( text => 'Some random 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"); - $ticket_id = $ticket->id; + ok( defined($ticket), + "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 { 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 $message = 'This is a message ' . random_string(), my $e; try { - RT::Client::REST::Ticket->new( - rt => $rt, id => $ticket_id, - )->comment( - message => random_string, - attachments => [ $filename ], + $ticket->comment( + message => $message, + 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, - ); 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) { - is($att->content, $att_contents, "Attachment content matches"); + 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'); + 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' ); +} +# 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' ); +} + +# 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; + 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 +{ + 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' ); +} + diff --git a/t/80-timeout.t b/t/80-timeout.t index ac70af9..20cc839 100644 --- a/t/80-timeout.t +++ b/t/80-timeout.t @@ -1,4 +1,5 @@ -#!/usr/bin/perl +#!perl +# vim:ft=perl: # # This script tests whether timeout actually works. @@ -7,49 +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://localhost:$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" ); } -# vim:ft=perl: diff --git a/t/81-submit.t b/t/81-submit.t index 1a6664e..eb69f21 100644 --- a/t/81-submit.t +++ b/t/81-submit.t @@ -1,4 +1,5 @@ -#!/usr/bin/perl +#!perl +# vim:ft=perl: # # This script tests whether submited data looks good @@ -7,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: $@"; @@ -22,27 +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://localhost:$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' +); -# vim:ft=perl: diff --git a/t/82-stringify.t b/t/82-stringify.t index d46ae17..bc121b1 100644 --- a/t/82-stringify.t +++ b/t/82-stringify.t @@ -1,4 +1,5 @@ -#!/usr/bin/perl +#!perl +# vim:ft=perl: # # This script tests whether submited data looks good @@ -7,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: $@"; @@ -27,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://localhost:$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; } @@ -52,13 +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" ); +} -# vim:ft=perl: diff --git a/t/83-attachments.t b/t/83-attachments.t index 4f7fd11..aa1d7fa 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 @@ -15,29 +15,27 @@ 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 -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 @@ -48,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'; @@ -104,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://localhost:$port", + server => "http://127.0.0.1:$port", timeout => 2, ); -# avoid need ot login -$rt->basic_auth_cb(sub { return }); +# 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'); + 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 new file mode 100644 index 0000000..5f746ee --- /dev/null +++ b/t/84-attachments-rt127607.t @@ -0,0 +1,144 @@ +#!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: 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 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]; + $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; diff --git a/t/85-attachments-rt127607.t b/t/85-attachments-rt127607.t new file mode 100644 index 0000000..be53c84 --- /dev/null +++ b/t/85-attachments-rt127607.t @@ -0,0 +1,144 @@ +#!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 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]; + $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; diff --git a/t/86-redirect.t b/t/86-redirect.t new file mode 100644 index 0000000..b5edd85 --- /dev/null +++ b/t/86-redirect.t @@ -0,0 +1,101 @@ +#!perl +# +use strict; +use warnings; + +use Test::More; +use Data::Dumper; +use IO::Socket; +use RT::Client::REST; +plan tests => 5; + +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, + 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'; + +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'; 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 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 @@ + + + + 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]