RT-Client-REST-0.72000755001750001750 014377177463 13002 5ustar00deandean000000000000TODO100644001750001750 153314377177463 13555 0ustar00deandean000000000000RT-Client-REST-0.72This is a TODO file. I will be checking things off as they get implemented. - There are a bunch of issues, both resolved and outstanding, that depend on RT functionality, i.e. to verify them one needs access to working RT installation. It is also likely that parts of RT behavior change a little from release to release. I think it would be a great help to create a test file that tests manupulation of actual RT tickets with an instance of RT in the backend. - We need a simple way to create a local instance of RT. - Fetch forms from RT and verify CFs etc. based on that on the client side because of RT REST's non-atomicity -- i.e. some fields/values will go through correctly, while others will give syntax/permission errors. Based on discussion with Jesse Vincent (obra) on #rt@irc.perl.org on 7/25/2006. - Write user manual. README100644001750001750 56414377177463 13730 0ustar00deandean000000000000RT-Client-REST-0.72This archive contains the distribution RT-Client-REST, version 0.72: Client for RT using REST API This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. This README file was generated by Dist::Zilla::Plugin::Readme v6.029. CHANGES100644001750001750 5462114377177463 14106 0ustar00deandean000000000000RT-Client-REST-0.72Revision history for Perl module RT::Client::REST 0.72 Mon Feb 27 2023 "Deean Hamstead" - More fixes for GH#27 to eliminate warnings and handle empty list fields 0.71 Mon Dec 5 2022 "Dean Hamstead" - Fixed GH#27 Missing fields 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 - Remove Pod, tests and other files that Dist-Zilla provides - Adjust git repo slightly - Note: no functional changes 0.51 Tue Feb 27 2017 "Dmitri Tikhonov" - Add method to retrieve attachment metadata. Thanks Oriol Soriano. - Fix filename parsing bug in get_attachment_ids(). Thanks djstauffer. 0.50 Fri Dec 11 2015 "Sarvesh Das" - Added the 'disabled' attribute to RT::Client::REST::Group and RT::Client::REST::Queue to match the addition in RT 4.2.2 -- commit 7557633. Thanks Tom. - Allow a trailing forward slash in the server URI -- RT#97621. Thanks Marco Pessotto. - Tests in 82-stringify.t are skipped with LWP::UserAgent 6.04 which has buggy read timeout -- commit da577af. Thanks Marco Pessotto. - Fixed warning `Unescaped left brace in regex is deprecated' in perl 5.22 -- RT#106795. Thanks Mike Andrews. - Fixed documentation for RT::Client:REST::search() in POD -- RT#98160. - Removed MYMETA* files from distribution -- RT#108083 0.49 Sat May 10 2014 "Dmitri Tikhonov" - This module is now all covered by the Perl Artistic License: GPL is gone. This was done with permission from the original author of the command-line `rt' utility, Abhijit Menon-Sen. - Support custom fields that contain '#' in their name. Patch contributed by Ryan Niebur in RT#83856 -- thanks! - Documented get_links() -- RT#68673. - All tests now correctly run on Windows -- RT#81872. - All tests now correctly run on OpenBSD -- RT#95223. 0.48 Wed Apr 30 2014 "Dmitri Tikhonov" - Fixed POD bug in 0.47 -- `logger' attribute and method of RT::Client::REST was not documented and this caused POD coverage test to fail. While at it, made it a developer-only test. This way, these types of issues do not cause all cpantesters to fail. 0.47 Wed Apr 30 2014 "Dmitri Tikhonov" - Support redirects on login, RT#92371. - Skip failing test 83-attachments.t on OpenBSD while we investigage why it fails. Track this issue in RT#95223. 0.46 Sat Apr 26 2014 "Dmitri Tikhonov" This release only fixes several tests, there are no functional changes. Dmitri Tikhonov - Skip some tests on Windows and with buggy LWP::UserAgent. Marco Pessotto - Bumped version for next release (+ fixed version number in POD) 0.45 Marco Pessotto - Fixed uploading preventing objects to be stringified (RT#88919) - Added option to get undecoded attachments (RT#90112) - Added test 82-stringify.t (fails with 0.44 before the RT#88919 fix) - Added test 83-attachments.t to illustrate and check RT#90112 0.44 Damien Krotkine - Add URI in the prereqs Dave Lambley - Add support for parsing RT dates and returning a datetime object. (RT#73920 + RT#76658) Gregor Hermann (Debian Perl Group) - Doc improvement (RT#74191) Darren Duncan Doc improvement for timeout (RT #78133) richardgmcmahon@gmail.com Doc improvement for show method (RT #78439) Miquel Ruiz Fix for submitting non latin-1 strings to RT 0.43 Miquel Ruiz - Added support for groups via new class RT::Client::REST::Group Tests and examples also added. Roman Plesll - Fix for ticket merges (RT #62405) Stuart Browne - Accept question mark in custom field names (RT #70631) T Pascal - Patch for different link types (RT #68673) Jose Luis Martinez - Skip timeout tests on Windows (RT #70225, RT #35770) - Fix 'priveleged' (renamed to 'privileged') method on RT::Client::REST::User - Add missing disabled, nickname, lang, contactinfo and signature methods to RT::Client::REST::User - Clean up the API for retrieving links. Patch from T.Pascal is missing some cases like links that are URLs. This feature is not documented as it's considered experimental. - Refactor login method to accept any type of field name (not just username and password) 0.42 False release. See 0.43 - support for groups via new class RT::Client::REST::Group - Fix for ticket merges - Accept question mark in custom field names 0.41 Tomas Doran - Make version number a string to avoid length of version number changing at 0.X0 releases (as this breaks distro packages) - Update META.yml to the 0.4 META spec. - Include repository metadata to make it easier for people to contribute to the module. - Change from ExtUtils::MakeMaker to Module::Install (I'm sure you can generate the correct information with EU::MM, I just don't know how offhand). - Add Test::More as a test_requires to help distros which split it out of their core perl package (RT#45150) 0.40 Jerrad Pierce - #38710, more user attributes - #39868 & #42391, Alter CF parsing to accomodate 3.8 as well as 3.6 This required tweaks to Forms as well as Object. - #38591 & #43844, Add requestor attribute to Ticket so that autoreplies are sent to users under RT3.8 0.37 Fri Aug 15 2008 "Dmitri Tikhonov" - Fri Aug 15 2008 "Dmitri Tikhonov" Improvement: reorganized exceptions, made RT::Client::REST::Object::Exception a subclass of RT::Client::REST::Exception. What this means is that now any native exception thrown by RT::Client::REST code can be caught by catching a generic RT::Client::REST::Exception class. Added tests to ticket and attachment tests scripts to verify the behavior. I have been meaning to do this for a while now. Fixed an error in RT::Client::REST::Ticket POD. Bug 36814. 0.36 Sat May 10 2008 "Damien Krotkine" - Sat May 10 2008 "Damien Krotkine" Bug 35692 and 35146 : added test and fix. 0.35 Tue Apr 15 2008 "Damien Krotkine" - Tue Mar 04 2008 "Damien Krotkine" Bug 34917 : applying patch from Andreas J. Koenig. remove unneeded Encode 0.34 Tue Mar 04 2008 "Damien Krotkine" - Mon, 03 Mar 2008 "Damien Krotkine" added Encode prerequist 0.33 Fri Feb 29 2008 "Damien Krotkine" - Fri, 01 Feb 2008 "Dmitri Tikhonov" Fixed a typo. Updated POD; no code changes. s/dtikhonov@vonage.com/dtikhonov@yahoo.com/ - Tue, 29 Jan 2008 "Damien Krotkine" Decode data from REST from the proper encoding to Perl internal. Thanks to "Sébastien Aperghis-Tramoni" - Fri, 25 Jan 2008 "Damien Krotkine" Add dirty custom fields handling. Without it, cf are always submitted, included void ones, which may (and does on rt.cpan.org) conflict with custom fields rules on the server (e.g. a custom field value cannot be empty) 0.32 Sun Dec 23 2007 "Dmitri Tikhonov" - Fixed bug 31827 -- allow to specify custom fields at creation time. Method 'cf' can now take a hash reference that has a list of custom fields and their values. - Fixed bug 31828: allow to specify ticket content at creation time. Methods RT::Client::REST->create and RT::Client::REST::Ticket->store now take optional 'text' parameter. 0.31 Fri May 25 2007 "Dmitri Tikhonov" ! lib/RT/Client/REST.pm * Fixed 'VERSION' section of POD to print the correct version. ! lib/RT/Client/REST/Ticket.pm ! lib/RT/Client/REST/User.pm * Fixed SYNOPSYS in POD to reflect reality. No code changes. ! lib/RT/Client/REST/Queue.pm * CPAN.RT #27267 - fixed POD. No code changes. ! Makefile.PL * Added 'LICENSE' option. 0.30 Sat May 19 2007 "Dmitri Tikhonov" ! lib/RT/Client/REST.pm * CPAN.RT #27201 -- if one login fails, subsequent logins should fail as well. 0.29 Thu May 17 2007 "Dmitri Tikhonov" ! lib/RT/Client/REST/Object.pm * Do not validate values received from the server (from_form method). 0.28 Fri Apr 27 2007 "Dmitri Tikhonov" This is a bug fix release. ! lib/RT/Client/REST/Ticket.pm * CPAN.RT #25185 -- fixed typos in attribute validation specs. ! lib/RT/Client/REST.pm * CPAN.RT #26528 -- fixed a typo in method 'get_transaction_ids' ! examples/show_ticket.pl * Added code to display all custom fields. + t/99-kwalitee.t * Kwalitee is spelled... vanity?! ! TODO * Removed a couple of old items. Special thanks to Damien Krotkine (Dams) who found and provided patches for both bugs. 0.27 Tue Oct 3 2006 "Dmitri Tikhonov" This is a small release to fix warnings and a couple of documentation errors. ! lib/RT/Client/REST.pm * Fixed SYNOPSIS (CPAN RT 21314). * Upped $VERSION to 0.27. ! lib/RT/Client/REST/Object.pm * Fixed code to avoid a possible 'undefined value' warnings from tests. * Fixed up POD (annocpan note #989). ! t/35-db.t * Changed from 'no_plan' to plan 20 tests. ! t/22-ticket.t * Added test to verify properties of list attributes. 0.26 Tue Aug 15 2006 "Dmitri Tikhonov" ! lib/RT/Client/REST.pm * Match either $res->content or $res->message for the timeout message; this depends on version of HTTP::Response installed on the system. Discovered when timeout tests threw wrong exceptions on an old box. ! README * Reworded some things. 0.25 Wed Aug 9 2006 "Dmitri Tikhonov" Added support for basic HTTP authentication. ! lib/RT/Client/REST.pm * Added support for using basic HTTP authentication with the help of a callback provided via method "basic_auth_cb". * Use our own UA class (subclass of LWP::UserAgent). ! t/10-core.t * More tests. + lib/RT/Client/REST/HTTPClient.pm * Subclass of LWP::UserAgent to add some methods. + examples/report-bug-to-cpan.pl * Report a bug to CPAN rt. ! examples/show_ticket.pl * Removed ticket-modifying code. ! MANIFEST * Added new files. ! TODO * More stuff to do. 0.24 Tue Aug 8 2006 "Dmitri Tikhonov" ! lib/RT/Client/REST.pm * Added 'timeout' attribute to the object. If specified, overrides the default used by LWP::UserAgent. ! lib/RT/Client/REST/Exception.pm * Added RT::Client::REST::RequestTimedOutException. ! 91-pod-coverage.t * RT::Client::REST now has improved POD. ! MANIFEST * Added new files. ! TODO * Added 'write user manual' item. + t/80-timeout.t * Test timeout exceptions. + README * Added README file. 0.23 Fri Aug 4 2006 "Dmitri Tikhonov" ! lib/RT/Client/REST.pm * API change -- added 'login' method. ! lib/RT/Client/REST/SearchResult.pm * API change -- 'object' instead of 'retrieve'. ! lib/RT/Client/REST/Object.pm * Added support for transparency and a bunch of other goodies. See POD. ! lib/RT/Client/REST/Attachment.pm ! lib/RT/Client/REST/Ticket.pm * Modified to conform to changed APIs. ! examples/*.pl * Modified to adhere to new APIs. + t/35-db.t * Test auto* goodies. + t/91-pod-coverage.t * Test POD coverage. ! t/10-core.t ! t/20-object.t ! t/40-search.t * Updated with new tests, methods, APIs, etc. ! MANIFEST * Added new test files. 0.22 Fri Aug 4 2006 "Dmitri Tikhonov" ! lib/RT/Client/REST/Object.pm * Modified behavior. Now list attribute methods return lists, not array references. * Fixed the way comma-separated values are split when parsing forms. * Updated POD. ! Makefile.PL * Added dependency on Test::Exception, so that automated CPAN tests don't fail. ! lib/RT/Client/REST.pm * Updated POD. * Upped VERSION. * No code changes. ! examples/edit_ticket.pl * Modified to support setting list attributes. 0.21 Thu Aug 3 2006 "Dmitri Tikhonov" ! lib/RT/Client/REST.pm * Added support for attachments. ! lib/RT/Client/REST/Ticket.pm * Updated POD. ! lib/RT/Client/REST/Exception.pm * Added exception RT::Client::REST::CannotReadAttachmentException. * Jump version to 0.17 so that CPAN indexer does not bitch. ! t/22-ticket.t * Added test for RT::Client::REST::CannotReadAttachmentException. 0.20 Wed Aug 2 2006 "Dmitri Tikhonov" Added support for queues. ! lib/RT/Client/REST.pm * Modified method "show()" to accept non-numeric IDs for objects of type 'queue'. + lib/RT/Client/REST/Queue.pm + t/25-queue.t * Queue support. + examples/show_queue.pl + examples/create_user.pl + examples/list_tickets.pl * More examples. ! MANIFEST * Added new files. 0.19 Wed Aug 2 2006 "Dmitri Tikhonov" ! lib/RT/Client/REST.pm * Fixed a bug in 'create' and 'edit' -- introduced in 0.14 when APIs changed. (Note to self - need a full-blown test suite). 0.18 Wed Aug 2 2006 "Dmitri Tikhonov" ! lib/RT/Client/REST.pm ! t/10-core.t * Added methods 'take', 'untake', and 'steal'. * If attribute 'server' is unset, RT::Client::REST::RequiredAttributeUnsetException will be thrown when a REST method is called. ! lib/RT/Client/REST/Exception.pm * Added exceptions: * RT::Client::REST::RequiredAttributeUnsetException * RT::Client::REST::AlreadyTicketOwnerException ! lib/RT/Client/REST/Object.pm ! t/20-object.t * Added convenience assertions methods: * _assert_rt_and_id * _assert_rt * Added assertions to methods 'retrieve', 'store', and 'count'. ! lib/RT/Client/REST/Object/Exception.pm * Added exceptions: * RT::Client::REST::Object::NoopOperationException * RT::Client::REST::Object::RequiredAttributeUnsetException ! lib/RT/Client/REST/Ticket.pm ! t/22-ticket.t * Added methods 'take', 'untake', and 'steal' * Added assertions in a couple of places * Fixed up POD. + examples/take_ticket.pl * Taking a ticket. ! MANIFEST * Added new example. 0.17 Tue Aug 1 2006 "Dmitri Tikhonov" + lib/RT/Client/REST/Transaction.pm + t/24-transaction.t * Added transaction object. + examples/show_transaction.pl + examples/list_transactions_rt.pl + examples/list_transactions.pl * Some more examples. ! lib/RT/Client/REST/Ticket.pm * Added method "transactions()". ! lib/RT/Client/REST.pm ! t/10-core.t * Added methods "get_transaction_ids()" and "get_transaction()" ! lib/RT/Client/REST/Attachment.pm * After retrieving values, set everything to not dirty. * Fixed up POD. ! MANIFEST * Added new files. 0.16 Tue Aug 1 2006 "Dmitri Tikhonov" Added support for user object; other minor changes. + lib/RT/Client/REST/User.pm + t/21-user.t * Added user object. + examples/show_user.pl + examples/edit_user.pl * Examples of the user APIs. ! lib/RT/Client/REST.pm * If method "show()" is called to retrieve an object of type "user", 'id' parameter does not have to be numeric. ! lib/RT/Client/REST/Exception.pm * Added RT::Client::REST::UnauthorizedActionException * Method _rt_content_to_exception() now returns a ready-to-throw exception with message set to massaged text from RT server. ! MANIFEST * Added new files. 0.15 Tue Aug 1 2006 "Dmitri Tikhonov" ! lib/RT/Client/REST/Ticket.pm * Fixed up POD. ! lib/RT/Client/REST.pm * Upped $VERSION to 0.15 -- no code changes. 0.14 Tue Aug 1 2006 "Dmitri Tikhonov" + lib/RT/Client/REST/Attachment.pm + examples/list_attachments.pl + examples/show_attachment.pl + t/23-attachment.t * New attachment representation. ! lib/RT/Client/REST/Ticket.pm ! t/22-ticket.t * Added method "attachments()". ! lib/RT/Client/REST/SearchResult.pm ! t/40-search.t * Changed APIs to be more flexible -- pass a closure to retrieve objects. ! lib/RT/Client/REST/Object.pm * Modified to work correctly with new REST.pm and SearchResult.pm APIs. ! lib/RT/Client/REST/Object/Exception.pm * Added RT::Client::REST::Object::IllegalMethodException ! examples/show_ticket.pl * Catch and display exceptions. ! lib/RT/Client/REST/Exception.pm * Added several exceptions. * Added POD. ! lib/RT/Client/REST.pm ! t/10-core.t * Modified "show()" and "edit()" methods to only accept a single ID. This is needed in order to correctly throw exceptions -- one object at a time, please. * Added methods "get_attachment_ids()" and "get_attachment()". * Removed list of exceptions (see Exception.pm docs). * Various small updates to POD. ! MANIFEST * Added the new files. 0.13 Mon Jul 31 2006 "Dmitri Tikhonov" Added searching APIs. ! lib/RT/Client/REST/Object.pm * Added methods 'search' and 'count'. * Updated POD. + lib/RT/Client/REST/SearchResult.pm * This class is an OO representation of search results. + t/40-search.t * Tests for RT/Client/REST/SearchResult.pm + examples/search_tickets.pl * Example of a search. ! lib/RT/Client/REST.pm * Added method 'search'. * Modified POD to reflect latest changes. ! t/10-core.t * Added test for method 'search'. ! lib/RT/Client/REST/Exception.pm * Added RT::Client::REST::InvalidQueryException * Added $VERSION ! lib/RT/Client/REST/Object/Exception.pm * Added two exceptions: * RT::Client::REST::Object::InvalidSearchParametersException * RT::Clite::REST::Object::InvalidAttributeException ! TODO * Search has been implemented. ! MANIFEST * Added search-related files. 0.12 Tue Jul 25 2006 "Dmitri Tikhonov" Refactoring and improvement continues. Still very much beta. ! lib/RT/Client/REST/Ticket.pm * Added methods 'comment' and 'correspond'. * Added attribute 'last_updated'. * Added POD. ! t/22-ticket.t * Added tests for new methods and attributes. ! lib/RT/Client/REST.pm * Added 'cc' and 'bcc' support to 'comment' and 'correspond' methods. * Refactoring: moved forms functions and exceptions into their own files. * Fixed POD (s/=end/=cut/). * Throw 409 RT errors (syntax errors), since this client is not interactive. + lib/RT/Client/REST/Exception.pm * Refactoring: moved forms functions and exceptions into their own files. * Mapped 'does not exist' to ObjectNotFound exception. * Added RT::Client::REST::UnknownCustomFieldException. + lib/RT/Client/REST/Forms.pm * Refactoring: moved forms functions and exceptions into their own files. ! lib/RT/Client/REST/Object.pm * When creating an object, update $self with the new id. * Added support for fetching and updating custom fields. * Added method 'cf' for custom field manipulation. * Added POD. ! t/20-object.t * Added test for 'cf' method. + t/90-pod.t * Added POD tests using Test::Pod. ! examples/edit_ticket.pl ! examples/show_ticket.pl * Now rtserver is $ENV{RTSERVER} by default. + examples/create_ticket.pl + examples/comment_on_ticket.pl + examples/edit_custom_field.pl * More examples. ! Makefile.PL * Added dependency on Params::Validate. ! MANIFEST * Updated to reflect new tests, examples, and classes. + TODO * Added TODO file. 0.11 Sat Jul 22 2006 "Dmitri Tikhonov" ! lib/RT/Client/REST.pm * Make $VERSION a string so that 'make tardist' works as expected (i.e. version 0.10 instead of 0.1). 0.10 Sat Jul 22 2006 "Dmitri Tikhonov" Started working on new APIs; new objects and file structure. 0.06 Wed Jul 12 2006 "Dmitri Tikhonov" * Method 'create' now returns numeric ID of the new object. * RT::Interface::REST is no longer a requirement. If it is not installed, embedded copy of auxiliary methods is used. * Added tests. 0.05 Thu Apr 20 2006 "Dmitri Tikhonov" * Added RT::Client::REST::CouldNotCreateObjectException 0.04 Wed Apr 19 2006 "Dmitri Tikhonov" * Removed old print statements 0.03 Wed Apr 19 2006 "Dmitri Tikhonov" This is the initial release. # vim:sts=2:sw=2:et:ft=changelog: LICENSE100644001750001750 4370314377177463 14117 0ustar00deandean000000000000RT-Client-REST-0.72This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End META.yml100644001750001750 347614377177463 14346 0ustar00deandean000000000000RT-Client-REST-0.72--- abstract: 'Client for RT using REST API' author: - 'Dean Hamstead ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' HTTP::Server::Simple: '0.44' HTTP::Server::Simple::CGI: '0' HTTP::Server::Simple::CGI::Environment: '0' IO::Handle: '0' IPC::Open3: '0' Module::Build: '0.28' Test::Exception: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' Module::Build: '0.28' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.029, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: RT-Client-REST requires: DateTime: '0' DateTime::Format::DateParse: '0' Encode: '0' Exception::Class: '0' Exporter: '0' HTTP::Cookies: '0' HTTP::Request::Common: '0' LWP: '0' Params::Validate: '0' Try::Tiny: '0' URI: '0' constant: '0' parent: '0' perl: '5.008' strict: '0' vars: '0' warnings: '0' resources: bugtracker: https://github.com/RT-Client-REST/RT-Client-REST/issues homepage: https://github.com/RT-Client-REST/RT-Client-REST repository: https://github.com/RT-Client-REST/RT-Client-REST.git version: '0.72' x_contributors: - 'Abhijit Menon-Sen ' - 'belg4mit ' - 'bobtfish ' - 'Byron Ellacott ' - 'Dean Hamstead ' - 'DJ Stauffer ' - 'dkrotkine ' - 'Dmitri Tikhonov ' - 'Marco Pessotto ' - 'pplusdomain ' - 'Sarvesh D ' - 'Søren Lund ' - 'Tom Harrison ' x_generated_by_perl: v5.36.0 x_serialization_backend: 'YAML::Tiny version 1.73' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' MANIFEST100644001750001750 356514377177463 14225 0ustar00deandean000000000000RT-Client-REST-0.72# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.029. Build.PL CHANGES CONTRIBUTORS LICENSE MANIFEST META.json META.yml Makefile.PL README README.md TODO cpanfile examples/comment_on_ticket.pl examples/create_ticket.pl examples/create_user.pl examples/edit_custom_field.pl examples/edit_group.pl examples/edit_ticket.pl examples/edit_user.pl examples/list_attachments.pl examples/list_tickets.pl examples/list_transactions.pl examples/list_transactions_rt.pl examples/report-bug-to-cpan.pl examples/search_tickets.pl examples/show_attachment.pl examples/show_group.pl examples/show_links.pl examples/show_queue.pl examples/show_ticket.pl examples/show_transaction.pl examples/show_user.pl examples/take_ticket.pl lib/RT/Client/REST.pm lib/RT/Client/REST/Attachment.pm lib/RT/Client/REST/Exception.pm lib/RT/Client/REST/Forms.pm lib/RT/Client/REST/Group.pm lib/RT/Client/REST/HTTPClient.pm lib/RT/Client/REST/Object.pm lib/RT/Client/REST/Object/Exception.pm lib/RT/Client/REST/Queue.pm lib/RT/Client/REST/SearchResult.pm lib/RT/Client/REST/Ticket.pm lib/RT/Client/REST/Transaction.pm lib/RT/Client/REST/User.pm t/00-compile.t t/00-report-prereqs.dd t/00-report-prereqs.t t/01-use.t t/10-core.t t/11-server-name.t t/20-object.t t/21-user.t t/22-ticket.t t/23-attachment.t t/24-transaction.t t/25-queue.t t/26-group.t t/35-db.t t/40-search.t t/50-forms.t t/60-with-rt.t t/80-timeout.t t/81-submit.t t/82-stringify.t t/83-attachments.t t/84-attachments-rt127607.t t/85-attachments-rt127607.t t/86-redirect.t t/author-critic.t t/author-distmeta.t t/author-eof.t t/author-eol.t t/author-no-breakpoints.t t/author-no-tabs.t t/author-pod-coverage.t t/author-pod-no404s.t t/author-pod-spell.t t/author-pod-syntax.t t/author-portability.t t/data/nonewline.txt t/data/spaces.txt t/data/test.png t/release-kwalitee.t t/release-pause-permissions.t t/release-test-legal.t t/release-unused-vars.t Build.PL100644001750001750 360014377177463 14356 0ustar00deandean000000000000RT-Client-REST-0.72 # This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v6.029. use strict; use warnings; use Module::Build 0.28; my %module_build_args = ( "build_requires" => { "HTTP::Server::Simple" => "0.44", "HTTP::Server::Simple::CGI" => 0, "HTTP::Server::Simple::CGI::Environment" => 0, "Module::Build" => "0.28", "Test::Exception" => 0, "Test::More" => 0 }, "configure_requires" => { "ExtUtils::MakeMaker" => 0, "Module::Build" => "0.28" }, "dist_abstract" => "Client for RT using REST API", "dist_author" => [ "Dean Hamstead " ], "dist_name" => "RT-Client-REST", "dist_version" => "0.72", "license" => "perl", "module_name" => "RT::Client::REST", "recursive_test_files" => 1, "requires" => { "DateTime" => 0, "DateTime::Format::DateParse" => 0, "Encode" => 0, "Exception::Class" => 0, "Exporter" => 0, "HTTP::Cookies" => 0, "HTTP::Request::Common" => 0, "LWP" => 0, "Params::Validate" => 0, "Try::Tiny" => 0, "URI" => 0, "constant" => 0, "parent" => 0, "perl" => "5.008", "strict" => 0, "vars" => 0, "warnings" => 0 }, "test_requires" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Test::More" => 0 } ); my %fallback_build_requires = ( "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "HTTP::Server::Simple" => "0.44", "HTTP::Server::Simple::CGI" => 0, "HTTP::Server::Simple::CGI::Environment" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Module::Build" => "0.28", "Test::Exception" => 0, "Test::More" => 0 ); unless ( eval { Module::Build->VERSION(0.4004) } ) { delete $module_build_args{test_requires}; $module_build_args{build_requires} = \%fallback_build_requires; } my $build = Module::Build->new(%module_build_args); $build->create_build_script; cpanfile100644001750001750 362114377177463 14571 0ustar00deandean000000000000RT-Client-REST-0.72# This file is generated by Dist::Zilla::Plugin::CPANFile v6.029 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "DateTime" => "0"; requires "DateTime::Format::DateParse" => "0"; requires "Encode" => "0"; requires "Exception::Class" => "0"; requires "Exporter" => "0"; requires "HTTP::Cookies" => "0"; requires "HTTP::Request::Common" => "0"; requires "LWP" => "0"; requires "Params::Validate" => "0"; requires "Try::Tiny" => "0"; requires "URI" => "0"; requires "constant" => "0"; requires "parent" => "0"; requires "perl" => "5.008"; requires "strict" => "0"; requires "vars" => "0"; requires "warnings" => "0"; on 'build' => sub { requires "HTTP::Server::Simple" => "0.44"; requires "HTTP::Server::Simple::CGI" => "0"; requires "HTTP::Server::Simple::CGI::Environment" => "0"; requires "Module::Build" => "0.28"; requires "Test::Exception" => "0"; requires "Test::More" => "0"; }; on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Test::More" => "0"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "Module::Build" => "0.28"; }; on 'configure' => sub { suggests "JSON::PP" => "2.27300"; }; on 'develop' => sub { requires "Pod::Coverage::TrustPod" => "0"; requires "Test::CPAN::Meta" => "0"; requires "Test::EOF" => "0"; requires "Test::EOL" => "0"; requires "Test::More" => "0.88"; requires "Test::NoBreakpoints" => "0.15"; requires "Test::NoTabs" => "0"; requires "Test::PAUSE::Permissions" => "0"; requires "Test::Perl::Critic" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Pod::Coverage" => "1.08"; requires "Test::Pod::No404s" => "0"; requires "Test::Portability::Files" => "0"; requires "Test::Spelling" => "0.12"; }; README.md100644001750001750 202014377177463 14334 0ustar00deandean000000000000RT-Client-REST-0.72RT::Client::REST ================ `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 -------- 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: ```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 ------- This module is licensed under both the Aristic 1.0 and GPL 1.0, the same terms as Perl itself. [![CPAN version](https://badge.fury.io/pl/RT-Client-REST.svg)](https://metacpan.org/pod/RT::Client::REST) t000755001750001750 014377177463 13166 5ustar00deandean000000000000RT-Client-REST-0.7235-db.t100644001750001750 446514377177463 14336 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: package MyObject; # For testing purposes use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); sub rt_type { 'myobject' } sub _attributes { { id => {}, abc => { validation => { type => SCALAR, }, }, } } sub retrieve { my $self = shift; $self->abc( $self->id ); $self->{__dirty} = {}; return $self; } my $i = 0; sub store { my $self = shift; $::STORED = ++$i; } __PACKAGE__->_generate_methods; package main; use strict; use warnings; 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" ); $obj->retrieve; 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( !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'; 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" ); my $stored = $STORED; $obj->abc(5); ok( $stored + 1 == $STORED, "object is stored" ); $stored = $STORED; $obj->id(10); ok( $stored == $STORED, "modifying 'id' did not trigger a store" ); META.json100644001750001750 713514377177463 14512 0ustar00deandean000000000000RT-Client-REST-0.72{ "abstract" : "Client for RT using REST API", "author" : [ "Dean Hamstead " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.029, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "RT-Client-REST", "prereqs" : { "build" : { "requires" : { "HTTP::Server::Simple" : "0.44", "HTTP::Server::Simple::CGI" : "0", "HTTP::Server::Simple::CGI::Environment" : "0", "Module::Build" : "0.28", "Test::Exception" : "0", "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "Module::Build" : "0.28" }, "suggests" : { "JSON::PP" : "2.27300" } }, "develop" : { "requires" : { "Pod::Coverage::TrustPod" : "0", "Test::CPAN::Meta" : "0", "Test::EOF" : "0", "Test::EOL" : "0", "Test::More" : "0.88", "Test::NoBreakpoints" : "0.15", "Test::NoTabs" : "0", "Test::PAUSE::Permissions" : "0", "Test::Perl::Critic" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Pod::No404s" : "0", "Test::Portability::Files" : "0", "Test::Spelling" : "0.12" } }, "runtime" : { "requires" : { "DateTime" : "0", "DateTime::Format::DateParse" : "0", "Encode" : "0", "Exception::Class" : "0", "Exporter" : "0", "HTTP::Cookies" : "0", "HTTP::Request::Common" : "0", "LWP" : "0", "Params::Validate" : "0", "Try::Tiny" : "0", "URI" : "0", "constant" : "0", "parent" : "0", "perl" : "5.008", "strict" : "0", "vars" : "0", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/RT-Client-REST/RT-Client-REST/issues" }, "homepage" : "https://github.com/RT-Client-REST/RT-Client-REST", "repository" : { "type" : "git", "url" : "https://github.com/RT-Client-REST/RT-Client-REST.git", "web" : "https://github.com/RT-Client-REST/RT-Client-REST" } }, "version" : "0.72", "x_contributors" : [ "Abhijit Menon-Sen ", "belg4mit ", "bobtfish ", "Byron Ellacott ", "Dean Hamstead ", "DJ Stauffer ", "dkrotkine ", "Dmitri Tikhonov ", "Marco Pessotto ", "pplusdomain ", "Sarvesh D ", "S\u00f8ren Lund ", "Tom Harrison " ], "x_generated_by_perl" : "v5.36.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.32", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } 01-use.t100644001750001750 24114377177463 14502 0ustar00deandean000000000000RT-Client-REST-0.72/t#!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.53 ); } 10-core.t100644001750001750 353514377177463 14667 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: use strict; use warnings; 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', ); use RT::Client::REST; my $rt; lives_ok { $rt = RT::Client::REST->new; } 'RT::Client::REST instance created'; for my $method (METHODS) { can_ok( $rt, $method ); } throws_ok { $rt->login; } 'RT::Client::REST::InvalidParameterValueException', "requires 'username' and 'password' parameters"; throws_ok { $rt->basic_auth_cb(1); } 'RT::Client::REST::InvalidParameterValueException'; throws_ok { $rt->basic_auth_cb( {} ); } 'RT::Client::REST::InvalidParameterValueException'; lives_ok { $rt->basic_auth_cb( sub { } ); }; { package BadLogger; sub new { bless \my $logger } for my $method (qw(debug me elmo)) { no strict 'refs'; *$method = sub { my $self = shift; Test::More::diag("$method: @_\n"); }; } } throws_ok { 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)) { no strict 'refs'; *$method = sub { my $self = shift; Test::More::diag("$method: @_\n"); }; } } lives_ok { RT::Client::REST->new( logger => GoodLogger->new ); } 'good logger, no exception thrown'; 1; 21-user.t100644001750001750 143414377177463 14713 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: use strict; use warnings; use Test::More; use Test::Exception; use constant METHODS => ( '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' ); BEGIN { use_ok('RT::Client::REST::User'); } my $user; lives_ok { $user = RT::Client::REST::User->new; } 'User can get successfully created'; for my $method (METHODS) { can_ok( $user, $method ); } ok( 'user' eq $user->rt_type ); done_testing; Makefile.PL100644001750001750 444414377177463 15043 0ustar00deandean000000000000RT-Client-REST-0.72# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.029. use strict; use warnings; use 5.008; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Client for RT using REST API", "AUTHOR" => "Dean Hamstead ", "BUILD_REQUIRES" => { "HTTP::Server::Simple" => "0.44", "HTTP::Server::Simple::CGI" => 0, "HTTP::Server::Simple::CGI::Environment" => 0, "Module::Build" => "0.28", "Test::Exception" => 0, "Test::More" => 0 }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "Module::Build" => "0.28" }, "DISTNAME" => "RT-Client-REST", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008", "NAME" => "RT::Client::REST", "PREREQ_PM" => { "DateTime" => 0, "DateTime::Format::DateParse" => 0, "Encode" => 0, "Exception::Class" => 0, "Exporter" => 0, "HTTP::Cookies" => 0, "HTTP::Request::Common" => 0, "LWP" => 0, "Params::Validate" => 0, "Try::Tiny" => 0, "URI" => 0, "constant" => 0, "parent" => 0, "strict" => 0, "vars" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Test::More" => 0 }, "VERSION" => "0.72", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "DateTime" => 0, "DateTime::Format::DateParse" => 0, "Encode" => 0, "Exception::Class" => 0, "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "HTTP::Cookies" => 0, "HTTP::Request::Common" => 0, "HTTP::Server::Simple" => "0.44", "HTTP::Server::Simple::CGI" => 0, "HTTP::Server::Simple::CGI::Environment" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "LWP" => 0, "Module::Build" => "0.28", "Params::Validate" => 0, "Test::Exception" => 0, "Test::More" => 0, "Try::Tiny" => 0, "URI" => 0, "constant" => 0, "parent" => 0, "strict" => 0, "vars" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); 50-forms.t100644001750001750 1022114377177463 15077 0ustar00deandean000000000000RT-Client-REST-0.72/t#!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 => 9; use RT::Client::REST::Forms qw(form_parse); use File::Spec::Functions qw(catfile); my $testfile = 'test.png'; my $testfile_path = catfile( 't' => 'data' => $testfile ); open( my $fh, '<', $testfile_path ) or die "Couldn't open $testfile_path $!"; my $contents = do { local $/; <$fh>; }; close $fh; sub dump_file { open( my $out, '>', '/tmp/test.png' ); print $out $_[0]; close $out; } sub create_http_body { my $binary_string = shift; my $length = length($binary_string); my $spaces = ' ' x length('Content: '); $binary_string =~ s/\n/\n$spaces/sg; my $body = <<"EOF"; id: 873 Subject: \nCreator: 12 Created: 2013-11-06 07:15:36 Transaction: 1457 Parent: 871 MessageId: \nFilename: prova2.png ContentType: image/png ContentEncoding: base64 Headers: Content-Type: image/png; name="prova2.png" Content-Disposition: attachment; filename="prova2.png" Content-Transfer-Encoding: base64 Content-Length: $length Content: $binary_string\n\n EOF return $body; } { my $body = qq| id: ticket/971216 Queue: whatever Owner: Nobody Creator: someone\@example.com Subject: Problems Status: new Priority: 10 InitialPriority: 10 FinalPriority: 50 Requestors: someone\@example.com\nCc:\nAdminCc:\nCreated: Fri Nov 04 15:38:18 2022 Starts: Not set Started: Not set Due: Sun Nov 06 15:38:18 2022 Resolved: Not set Told: Not set LastUpdated: Fri Nov 04 16:19:43 2022 TimeEstimated: 0 TimeWorked: 0 TimeLeft: 0 CF.{AdminURI}: \n |; my $form = form_parse($body); is( ref($form), 'ARRAY', 'form is an array reference' ); my ( $c, $o, $k, $e ) = @{ $$form[0] }; is( ref($k), 'HASH', 'third element ($k) is a hash reference' ); is_deeply( $k, { 'id' => 'ticket/971216', 'Queue' => 'whatever', 'Owner' => 'Nobody', 'Creator' => 'someone@example.com', 'Subject' => 'Problems', 'Status' => 'new', 'Priority' => '10', 'InitialPriority' => '10', 'FinalPriority' => '50', 'Requestors' => 'someone@example.com', 'Cc' => undef, 'AdminCc' => undef, 'Created' => 'Fri Nov 04 15:38:18 2022', 'Starts' => 'Not set', 'Started' => 'Not set', 'Due' => 'Sun Nov 06 15:38:18 2022', 'Resolved' => 'Not set', 'Told' => 'Not set', 'LastUpdated' => 'Fri Nov 04 16:19:43 2022', 'TimeEstimated' => '0', 'TimeWorked' => '0', 'TimeLeft' => '0', 'CF.{AdminURI}' => undef, }, 'Empty fields undertood' ); } { my $body = create_http_body($contents); my $form = form_parse($body); 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' ); } 25-queue.t100644001750001750 113514377177463 15063 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: use strict; use warnings; use Test::More tests => 17; use Test::Exception; use constant METHODS => ( 'new', 'to_form', 'from_form', 'rt_type', 'tickets', # attrubutes: 'id', 'name', 'description', 'correspond_address', 'comment_address', 'initial_priority', 'final_priority', 'default_due_in', 'sla_disabled', ); BEGIN { use_ok('RT::Client::REST::Queue'); } my $user; lives_ok { $user = RT::Client::REST::Queue->new; } 'Queue can get successfully created'; for my $method (METHODS) { can_ok( $user, $method ); } ok( 'queue' eq $user->rt_type ); 26-group.t100644001750001750 77714377177463 15067 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: use strict; use warnings; use Test::More tests => 11; use Test::Exception; use constant METHODS => ( 'new', 'to_form', 'from_form', 'rt_type', 'id', # attributes: 'name', 'description', 'members' ); BEGIN { use_ok('RT::Client::REST::Group'); } my $user; lives_ok { $user = RT::Client::REST::Group->new; } 'User can get successfully created'; for my $method (METHODS) { can_ok( $user, $method ); } ok( 'group' eq $user->rt_type, 'rt_type is ok' ); CONTRIBUTORS100644001750001750 76314377177463 14731 0ustar00deandean000000000000RT-Client-REST-0.72 # RT-CLIENT-REST CONTRIBUTORS # This is the (likely incomplete) list of people who have helped make this distribution what it is, either via code contributions, patches, bug reports, help with troubleshooting, etc. A huge 'thank you' to all of them. * Abhijit Menon-Sen * belg4mit * bobtfish * Byron Ellacott * Dean Hamstead * DJ Stauffer * dkrotkine * Dmitri Tikhonov * Marco Pessotto * pplusdomain * Sarvesh D * Søren Lund * Tom Harrison 81-submit.t100644001750001750 172614377177463 15252 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: # # This script tests whether submited data looks good use strict; use warnings; use Test::More; use IO::Socket; use RT::Client::REST; 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 $buf; my $client = $server->accept; $client->write( "RT/42foo 200 this is a fake successful response header header line 1 header line 2 response text" ); exit; } plan tests => 1; my $rt = RT::Client::REST->new( server => "http://127.0.0.1:$port", timeout => 2, ); 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' ); 40-search.t100644001750001750 226714377177463 15210 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: use strict; use warnings; package Mock; use parent 'RT::Client::REST::Object'; sub new { my $class = shift; bless {@_}, ref($class) || $class; } sub retrieve { shift } sub id { shift->{id} } package main; use Test::More tests => 20; use Test::Exception; 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 ); } my $search; my @ids = ( 1 .. 9 ); lives_ok { $search = RT::Client::REST::SearchResult->new( ids => \@ids, object => sub { Mock->new( id => shift ) }, ); }; ok( $search->count == 9 ); my $iter; lives_ok { $iter = $search->get_iterator; } "'get_iterator' call OK"; ok( 'CODE' eq ref($iter), "'get_iterator' returns a coderef" ); my @results = &$iter; ok( 9 == @results, "Got 9 results in list context" ); @results = &$iter; ok( 0 == @results, "Got 0 results in list context second time around" ); $iter = $search->get_iterator; my $i = 0; while ( my $obj = &$iter ) { ++$i; ok( $i == $obj->id, "id as expected" ); } ok( 9 == $i, "Iterated 9 times (as expected)" ); 20-object.t100644001750001750 431214377177463 15200 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl package MyObject; # vim:ft=perl: # For testing purposes -- Object with 'id' attribute. @ISA = qw(RT::Client::REST::Object); sub id { my $self = shift; if (@_) { $self->{_id} = shift; } return $self->{_id}; } sub rt_type { 'myobject' } sub _attributes { { id => {}, } } package main; use strict; use warnings; 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', ); BEGIN { use_ok('RT::Client::REST::Object'); } my $obj; lives_ok { $obj = RT::Client::REST::Object->new; } 'Object can get successfully created'; for my $method (METHODS) { can_ok( $obj, $method ); } use RT::Client::REST; my $rt = RT::Client::REST->new; for my $method (qw(retrieve)) { my $obj = MyObject->new; # local copy; throws_ok { $obj->$method; } 'RT::Client::REST::Object::RequiredAttributeUnsetException', "won't go on without 'rt' set"; lives_ok { $obj->rt($rt) } "Successfully set 'rt'"; throws_ok { $obj->$method; } 'RT::Client::REST::Object::RequiredAttributeUnsetException', "won't go on without 'id' set"; lives_ok { $obj->id(1); } "Successfully set 'id' to 1"; throws_ok { $obj->$method; } 'RT::Client::REST::RequiredAttributeUnsetException', "rt object is not correctly initialized"; } for my $method (qw(store count search)) { my $obj = MyObject->new; # local copy; throws_ok { $obj->$method; } 'RT::Client::REST::Object::RequiredAttributeUnsetException', "won't go on without 'rt' set"; lives_ok { $obj->rt($rt) } "Successfully set 'rt'"; lives_ok { $obj->id(1); } "Successfully set 'id' to 1"; throws_ok { $obj->$method; } 'RT::Client::REST::RequiredAttributeUnsetException', "rt object is not correctly initialized"; } 22-ticket.t100644001750001750 1411714377177463 15243 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: use strict; use warnings; 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', # attributes: 'id', 'queue', 'owner', 'creator', 'subject', 'status', 'priority', 'initial_priority', 'final_priority', 'requestors', 'cc', 'admin_cc', 'created', 'starts', 'started', 'due', 'resolved', 'told', 'time_estimated', 'time_worked', 'time_left', 'last_updated', 'sla', ); BEGIN { use_ok('RT::Client::REST::Ticket'); } my $ticket; lives_ok { $ticket = RT::Client::REST::Ticket->new; } 'Ticket can get successfully created'; for my $method (METHODS) { 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 throws_ok { $ticket->$method(1); } 'RT::Client::REST::Object::OddNumberOfArgumentsException'; throws_ok { $ticket->$method; } '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"; lives_ok { $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"; lives_ok { $ticket->id(1); } "'id' successfully set to a numeric value"; throws_ok { $ticket->$method; } 'RT::Client::REST::Object::InvalidValueException'; lives_ok { $ticket->id(1); } "'id' successfully set to a numeric value"; throws_ok { $ticket->$method; } 'RT::Client::REST::Object::InvalidValueException', "Need 'message' to $method"; throws_ok { $ticket->$method( message => 'abc' ); } 'RT::Client::REST::RequiredAttributeUnsetException'; throws_ok { $ticket->$method( message => 'abc', attachments => ['- this file does not exist -'], ); } '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"; throws_ok { $ticket->rt('anc'); } 'RT::Client::REST::Object::InvalidValueException', "'rt' expects an actual RT object"; lives_ok { $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"; lives_ok { $ticket->id(1); } "'id' successfully set to a numeric value"; throws_ok { $ticket->$method; } '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"; throws_ok { $ticket->rt('anc'); } 'RT::Client::REST::Object::InvalidValueException', "'rt' expects an actual RT object"; lives_ok { $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"; lives_ok { $ticket->id(1); } "'id' successfully set to a numeric value"; throws_ok { $ticket->$method; } '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'; lives_ok { $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' ); lives_ok { $ticket->add_requestors(qw(xyz@localhost root pgsql)); } 'Added three more requestors'; ok( 5 == $ticket->requestors, 'There are now 5 requestors' ); lives_ok { $ticket->delete_requestors('root'); } 'Deleted a requestor (root)'; ok( 4 == $ticket->requestors, 'There are now 4 requestors' ); 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' ); $dt = DateTime->new( year => 1983, month => 9, day => 1, hour => 1, minute => 2, second => 3, time_zone => 'EST' ); $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( $ticket->due, 'Thu Sep 01 01:02:03 1983' ); throws_ok { $ticket->due_datetime( bless {}, 'foo' ); } 'RT::Client::REST::Object::InvalidValueException'; 80-timeout.t100644001750001750 253214377177463 15430 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: # # This script tests whether timeout actually works. use strict; use warnings; use Test::More; 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'; 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; # Fork die "Could not fork: $!" unless defined $pid; if ( 0 == $pid ) { # Child my $buf; my $client = $server->accept; 1 while ( $client->read( $buf, 1024 ) ); exit; } plan tests => 8; # Parent for my $timeout ( 1, 2, 5, 10 ) { my $rt = RT::Client::REST->new( server => "http://127.0.0.1:$port", timeout => $timeout, ); my $t1 = time; my ( $e, $t2 ); try { $rt->login(qw(username a password b)); } 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" ); } 60-with-rt.t100644001750001750 2420314377177463 15355 0ustar00deandean000000000000RT-Client-REST-0.72/t#!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. 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' ); } 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' ); sub random_string { my $retval = ''; for ( 1 .. 10 ) { $retval .= $chars[ int( rand( scalar(@chars) ) ) ]; } return $retval; } } plan 'no_plan'; 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' ); # 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 { 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' ); } # Now log in successfully { my $e; try { $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' ); } # Create a user my $user_id; my %user_props = ( name => random_string(), password => random_string(), comments => random_string(), real_name => random_string(), ); { my ( $user, $e ); try { $user = RT::Client::REST::User->new( rt => $rt, %user_props, )->store; } 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: " . ( 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 $e; try { $user->retrieve; } 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) ) { next if $prop eq 'password'; # This property comes back obfuscated is( $user->$prop, $val, "user property `$prop' matches" ); } } # Create a queue my $queue_name = 'A queue named ' . random_string(); my $queue_id; my $queue; { my $e; try { $queue = RT::Client::REST::Queue->new( rt => $rt, name => $queue_name, )->store; $queue_id = $queue->id; } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { $e = $_; diag("test queue store: $e"); } else { $_->rethrow; } }; 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, )->retrieve; } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { $e = $_; diag("queue retrieve $e"); } else { $_->rethrow; } }; 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; { my $e; my $subject = 'This is a subject ' . random_string(); try { $ticket = RT::Client::REST::Ticket->new( 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 '$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; $fh->print($att_contents); $fh->close; my $message = 'This is a message ' . random_string(), my $e; try { $ticket->comment( message => $message, attachments => [$filename], ); } 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' ); unlink $filename; $e = undef; try { my $atts = $ticket->attachments; # XXX With RT 4.2.3, the count is 4. Is it the same with previous # versions or is this a change in behavior? is( $atts->count, 4, 'There are 4 attachment to ticket ' . $ticket->id ); my $att_iter = $atts->get_iterator; my $basename = (splitpath($filename))[2]; my ($att) = grep { $_->file_name eq $basename } &$att_iter; if ($att) { ok(1, "Found attachment with filename: $basename"); is( $att->content, $att_contents, 'Attachment content matches' ); } 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; } }; 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' ); } 00-compile.t100644001750001750 347314377177463 15367 0ustar00deandean000000000000RT-Client-REST-0.72/tuse 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More; plan tests => 13 + ($ENV{AUTHOR_TESTING} ? 1 : 0); my @module_files = ( 'RT/Client/REST.pm', 'RT/Client/REST/Attachment.pm', 'RT/Client/REST/Exception.pm', 'RT/Client/REST/Forms.pm', 'RT/Client/REST/Group.pm', 'RT/Client/REST/HTTPClient.pm', 'RT/Client/REST/Object.pm', 'RT/Client/REST/Object/Exception.pm', 'RT/Client/REST/Queue.pm', 'RT/Client/REST/SearchResult.pm', 'RT/Client/REST/Ticket.pm', 'RT/Client/REST/Transaction.pm', 'RT/Client/REST/User.pm' ); # no fake home requested my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; author-eof.t100644001750001750 64114377177463 15545 0ustar00deandean000000000000RT-Client-REST-0.72/t BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::More; # Generated by Dist::Zilla::Plugin::Test::EOF 0.0600 eval "use Test::EOF"; plan skip_all => 'Test::EOF required to test for correct end of file flag' if $@; all_perl_files_ok({ minimum_newlines => 1, maximum_newlines => 4 }); done_testing(); author-eol.t100644001750001750 345114377177463 15575 0ustar00deandean000000000000RT-Client-REST-0.72/t BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::EOL 0.19 use Test::More 0.88; use Test::EOL; my @files = ( 'lib/RT/Client/REST.pm', 'lib/RT/Client/REST/Attachment.pm', 'lib/RT/Client/REST/Exception.pm', 'lib/RT/Client/REST/Forms.pm', 'lib/RT/Client/REST/Group.pm', 'lib/RT/Client/REST/HTTPClient.pm', 'lib/RT/Client/REST/Object.pm', 'lib/RT/Client/REST/Object/Exception.pm', 'lib/RT/Client/REST/Queue.pm', 'lib/RT/Client/REST/SearchResult.pm', 'lib/RT/Client/REST/Ticket.pm', 'lib/RT/Client/REST/Transaction.pm', 'lib/RT/Client/REST/User.pm', 't/00-compile.t', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/01-use.t', 't/10-core.t', 't/11-server-name.t', 't/20-object.t', 't/21-user.t', 't/22-ticket.t', 't/23-attachment.t', 't/24-transaction.t', 't/25-queue.t', 't/26-group.t', 't/35-db.t', 't/40-search.t', 't/50-forms.t', 't/60-with-rt.t', 't/80-timeout.t', 't/81-submit.t', 't/82-stringify.t', 't/83-attachments.t', 't/84-attachments-rt127607.t', 't/85-attachments-rt127607.t', 't/86-redirect.t', 't/author-critic.t', 't/author-distmeta.t', 't/author-eof.t', 't/author-eol.t', 't/author-no-breakpoints.t', 't/author-no-tabs.t', 't/author-pod-coverage.t', 't/author-pod-no404s.t', 't/author-pod-spell.t', 't/author-pod-syntax.t', 't/author-portability.t', 't/release-kwalitee.t', 't/release-pause-permissions.t', 't/release-test-legal.t', 't/release-unused-vars.t' ); eol_unix_ok($_, { trailing_whitespace => 1 }) foreach @files; done_testing; 86-redirect.t100644001750001750 446014377177463 15553 0ustar00deandean000000000000RT-Client-REST-0.72/t#!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'; data000755001750001750 014377177463 14077 5ustar00deandean000000000000RT-Client-REST-0.72/ttest.png100644001750001750 3745714377177463 15764 0ustar00deandean000000000000RT-Client-REST-0.72/t/dataPNG  IHDR\gAMA asRGB cHRMz&u0`:pQ<bKGD oFFsP?5b pHYs  ~ vpAg_`V>\IDATx}{XlKlHD.E0(4osiEkE+*xb>mAԾbO8jRS#r*Bdlκ&% ó;w3|0 0 X-~A4Nkfo@؈̕YK Jz|AAMTMջ~kgPΖc\Zso3M:5//OPL4/XLϑcT~U^#/mX";;{+Wd6a$SZZZ,X@N?FdΝMMM~G䂟8pZ^^kKe? З#Q,Y̞=( DA{|4;6~+Yٌ gK>y-mf ;iGQd]6s6o),B>Ȭl&/a3Y{ egFYz<<<6o\PPPZZo0]:@Ri0 {.֭[1 [lT*0,##OW(%&&_` r`^^ȑ#~m N?`[[[ASSSm1X,_)x<.aح[;w`& ggg&p{D"H$0֘rXB b~z0gnas@^mb{.i d30fኴrG(4! !M5|}}׭[cd=޽{{qơ(:S !Zm:www@{{;~+xikk|"˽|>߼W.]N;ǶΧQ 1q`6ԝ:Eڃ%F)l2yd[[[mmm;;;n L&۾}JbX|zz:A111*jǎdZZ\.ǃQ/W޵kWEEűcnjɗ~\mصkWzz@*oO 8:>.*++§ޏ=燧_.\H_ #Qׯ~8>\S7a!o%ӆ>mw;g6~mT>!_}R- C8pl7a{'avo %%E+|5kyw}wƍj633 x566Zr?7[$i&]2WYrY ^ rPf n‚X00 t*E˓^zG}+WK 0`cT{}Z6#J,СF`XsΝ1c˭.((1|RP({nnn۷/sNYY˗i 7nP(4ӦM wuuPŋSSS|>~Jr„ Jrĉb_GyyRSSQ [D".j*#7))I$q8 |x:=wr%''p8yd2zf;v,qss7\Tvvv{ x7cggׯT>JH$iiiI~ Q-,,xNArrrbccsrr*yzK uVm7|JDشiOfԛ?h pSJ)2_^WWg())ikkkoo/))>}:̙3󛛛JKKquСfZ_=<<T*Ν;ՓРV˽Ϟ=[PT*ZM4\T=Y|y\\\NNΣG݇]*++'NӧO6?loovZrrk:::Ǐwv~~~*boODBā@z?~}CQ  Q2F' v3.*hjGK,h*wGTTѣ\1B{^.ڦ&2T>Xb=|[ouYoo3gdO>O?7ASLTWWGDD$`Tq A* )ƣxvurrU{pA㫘lQ-[tuu7VJJJ*++r>ww:tSE#?}t[[[@pppeeyvbHB(*3W^5[LׇX,xJXR?3(w}Po߾=g# h |>Nj9sfժUb`;B\666jZ$ɓbḸ,_ܼrQxBo߾Xa ;] >ܼywѢE.]2uرcȏc/˗/󣣣Rqǣ333bf?gRGiiD"!ϽCゆCReggk4/?~^yy9`ӦM#Fwޗ_~Io?=A_.Brȑ zNz|uQ|LSTUUU_ "h|}%((a>r}1 ABCC- " `,C f4Ç&8qGkk@0`Esq7O*_[~K˗+[s<,0s c0J  ###e2Yaaahh(0z>>۷o_fFgΜ9s&~vXqwm3S)I&1=3'mwQYKy悂~[R@Ri0 {.֭[1 [lT*0 '( ׯ_o0s\ 0//oȑo6a'Oϗޞ ölbL!Cȴ4@RRRIJGȆp?NЛ%ɷc`xbۀ1ؒu}!r=s /( Ѧ3=- w{0)M\sG@6 p=ܯrss'Oe2Yppplkk 7caXTSjkk1 x\.ð[nw0L$9;;AMmmm5/D"HaXmm12>ٳE;rqqqĂ`>8怰Đ\Ȗg`&M? i8Ph:BBƛj[.11zЯϽ{{ƍCQz$0j߼mvW^&iHH\.vpp|Cf^pt;:D@@ `c89v;u+KRy Ql,K9OĞ0wj r;'h'ONn )S]vkڵ}}}yyyW^5U\._tkOOOAAŋn1x{zz(J!(JWg$RTTo<|[aq:55 1uĈZPh*Nw+m :FzkOU=y {03 bW?_K2`wSl@F^~|~k׮^B}\͖H$qqqL X "Rp6BL8~bʺqCNKʢGd.4#' Q8uC5}V=mدs v׺31f'joMUU:+eۢ0+z~#w6`7/ RRR4M^^^\'O|w7nܨVkkk333@ aXcc/Ohx('UIL$e  #Bp͚5X)]]] 0}UUU('%%05xՏ>+W00`ǰϩ4 y28 hkxcbf?X,`K6nx-x-PW\qFYY8ox`XXuF|UUUU=*H$D(.. Ag1E Ul0, shpBxn73S --ڽcj 5zh.k~Px޽FLDo'UVģG._[o={;''g8̙32O^O?D7FޤM2fP]]a_P''pjcPkkP(lhhpP^IWb:DElեgPXsG+)),;;tM-mmm9BG# T\z$o1U^b㑟+bJ,loo'Ϡ@b}]TTCQ4::z3}9s8P(^ "A </**J竒Ϝ9j*gggAb1t@_.Z-xXp\\\/_n^y<^LLBطo_ll,c.Un޼ۻhѢK.:Tf?vرc1_R˗W8љ{13p?T"^qAÉR5ŋ?NiӦ#Fܻw/`/BINNnii9rHPPSN=|>puu:z(nj.\.\lٲl3v!"Wtt?l7Rs~Ԡ1iuuڵk>ljTT*cccӪ*¯4``VİӀf9rb 0@!NuÿLu z 0`"9z8UFʛyk/TɭTˀ-9pw 9i 1XwJrÆ 2044Q,@l,&קT* ߿tRef"""[XXoJAFF믿#RPP/*/8*y; |||ݷe~;~ v_&b}ӧ322"##O8!Νk|):q@ :ٸqcJJH$7Ӱ0۷YF3g̜9?:u͛7σR^VK$E% Nꫯ^}QF8q_y3{ͦ:___+[LixSTpuF3AZZ23gr6UZZ*TSR*x}R^47oޱc:@u;oy[sp k02a]-O0I[w=/ L%a/f] G˄v"rY/G0pw0~|r(pD0FX2 Ƃ`PA1 epwo! q3Fؤ[^Ƥ~bӿb2F2)/0 3[E/Y3{i( ހ3cHMe8RAd y,|MT]v Eilih?u8;6ÙԩS ŤI򀙓6#Ǩ:_F_]bEvvݻW\8m H /X Ν;뛚GoG?=p@{{;9=!!wRُ HfffCCCCCCff&AU.zD][S`^d80{lc8F rowHsopd<36{k_9 iɰvIe3Ga q" A, فfR<ءH^P37(,AؼysAAAiiizzz߭g`)ARtڴiݽ{^~֭-[L*b aׯ7\.7rȷ~ð'OKoOBBBBBa[l1\T|MdddZZ@ x)))F$Q#ldC _|՟dy'FxAۈƱP\k< mYl:>99hʞ;A= OX& # GT}b'OFQt2,88 ?EۛYYj1X,_)x<.aح[;w`& ggg&p{D"H$0֘rXB b~z0gnas@^mb{.i d30fኴrG(4! !M5|}}׭[cd=޽{{qơ(jy_owww@{{;~+xNFSS4$$D.{{{;88|y!uss3\8ԝvmO@ s 1ԝ:Eڃ%F)|h8H:b\P(4R'ƶD#C=Vµ<=vوTW ߯% ?ʌǏ 6 #_^SSW >? AڵkW^M>D}}}nn.fK$8&Y,^xyy)8L&stt?~|qq17-Z/k640QQQK@ddddd$qj6kǺ#TTT:99x]DGDD2j&\Ă:Zwh&eF~/زeɓmmmadBC:42l*b$&&T;viiirFο^z׮]8e\R/y<޶mvJOOHeݸ!Gև%BeeeQQQѣG 2`(~h¾ ~+6׿hk͘?5h* mQ[g`;A}C)))&//_a}'O7nTյLWg0J허4<$i&]2WYrY ^ rPf n}H cqx*E˓^zG}+WK 0`cT{%%O?%]lR'É Ÿ~?45>PŋSSS|>~Jr„ Jrĉb_GyyRSSQ [D".j*#7))I$q8 |x:=wr%''p8yd2zf;v,qss7\Tvvv{ x7cggׯT>JH$iiiI~ Q-,,xNArrrbccsrr*yzK uVm7|JDشiOfԛ?h pSJ)2_^WWg())ikkkoo/))>}:̙3󛛛JKKquСfZ_=<<T*Ν;ՓРV˽Ϟ=[PT*ZM4\T=Y|y\\\NNΣG݇]*++'NӧO6?loovZrrk:::Ǐwv~~~*MJ$"Syil694u8PH<\g1ZhM=z45FP(wE#_[[D&]] ѣG/_~뭷Ξ=흓3~xL'|/䧟~"#o Lo30H/A8A凃O1U(644S8(Goo/W1~"}[l3(o#˕TVVr |uuu:首F~鶶Jv ?PTf*^j*XϕbXR KgPg.**(=߾}{Μ9G(?s/ DžADEE|UI}gΜYj3 bxi:X/MGGZDqqq?yd||X,p8...˗/7\T</&&FP۷/661m*7o]hѥKl*|;vlp1/x{hxvtLϙT8p@|||DDQZZ*Hȿs/縠PTŋǏ_^^شiӈ#ݻ_Oa0FpGKP$''9r$((^S>|vuu=zO7\Tqqq.\Y.\XlYvvvu+::6@?jИ{nⴺzڵ65S*T*iUUWn0+__v bXif9b|_uAP|y  Y'q_~Eg|:v= 0x?db*#ŀ5Ve`d; ̜4, yRaÆHLVXX (O 6WRS*aaa_t)y˲bX{-,,LHH7% ##_Ǐ)((S sqwY<>>>۲@yo;_/wC>'Ns5C 8 clܸ1%%E$iXX׬Yh3gfΜO:͛A)/% 'o|WjllQN8ѯyfSSS]]-˴PGs)/ ͛7رxs:UUUȼۭtyHbsw``|ۮz椭G˄UpwXߒ0.#e [xxX;w#eb;}> 9`8"X#,ocpD0`v( cqa 2` NKeD4?p&R\$O3ɘ2ϒed ^01Y3{i( ހ4`|AdYTjz7olΖc\Zso3M:5//OPL4*:30s&sUC_UHK[+V޽{ʕ+g{yݫAVxC{zz֭[U!U|'> ǏONNH$?,X@`<HOHHغuͥKV^}m|GD.Ç+ЩE?̎g /,YRgK{c9ɷ_gl:B=X=4wvNSQ_w c_c=F@=*CW5?>y~/F`8@׿;gb-AT4|E__rXUZZziRyСF?p8?P\\LlkP*%%%gvppA; Kʞ]v3Ǝrʤ$\OpppddP(qBb;=J2++K* »w8xT*6mawޥߺu+a˖-J$rBaXbbuO\.7rȷ~ð'OKoOBBBBBa[l1\T|MdddZZ@ x)))F$Q#ldC _|՟dy'FxAۈƱP\k< mYl:'D``!@$:t{%Nb&a5UXnnɓQ?L& B|R&LV*'N+R(OMM壣SSS|>6moZ*L__зA Kʞ [bccz]\\8μyd2y(ʤ$Hp,X8ŢR[[arݺu Osa"` rvv6hΝ#D"aƔgb ,Ӄ9tjCv sNc [44/W8BY^oA@nݺD{~ l68?T*E#ωtWW׽{U1¤v4(i0_*T5JPo߾W^yE?/SRRb=JRNCQn pwwD!Fg;;MMMӐ\ͼrRw:9u> 2psRw$ViDxWY3—rx==a$ȓvNORWlL2%,,ڵkEEE^^^k׮˻zڨ) r|"EQ*#A-ʞ;w3C=<4maq:55 1uĈZPh*Nw+m :FzkOU=y {03 bW?_K2`wSl@F^~|~k׮^z] K{{;9]{Ƀ-ƞK.[ʲ\naa@чy~n$^xyy)8L&stt?~|qq17-Z/k640QQQK|0?;FG]cXq䔊X''''JCI2m\]c-m@C _Ozx|lz 1,doL"tM[9^._h#i.[F4\xQ"H$rMGGZDqqq: rzdy~n$ #oL&۾}J"eCRv؁Kyxxr<{Xz]*** ϗ~\mصkWzz@*oO 8:>ԎWʢGd.4#' Q8uCj &,d{ڰ_6ug4cFWOԠߚ'uWʶEaҾuQ)))&//F NjRTUUӷIҔʞ~ɓ'P(bbb[ZZ9d^=POs2IENDB`82-stringify.t100644001750001750 334014377177463 15760 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: # # This script tests whether submited data looks good use strict; use warnings; use Test::More; 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'; 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 $rt = RT::Client::REST->new( server => "http://127.0.0.1:$port", # This ensures that we die soon. When the client dies, the # while (<$client>) above stops looping. timeout => 2, ); try { $rt->_submit( "ticket/1", "aaaa", { user => 'a', pass => 'b', } ); } 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; } plan tests => 3; my $buf; my $client = $server->accept; my $data; while (<$client>) { $data .= $_; } unlike( $data, qr/ARRAY\(/, "Avoid stringify objects when sending a request" ); SKIP: { skip "Self-tests only for release testing", 2 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" ); } 23-attachment.t100644001750001750 175514377177463 16075 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: use strict; use warnings; use Test::More tests => 26; use Test::Exception; use constant METHODS => ( 'new', 'to_form', 'from_form', 'rt_type', # attrubutes: 'id', 'creator_id', 'subject', 'created', 'message_id', 'parent_id', 'content_type', 'file_name', 'transaction_id', 'content', 'headers', 'parent', 'content_encoding', ); BEGIN { use_ok('RT::Client::REST::Attachment'); } for my $method (METHODS) { can_ok( 'RT::Client::REST::Attachment', $method ); } my $ticket; lives_ok { $ticket = RT::Client::REST::Attachment->new; } '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 throws_ok { $ticket->$method; } 'RT::Client::REST::Object::IllegalMethodException', "method '$method' should throw an exception"; } ok( 'attachment' eq $ticket->rt_type ); spaces.txt100644001750001750 3714377177463 16216 0ustar00deandean000000000000RT-Client-REST-0.72/t/data author-critic.t100644001750001750 40714377177463 16251 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::Perl::Critic (-profile => "t/.perlcriticrc") x!! -e "t/.perlcriticrc"; all_critic_ok(); 83-attachments.t100644001750001750 643714377177463 16270 0ustar00deandean000000000000RT-Client-REST-0.72/t#!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; 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 $!"; local $/; <$fh>; }; my ( $reply_header, $reply_body ) = do { my $binary_string = $testfile_content; my $length = length($binary_string); $binary_string =~ s/\n/\n /sg; my $body = <<"EOF"; id: 873 Subject: \nCreator: 12 Created: 2013-11-06 07:15:36 Transaction: 1457 Parent: 871 MessageId: \nFilename: prova2.png ContentType: image/png ContentEncoding: base64 Headers: Content-Type: image/png; name="prova2.png" Content-Disposition: attachment; filename="prova2.png" Content-Transfer-Encoding: base64 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 => 4; { my $res = HTTP::Response->parse($http_reply); ok( $res->content eq $http_payload, 'self-test: HTTP::Response gives back correct payload' ); } my $rt = RT::Client::REST->new( server => "http://127.0.0.1:$port", timeout => 2, ); # avoid need to login $rt->basic_auth_cb( sub { return } ); { my $res = $rt->get_attachment( parent_id => 130, id => 873, undecoded => 1 ); ok( $res->{Content} eq $testfile_content, 'binary files match with undecoded option' ); } { 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; waitpid $pid, 0; exit; 11-server-name.t100644001750001750 116214377177463 16156 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl use strict; use warnings; use Test::More tests => 5; use RT::Client::REST; my $rt = RT::Client::REST->new( server => 'http://localhost/' ); is $rt->server, 'http://localhost', 'Trailing slash stripped'; is $rt->_rest, 'http://localhost/REST/1.0', 'rest uri ok'; $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'; 24-transaction.t100644001750001750 154014377177463 16263 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl # vim:ft=perl: use strict; use warnings; use Test::More tests => 23; use Test::Exception; 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', 'description', 'data', ); BEGIN { use_ok('RT::Client::REST::Transaction'); } for my $method (METHODS) { can_ok( 'RT::Client::REST::Transaction', $method ); } my $tr; lives_ok { $tr = RT::Client::REST::Transaction->new; } '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"; } ok( 'transaction' eq $tr->rt_type ); author-no-tabs.t100644001750001750 341714377177463 16363 0ustar00deandean000000000000RT-Client-REST-0.72/t BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::NoTabs 0.15 use Test::More 0.88; use Test::NoTabs; my @files = ( 'lib/RT/Client/REST.pm', 'lib/RT/Client/REST/Attachment.pm', 'lib/RT/Client/REST/Exception.pm', 'lib/RT/Client/REST/Forms.pm', 'lib/RT/Client/REST/Group.pm', 'lib/RT/Client/REST/HTTPClient.pm', 'lib/RT/Client/REST/Object.pm', 'lib/RT/Client/REST/Object/Exception.pm', 'lib/RT/Client/REST/Queue.pm', 'lib/RT/Client/REST/SearchResult.pm', 'lib/RT/Client/REST/Ticket.pm', 'lib/RT/Client/REST/Transaction.pm', 'lib/RT/Client/REST/User.pm', 't/00-compile.t', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/01-use.t', 't/10-core.t', 't/11-server-name.t', 't/20-object.t', 't/21-user.t', 't/22-ticket.t', 't/23-attachment.t', 't/24-transaction.t', 't/25-queue.t', 't/26-group.t', 't/35-db.t', 't/40-search.t', 't/50-forms.t', 't/60-with-rt.t', 't/80-timeout.t', 't/81-submit.t', 't/82-stringify.t', 't/83-attachments.t', 't/84-attachments-rt127607.t', 't/85-attachments-rt127607.t', 't/86-redirect.t', 't/author-critic.t', 't/author-distmeta.t', 't/author-eof.t', 't/author-eol.t', 't/author-no-breakpoints.t', 't/author-no-tabs.t', 't/author-pod-coverage.t', 't/author-pod-no404s.t', 't/author-pod-spell.t', 't/author-pod-syntax.t', 't/author-portability.t', 't/release-kwalitee.t', 't/release-pause-permissions.t', 't/release-test-legal.t', 't/release-unused-vars.t' ); notabs_ok($_) foreach @files; done_testing; author-distmeta.t100644001750001750 42514377177463 16606 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::MetaTests. use strict; use warnings; use Test::CPAN::Meta; meta_yaml_ok(); nonewline.txt100644001750001750 2014377177463 16726 0ustar00deandean000000000000RT-Client-REST-0.72/t/datano new line noperelease-kwalitee.t100644001750001750 67214377177463 16723 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { print qq{1..0 # SKIP these tests are for release candidate testing\n}; exit } } # This test is generated by Dist::Zilla::Plugin::Test::Kwalitee::Extra use strict; use warnings; use Test::More; # needed to provide plan. eval { require Test::Kwalitee::Extra }; plan skip_all => "Test::Kwalitee::Extra required for testing kwalitee: $@" if $@; eval "use Test::Kwalitee::Extra"; author-pod-spell.t100644001750001750 126214377177463 16713 0ustar00deandean000000000000RT-Client-REST-0.72/t BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007005 use Test::Spelling 0.12; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ Abhijit Attachment Byron Client DJ Dean Dmitri Ellacott Exception Forms Group HTTPClient Hamstead Harrison Lund Marco Menon Object Pessotto Queue REST RT Sarvesh SearchResult Stauffer Søren Ticket Tikhonov Tom Transaction User ams belg4mit bobtfish code dean dj djzort dkrotkine dmitri lib melmothx pplusdomain sarveshd soren tomh examples000755001750001750 014377177463 14541 5ustar00deandean000000000000RT-Client-REST-0.72show_user.pl100644001750001750 135014377177463 17253 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::User; unless ( @ARGV >= 3 ) { die "Usage: $0 username password user_id\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $user; try { $user = RT::Client::REST::User->new( rt => $rt, id => shift(@ARGV), )->retrieve; } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { die ref($_), ": ", $_->message || $_->description, "\n"; } }; use Data::Dumper; print Dumper($user); edit_user.pl100644001750001750 103314377177463 17216 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # edit_ticket.pl -- edit an RT ticket. use strict; use warnings; use RT::Client::REST; use RT::Client::REST::User; 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' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $user = RT::Client::REST::User->new( rt => $rt, id => shift(@ARGV), @ARGV, )->store; use Data::Dumper; print Dumper($user); Client000755001750001750 014377177463 15234 5ustar00deandean000000000000RT-Client-REST-0.72/lib/RTREST.pm100644001750001750 11502014377177463 16546 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client#!perl # vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST # ABSTRACT: Client for RT using REST API # # Dmitri Tikhonov # # Part of the source is Copyright (c) 2007-2008 Damien Krotkine # # This code is adapted from /usr/bin/rt that came with RT. As of version 0.49, # this module is licensed using Perl Artistic License, with permission from the # original author of rt utility, Abhijit Menon-Sen. # # Original notice: #------------------------ # COPYRIGHT: # This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC # # Designed and implemented for Best Practical Solutions, LLC by # Abhijit Menon-Sen #------------------------ use strict; use warnings; package RT::Client::REST; $RT::Client::REST::VERSION = '0.72'; use Try::Tiny; use HTTP::Cookies; use HTTP::Request::Common; 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 verbose_errors user_agent_args)) { no strict 'refs'; ## no critic (ProhibitNoStrict) *{__PACKAGE__ . '::' . $method} = sub { my $self = shift; if (@_) { my $val = shift; { no warnings 'uninitialized'; $self->logger->debug("set `$method' to $val"); } $self->{'_' . $method} = $val; } return $self->{'_' . $method}; }; } sub new { my $class = shift; $class->_assert_even(@_); my $self = bless { _logger => RT::Client::REST::NoopLogger->new, }, ref($class) || $class; my %opts = @_; while (my ($k, $v) = each(%opts)) { # in _rest we concatenate server with '/REST/1.0'; if ($k eq 'server') { $v =~ s!/$!!; } $self->$k($v); } return $self; } sub login { my $self = shift; $self->_assert_even(@_); my %opts = @_; unless (scalar(keys %opts) > 0) { RT::Client::REST::InvalidParameterValueException->throw( "You must provide credentials (user and pass) to log in", ); } # back-compat hack if (defined $opts{username}){ $opts{user} = $opts{username}; delete $opts{username} } if (defined $opts{password}){ $opts{pass} = $opts{password}; delete $opts{password} } # OK, here's how login works. We request to see ticket 1. We don't # even care if it exists. We watch exceptions: auth. failures and # 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 { 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. }; } sub show { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $type = $self->_valid_type(delete($opts{type})); my $id; if (grep { $type eq $_ } (qw(user queue group))) { # User or queue ID does not have to be numeric $id = delete($opts{id}); } else { $id = $self->_valid_numeric_object_id(delete($opts{id})); } my $form = form_parse($self->_submit("$type/$id")->decoded_content); my ($c, $o, $k) = @{$$form[0]}; # my ($c, $o, $k, $e) if (!@$o && $c) { RT::Client::REST::Exception->_rt_content_to_exception($c)->throw; } return $k; } sub get_attachment_ids { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $type = $self->_valid_type(delete($opts{type}) || 'ticket'); my $id = $self->_valid_numeric_object_id(delete($opts{id})); my $form = form_parse( $self->_submit("$type/$id/attachments/")->decoded_content ); my ($c, $o, $k) = @{$$form[0]}; # my ($c, $o, $k, $e) if (!@$o && $c) { RT::Client::REST::Exception->_rt_content_to_exception($c)->throw; } return $k->{Attachments} =~ m/^\s*(\d+):/mg; } sub get_attachments_metadata { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $type = $self->_valid_type(delete($opts{type}) || 'ticket'); my $id = $self->_valid_numeric_object_id(delete($opts{id})); my $form = form_parse( $self->_submit("$type/$id/attachments/")->decoded_content ); my ($c, $o, $k) = @{$$form[0]}; # my ($c, $o, $k, $e) if (!@$o && $c) { RT::Client::REST::Exception->_rt_content_to_exception($c)->throw; } 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 => ( defined($c[1]) && ( $c[1] eq '(Unnamed)' ) ) ? undef : $c[1], Type => $c[2], Size => $c[3] }; } split(/\n/, $k->{Attachments}); } sub get_attachment { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $type = $self->_valid_type(delete($opts{type}) || 'ticket'); my $parent_id = $self->_valid_numeric_object_id(delete($opts{parent_id})); my $id = $self->_valid_numeric_object_id(delete($opts{id})); my $res = $self->_submit("$type/$parent_id/attachments/$id"); my $content; if ($opts{undecoded}) { $content = $res->content; } else { $content = $res->decoded_content; } my $form = form_parse($content); my ($c, $o, $k) = @{$$form[0]}; # my ($c, $o, $k, $e) if (!@$o && $c) { RT::Client::REST::Exception->_rt_content_to_exception($c)->throw; } return $k; } sub get_links { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $type = $self->_valid_type(delete($opts{type}) || 'ticket'); my $id = $self->_valid_numeric_object_id(delete($opts{id})); my $form = form_parse( $self->_submit("$type/$id/links/$id")->decoded_content ); my ($c, $o, $k) = @{$$form[0]}; # my ($c, $o, $k, $e) if (!@$o && $c) { RT::Client::REST::Exception->_rt_content_to_exception($c)->throw; } # Turn the links into id lists 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 = (); 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 }); } else { # Something we don't recognise push(@newlist, { 'url' => $val }); } } # Copy the newly created list $k->{$key} = (); $k->{$key} = \@newlist; } 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' } } return $k; } sub get_transaction_ids { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $parent_id = $self->_valid_numeric_object_id(delete($opts{parent_id})); my $type = $self->_valid_type(delete($opts{type}) || 'ticket'); my $path; my $tr_type = delete($opts{transaction_type}); if (!defined($tr_type)) { # Gotta catch 'em all! $path = "$type/$parent_id/history"; } elsif ('ARRAY' eq ref($tr_type)) { # OK, more than one type. Call ourselves for each. # NOTE: this may be very expensive. my @return = sort map { $self->get_transaction_ids( parent_id => $parent_id, transaction_type => $_, ) } map { # Check all the types before recursing, cheaper to catch an # error this way. $self->_valid_transaction_type($_) } @$tr_type; return @return } else { $tr_type = $self->_valid_transaction_type($tr_type); $path = "$type/$parent_id/history/type/$tr_type" } my $form = form_parse( $self->_submit($path)->decoded_content ); my ($c, $o, $k, $e) = @{$$form[0]}; if (!length($e)) { my $ex = RT::Client::REST::Exception->_rt_content_to_exception($c); unless ($ex->message =~ m~^0/~) { # We do not throw exception if the error is that no values # were found. $ex->throw; } } return $e =~ m/^(?:>> )?(\d+):/mg; } sub get_transaction { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $type = $self->_valid_type(delete($opts{type}) || 'ticket'); my $parent_id = $self->_valid_numeric_object_id(delete($opts{parent_id})); my $id = $self->_valid_numeric_object_id(delete($opts{id})); my $form = form_parse( $self->_submit("$type/$parent_id/history/id/$id")->decoded_content ); my ($c, $o, $k) = @{$$form[0]}; # my ($c, $o, $k, $e) if (!@$o && $c) { RT::Client::REST::Exception->_rt_content_to_exception($c)->throw; } return $k; } sub search { my $self = shift; $self->_assert_even(@_); my %opts = @_; 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; } sub edit { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $type = $self->_valid_type(delete($opts{type})); my $id = delete($opts{id}); unless ('new' eq $id) { $id = $self->_valid_numeric_object_id($id); } my %set; if (defined(my $set = delete($opts{set}))) { while (my ($k, $v) = each(%$set)) { vpush(\%set, lc($k), $v); } } if (defined(my $text = delete($opts{text}))) { $text =~ s/(\n\r?)/$1 /g; vpush(\%set, 'text', $text); } $set{id} = "$type/$id"; my $r = $self->_submit('edit', { content => form_compose([['', [keys %set], \%set]]) }); # This seems to be a bug on the server side: returning 200 Ok when # ticket creation (for instance) fails. We check it here: if ($r->decoded_content =~ /not/) { RT::Client::REST::Exception->_rt_content_to_exception($r->decoded_content) ->throw( code => $r->code, message => "RT server returned this error: " . $r->decoded_content, ); } if ($r->decoded_content =~ /^#[^\d]+(\d+) (?:created|updated)/) { return $1; } else { RT::Client::REST::MalformedRTResponseException->throw( message => "Cound not read ID of the modified object", ); } } sub create { shift->edit(@_, id => 'new') } sub comment { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $action = $self->_valid_comment_action( delete($opts{comment_action}) || 'comment'); my $ticket_id = $self->_valid_numeric_object_id(delete($opts{ticket_id})); my $msg = $self->_valid_comment_message(delete($opts{message})); my @objects = ('Ticket', 'Action', 'Text'); my %values = ( Ticket => $ticket_id, Action => $action, 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}); } if (exists($opts{bcc})) { push @objects, 'Bcc'; $values{Bcc} = delete($opts{bcc}); } my %data; if (exists($opts{attachments})) { my $files = delete($opts{attachments}); unless ('ARRAY' eq ref($files)) { RT::Client::REST::InvalidParameterValueException->throw( "'attachments' must be an array reference", ); } push @objects, 'Attachment'; $values{Attachment} = $files; for (my $i = 0; $i < @$files; ++$i) { unless (-f $files->[$i] && -r _) { RT::Client::REST::CannotReadAttachmentException->throw( "File '" . $files->[$i] . "' is not readable", ); } my $index = $i + 1; $data{"attachment_$index"} = bless([ $files->[$i] ], 'Attachment'); } } my $text = form_compose([[ '', \@objects, \%values, ]]); $data{content} = $text; $self->_submit("ticket/$ticket_id/comment", \%data); return; } sub correspond { shift->comment(@_, comment_action => 'correspond') } sub merge_tickets { my $self = shift; $self->_assert_even(@_); my %opts = @_; my ($src, $dst) = map { $self->_valid_numeric_object_id($_) } @opts{qw(src dst)}; $self->_submit("ticket/$src/merge/$dst"); return; } sub _link { my $self = shift; $self->_assert_even(@_); my %opts = @_; my ($src, $dst) = map { $self->_valid_numeric_object_id($_) } @opts{qw(src dst)}; my $ltype = $self->_valid_link_type(delete($opts{link_type})); my $del = (exists($opts{'unlink'}) ? 1 : ''); my $type = $self->_valid_type(delete($opts{type}) || 'ticket'); #$self->_submit("$type/$src/link", { #id => $from, rel => $rel, to => $to, del => $del #} $self->_submit("$type/link", { id => $src, rel => $ltype, to => $dst, del => $del, }); return; } sub link_tickets { shift->_link(@_, type => 'ticket') } # sub unlink { shift->_link(@_, unlink => 1) } ## nothing calls this & undocumented, so commenting out for now sub unlink_tickets { shift->_link(@_, type => 'ticket', unlink => 1) } sub _ticket_action { my $self = shift; $self->_assert_even(@_); my %opts = @_; my $id = delete $opts{id}; my $action = delete $opts{action}; my $text = form_compose([[ '', ['Action'], { Action => $action }, ]]); my $form = form_parse( $self->_submit("/ticket/$id/take", { content => $text })->decoded_content ); my ($c, $o, $k, $e) = @{$$form[0]}; if ($e) { RT::Client::REST::Exception->_rt_content_to_exception($c)->throw; } } sub take { shift->_ticket_action(@_, action => 'take') } sub untake { shift->_ticket_action(@_, action => 'untake') } sub steal { shift->_ticket_action(@_, action => 'steal') } sub _submit { my ($self, $uri, $content, $auth) = @_; my ($req, $data); # Did the caller specify any data to send with the request? $data = []; if (defined $content) { 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, q(), Content => $content] ]; } elsif (ref $content eq 'HASH') { my @data; for my $k (keys %$content) { if (ref $content->{$k} eq 'ARRAY') { for my $v (@{ $content->{$k} }) { push @data, $k, $v; } } else { push @data, $k, $content->{$k} } } $content = \@data; } $data = $content; } # Should we send authentication information to start a new session? unless ($self->_cookie || $self->basic_auth_cb) { unless (defined($auth)) { RT::Client::REST::RequiredAttributeUnsetException->throw( 'You must log in first', ); } push @$data, %$auth; } # Now, we construct the request. if (@$data) { # The request object expects "bytes", not strings map { utf8::encode($_) unless ref($_)} @$data; $req = POST($self->_uri($uri), $data, Content_Type => 'form-data'); } else { $req = GET($self->_uri($uri)); } #$session->add_cookie_header($req); if ($self->_cookie) { $self->_cookie->add_cookie_header($req); } # Then we send the request and parse the response. $self->logger->debug('request: ', $req->as_string); my $res = $self->_ua->request($req); $self->logger->debug('response: ', $res->as_string); if ($res->is_success) { # The content of the response we get from the RT server consists # of an HTTP-like status line followed by optional header lines, # a blank line, and arbitrary text. my ($head, $text) = split /\n\n/, $res->decoded_content(charset => 'none'), 2; my ($status) = split /\n/, $head; # my ($status, @headers) = split /\n/, $head; # Example: # "RT/3.0.1 401 Credentials required" if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) { 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 # response code and message. (Doing that directly is apparently # not sufficiently portable and uncomplicated.) $res->code($1); $res->message($2); $res->content($text); #$session->update($res) if ($res->is_success || $res->code != 401); if ($res->header('set-cookie')) { my $jar = HTTP::Cookies->new; $jar->extract_cookies($res); $self->_cookie($jar); } if (!$res->is_success) { # We can deal with authentication failures ourselves. Either # we sent invalid credentials, or our session has expired. if ($res->code == 401) { my %d = @$data; if (exists $d{user}) { RT::Client::REST::AuthenticationFailureException->throw( code => $res->code, message => 'Incorrect username or password', ); } 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 { 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: ' . $res->decoded_content, ); } } } elsif ( 500 == $res->code && # Older versions of HTTP::Response populate 'message', newer # versions populate 'content'. This catches both cases. ($res->decoded_content || $res->message) =~ m/read timeout/ ) { RT::Client::REST::RequestTimedOutException->throw( 'Your request to ' . $self->server . ' timed out', ); } elsif (302 == $res->code && !$self->{'_redirected'}) { $self->{'_redirected'} = 1; # We only allow one redirection # Figure out the new value of 'server'. We assume that the /REST/.. # part of the URI stays the same. my $new_location = $res->header('Location'); $self->logger->info("We're being redirected to $new_location"); my $orig_server = $self->server; (my $suffix = $self->_uri($uri)) =~ s/^\Q$orig_server//; (my $new_server = $new_location) =~ s/\Q$suffix\E$//; $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 => $err_msg, ); } return $res; } 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); } if ($self->basic_auth_cb) { $self->{_ua}->basic_auth_cb($self->basic_auth_cb); } } return $self->{_ua}; } sub user_agent { shift->_ua; } sub basic_auth_cb { my $self = shift; if (@_) { my $sub = shift; unless ('CODE' eq ref($sub)) { RT::Client::REST::InvalidParameterValueException->throw( "'basic_auth_cb' must be a code reference", ); } $self->{_basic_auth_cb} = $sub; } return $self->{_basic_auth_cb}; } # Sometimes PodCoverageTests think LOGGER_METHODS is a vanilla sub use constant LOGGER_METHODS => (qw(debug warn info error)); sub logger { my $self = shift; if (@_) { my $new_logger = shift; for my $method (LOGGER_METHODS) { unless ($new_logger->can($method)) { RT::Client::REST::InvalidParameterValueException->throw( "logger does not know how to `$method'", ); } } $self->{'_logger'} = $new_logger; } return $self->{'_logger'}; } # Not a constant so that it can be overridden. sub _list_of_valid_transaction_types { sort +(qw( Create Set Status Correspond Comment Give Steal Take Told CustomField AddLink DeleteLink AddWatcher DelWatcher EmailRecord )); } sub _valid_type { my ($self, $type) = @_; unless ($type =~ /^[A-Za-z0-9_.-]+$/) { RT::Client::REST::InvaildObjectTypeException->throw( "'$type' is not a valid object type", ); } return $type; } sub _valid_objects { my ($self, $objects) = @_; unless ('ARRAY' eq ref($objects)) { RT::Client::REST::InvalidParameterValueException->throw( "'objects' must be an array reference", ); } return $objects; } sub _valid_numeric_object_id { my ($self, $id) = @_; unless ($id =~ m/^\d+$/) { RT::Client::REST::InvalidParameterValueException->throw( "'$id' is not a valid numeric object ID", ); } return $id; } sub _valid_comment_action { my ($self, $action) = @_; unless (grep { $_ eq lc($action) } (qw(comment correspond))) { RT::Client::REST::InvalidParameterValueException->throw( "'$action' is not a valid comment action", ); } return lc($action); } sub _valid_comment_message { my ($self, $message) = @_; unless (defined($message) and length($message)) { RT::Client::REST::InvalidParameterValueException->throw( "Comment cannot be empty (specify 'message' parameter)", ); } return $message; } sub _valid_link_type { my ($self, $type) = @_; my @types = qw(DependsOn DependedOnBy RefersTo ReferredToBy HasMember Members MemberOf RunsOn IsRunning ComponentOf HasComponent); unless (grep { lc($type) eq lc($_) } @types) { RT::Client::REST::InvalidParameterValueException->throw( "'$type' is not a valid link type", ); } return lc($type); } sub _valid_transaction_type { my ($self, $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) ); } return $type; } sub _assert_even { shift; RT::Client::REST::OddNumberOfArgumentsException->throw( "odd number of arguments passed") if @_ & 1; } sub _rest { my $self = shift; my $server = $self->server; unless (defined($server)) { RT::Client::REST::RequiredAttributeUnsetException->throw( "'server' attribute is not set", ); } return $server . '/REST/1.0'; } sub _uri { shift->_rest . '/' . shift } sub _ua_string { my $self = shift; return ref($self) . '/' . ($self->_version || '???'); } sub _version { $RT::Client::REST::VERSION } { # This is a noop logger: it discards all log messages. It is the default # logger. I think this approach is better than doing either checks all # over the place like this: # # if ($self->logger) { # $self->logger->warn("message"); # } # # or creating our own logging methods which will hide the checks: # # sub warn { # my $self = shift; # if ($self->logger) { # $self->logger->warn(@_); # } # } # # and later: # sub xyz { # ... # $self->warn("message"); # } # # The problem with the second approach is that it creates unrelated # methods in RT::Client::REST namespace. package RT::Client::REST::NoopLogger; $RT::Client::REST::NoopLogger::VERSION = '0.72'; sub new { bless \(my $logger), __PACKAGE__ } for my $method (RT::Client::REST::LOGGER_METHODS) { no strict 'refs'; ## no critic (ProhibitNoStrict) *{$method} = sub {}; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST - Client for RT using REST API =head1 VERSION version 0.72 =head1 SYNOPSIS use Try::Tiny; use RT::Client::REST; my $rt = RT::Client::REST->new( server => 'http://example.com/rt', timeout => 30, ); try { $rt->login(username => $user, password => $pass); } catch { if ($_->isa('Exception::Class::Base') { die "problem logging in: ", shift->message; } }; try { # Get ticket #10 $ticket = $rt->show(type => 'ticket', id => 10); } 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 B is B converted to a Perl module. I needed to implement some RT interactions from my application, but did not feel that invoking a shell command is appropriate. Thus, I took B tool, written by Abhijit Menon-Sen, and converted it to an object-oriented Perl module. =for Pod::Coverage LOGGER_METHODS =head1 USAGE NOTES This API mimics that of 'rt'. For a more OO-style APIs, please use L-derived classes: L and L. not implemented yet). =head1 METHODS =over =item new () The constructor can take these options (note that these can also be called as their own methods): =over 2 =item B B is a URI pointing to your RT installation. If you have already authenticated against RT in some other part of your program, you can use B<_cookie> parameter to supply an object of type B to use for credentials information. =item B B is the number of seconds HTTP client will wait for the server to respond. Defaults to LWP::UserAgent's default timeout, which is 180 seconds (please check LWP::UserAgent's documentation for accurate timeout information). =item B This callback is to provide the HTTP client (based on L) with username and password for basic authentication. It takes the same arguments as C of LWP::UserAgent and returns username and password: $rt->basic_auth_cb( sub { my ($realm, $uri, $proxy) = @_; # do some evil things 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') =item login (my_userfield => 'root', my_passfield => 'password') Log in to RT. Throws an exception on error. Usually, if the other side uses basic HTTP authentication, you do not have to log in, but rather provide HTTP username and password instead. See B above. =item show (type => $type, id => $id) Return a reference to a hash with key-value pair specifying object C<$id> of type C<$type>. The keys are the names of RT's fields. Keys for custom fields are in the form of "CF.{CUST_FIELD_NAME}". =item edit (type => $type, id => $id, set => { status => 1 }) Set fields specified in parameter B in object C<$id> of type C<$type>. =item create (type => $type, set => \%params, text => $text) Create a new object of type B<$type> and set initial parameters to B<%params>. For a ticket object, 'text' parameter can be supplied to set the initial 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, format => $format, %opts) Search for object of type C<$type> by using query C<$query>. For example: # Find all stalled tickets my @ids = $rt->search( type => 'ticket', query => "Status = 'stalled'", ); C<%opts> is a list of key-value pairs: =for stopwords orderby =over 4 =item B The value is the name of the field you want to sort by. Plus or minus sign in front of it signifies ascending order (plus) or descending order (minus). For example: # Get all stalled tickets in reverse order: my @ids = $rt->search( type => 'ticket', query => "Status = 'stalled'", orderby => '-id', ); =back 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: my @ids = $rt->search( type => 'ticket', query => "Status = 'stalled'", ); for my $id (@ids) { my ($ticket) = $rt->show(type => 'ticket', id => $id); 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) =for stopwords bcc Comment on a ticket with ID B<$id>. 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, message => "Wild thing, you make my heart sing", 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, B, and B parameters (see C above). =item get_attachment_ids (id => $id) Get a list of numeric attachment IDs associated with ticket C<$id>. =for stopwords undecoded =item get_attachments_metadata (id => $id) Get a list of the metadata related to every attachment of the ticket <$id> Every member of the list is a hashref with the shape: { id => $attachment_id, Filename => $attachment_filename, Type => $attachment_type, Size => $attachment_size, } =item get_attachment (parent_id => $parent_id, id => $id, undecoded => $bool) Returns reference to a hash with key-value pair describing attachment C<$id> of ticket C<$parent_id>. (parent_id because -- who knows? -- maybe attachments won't be just for tickets anymore in the future). If the option undecoded is set to a true value, the attachment will be returned verbatim and undecoded (this is probably what you want with images and binary data). =item get_links (type =E $type, id =E $id) Get link information for object of type $type whose id is $id. If type is not specified, 'ticket' is used. =item get_transaction_ids (parent_id => $id, %opts) Get a list of numeric IDs associated with parent ID C<$id>. C<%opts> have the following options: =over 2 =item B Type of the object transactions are associated with. Defaults to "ticket" (I do not think server-side supports anything else). This is designed with the eye on the future, as transactions are not just for tickets, but for other objects as well. =item B If not specified, IDs of all transactions are returned. If set to a scalar, only transactions of that type are returned. If you want to specify more than one type, pass an array reference. Transactions may be of the following types (case-sensitive): =for stopwords AddLink AddWatcher CustomField DelWatcher DeleteLink DependedOnBy DependsOn EmailRecord HasMember MemberOf ReferredToBy RefersTo =over 2 =item AddLink =item AddWatcher =item Comment =item Correspond =item Create =item CustomField =item DeleteLink =item DelWatcher =item EmailRecord =item Give =item Set =item Status =item Steal =item Take =item Told =back =back =item get_transaction (parent_id => $id, id => $id, %opts) Get a hashref representation of transaction C<$id> associated with parent object C<$id>. You can optionally specify parent object type in C<%opts> (defaults to 'ticket'). =for stopwords dst src =item merge_tickets (src => $id1, dst => $id2) Merge ticket B<$id1> into ticket B<$id2>. =item link_tickets (src => $id1, dst => $id2, link_type => $type) Create a link between two tickets. A link type can be one of the following: =over 2 =item DependsOn =item DependedOnBy =item RefersTo =item ReferredToBy =item HasMember =item MemberOf =back =item unlink_tickets (src => $id1, dst => $id2, link_type => $type) Remove a link between two tickets (see B) =item take (id => $id) Take ticket C<$id>. This will throw C if you are already the ticket owner. =for stopwords Untake untake =item untake (id => $id) Untake ticket C<$id>. This will throw C if Nobody is already the ticket owner. =item steal (id => $id) Steal ticket C<$id>. This will throw C if you are already the ticket owner. =back =head1 EXCEPTIONS When an error occurs, this module will throw exceptions. I recommend 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. =head1 LIMITATIONS Beginning with version 0.14, methods C and C only support operating on a single object. This is a conscious departure from semantics offered by the original tool, as I would like to have a precise behavior for exceptions. If you want to operate on a whole bunch of objects, please use a loop. =head1 DEPENDENCIES The following modules are required: =over 2 =item Exception::Class =item LWP =item HTTP::Cookies =item HTTP::Request::Common =back =head1 SEE ALSO L, L =head1 BUGS Most likely. Please report. =head1 VARIOUS NOTES =for stopwords TODO 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 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 CONTRIBUTORS =for stopwords Abhijit Menon-Sen belg4mit bobtfish Byron Ellacott Dean Hamstead DJ Stauffer dkrotkine Dmitri Tikhonov Marco Pessotto pplusdomain Sarvesh D Søren Lund Tom Harrison =over 4 =item * Abhijit Menon-Sen =item * belg4mit =item * bobtfish =item * Byron Ellacott =item * Dean Hamstead =item * DJ Stauffer =item * dkrotkine =item * Dmitri Tikhonov =item * Marco Pessotto =item * pplusdomain =item * Sarvesh D =item * Søren Lund =item * Tom Harrison =back =cut author-pod-no404s.t100644001750001750 73114377177463 16603 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::More; foreach my $env_skip ( qw( SKIP_POD_NO404S AUTOMATED_TESTING ) ){ plan skip_all => "\$ENV{$env_skip} is set, skipping" if $ENV{$env_skip}; } eval "use Test::Pod::No404s"; if ( $@ ) { plan skip_all => 'Test::Pod::No404s required for testing POD'; } else { all_pod_files_ok(); } 00-report-prereqs.t100644001750001750 1360114377177463 16743 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.029 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if grep { $_ eq $mod } @exclude; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; if ($mod eq 'perl') { push @reports, ['perl', $want, $]]; next; } my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass('Reported prereqs'); # vim: ts=4 sts=4 sw=4 et: author-pod-syntax.t100644001750001750 45414377177463 17104 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); show_links.pl100644001750001750 213514377177463 17417 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; 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"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); RT::Client::REST::Object->use_single_rt($rt); RT::Client::REST::Object->use_autoget(1); RT::Client::REST::Object->use_autosync(1); my $ticket; my $type = shift(@ARGV); my $id = shift(@ARGV); try { $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 ) ); show_group.pl100644001750001750 101014377177463 17422 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_group.pl -- retrieve an RT group. use strict; use warnings; use RT::Client::REST; use RT::Client::REST::Group; unless ( @ARGV >= 3 ) { die "Usage: $0 username password group_id\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $group = RT::Client::REST::Group->new( rt => $rt, id => shift(@ARGV), )->retrieve; use Data::Dumper; print Dumper($group); show_queue.pl100644001750001750 135414377177463 17425 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_queue.pl -- retrieve an RT queue. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Queue; unless ( @ARGV >= 3 ) { die "Usage: $0 username password queue_id\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $queue; try { $queue = RT::Client::REST::Queue->new( rt => $rt, id => shift(@ARGV), )->retrieve; } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { die ref($_), ": ", $_->message || $_->description, "\n"; } }; use Data::Dumper; print Dumper($queue); edit_group.pl100644001750001750 103714377177463 17400 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # edit_ticket.pl -- edit an RT ticket. use strict; use warnings; use RT::Client::REST; use RT::Client::REST::Group; 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' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $group = RT::Client::REST::Group->new( rt => $rt, id => shift(@ARGV), @ARGV )->store; use Data::Dumper; print Dumper($group); release-test-legal.t100644001750001750 102314377177463 17166 0ustar00deandean000000000000RT-Client-REST-0.72/t BEGIN { unless ($ENV{RELEASE_TESTING}) { print qq{1..0 # SKIP these tests are for release candidate testing\n}; exit } } use strict; use warnings; use Test::More qw(no_plan); SKIP: { eval { require Test::Legal }; skip "Test::Legal required for testing licences" if $@; eval { Test::Legal->import() }; BAIL_OUT "Test::Legal reported error on import so aborting tests: $@" if $@; can_ok( __PACKAGE__, qw(copyright_ok license_ok) ); main->copyright_ok; main->license_ok; }; author-portability.t100644001750001750 33214377177463 17333 0ustar00deandean000000000000RT-Client-REST-0.72/t BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::More; use Test::Portability::Files; run_tests(); 00-report-prereqs.dd100644001750001750 712014377177463 17046 0ustar00deandean000000000000RT-Client-REST-0.72/tdo { my $x = { 'build' => { 'requires' => { 'HTTP::Server::Simple' => '0.44', 'HTTP::Server::Simple::CGI' => '0', 'HTTP::Server::Simple::CGI::Environment' => '0', 'Module::Build' => '0.28', 'Test::Exception' => '0', 'Test::More' => '0' } }, 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0', 'Module::Build' => '0.28' }, 'suggests' => { 'JSON::PP' => '2.27300' } }, 'develop' => { 'requires' => { 'Pod::Coverage::TrustPod' => '0', 'Test::CPAN::Meta' => '0', 'Test::EOF' => '0', 'Test::EOL' => '0', 'Test::More' => '0.88', 'Test::NoBreakpoints' => '0.15', 'Test::NoTabs' => '0', 'Test::PAUSE::Permissions' => '0', 'Test::Perl::Critic' => '0', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Pod::No404s' => '0', 'Test::Portability::Files' => '0', 'Test::Spelling' => '0.12' } }, 'runtime' => { 'requires' => { 'DateTime' => '0', 'DateTime::Format::DateParse' => '0', 'Encode' => '0', 'Exception::Class' => '0', 'Exporter' => '0', 'HTTP::Cookies' => '0', 'HTTP::Request::Common' => '0', 'LWP' => '0', 'Params::Validate' => '0', 'Try::Tiny' => '0', 'URI' => '0', 'constant' => '0', 'parent' => '0', 'perl' => '5.008', 'strict' => '0', 'vars' => '0', 'warnings' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Test::More' => '0' } } }; $x; }show_ticket.pl100644001750001750 210314377177463 17555 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); RT::Client::REST::Object->use_single_rt($rt); RT::Client::REST::Object->use_autoget(1); RT::Client::REST::Object->use_autosync(1); my $ticket; my $id = shift(@ARGV); try { $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 ) { print "Custom field '$cf'=", $ticket->cf($cf), "\n"; } take_ticket.pl100644001750001750 125014377177463 17523 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # take_ticket.pl -- take a ticket. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); try { RT::Client::REST::Ticket->new( rt => $rt, id => shift(@ARGV), )->take; } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { die ref($_), ": ", $_->message || $_->description, "\n"; } }; create_user.pl100644001750001750 140514377177463 17537 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # create_user.pl use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::User; unless ( @ARGV >= 3 ) { die "Usage: $0 username password user password\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $user; try { $user = RT::Client::REST::User->new( rt => $rt, name => shift(@ARGV), password => shift(@ARGV), )->store; } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { die ref($_), ": ", $_->message || $_->description, "\n"; } }; print "User created. Id: ", $user->id, "\n"; edit_ticket.pl100644001750001750 117614377177463 17533 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # edit_ticket.pl -- edit an RT ticket. use strict; use warnings; use RT::Client::REST; use RT::Client::REST::Ticket; 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' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); RT::Client::REST::Ticket->be_transparent($rt); my ( $id, $attr, @vals ) = @ARGV; my $ticket = RT::Client::REST::Ticket->new( id => $id, $attr, 1 == @vals ? @vals : \@vals, ); use Data::Dumper; print Dumper($ticket); release-unused-vars.t100644001750001750 57114377177463 17370 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { print qq{1..0 # SKIP these tests are for release candidate testing\n}; exit } } use Test::More 0.96 tests => 1; eval { require Test::Vars }; SKIP: { skip 1 => 'Test::Vars required for testing for unused vars' if $@; Test::Vars->import; subtest 'unused vars' => sub { all_vars_ok(); }; }; author-pod-coverage.t100644001750001750 56714377177463 17356 0ustar00deandean000000000000RT-Client-REST-0.72/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use strict; use warnings; use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); list_tickets.pl100644001750001750 166114377177463 17743 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # list_tickets.pl -- list tickets in a queue use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Queue; unless ( @ARGV >= 3 ) { die "Usage: $0 username password queue_id\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $queue = RT::Client::REST::Queue->new( rt => $rt, id => shift(@ARGV) ); my $results; try { $results = $queue->tickets; } 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 ) { print "Id: ", $t->id, "; Status: ", $t->status, "; Subject ", $t->subject, "\n"; } create_ticket.pl100644001750001750 123114377177463 20041 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # create_ticket.pl -- create an RT ticket. use strict; use warnings; use RT::Client::REST; use RT::Client::REST::Ticket; unless ( @ARGV >= 3 ) { die "Usage: $0 username password queue subject\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); print "Please enter the text of the ticket:\n"; my $text = join( '', ); my $ticket = RT::Client::REST::Ticket->new( rt => $rt, queue => shift(@ARGV), subject => shift(@ARGV), )->store( text => $text ); use Data::Dumper; print Dumper($ticket); author-no-breakpoints.t100644001750001750 51614377177463 17730 0ustar00deandean000000000000RT-Client-REST-0.72/t BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::NoBreakpoints 0.0.2 use Test::More 0.88; use Test::NoBreakpoints 0.15; all_files_no_breakpoints_ok(); done_testing; search_tickets.pl100644001750001750 206314377177463 20232 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; unless ( @ARGV >= 2 ) { die "Usage: $0 username password\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $ticket = RT::Client::REST::Ticket->new( rt => $rt ); my $results; try { $results = $ticket->search( limits => [ { attribute => 'id', operator => '>=', value => '1' }, ], orderby => 'subject', ); } 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 ) { print "Id: ", $ticket->id, "; owner: ", $ticket->owner, "; Subject: ", $ticket->subject, "\n"; } REST000755001750001750 014377177463 16011 5ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/ClientUser.pm100644001750001750 1352414377177463 17452 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # PODNAME: RT::Client::REST::User # ABSTRACT: user object representation. use strict; use warnings; package RT::Client::REST::User; $RT::Client::REST::User::VERSION = '0.72'; use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); use RT::Client::REST; use RT::Client::REST::Object::Exception; use RT::Client::REST::SearchResult; sub _attributes {{ id => { validation => { type => SCALAR, }, form2value => sub { shift =~ m~^user/(\d+)$~i; return $1; }, value2form => sub { return 'user/' . shift; }, }, privileged => { validation => { type => SCALAR, }, }, disabled => { validation => { type => SCALAR, }, }, name => { validation => { type => SCALAR, }, }, password => { validation => { type => SCALAR, }, }, email_address => { validation => { type => SCALAR, }, rest_name => 'EmailAddress', }, real_name => { validation => { type => SCALAR, }, rest_name => 'RealName', }, gecos => { validation => { type => SCALAR, }, }, comments => { validation => { type => SCALAR, }, }, nickname => { validation => { type => SCALAR, }, }, lang => { validation => { type => SCALAR, }, }, contactinfo => { validation => { type => SCALAR, }, }, signature => { validation => { type => SCALAR, }, }, organization => { validation => { type => SCALAR, }, }, address_one => { validation => { type => SCALAR, }, rest_name => 'Address1', }, address_two => { validation => { type => SCALAR, }, rest_name => 'Address2', }, city => { validation => { type => SCALAR, }, }, state => { validation => { type => SCALAR, }, }, zip => { validation => { type => SCALAR, }, }, country => { validation => { type => SCALAR, }, }, home_phone => { validation => { type => SCALAR, }, rest_name => 'HomePhone', }, work_phone => { validation => { type => SCALAR, }, rest_name => 'WorkPhone', }, cell_phone => { validation => { type => SCALAR, }, rest_name => 'MobilePhone', }, pager => { validation => { type => SCALAR, }, rest_name => 'PagerPhone', }, }} sub rt_type { 'user' } __PACKAGE__->_generate_methods; 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::User - user object representation. =head1 VERSION version 0.72 =head1 SYNOPSIS my $rt = RT::Client::REST->new(server => $ENV{RTSERVER}); my $user = RT::Client::REST::User->new( rt => $rt, id => $id, )->retrieve; =head1 DESCRIPTION B is based on L. The representation allows one to retrieve, edit, comment on, and create users in RT. Note: RT currently does not allow REST client to search users. =for stopwords EmailAddress gecos Gecos HomePhone MobilePhone PagerPhone RealName WorkPhone =head1 ATTRIBUTES =over 2 =item B For retrieval, you can specify either the numeric ID of the user or his username. After the retrieval, however, this attribute will be set to the numeric id. =item B This is the username of the user. =item B User's password. Reading it will only give you a bunch of stars (what else would you expect?). =item B Can the user have special rights? =item B Can this user access RT? =item B E-mail address of the user, EmailAddress. =item B Real name of the user, RealName. =item B Gecos. =item B Comments about this user. =item B Nickname of this user. =for stopwords lang =item B Language for this user. =item B =item B First line of the street address, Address1. =item B Second line of the street address, Address2. =item B City segment of user's address. =item B ZIP or Postal code segment of user's address. =item B Country segment of user's address. =item B User's home phone number, HomePhone. =item B User's work phone number, WorkPhone. =item B User's cell phone number, MobilePhone. =item B User's pager number, PagerPhone. =for stopwords contactinfo =item B Contact info (Extra Info field). =item B Signature for the user. =back =head1 DB METHODS For full explanation of these, please see B<"DB METHODS"> in L documentation. =over 2 =item B Retrieve RT user from database. =item B Create or update the user. =item B Currently RT does not allow REST clients to search users. =back =head1 INTERNAL METHODS =over 2 =item B Returns 'user'. =back =head1 SEE ALSO L, L, L. =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut show_attachment.pl100644001750001750 147514377177463 20435 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Attachment; 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' ), ); $rt->login( 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), ); } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { die ref($_), ": ", $_->message || $_->description, "\n"; } }; use Data::Dumper; print Dumper($att); 84-attachments-rt127607.t100644001750001750 656314377177463 17403 0ustar00deandean000000000000RT-Client-REST-0.72/t#!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; 85-attachments-rt127607.t100644001750001750 662314377177463 17401 0ustar00deandean000000000000RT-Client-REST-0.72/t#!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; Queue.pm100644001750001750 1217314377177463 17617 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # PODNAME: RT::Client::REST::Queue # ABSTRACT: queue object representation. use strict; use warnings; package RT::Client::REST::Queue; $RT::Client::REST::Queue::VERSION = '0.72'; use Params::Validate qw(:types); 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 parent 'RT::Client::REST::Object'; sub _attributes {{ id => { validation => { type => SCALAR, }, form2value => sub { shift =~ m~^queue/(\d+)$~i; return $1; }, value2form => sub { return 'queue/' . shift; }, }, name => { validation => { type => SCALAR, }, }, description => { validation => { type => SCALAR, }, }, correspond_address => { validation => { type => SCALAR, }, rest_name => 'CorrespondAddress', }, comment_address => { validation => { type => SCALAR, }, rest_name => 'CommentAddress', }, initial_priority => { validation => { type => SCALAR, }, rest_name => 'InitialPriority', }, final_priority => { validation => { type => SCALAR, }, rest_name => 'FinalPriority', }, default_due_in => { validation => { type => SCALAR, }, rest_name => 'DefaultDueIn', }, disabled => { 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', }, }} sub tickets { my $self = shift; $self->_assert_rt_and_id; return RT::Client::REST::Ticket ->new(rt => $self->rt) ->search(limits => [ {attribute => 'queue', operator => '=', value => $self->id}, ]); } sub rt_type { 'queue' } __PACKAGE__->_generate_methods; 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::Queue - queue object representation. =head1 VERSION version 0.72 =head1 SYNOPSIS my $rt = RT::Client::REST->new(server => $ENV{RTSERVER}); my $queue = RT::Client::REST::Queue->new( rt => $rt, id => 'General', )->retrieve; =head1 DESCRIPTION B is based on L. The representation allows one to retrieve, edit, comment on, and create queue in RT. Note: RT currently does not allow REST client to search queues. =head1 ATTRIBUTES =over 2 =item B For retrieval, you can specify either the numeric ID of the queue or its name (case-sensitive). After the retrieval, however, this attribute will be set to the numeric id. =item B This is the name of the queue. =item B Queue description. =item B Correspond address. =item B Comment address. =item B Initial priority. =item B Final priority. =item B 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 For full explanation of these, please see B<"DB METHODS"> in L documentation. =over 2 =item B Retrieve queue from database. =item B Create or update the queue. =item B Currently RT does not allow REST clients to search queues. =back =head1 QUEUE-SPECIFIC METHODS =over 2 =item B Get tickets that are in this queue (note: this may be a lot of tickets). Note: tickets with status "deleted" will not be shown. Object of type L is returned which then can be used to get to objects of type L. =back =head1 INTERNAL METHODS =over 2 =item B Returns 'queue'. =back =head1 SEE ALSO L, L, L, L. =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Forms.pm100644001750001750 1724414377177463 17625 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # PODNAME: RT::Client::REST::Forms # ABSTRACT: This package provides functions from RT::Interface::REST, because we don't want to depend on rt being installed. Derived from rt 3.4.5. use strict; use warnings; package RT::Client::REST::Forms; $RT::Client::REST::Forms::VERSION = '0.72'; use Exporter; use vars qw(@EXPORT @ISA); @ISA = qw(Exporter); @EXPORT = qw(expand_list form_parse form_compose vpush vsplit); 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; sub expand_list { my ($list) = @_; my (@elts, %elts); for my $elt (split /,/, $list) { if ($elt =~ m/^(\d+)-(\d+)$/) { push @elts, ($1..$2) } else { push @elts, $elt } } @elts{@elts}=(); my @return = sort {$a<=>$b} keys %elts; return @return } sub form_parse { my @lines = split /(?<=\n)/, shift; my $state = 0; my @forms = (); my ($c, $o, $k, $e) = ('', [], {}, ''); LINE: while (@lines) { my $line = shift @lines; next LINE if $line eq "\n"; 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) { push @forms, [ $c, $o, $k, $e ]; $c = ''; $o = []; $k = {}; $e = ''; } $state = 0; next LINE } 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 .= shift @lines; } 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 } if ($state <= 1 && $line =~ m/^($field:) (.*)?$/s) { # Read a field: value specification. my $f = $1; my $value = $2; $f =~ s/:?$//; # Read continuation lines, if any. while (@lines && ($lines[0] eq "\n" || $lines[0] =~ m/^ +/)) { my $l = shift @lines; $l =~ s/^$spaces//; $value .= $l } # `Content` is always supposed to be followed by three new lines # ... but this doesnt behave as documented # https://rt-wiki.bestpractical.com/wiki/REST#Ticket_Attachments if ($f eq 'Content') { $value =~ s/\n\n\n?$//g } # Chomp everything else else { chomp $value } push(@$o, $f) unless exists $k->{$f}; vpush($k, $f, $value); $state = 1; next LINE } if ($line !~ m/^#/) { # We've found a syntax error, so we'll reconstruct the # form parsed thus far, and add an error marker. (>>) $state = -1; $e = form_compose([[ '', $o, $k, '' ]]); $e.= $line =~ m/^>>/ ? "$line\n" : ">> $line\n"; next LINE } # line will be ignored } else { # We saw a syntax error earlier, so we'll accumulate the # contents of this form until the end. $e .= "$line\n"; } } push(@forms, [ $c, $o, $k, $e ]) if ($e || $c || @$o); for my $l (keys %$k) { $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY'); } return \@forms; } sub form_compose { my ($forms) = @_; my @text; for my $form (@$forms) { my ($c, $o, $k, $e) = @$form; my $text = ''; if ($c) { $c =~ s/\n*$/\n/; $text = "$c\n"; } if ($e) { $text .= $e; } elsif ($o) { my @lines; for my $key (@$o) { my ($line, $sp); my @values = (ref $k->{$key} eq 'ARRAY') ? @{ $k->{$key} } : $k->{$key}; $sp = " "x(length("$key: ")); $sp = " "x4 if length($sp) > 16; for my $v (@values) { if ($v =~ /\n/) { $v =~ s/^/$sp/gm; $v =~ s/^$sp//; if ($line) { push @lines, "$line\n\n"; $line = ''; } elsif (@lines && $lines[-1] !~ m/\n\n$/) { $lines[-1] .= "\n"; } push @lines, "$key: $v\n\n"; } elsif ($line && length($line)+length($v)-rindex($line, "\n") >= 70) { $line .= ",\n$sp$v"; } else { $line = $line ? "$line, $v" : "$key: $v"; } } $line = "$key:" unless @values; if ($line) { if ($line =~ m/\n/) { if (@lines && $lines[-1] !~ m/\n\n$/) { $lines[-1] .= "\n"; } $line .= "\n"; } push @lines, "$line\n"; } } $text .= join '', @lines; } else { chomp $text; } push @text, $text; } return join "\n--\n\n", @text; } sub vpush { my ($hash, $key, $val) = @_; my @val = ref $val eq 'ARRAY' ? @$val : $val; if (exists $hash->{$key}) { unless (ref $hash->{$key} eq 'ARRAY') { my @v = $hash->{$key} ne '' ? $hash->{$key} : (); $hash->{$key} = \@v; } push @{ $hash->{$key} }, @val; } else { $hash->{$key} = $val; } } sub vsplit { my ($val) = @_; my (@words); for my $line (map {split /\n/} (ref $val eq 'ARRAY') ? @$val : $val) { # XXX: This should become a real parser, à la Text::ParseWords. $line =~ s/^\s+//; $line =~ s/\s+$//; push @words, split /\s*,\s*/, $line; } return \@words; } __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::Forms - This package provides functions from RT::Interface::REST, because we don't want to depend on rt being installed. Derived from rt 3.4.5. =head1 VERSION version 0.72 =head2 METHODS =over 4 =item expand_list Expands a list, splitting on commas and stuff. =item form_parse Returns a reference to an array of parsed forms. =item form_compose Returns text representing a set of forms. =for stopwords vpush vsplit =item vpush Add a value to a (possibly multi-valued) hash key. =item vsplit "Normalize" a hash key that's known to be multi-valued. =back 1; =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Group.pm100644001750001750 527614377177463 17615 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # PODNAME: RT::Client::REST::Group # ABSTRACT: group object representation. use strict; use warnings; package RT::Client::REST::Group; $RT::Client::REST::Group::VERSION = '0.72'; use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); use RT::Client::REST; use RT::Client::REST::Object::Exception; use RT::Client::REST::SearchResult; sub _attributes {{ id => { validation => { type => SCALAR, }, form2value => sub { shift =~ m~^group/(\d+)$~i; return $1; }, value2form => sub { return 'group/' . shift; }, }, name => { validation => { type => SCALAR, }, }, description => { validation => { type => SCALAR, }, }, members => { validation => { type => ARRAYREF, }, list => 1, }, disabled => { validation => { type => SCALAR, }, }, }} sub rt_type { 'group' } __PACKAGE__->_generate_methods; 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::Group - group object representation. =head1 VERSION version 0.72 =head1 SYNOPSIS my $rt = RT::Client::REST->new(server => $ENV{RTSERVER}); my $group = RT::Client::REST::Group->new( rt => $rt, id => $id, )->retrieve; =head1 DESCRIPTION B is based on L. The representation allows one to retrieve, edit, and create groups in RT. Note: RT currently does not allow REST client to search groups. =head1 ATTRIBUTES =over 2 =item B For retrieval, you can specify either the numeric ID of the group or his group name. After the retrieval, however, this attribute will be set to the numeric id. =item B Name of the group =item B Description =item B List of the members of this group. =back =head1 DB METHODS For full explanation of these, please see B<"DB METHODS"> in L documentation. =over 2 =item B Retrieve RT group from database. =item B Create or update the group. =item B Currently RT does not allow REST clients to search groups. =back =head1 INTERNAL METHODS =over 2 =item B Returns 'group'. =back =head1 SEE ALSO L, L, L. =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut list_attachments.pl100644001750001750 173014377177463 20605 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Attachment; use RT::Client::REST::Ticket; unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $ticket = RT::Client::REST::Ticket->new( rt => $rt, id => shift(@ARGV) ); my $results; try { $results = $ticket->attachments; } 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 ) { print "Id: ", $att->id, "; Subject: ", $att->subject, "\n"; } show_transaction.pl100644001750001750 147414377177463 20631 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_transaction.pl -- retrieve an RT transaction. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Transaction; 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' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $tr; try { $tr = RT::Client::REST::Transaction->new( rt => $rt, parent_id => shift(@ARGV), id => shift(@ARGV), )->retrieve; } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { die ref($_), ": ", $_->message || $_->description, "\n"; } }; use Data::Dumper; print Dumper($tr); Ticket.pm100644001750001750 3107314377177463 17756 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST::Ticket # ABSTRACT: ticket object representation. use strict; use warnings; package RT::Client::REST::Ticket; $RT::Client::REST::Ticket::VERSION = '0.72'; use parent 'RT::Client::REST::Object'; use Try::Tiny; use Params::Validate qw(:types); use RT::Client::REST; use RT::Client::REST::Attachment; use RT::Client::REST::Object::Exception; use RT::Client::REST::SearchResult; use RT::Client::REST::Transaction; sub _attributes {{ id => { validation => { type => SCALAR, regex => qr/^\d+$/, }, form2value => sub { shift =~ m~^ticket/(\d+)$~i; return $1; }, value2form => sub { return 'ticket/' . shift; }, }, queue => { validation => { type => SCALAR, }, }, owner => { validation => { type => SCALAR, }, }, creator => { validation => { type => SCALAR, }, }, subject => { validation => { type => SCALAR, }, }, status => { validation => { # That's it for validation... People can create their own # custom statuses. type => SCALAR, }, rest_name => 'Status', }, priority => { validation => { type => SCALAR, }, }, initial_priority => { validation => { type => SCALAR, }, rest_name => 'InitialPriority', }, final_priority => { validation => { type => SCALAR, }, rest_name => 'FinalPriority', }, requestors => { validation => { type => ARRAYREF, }, list => 1, }, requestor => { validation => { type => ARRAYREF, }, list => 1, }, cc => { validation => { type => ARRAYREF, }, list => 1, }, admin_cc => { validation => { type => ARRAYREF, }, list => 1, rest_name => 'AdminCc', }, created => { validation => { type => SCALAR, }, is_datetime => 1, }, starts => { validation => { type => SCALAR|UNDEF, }, is_datetime => 1, }, started => { validation => { type => SCALAR|UNDEF, }, is_datetime => 1, }, due => { validation => { type => SCALAR|UNDEF, }, is_datetime => 1, }, resolved => { validation => { type => SCALAR|UNDEF, }, is_datetime => 1, }, told => { validation => { type => SCALAR|UNDEF, }, is_datetime => 1, }, time_estimated => { validation => { type => SCALAR, }, rest_name => 'TimeEstimated', }, time_worked => { validation => { type => SCALAR, }, rest_name => 'TimeWorked', }, time_left => { validation => { type => SCALAR, }, rest_name => 'TimeLeft', }, last_updated => { validation => { type => SCALAR, }, rest_name => 'LastUpdated', is_datetime => 1, }, sla => { validation => { type => SCALAR, }, }, }} # comment and correspond are really the same method, so we save ourselves # some duplication here. for my $method (qw(comment correspond)) { no strict 'refs'; ## no critic (ProhibitNoStrict) *$method = sub { my $self = shift; if (@_ & 1) { RT::Client::REST::Object::OddNumberOfArgumentsException->throw; } $self->_assert_rt_and_id($method); my %opts = @_; unless (defined($opts{message})) { RT::Client::REST::Object::InvalidValueException->throw( "No message was provided", ); } $self->rt->$method( ticket_id => $self->id, %opts, ); return; }; } sub attachments { my $self = shift; $self->_assert_rt_and_id; RT::Client::REST::SearchResult->new( ids => [ $self->rt->get_attachment_ids(id => $self->id) ], object => sub { RT::Client::REST::Attachment->new( id => shift, parent_id => $self->id, rt => $self->rt, ); }, ); } sub transactions { my $self = shift; if (@_ & 1) { RT::Client::REST::Object::OddNumberOfArgumentsException->throw; } $self->_assert_rt_and_id; my %opts = @_; my %params = ( parent_id => $self->id, ); if (defined(my $type = delete($opts{type}))) { $params{transaction_type} = $type; } RT::Client::REST::SearchResult->new( ids => [ $self->rt->get_transaction_ids(%params) ], object => sub { RT::Client::REST::Transaction->new( id => shift, parent_id => $self->id, rt => $self->rt, ); }, ); } for my $method (qw(take untake steal)) { no strict 'refs'; ## no critic (ProhibitNoStrict) *$method = sub { my $self = shift; $self->_assert_rt_and_id($method); try { $self->rt->$method(id => $self->id); } 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; }; } sub rt_type { 'ticket' } __PACKAGE__->_generate_methods; 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::Ticket - ticket object representation. =head1 VERSION version 0.72 =head1 SYNOPSIS my $rt = RT::Client::REST->new(server => $ENV{RTSERVER}); # Create a new ticket: my $ticket = RT::Client::REST::Ticket->new( rt => $rt, queue => "General", subject => $subject, )->store(text => "This is the initial text of the ticket"); print "Created a new ticket, ID ", $ticket->id, "\n"; # Update my $ticket = RT::Client::REST::Ticket->new( rt => $rt, id => $id, priority => 10, )->store; # Retrieve my $ticket => RT::Client::REST::Ticket->new( rt => $rt, id => $id, )->retrieve; unless ($ticket->owner eq $me) { $ticket->steal; # Give me more work! } =head1 DESCRIPTION B is based on L. The representation allows one to retrieve, edit, comment on, and create tickets in RT. =head1 ATTRIBUTES =over 2 =item B This is the numeric ID of the ticket. =item B This is the B of the queue (not numeric id). =item B Username of the owner. =item B Username of RT user who created the ticket. =item B Subject of the ticket. =item B The status is usually one of the following: "new", "open", "resolved", "stalled", "rejected", and "deleted". However, custom RT installations sometimes add their own statuses. =item B Ticket priority. Usually a numeric value. =item B =item B =for stopwords requestor requestors =item B This is the attribute for setting the requestor on ticket creation. If you use requestors to do this in 3.8, the recipient may not receive an auto-reply from RT because the ticket is initially created as the user your REST session is connected as. It is a list attribute (for explanation of list attributes, see B in L). =item B This contains e-mail addresses of the requestors. It is a list attribute (for explanation of list attributes, see B in L). =item B A list of e-mail addresses used to notify people of 'correspond' actions. =item B A list of e-mail addresses used to notify people of all actions performed on a ticket. =item B Time at which ticket was created. Note that this is an immutable field and therefore the value cannot be changed.. =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head2 Attributes storing a time The attributes which store a time stamp have an additional accessor with the suffix C<_datetime> (e.g. C). This allows you can get and set the stored value as a DateTime object. Internally, it is converted into the date-time string which RT uses, which is assumed to be in UTC. =head1 DB METHODS For full explanation of these, please see B<"DB METHODS"> in L documentation. =over 2 =item B Retrieve RT ticket from database. =item B $text])> Create or update the ticket. When creating a new ticket, optional 'text' parameter can be supplied to set the initial text of the ticket. =item B Search for tickets that meet specific conditions. =back =head1 TICKET-SPECIFIC METHODS =over 2 =item B (message => $message, %opts) Comment on this ticket with message $message. C<%opts> is a list of key-value pairs as follows: =over 2 =item B List of filenames (an array reference) that should be attached to the ticket along with the comment. =item B List of e-mail addresses to send carbon copies to (an array reference). =for stopwords bcc =item B List of e-mail addresses to send blind carbon copies to (an array reference). =back =item B (message => $message, %opts) Add correspondence to the ticket. Takes exactly the same arguments as the B method above. =item B Get attachments associated with this ticket. What is returned is an object of type L which can then be used to get at objects of type L. =item B Get transactions associated with this ticket. Optionally, you can specify exactly what types of transactions you want listed, for example: my $result = $ticket->transactions(type => [qw(Comment Correspond)]); Please reference L documentation for the full list of valid transaction types. Return value is an object of type L which can then be used to iterate over transaction objects (L). =item B Take this ticket. If you already the owner of this ticket, C will be thrown. =for stopwords Untake untake =item B Untake this ticket. If Nobody is already the owner of this ticket, C will be thrown. =item B Steal this ticket. If you already the owner of this ticket, C will be thrown. =back =head1 CUSTOM FIELDS This class inherits 'cf' method from L. To create a ticket with a bunch of custom fields, use the following approach: RT::Client::REST::Ticket->new( rt => $rt, # blah blah cf => { 'field one' => $value1, 'field two' => $another_value, }, )->store; Some more examples: # Update a custom field value: $ticket->cf('field one' => $value1); $ticket->store; # Get a custom field value: my $another value = $ticket->cf('field two'); # Get a list of ticket's custom field names: my @custom_fields = $ticket->cf; =head1 INTERNAL METHODS =over 2 =item B Returns 'ticket'. =back =head1 SEE ALSO L, L, L, L, L. =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Object.pm100644001750001750 5611414377177463 17744 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST::Object # ABSTRACT: base class for RT objects use strict; use warnings; package RT::Client::REST::Object; $RT::Client::REST::Object::VERSION = '0.72'; use Try::Tiny; use Params::Validate; use RT::Client::REST::Object::Exception; use RT::Client::REST::SearchResult; use DateTime; use DateTime::Format::DateParse; sub new { my $class = shift; if (@_ & 1) { RT::Client::REST::Object::OddNumberOfArgumentsException->throw; } my $self = bless {}, ref($class) || $class; my %opts = @_; my $id = delete($opts{id}); if (defined($id)) {{ $self->id($id); if ($self->can('parent_id')) { # If object can parent_id, we assume that it's needed for # retrieval. my $parent_id = delete($opts{parent_id}); if (defined($parent_id)) { $self->parent_id($parent_id); } else { last; } } if ($self->autoget) { $self->retrieve; } }} while (my ($k, $v) = each(%opts)) { $self->$k($v); } return $self; } sub _generate_methods { my $class = shift; my $attributes = $class->_attributes; while (my ($method, $settings) = each(%$attributes)) { no strict 'refs'; ## no critic (ProhibitNoStrict) *{$class . '::' . $method} = sub { my $self = shift; if (@_) { my $caller = defined((caller(1))[3]) ? (caller(1))[3] : ''; if ($settings->{validation} && # Don't validate values from the server $caller ne __PACKAGE__ . '::from_form') { my @v = @_; Params::Validate::validation_options( on_fail => sub { no warnings 'uninitialized'; RT::Client::REST::Object::InvalidValueException ->throw( "'@v' is not a valid value for attribute '$method'" ); }, ); validate_pos(@_, $settings->{validation}); } $self->{'_' . $method} = shift; $self->_mark_dirty($method); # Let's try to autosync, shall we? Logic is a bit hairy # in order to make it efficient. if ($self->autosync && $self->can('store') && # OK, so id is special. This is so that 'new' would # work. 'id' ne $method && 'parent_id' ne $method && # Plus we don't want to store right after retrieving # (that's where from_form is called from). $caller ne __PACKAGE__ . '::from_form') { $self->store; } } if ($settings->{list}) { my $retval = $self->{'_' . $method} || []; return @$retval; } else { return $self->{'_' . $method}; } }; if ($settings->{is_datetime}) { *{$class. '::' . $method . '_datetime'} = sub { # All dates are in UTC # http://requesttracker.wikia.com/wiki/REST#Data_format my ($self) = shift; if (@_) { unless ($_[0]->isa('DateTime')) { RT::Client::REST::Object::InvalidValueException ->throw( "'$_[0]' is not a valid value for attribute '${method}_datetime'" ); } my $z = $_[0]->clone; $z->set_time_zone('UTC'); $self->$method($_[0]->strftime('%a %b %d %T %Y')); return $z; } return DateTime::Format::DateParse->parse_datetime($self->$method, 'UTC'); }; } if ($settings->{list}) { # Generate convenience methods for list manipulation. my $add_method = $class . '::add_' . $method; my $delete_method = $class . '::delete_' . $method; *$add_method = sub { my $self = shift; unless (@_) { RT::Client::REST::Object::NoValuesProvidedException ->throw; } my @values = $self->$method; my %values = map { $_, 1 } @values; # Now add new values for (@_) { $values{$_} = 1; } $self->$method([keys %values]); }; *$delete_method = sub { my $self = shift; unless (@_) { RT::Client::REST::Object::NoValuesProvidedException ->throw; } my @values = $self->$method; my %values = map { $_, 1 } @values; # Now delete values for (@_) { delete $values{$_}; } $self->$method([keys %values]); }; } } } sub _mark_dirty { my ($self, $attr) = @_; $self->{__dirty}{$attr} = 1; } sub _dirty { my $self = shift; if (exists($self->{__dirty})) { return keys %{$self->{__dirty}}; } return; } sub _mark_dirty_cf { my ($self, $cf) = @_; $self->{__dirty_cf}{$cf} = 1; } sub _dirty_cf { my $self = shift; if (exists($self->{__dirty_cf})) { return keys %{$self->{__dirty_cf}}; } return; } sub to_form { my ($self, $all) = @_; my $attributes = $self->_attributes; my @attrs = ($all ? keys(%$attributes) : $self->_dirty); my %hash; for my $attr (@attrs) { my $rest_name = (exists($attributes->{$attr}{rest_name}) ? $attributes->{$attr}{rest_name} : ucfirst($attr)); my $value; if (exists($attributes->{$attr}{value2form})) { $value = $attributes->{$attr}{value2form}($self->$attr) } elsif ($attributes->{$attr}{list}) { $value = join(',', $self->$attr) } else { $value = (defined($self->$attr) ? $self->$attr : ''); } $hash{$rest_name} = $value; } my @cfs = ($all ? $self->cf : $self->_dirty_cf); for my $cf (@cfs) { $hash{'CF-' . $cf} = $self->cf($cf); } return \%hash; } sub from_form { my $self = shift; unless (@_) { RT::Client::REST::Object::NoValuesProvidedException->throw; } my $hash = shift; unless ('HASH' eq ref($hash)) { RT::Client::REST::Object::InvalidValueException->throw( q|Expecting a hash reference as argument to 'from_form'|, ); } # lowercase hash keys my $i = 0; $hash = { map { ($i++ & 1) ? $_ : lc } %$hash }; my $attributes = $self->_attributes; my %rest2attr; # Mapping of REST names to our 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, $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 (defined $value and $value =~ /,/) { $value = [ split(/\s*,\s*/, $value) ]; } $self->cf($key, $value); next } unless (exists($rest2attr{$key})) { warn "Unknown key: $key\n"; next; } my ($method, $settings) = @{$rest2attr{$key}}; if ($settings->{is_datetime} and $value eq 'Not set') { $value = undef } if (exists($attributes->{$method}{form2value})) { $value = $attributes->{$method}{form2value}($value); } elsif ($attributes->{$method}{list}) { $value = defined $value ? [split(/\s*,\s*/, $value)] : [] } $self->$method($value); } return; } sub retrieve { my $self = shift; $self->_assert_rt_and_id; my $rt = $self->rt; my ($hash) = $rt->show(type => $self->rt_type, id => $self->id); $self->from_form($hash); $self->{__dirty} = {}; $self->{__dirty_cf} = {}; return $self; } sub store { my $self = shift; $self->_assert_rt; my $rt = $self->rt; if (defined($self->id)) { $rt->edit( type => $self->rt_type, id => $self->id, set => $self->to_form, ); } else { my $id = $rt->create( type => $self->rt_type, set => $self->to_form, @_, ); $self->id($id); } $self->{__dirty} = {}; return $self; } sub search { my $self = shift; if (@_ & 1) { RT::Client::REST::Object::OddNumberOfArgumentsException->throw; } $self->_assert_rt; my %opts = @_; my $limits = delete($opts{limits}) || []; my $query = ''; for my $limit (@$limits) { my $kw; try { $kw = $self->_attr2keyword($limit->{attribute}); } 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}; my $agg = $limit->{aggregator} || 'and'; if (length($query)) { $query = "($query) $agg $kw $op '$val'"; } else { $query = "$kw $op '$val'"; } } my $orderby; try { # Defaults to 'id' at the moment. Do not rely on this -- # implementation may change! $orderby = (delete($opts{reverseorder}) ? '-' : '+') . ($self->_attr2keyword(delete($opts{orderby}) || 'id')); } 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; my @results; try { @results = $rt->search( type => $self->rt_type, query => $query, orderby => $orderby, ); } 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( ids => \@results, object => sub { $self->new(id => shift, rt => $rt) }, ); } sub count { my $self = shift; $self->_assert_rt; return $self->search(@_)->count; } sub _attr2keyword { my ($self, $attr) = @_; my $attributes = $self->_attributes; unless (exists($attributes->{$attr})) { no warnings 'uninitialized'; RT::Clite::REST::Object::InvalidAttributeException->throw( "Attribute '$attr' does not exist in object type '" . ref($self) . "'" ); } return (exists($attributes->{$attr}{rest_name}) ? $attributes->{$attr}{rest_name} : ucfirst($attr)); } sub _assert_rt_and_id { my $self = shift; my $method = shift || (caller(1))[3]; unless (defined($self->rt)) { RT::Client::REST::Object::RequiredAttributeUnsetException ->throw("Cannot '$method': 'rt' attribute of the object ". "is not set"); } unless (defined($self->id)) { RT::Client::REST::Object::RequiredAttributeUnsetException ->throw("Cannot '$method': 'id' attribute of the object ". "is not set"); } } sub _assert_rt { my $self = shift; my $method = shift || (caller(1))[3]; unless (defined($self->rt)) { RT::Client::REST::Object::RequiredAttributeUnsetException ->throw("Cannot '$method': 'rt' attribute of the object ". "is not set"); } } sub param { my $self = shift; unless (@_) { RT::Client::REST::Object::NoValuesProvidedException->throw; } my $name = shift; if (@_) { $self->{__param}{$name} = shift; } return $self->{__param}{$name}; } sub cf { my $self = shift; unless (@_) { # Return a list of CFs. return keys %{$self->{__cf}}; } my $name = shift; if ('HASH' eq ref($name)) { while (my ($k, $v) = each(%$name)) { $self->{__cf}{lc($k)} = $v; $self->_mark_dirty_cf($k); } return keys %{$self->{__cf}}; } else { $name = lc $name; if (@_) { $self->{__cf}{$name} = shift; $self->_mark_dirty_cf($name); } return $self->{__cf}{$name}; } } sub rt { my $self = shift; if (@_) { my $rt = shift; unless (UNIVERSAL::isa($rt, 'RT::Client::REST')) { RT::Client::REST::Object::InvalidValueException->throw; } $self->{__rt} = $rt; } return $self->{__rt}; } sub use_single_rt { my ($class, $rt) = @_; unless (UNIVERSAL::isa($rt, 'RT::Client::REST')) { RT::Client::REST::Object::InvalidValueException->throw; } no strict 'refs'; ## no critic (ProhibitNoStrict) no warnings 'redefine'; *{(ref($class) || $class) . '::rt'} = sub { $rt }; } sub autostore {} sub use_autostore { my ($class, $autostore) = @_; no strict 'refs'; ## no critic (ProhibitNoStrict) no warnings 'redefine'; *{(ref($class) || $class) . '::autostore'} = sub { $autostore }; } sub DESTROY { my $self = shift; $self->autostore && $self->can('store') && $self->store; } sub autoget {} sub use_autoget { my ($class, $autoget) = @_; no strict 'refs'; ## no critic (ProhibitNoStrict) no warnings 'redefine'; *{(ref($class) || $class) . '::autoget'} = sub { $autoget }; } sub autosync {} sub use_autosync { my ($class, $autosync) = @_; no strict 'refs'; ## no critic (ProhibitNoStrict) no warnings 'redefine'; *{(ref($class) || $class) . '::autosync'} = sub { $autosync }; } sub be_transparent { my ($class, $rt) = @_; $class->use_autosync(1); $class->use_autoget(1); $class->use_single_rt($rt); } 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::Object - base class for RT objects =head1 VERSION version 0.72 =head1 SYNOPSIS # Create a new type package RT::Client::REST::MyType; use parent qw(RT::Client::REST::Object); sub _attributes {{ myattribute => { validation => { type => SCALAR, }, }, }} sub rt_type { "mytype" } 1; =head1 DESCRIPTION The RT::Client::REST::Object module is a superclass providing a whole bunch of class and object methods in order to streamline the development of RT's REST client interface. =head1 ATTRIBUTES Attributes are defined by method C<_attributes> that should be defined in your class. This method returns a reference to a hash whose keys are the attributes. The values of the hash are attribute settings, which are as follows: =over 2 =item list If set to true, this is a list attribute. See L below. =item validation A hash reference. This is passed to validation routines when associated mutator is called. See L for reference. =item rest_name =for stopwords FinalPriority This specifies this attribute's REST name. For example, attribute "final_priority" corresponds to RT REST's "FinalPriority". This option may be omitted if the two only differ in first letter capitalization. =item form2value Convert form value (one that comes from the server) into attribute-digestible format. =item value2form Convert value into REST form format. =back Example: sub _attributes {{ id => { validation => { type => SCALAR, regex => qr/^\d+$/, }, form2value => sub { shift =~ m~^ticket/(\d+)$~i; return $1; }, value2form => sub { return 'ticket/' . shift; }, }, admin_cc => { validation => { type => ARRAYREF, }, list => 1, rest_name => 'AdminCc', }, }} =head1 LIST ATTRIBUTE PROPERTIES List attributes have the following properties: =over 2 =item * When called as accessors, return a list of items =item * When called as mutators, only accept an array reference =item * Convenience methods "add_attr" and "delete_attr" are available. For example: # Get the list my @requestors = $ticket->requestors; # Replace with a new list $ticket->requestors( [qw(dude@localhost)] ); # Add some random guys to the current list $ticket->add_requestors('randomguy@localhost', 'evil@local'); =back =for stopwords autoget autostore autosync =head1 SPECIAL ATTRIBUTES B and B are special attributes. They are used by various DB-related methods and are especially relied upon by: =over 2 =item autostore =item autosync =item autoget =back =head1 METHODS =over 2 =item new Constructor =item _generate_methods This class method generates accessors and mutators based on B<_attributes> method which your class should provide. For items that are lists, 'add_' and 'delete_' methods are created. For instance, the following two attributes specified in B<_attributes> will generate methods 'creator', 'cc', 'add_cc', and 'delete_cc': creator => { validation => { type => SCALAR }, }, cc => { list => 1, validation => { type => ARRAYREF }, }, =item _mark_dirty($attrname) Mark an attribute as dirty. =item _dirty Return the list of dirty attributes. =item _mark_dirty_cf($attrname) Mark an custom flag as dirty. =item _dirty_cf Return the list of dirty custom flags. =item to_form($all) Convert the object to 'form' (used by REST protocol). This is done based on B<_attributes> method. If C<$all> is true, create a form from all of the object's attributes and custom flags, otherwise use only dirty (see B<_dirty> method) attributes and custom flags. Defaults to the latter. =item from_form Set object's attributes from form received from RT server. =item param($name, $value) Set an arbitrary parameter. =item cf([$name, [$value]]) Given no arguments, returns the list of custom field names. With one argument, returns the value of custom field C<$name>. With two arguments, sets custom field C<$name> to C<$value>. Given a reference to a hash, uses it as a list of custom fields and their values, returning the new list of all custom field names. =item rt Get or set the 'rt' object, which should be of type L. =back =head1 DB METHODS The following are methods that have to do with reading, creating, updating, and searching objects. =over 2 =item count Takes the same arguments as C but returns the actual count of the found items. Throws the same exceptions. =item retrieve Retrieve object's attributes. Note that 'id' attribute must be set for this to work. =item search (%opts) This method is used for searching objects. It returns an object of type L, which can then be used to process results. C<%opts> is a list of key-value pairs, which are as follows: =over 2 =item limits This is a reference to array containing hash references with limits to apply to the search (think SQL limits). =for stopwords orderby reverseorder =item orderby Specifies attribute to sort the result by (in ascending order). =item reverseorder If set to a true value, sorts by attribute specified by B in descending order. =back If the client cannot construct the query from the specified arguments, or if the server cannot make it out, C is thrown. =item store Store the object. If 'id' is set, this is an update; otherwise, a new object is created and the 'id' attribute is set. Note that only changed (dirty) attributes are sent to the server. =back =head1 CLASS METHODS =over 2 =item use_single_rt =for stopwords instantiations This method takes a single argument -- L object and makes this class use it for all instantiations. For example: my $rt = RT::Client::REST->new(%args); # Make all tickets use this RT: RT::Client::REST::Ticket->use_single_rt($rt); # Now make all objects use it: RT::Client::REST::Object->use_single_rt($rt); =for stopwords autostoring autostore =item use_autostore Turn I on and off. I means that you do not have to explicitly call C on an object - it will be called when the object goes out of scope. # Autostore tickets: RT::Client::REST::Ticket->use_autostore(1); my $ticket = RT::Client::REST::Ticket->new(%opts)->retrieve; $ticket->priority(10); # Don't have to call store(). =item use_autoget Turn I feature on or off (off by default). When set to on, C will be automatically called from the constructor if it is called with that object's special attributes (see L above). RT::Client::Ticket->use_autoget(1); my $ticket = RT::Client::Ticket->new(id => 1); # Now all attributes are available: my $subject = $ticket->subject; =for stopwords autosync =item use_autosync Turn I feature on or off (off by default). When set, every time an attribute is changed, C method is invoked. This may be pretty expensive. =item be_transparent This turns on B and B. Transparency is a neat idea, but it may be expensive and slow. Depending on your circumstances, you may want a finer control of your objects. Transparency makes C and C calls invisible: RT::Client::REST::Ticket->be_transparent($rt); my $ticket = RT::Client::REST::Ticket->new(id => $id); # retrieved $ticket->add_cc('you@localhost.localdomain'); # stored $ticket->status('stalled'); # stored # etc. Do not forget to pass RT::Client::REST object to this method. =back =head1 SEE ALSO L, L. =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut comment_on_ticket.pl100644001750001750 161114377177463 20736 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # comment_on_ticket.pl -- add comment to an RT ticket. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; 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' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $ticket = RT::Client::REST::Ticket->new( rt => $rt, id => shift(@ARGV), ); try { $ticket->comment( message => shift(@ARGV), cc => [qw(dmitri@abc.com dmitri@localhost)], bcc => [qw(dmitri@localhost)], ); } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { die ref($_), ": ", $_->message || $_->description, "\n"; } }; use Data::Dumper; print Dumper($ticket); edit_custom_field.pl100644001750001750 154714377177463 20727 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # edit_custom_field.pl -- set one or more custom fields use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Ticket; 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' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); my $ticket = RT::Client::REST::Ticket->new( rt => $rt, id => shift(@ARGV), ); my %opts = @ARGV; while ( my ( $cf, $value ) = each(%opts) ) { $ticket->cf( $cf, $value ); } try { $ticket->store; } catch { die $_ unless blessed $_ && $_->can('rethrow'); if ( $_->isa('Exception::Class::Base') ) { die ref($_), ": ", $_->message || $_->description, "\n"; } }; use Data::Dumper; print Dumper($ticket); list_transactions.pl100644001750001750 203014377177463 20774 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # list_transactions.pl -- list transactions associated with a ticket. use strict; use warnings; use Try::Tiny; use RT::Client::REST; use RT::Client::REST::Transaction; use RT::Client::REST::Ticket; unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => shift(@ARGV), ); RT::Client::REST::Object->be_transparent($rt); my $ticket = RT::Client::REST::Ticket->new( id => shift(@ARGV) ); my $results; try { $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 ) { print "Id: ", $tr->id, "; Type: ", $tr->type, "\n"; } release-pause-permissions.t100644001750001750 67314377177463 20605 0ustar00deandean000000000000RT-Client-REST-0.72/t BEGIN { unless ($ENV{RELEASE_TESTING}) { print qq{1..0 # SKIP these tests are for release candidate testing\n}; exit } } use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::PAUSE::Permissions 0.003 use Test::More; BEGIN { plan skip_all => 'Test::PAUSE::Permissions required for testing pause permissions' if $] < 5.010; } use Test::PAUSE::Permissions; all_permissions_ok('DJZORT'); report-bug-to-cpan.pl100644001750001750 263514377177463 20671 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # This scripts reports a new RT::Client::REST bug to CPAN. use strict; use warnings; 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 $dist = 'RT-Client-REST'; # This is the name of the queue. my ( $username, $password ); print "RT Username: "; chomp( $username = <> ); print "RT Password: "; ReadMode 2; chomp( $password = <> ); ReadMode 0; $| = 1; print "\nAuthenticating..."; try { $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 = <> ); print "Long description (lone period or Ctrl-D to end):\n"; my $description = ''; while (<>) { chomp; last if '.' eq $_; $description = $description . "\n" . $_; } my $ticket; try { $ticket = RT::Client::REST::Ticket->new( rt => $rt, subject => $subject, queue => $dist, )->store; $ticket->correspond( message => $description ); } catch Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; print "Created ticket ", $ticket->id, " in queue ", $ticket->queue, "\n"; Exception.pm100644001750001750 2443214377177463 20472 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # PODNAME: RT::Client::REST::Exception # ABSTRACT: Exceptions thrown by RT::Client::REST use strict; use warnings; package RT::Client::REST::Exception; $RT::Client::REST::Exception::VERSION = '0.72'; use parent qw(Exception::Class); use vars qw($VERSION); $VERSION = '0.19'; use Exception::Class ( 'RT::Client::REST::OddNumberOfArgumentsException' => { isa => __PACKAGE__, description => 'This means that we wanted name/value pairs', }, 'RT::Client::REST::InvaildObjectTypeException' => { isa => __PACKAGE__, description => 'Invalid object type was specified', }, 'RT::Client::REST::MalformedRTResponseException' => { isa => __PACKAGE__, description => 'Malformed RT response received from server', }, 'RT::Client::REST::InvalidParameterValueException' => { isa => __PACKAGE__, description => 'This happens when you feed me bad values', }, 'RT::Client::REST::CannotReadAttachmentException' => { isa => __PACKAGE__, description => 'Cannot read attachment', }, 'RT::Client::REST::RequiredAttributeUnsetException' => { isa => __PACKAGE__, 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', }, 'RT::Client::REST::ObjectNotFoundException' => { isa => 'RT::Client::REST::RTException', description => 'One or more of the specified objects was not found', }, 'RT::Client::REST::CouldNotCreateObjectException' => { isa => 'RT::Client::REST::RTException', description => 'Object could not be created', }, 'RT::Client::REST::AuthenticationFailureException' => { isa => 'RT::Client::REST::RTException', description => 'Incorrect username or password', }, 'RT::Client::REST::UpdateException' => { isa => 'RT::Client::REST::RTException', description => 'Error updating an object. Virtual exception', }, 'RT::Client::REST::UnknownCustomFieldException' => { isa => 'RT::Client::REST::RTException', description => 'Unknown custom field', }, 'RT::Client::REST::InvalidQueryException' => { isa => 'RT::Client::REST::RTException', description => 'Invalid query (server could not parse it)', }, 'RT::Client::REST::CouldNotSetAttributeException' => { isa => 'RT::Client::REST::UpdateException', description => 'Attribute could not be updated with a new value', }, 'RT::Client::REST::InvalidEmailAddressException' => { isa => 'RT::Client::REST::UpdateException', description => 'Invalid e-mail address', }, 'RT::Client::REST::AlreadyCurrentValueException' => { isa => 'RT::Client::REST::UpdateException', description => 'The attribute you are trying to update already has '. 'this value', }, 'RT::Client::REST::ImmutableFieldException' => { isa => 'RT::Client::REST::UpdateException', description => 'Trying to update an immutable field', }, 'RT::Client::REST::IllegalValueException' => { isa => 'RT::Client::REST::UpdateException', description => 'Illegal value', }, 'RT::Client::REST::UnauthorizedActionException' => { isa => 'RT::Client::REST::RTException', description => 'You are not authorized to perform this action', }, 'RT::Client::REST::AlreadyTicketOwnerException' => { isa => 'RT::Client::REST::RTException', description => 'The owner you are trying to assign to a ticket ' . 'is already the owner', }, 'RT::Client::REST::RequestTimedOutException' => { isa => 'RT::Client::REST::RTException', description => 'Request timed out', }, 'RT::Client::REST::UnknownRTException' => { isa => 'RT::Client::REST::RTException', description => 'Some other RT error', }, 'RT::Client::REST::HTTPException' => { isa => __PACKAGE__, fields => ['code'], description => 'Error in the underlying protocol (HTTP)', }, ); sub _get_exception_class { my ($self, $content) = @_; if ($content =~ m/not found|\d+ does not exist|[Ii]nvalid attachment id/) { return 'RT::Client::REST::ObjectNotFoundException'; } if ($content =~ m/not create/) { return 'RT::Client::REST::CouldNotCreateObjectException'; } if ($content =~ m/[Uu]nknown custom field/) { return 'RT::Client::REST::UnknownCustomFieldException'; } if ($content =~ m/[Ii]nvalid query/) { return 'RT::Client::REST::InvalidQueryException'; } if ($content =~ m/could not be set to/) { return 'RT::Client::REST::CouldNotSetAttributeException'; } if ($content =~ m/not a valid email address/) { return 'RT::Client::REST::InvalidEmailAddressException'; } if ($content =~ m/is already the current value/) { return 'RT::Client::REST::AlreadyCurrentValueException'; } if ($content =~ m/[Ii]mmutable field/) { return 'RT::Client::REST::ImmutableFieldException'; } if ($content =~ m/[Ii]llegal value/) { return 'RT::Client::REST::IllegalValueException'; } if ($content =~ m/[Yy]ou are not allowed/) { return 'RT::Client::REST::UnauthorizedActionException'; } if ($content =~ m/[Yy]ou already own this ticket/ || $content =~ m/[Tt]hat user already owns that ticket/) { return 'RT::Client::REST::AlreadyTicketOwnerException'; } return 'RT::Client::REST::UnknownRTException'; } sub _rt_content_to_exception { my ($self, $content) = @_; (my $message = $content) =~ s/^#\s*//; chomp($message); return $self->_get_exception_class($content)->new( message => $message, ); } # Some mildly weird magic to fix up inheritance (see Exception::Class POD). { no strict 'refs'; ## no critic (ProhibitNoStrict) push @{__PACKAGE__ . '::ISA'}, 'Exception::Class::Base'; } 1; =pod =encoding UTF-8 =head1 NAME RT::Client::REST::Exception - Exceptions thrown by RT::Client::REST =head1 VERSION version 0.72 =head1 DESCRIPTION These are exceptions that are thrown by various L methods. =head1 EXCEPTION HIERARCHY =over 2 =item B This exception is virtual -- it is never thrown. It is used to group all the exceptions in this category. =over 2 =item B This means that the method you called wants key-value pairs. =item B Thrown when you specify an invalid type to C, C, or C methods. =item B An operation failed because a required attribute was not set in the object. =item B RT server sent response that we cannot parse. This may very well mean a bug in this client, so if you get this exception, some debug information mailed to the author would be appreciated. =item B Invalid value for comments, link types, object IDs, etc. =item B Cannot read attachment (thrown from methods "comment()" and "correspond"). =item B This is a virtual exception and is never thrown. It is used to group exceptions thrown because RT server returns an error. =over 2 =item B One or more of the specified objects was not found. =item B Incorrect username or password. =item B This is a virtual exception. It is used to group exceptions thrown when RT server returns an error trying to update an object. =over 2 =item B For one or another reason, attribute could not be updated with the new value. =item B Invalid e-mail address specified. =item B The attribute you are trying to update already has this value. I do not know why RT insists on treating this as an exception, but since it does so, so should the client. You can probably safely catch and throw away this exception in your code. =item B Trying to update an immutable field (such as "last_updated", for example). =item B Illegal value for attribute was specified. =back =item B Unknown custom field was specified in the request. =item B Server could not parse the search query. =item B You are not authorized to perform this action. =item B The owner you are trying to assign to a ticket is already the owner. This exception is usually thrown by methods C, C, and C, if the operation is a noop. =item B Request timed out. =item B Some other RT exception that the driver cannot recognize. =back =back =back =head1 METHODS =over 2 =item B<_get_exception_class> Figure out exception class based on content returned by RT. =item B<_rt_content_to_exception> Translate error string returned by RT server into an exception object ready to be thrown. =back =head1 SEE ALSO L, L. =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ RT::Client::REST::Exception -- exceptions thrown by RT::Client::REST methods. list_transactions_rt.pl100644001750001750 141714377177463 21511 0ustar00deandean000000000000RT-Client-REST-0.72/examples#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Data::Dumper; use RT::Client::REST; unless ( @ARGV >= 3 ) { die "Usage: $0 username password ticket_id\n"; } my $rt = RT::Client::REST->new( server => ( $ENV{RTSERVER} || 'http://rt.cpan.org' ), ); $rt->login( username => shift(@ARGV), password => 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 ) ) : () ), ); for my $tid (@ids) { my $t = $rt->get_transaction( parent_id => $id, id => $tid ); print Dumper($t); } Attachment.pm100644001750001750 1326114377177463 20622 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST::Attachment # ABSTRACT: attachment object representation. use strict; use warnings; package RT::Client::REST::Attachment; $RT::Client::REST::Attachment::VERSION = '0.72'; use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); use RT::Client::REST::Object::Exception; sub _attributes {{ id => { validation => { type => SCALAR, regex => qr/^\d+$/, }, }, creator_id => { validation => { type => SCALAR, regex => qr/^\d+$/, }, rest_name => 'Creator', }, parent_id => { validation => { type => SCALAR, regex => qr/^\d+$/, }, }, subject => { validation => { type => SCALAR, }, }, content_type => { validation => { type => SCALAR, }, rest_name => 'ContentType', }, file_name => { validation => { type => SCALAR, }, rest_name => 'Filename', }, transaction_id => { validation => { type => SCALAR, regex => qr/^\d+$/, }, rest_name => 'Transaction', }, message_id => { validation => { type => SCALAR, }, rest_name => 'MessageId', }, created => { validation => { type => SCALAR, }, is_datetime => 1, }, content => { validation => { type => SCALAR, }, }, headers => { validation => { type => SCALAR, }, }, parent => { validation => { type => SCALAR, }, }, content_encoding => { validation => { type => SCALAR, }, rest_name => 'ContentEncoding', }, }} sub rt_type { 'attachment' } sub retrieve { my $self = shift; $self->from_form( $self->rt->get_attachment( parent_id => $self->parent_id, id => $self->id, ), ); $self->{__dirty} = {}; return $self; } my @unsupported = qw(store search count); # Override unsupported methods. for my $method (@unsupported) { no strict 'refs'; ## no critic (ProhibitNoStrict) *$method = sub { my $self = shift; RT::Client::REST::Object::IllegalMethodException->throw( ref($self) . " does not support '$method' method", ); }; } # FIXME this is kind of horrible, probably functions should be provided via mixin? sub can { my ($self, $method) = @_; if (grep { $_ eq $method } @unsupported) { return; } return $self->SUPER::can($method); } __PACKAGE__->_generate_methods; 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::Attachment - attachment object representation. =head1 VERSION version 0.72 =head1 SYNOPSIS my $attachments = $ticket->attachments; my $count = $attachments->count; print "There are $count attachments.\n"; my $iterator = $attachments->get_iterator; while (my $att = &$iterator) { print "Id: ", $att->id, "; Subject: ", $att->subject, "\n"; } =head1 DESCRIPTION An attachment is a second-class citizen, as it does not exist (at least from the current REST protocol implementation) by itself. At the moment, it is always associated with a ticket (see B attribute). Thus, you will rarely retrieve an attachment by itself; instead, you should use C method of L object to get an iterator for all attachments for that ticket. =head1 ATTRIBUTES =over 2 =item B Numeric ID of the attachment. =item B Numeric ID of the user who created the attachment. =item B Numeric ID of the object the attachment is associated with. This is not a proper attribute of the attachment as specified by REST -- it is simply to store the ID of the L object this attachment belongs to. =item B Subject of the attachment. =item B Content type. =item B File name (if any). =item B Numeric ID of the L object this attachment is associated with. =item B Message ID. =item B Time when the attachment was created =item B Actual content of the attachment. =item B Headers (not parsed), if any. =item B Parent (not sure what this is yet). =item B Content encoding, if any. =back =head1 METHODS B is a read-only object, so you cannot C it. Also, because it is a second-class citizen, you cannot C or C it -- use C method provided by L. =over 2 =item retrieve To retrieve an attachment, attributes B and B must be set. =back =head1 INTERNAL METHODS =over 2 =item B Wraps the normal I call, to exclude unsupported methods from parent. =item B Returns 'attachment'. =back =head1 CREATING ATTACHMENTS Currently RT does not allow creating attachments via their API. See L =head1 SEE ALSO L, L. =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTPClient.pm100644001750001750 227414377177463 20432 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # PODNAME: RT::Client::REST::HTTPClient # ABSTRACT: Subclass LWP::UserAgent in order to support basic authentication. use strict; use warnings; package RT::Client::REST::HTTPClient; $RT::Client::REST::HTTPClient::VERSION = '0.72'; use parent 'LWP::UserAgent'; sub get_basic_credentials { my $self = shift; if ($self->basic_auth_cb) { return $self->basic_auth_cb->(@_); } else { return; } } sub basic_auth_cb { my $self = shift; if (@_) { $self->{basic_auth_cb} = shift; } return $self->{basic_auth_cb}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::HTTPClient - Subclass LWP::UserAgent in order to support basic authentication. =head1 VERSION version 0.72 =head1 METHODS =over 4 =item get_basic_credentials Returns basic authentication credentials =item basic_auth_cb Gets/sets basic authentication callback =back =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Transaction.pm100644001750001750 1173614377177463 21024 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # PODNAME: RT::Client::REST::Transaction # ABSTRACT: transaction object representation. use strict; use warnings; package RT::Client::REST::Transaction; $RT::Client::REST::Transaction::VERSION = '0.72'; use parent 'RT::Client::REST::Object'; use Params::Validate qw(:types); use RT::Client::REST::Object::Exception; sub _attributes {{ id => { validation => { type => SCALAR, regex => qr/^\d+$/, }, }, creator => { validation => { type => SCALAR, }, }, type => { validation => { type => SCALAR, }, }, old_value => { validation => { type => SCALAR, }, rest_name => "OldValue", }, new_value => { validation => { type => SCALAR, }, rest_name => "NewValue", }, parent_id => { validation => { type => SCALAR, regex => qr/^\d+$/, }, rest_name => 'Ticket', }, attachments => { validation => { type => SCALAR, }, }, time_taken => { validation => { type => SCALAR, }, rest_name => 'TimeTaken', }, field => { validation => { type => SCALAR, }, }, content => { validation => { type => SCALAR, }, }, created => { validation => { type => SCALAR, }, is_datetime => 1, }, description => { validation => { type => SCALAR|UNDEF, }, }, data => { validation => { type => SCALAR, }, }, }} sub rt_type { 'transaction' } sub retrieve { my $self = shift; $self->from_form( $self->rt->get_transaction( parent_id => $self->parent_id, id => $self->id, ), ); $self->{__dirty} = {}; return $self; } # Override unsupported methods. for my $method (qw(store search count)) { no strict 'refs'; ## no critic (ProhibitNoStrict) *$method = sub { my $self = shift; RT::Client::REST::Object::IllegalMethodException->throw( ref($self) . " does not support '$method' method", ); }; } __PACKAGE__->_generate_methods; 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::Transaction - transaction object representation. =head1 VERSION version 0.72 =head1 SYNOPSIS my $transactions = $ticket->transactions; my $count = $transactions->count; print "There are $count transactions.\n"; my $iterator = $transactions->get_iterator; while (my $tr = &$iterator) { print "Id: ", $tr->id, "; Type: ", $tr->type, "\n"; } =head1 DESCRIPTION A transaction is a second-class citizen, as it does not exist (at least from the current REST protocol implementation) by itself. At the moment, it is always associated with a ticket (see B attribute). Thus, you will rarely retrieve a transaction by itself; instead, you should use C method of L object to get an iterator for all (or some) transactions for that ticket. =head1 ATTRIBUTES =over 2 =item B Numeric ID of the transaction. =item B Username of the user who created the transaction. =item B Numeric ID of the object the transaction is associated with. =item B Type of the transactions. Please refer to L documentation for the list of transaction types you can expect this field to contain. Note that there may be some transaction types not (dis)covered yet. =item B Old value. =item B New value. =item B Name of the field the transaction is describing (if any). =item B I have never seen it set to anything yet. (I will some day investigate this). =item B Time when the transaction was created. =item B Actual content of the transaction. =item B Human-readable description of the transaction as provided by RT. =item B Not sure what this is yet. =back =head1 METHODS B is a read-only object, so you cannot C it. Also, because it is a second-class citizen, you cannot C or C it -- use C method provided by L. =over 2 =item retrieve To retrieve a transaction, attributes B and B must be set. =back =head1 INTERNAL METHODS =over 2 =item B Returns 'transaction'. =back =head1 SEE ALSO L, L, L. =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SearchResult.pm100644001750001750 701614377177463 21117 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST#!perl # vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab # PODNAME: RT::Client::REST::SearchResult # ABSTRACT: search results object. use strict; use warnings; package RT::Client::REST::SearchResult; $RT::Client::REST::SearchResult::VERSION = '0.72'; sub new { my $class = shift; my %opts = @_; my $self = bless {}, ref($class) || $class; # FIXME: add validation. $self->{_object} = $opts{object}; $self->{_ids} = $opts{ids} || []; return $self; } sub count { scalar( @{ shift->{_ids} } ) } sub _retrieve { my ( $self, $obj ) = @_; unless ( $obj->autoget ) { $obj->retrieve; } return $obj; } sub get_iterator { my $self = shift; my @ids = @{ $self->{_ids} }; my $object = $self->{_object}; return sub { if (wantarray) { 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 } }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::SearchResult - search results object. =head1 VERSION version 0.72 =head1 SYNOPSIS my $iterator = $search->get_iterator; my $count = $iterator->count; while (defined(my $obj = &$iterator)) { # do something with the $obj } =head1 DESCRIPTION This class is a representation of a search result. This is the type of the object you get back when you call method C on L-derived objects. It makes it easy to iterate over results and find out just how many there are. =head1 METHODS =over 4 =item B Returns the number of search results. This number will always be the same unless you stick your fat dirty fingers into the object and abuse it. This number is not affected by calls to C. =item B Returns a reference to a subroutine which is used to iterate over the results. Evaluating it in scalar context, returns the next object or C if all the results have already been iterated over. Note that for each object to be instantiated with correct values, B method is called on the object before returning it to the caller. Evaluating the subroutine reference in list context returns a list of all results fully instantiated. WARNING: this may be expensive, as each object is issued B method. Subsequent calls to the iterator result in empty list. You may safely mix calling the iterator in scalar and list context. For example: $iterator = $search->get_iterator; $first = &$iterator; $second = &$iterator; @the_rest = &$iterator; You can get as many iterators as you want -- they will not step on each other's toes. =item B You should not have to call it yourself, but just for the sake of completeness, here are the arguments: my $search = RT::Client::REST::SearchResult->new( ids => [1 .. 10], object => sub { # Yup, that's a closure. RT::Client::REST::Ticket->new( id => shift, rt => $rt, ); }, ); =back =head1 SEE ALSO L, L. =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Object000755001750001750 014377177463 17217 5ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/RESTException.pm100644001750001750 405514377177463 21657 0ustar00deandean000000000000RT-Client-REST-0.72/lib/RT/Client/REST/Object#!perl # PODNAME: RT::Client::REST::Object::Exception use strict; use warnings; package RT::Client::REST::Object::Exception; $RT::Client::REST::Object::Exception::VERSION = '0.72'; use parent qw(RT::Client::REST::Exception); use RT::Client::REST::Exception ( 'RT::Client::REST::Object::OddNumberOfArgumentsException' => { isa => __PACKAGE__, description => 'This means that we wanted name/value pairs', }, 'RT::Client::REST::Object::InvalidValueException' => { isa => __PACKAGE__, description => 'Object attribute was passed an invalid value', }, 'RT::Client::REST::Object::NoValuesProvidedException' => { isa => __PACKAGE__, description => 'Method expected parameters, but none were provided', }, 'RT::Client::REST::Object::InvalidSearchParametersException' => { isa => __PACKAGE__, description => 'Invalid search parameters provided', }, 'RT::Clite::REST::Object::InvalidAttributeException' => { isa => __PACKAGE__, description => 'Invalid attribute name', }, 'RT::Client::REST::Object::IllegalMethodException' => { isa => __PACKAGE__, description => 'Illegal method is called on the object', }, 'RT::Client::REST::Object::NoopOperationException' => { isa => __PACKAGE__, description => 'The operation was a noop', }, 'RT::Client::REST::Object::RequiredAttributeUnsetException' => { isa => __PACKAGE__, description => 'An operation failed because a required attribute ' . 'was not set in the object', }, ); 1; __END__ =pod =encoding UTF-8 =head1 NAME RT::Client::REST::Object::Exception =head1 VERSION version 0.72 =head1 AUTHOR Dean Hamstead =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023, 2020 by Dmitri Tikhonov. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut