RT-Client-REST-0.45/0000755000175000017500000000000012241164166013655 5ustar melmothmelmothRT-Client-REST-0.45/examples/0000755000175000017500000000000012241164166015473 5ustar melmothmelmothRT-Client-REST-0.45/examples/show_ticket.pl0000644000175000017500000000200212240632475020347 0ustar melmothmelmoth#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Error qw(:try); 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 RT::Client::REST::UnauthorizedActionException with { die "You are not authorized to view ticket #$id\n"; } catch RT::Client::REST::Exception with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; use Data::Dumper; print Dumper($ticket); for my $cf (sort $ticket->cf) { print "Custom field '$cf'=", $ticket->cf($cf), "\n"; } RT-Client-REST-0.45/examples/search_tickets.pl0000644000175000017500000000175512240632475021035 0ustar melmothmelmoth#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message; }; 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"; } RT-Client-REST-0.45/examples/edit_custom_field.pl0000644000175000017500000000142412240632475021515 0ustar melmothmelmoth#!/usr/bin/perl # # edit_ticket.pl -- edit an RT ticket. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; use Data::Dumper; print Dumper($ticket); RT-Client-REST-0.45/examples/take_ticket.pl0000644000175000017500000000115412240632475020322 0ustar melmothmelmoth#!/usr/bin/perl # # take_ticket.pl -- take a ticket. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; RT-Client-REST-0.45/examples/show_links.pl0000644000175000017500000000203012240632475020205 0ustar melmothmelmoth#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Error qw(:try); 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 RT::Client::REST::UnauthorizedActionException with { die "You are not authorized to view ticket #$id\n"; } catch RT::Client::REST::Exception with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; use Data::Dumper; print Dumper($rt->get_links('type' => $type, 'id' => $id)); RT-Client-REST-0.45/examples/comment_on_ticket.pl0000644000175000017500000000150512240632475021534 0ustar melmothmelmoth#!/usr/bin/perl # # comment_on_ticket.pl -- add comment to an RT ticket. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; use Data::Dumper; print Dumper($ticket); RT-Client-REST-0.45/examples/show_transaction.pl0000644000175000017500000000136312240632475021422 0ustar melmothmelmoth#!/usr/bin/perl # # show_transaction.pl -- retrieve an RT transaction. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; use Data::Dumper; print Dumper($tr); RT-Client-REST-0.45/examples/report-bug-to-cpan.pl0000644000175000017500000000251712240632475021464 0ustar melmothmelmoth#!/usr/bin/perl # # This scripts reports a new RT::Client::REST bug to CPAN. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->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"; RT-Client-REST-0.45/examples/create_user.pl0000644000175000017500000000127612240632475020341 0ustar melmothmelmoth#!/usr/bin/perl # # create_user.pl use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; print "User created. Id: ", $user->id, "\n"; RT-Client-REST-0.45/examples/show_queue.pl0000644000175000017500000000126012240632475020215 0ustar melmothmelmoth#!/usr/bin/perl # # show_queue.pl -- retrieve an RT queue. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; use Data::Dumper; print Dumper($queue); RT-Client-REST-0.45/examples/list_transactions_rt.pl0000644000175000017500000000136412240632475022306 0ustar melmothmelmoth#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Data::Dumper; use Error qw(:try); 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); } RT-Client-REST-0.45/examples/list_attachments.pl0000644000175000017500000000157512240632475021410 0ustar melmothmelmoth#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message; }; 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"; } RT-Client-REST-0.45/examples/edit_group.pl0000644000175000017500000000103412240632475020171 0ustar melmothmelmoth#!/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); RT-Client-REST-0.45/examples/edit_ticket.pl0000644000175000017500000000117012240632475020321 0ustar melmothmelmoth#!/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); RT-Client-REST-0.45/examples/list_tickets.pl0000644000175000017500000000153012240632475020532 0ustar melmothmelmoth#!/usr/bin/perl # # list_tickets.pl -- list tickets in a queue use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message; }; 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"; } RT-Client-REST-0.45/examples/edit_user.pl0000644000175000017500000000103012240632475020007 0ustar melmothmelmoth#!/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); RT-Client-REST-0.45/examples/create_ticket.pl0000644000175000017500000000121412240632475020636 0ustar melmothmelmoth#!/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); RT-Client-REST-0.45/examples/show_attachment.pl0000644000175000017500000000137212240632475021225 0ustar melmothmelmoth#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; use Data::Dumper; print Dumper($att); RT-Client-REST-0.45/examples/list_transactions.pl0000644000175000017500000000167112240632475021602 0ustar melmothmelmoth#!/usr/bin/perl # # list_transactions.pl -- list transactions associated with a ticket. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message; }; 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"; } RT-Client-REST-0.45/examples/show_group.pl0000644000175000017500000000100512240632475020222 0ustar melmothmelmoth#!/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); RT-Client-REST-0.45/examples/show_user.pl0000644000175000017500000000125412240632475020052 0ustar melmothmelmoth#!/usr/bin/perl # # show_ticket.pl -- retrieve an RT ticket. use strict; use warnings; use Error qw(:try); 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 Exception::Class::Base with { my $e = shift; die ref($e), ": ", $e->message || $e->description, "\n"; }; use Data::Dumper; print Dumper($user); RT-Client-REST-0.45/META.yml0000644000175000017500000000154312241164062015124 0ustar melmothmelmoth--- abstract: 'talk to RT installation using REST protocol.' author: - 'Original /usr/bin/rt was written by Abhijit Menon-Sen . rt' build_requires: ExtUtils::MakeMaker: 6.36 Test::Exception: 0 Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.36 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: RT-Client-REST no_index: directory: - examples - inc - t requires: DateTime: 0 DateTime::Format::DateParse: 0 Encode: 0 Error: 0 Exception::Class: 0 HTTP::Cookies: 0 HTTP::Request::Common: 0 LWP: 0 Params::Validate: 0 URI: 0 resources: license: http://dev.perl.org/licenses/ repository: https://github.com/RT-Client-REST/RT-Client-REST.git version: 0.45 RT-Client-REST-0.45/TODO0000644000175000017500000000062412240632475014351 0ustar melmothmelmothThis is a TODO file. I will be checking things off as they get implemented. - 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. RT-Client-REST-0.45/MANIFEST0000644000175000017500000000300312241164143014775 0ustar melmothmelmothCHANGES 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 inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm 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 Makefile.PL MANIFEST This list of files META.yml MYMETA.json MYMETA.yml README t/01-use.t t/026-group.t t/10-core.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/35-db.t t/40-search.t t/80-timeout.t t/81-submit.t t/82-stringify.t t/83-attachments.t t/90-pod.t t/91-pod-coverage.t t/99-kwalitee.t t/test.png TODO RT-Client-REST-0.45/MYMETA.yml0000644000175000017500000000156112241164062015372 0ustar melmothmelmoth--- abstract: 'talk to RT installation using REST protocol.' author: - 'Original /usr/bin/rt was written by Abhijit Menon-Sen . rt' build_requires: ExtUtils::MakeMaker: 6.36 Test::Exception: 0 Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.36 dynamic_config: 0 generated_by: 'Module::Install version 1.06, CPAN::Meta::Converter version 2.132140' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: RT-Client-REST no_index: directory: - examples - inc - t requires: DateTime: 0 DateTime::Format::DateParse: 0 Encode: 0 Error: 0 Exception::Class: 0 HTTP::Cookies: 0 HTTP::Request::Common: 0 LWP: 0 Params::Validate: 0 URI: 0 resources: license: http://dev.perl.org/licenses/ repository: https://github.com/RT-Client-REST/RT-Client-REST.git version: 0.45 RT-Client-REST-0.45/t/0000755000175000017500000000000012241164166014120 5ustar melmothmelmothRT-Client-REST-0.45/t/99-kwalitee.t0000644000175000017500000000021712240632475016353 0ustar melmothmelmothuse Test::More; eval { require Test::Kwalitee; Test::Kwalitee->import }; plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@; RT-Client-REST-0.45/t/82-stringify.t0000644000175000017500000000200312241126350016536 0ustar melmothmelmoth#!/usr/bin/perl # # This script tests whether submited data looks good use strict; use warnings; use Test::More; use Error qw(:try); use IO::Socket; use RT::Client::REST; my $server = IO::Socket::INET->new( Type => SOCK_STREAM, Reuse => 1, Listen => 10, ) or die "Could not set up TCP server: $@"; my $port = $server->sockport; my $pid = fork; if ($pid > 0) { plan tests => 1; my $buf; my $client = $server->accept; my $data; while (<$client>) { $data .= $_; } unlike($data, qr/ARRAY\(/, "Avoid stringify objects when sending a request"); $client->write( "RT/42foo 200 this is a fake successful response header header line 1 header line 2 response text"); } elsif (defined($pid)) { my $rt = RT::Client::REST->new( server => "http://localhost:$port", timeout => 2, ); my $res = $rt->_submit("ticket/1", "aaaa", { user => 'a', pass => 'b', }); } else { die "Could not fork: $!"; } # vim:ft=perl: RT-Client-REST-0.45/t/90-pod.t0000644000175000017500000000022112240632475015312 0ustar melmothmelmothuse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); # vim:ft=perl: RT-Client-REST-0.45/t/23-attachment.t0000644000175000017500000000172612240632475016667 0ustar melmothmelmothuse 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); # vim:ft=perl: RT-Client-REST-0.45/t/24-transaction.t0000644000175000017500000000150712240632475017062 0ustar melmothmelmothuse 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); # vim:ft=perl: RT-Client-REST-0.45/t/22-ticket.t0000644000175000017500000001273312240632475016021 0ustar melmothmelmothuse strict; use warnings; use Test::More tests => 113; 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', ); 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: 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(\@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'; # vim:ft=perl: RT-Client-REST-0.45/t/10-core.t0000644000175000017500000000170112240632475015454 0ustar melmothmelmothuse strict; use warnings; use Test::More tests => 26; 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 {}); }; # vim:ft=perl: RT-Client-REST-0.45/t/test.png0000644000175000017500000003745712241106034015613 0ustar melmothmelmothPNG  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`RT-Client-REST-0.45/t/20-object.t0000644000175000017500000000412512240632475015776 0ustar melmothmelmothpackage MyObject; # 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"; } # vim:ft=perl: RT-Client-REST-0.45/t/35-db.t0000644000175000017500000000417112240632475015124 0ustar melmothmelmothpackage MyObject; # For testing purposes use base '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"); # vim:ft=perl: RT-Client-REST-0.45/t/25-queue.t0000644000175000017500000000110512240632475015654 0ustar melmothmelmothuse strict; use warnings; use Test::More tests => 16; 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', ); 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); # vim:ft=perl: RT-Client-REST-0.45/t/81-submit.t0000644000175000017500000000175612240632475016051 0ustar melmothmelmoth#!/usr/bin/perl # # This script tests whether submited data looks good use strict; use warnings; use Test::More; use Error qw(:try); use IO::Socket; use RT::Client::REST; my $server = IO::Socket::INET->new( Type => SOCK_STREAM, Reuse => 1, Listen => 10, ) or die "Could not set up TCP server: $@"; my $port = $server->sockport; my $pid = fork; if ($pid > 0) { plan tests => 1; my $rt = RT::Client::REST->new( server => "http://localhost:$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"); } elsif (defined($pid)) { 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"); } else { die "Could not fork: $!"; } # vim:ft=perl: RT-Client-REST-0.45/t/21-user.t0000644000175000017500000000134612240632475015511 0ustar melmothmelmothuse 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; # vim:ft=perl: RT-Client-REST-0.45/t/40-search.t0000644000175000017500000000223212240632475015774 0ustar melmothmelmothuse strict; use warnings; package Mock; use base '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)"); # vim:ft=perl: RT-Client-REST-0.45/t/83-attachments.t0000644000175000017500000000463512241126331017050 0ustar melmothmelmoth#!/usr/bin/perl # # This script tests whether submited data looks good use strict; use warnings; use Test::More; use Error qw(:try); use IO::Socket; use RT::Client::REST; use HTTP::Response; use File::Spec::Functions; use Data::Dumper; use Encode; my $testfile = "test.png"; my $testfile_path = catfile(t => $testfile); 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; if ($pid > 0) { plan tests => 3; my $rt = RT::Client::REST->new( server => "http://localhost:$port", timeout => 2, ); # avoid need ot login $rt->basic_auth_cb(sub { return }); my $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 1); # slurp the file local $/ = undef; open (my $fh, "<", $testfile_path) or die "Couldn't open $testfile_path $!"; my $binary_string = <$fh>; close $fh; ok($res->{Content} eq $binary_string, "binary files match with undecoded option"); $res = $rt->get_attachment(parent_id => 130, id => 873, undecoded => 0); ok($res->{Content} ne encode("latin1", $binary_string), "binary files don't match when decoded to latin1"); ok($res->{Content} ne encode("utf-8", $binary_string), "binary files don't match when decoded to utf8"); } elsif (defined($pid)) { # serve two requests: for (1..2) { my $client = $server->accept; # emulate the header $client->write("HTTP/1.1 200 OK\r\nContent-Type: text/plain; charset=utf-8\r\n\r\n" . create_http_body()); $client->close; } } else { die "Could not fork: $!"; } sub create_http_body { my $binary_string; local $/ = undef; open (my $fh, "<", $testfile_path) or die "Couldn't open $testfile_path $!"; $binary_string = <$fh>; close $fh; my $length = length($binary_string); $binary_string =~ s/\n/\n /sg; $binary_string .= "\n\n"; my $body = <<"EOF"; RT/4.0.7 200 Ok id: 873 Subject: Creator: 12 Created: 2013-11-06 07:15:36 Transaction: 1457 Parent: 871 MessageId: Filename: 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 return $body; } RT-Client-REST-0.45/t/026-group.t0000644000175000017500000000076312240632475015756 0ustar melmothmelmothuse 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'); # vim:ft=perl: RT-Client-REST-0.45/t/80-timeout.t0000644000175000017500000000222512240632475016223 0ustar melmothmelmoth#!/usr/bin/perl # # This script tests whether timeout actually works. use strict; use warnings; use Test::More; use Error qw(:try); use IO::Socket; use RT::Client::REST; plan( skip_all => 'Timeout tests hanging on Windows' ) if $^O eq 'MSWin32'; 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; if ($pid > 0) { plan tests => 8; for my $timeout (1, 2, 5, 10) { my $rt = RT::Client::REST->new( server => "http://localhost:$port", timeout => $timeout, ); my $t1 = time; my ($e, $t2); try { $rt->login(qw(username a password b)); } catch Exception::Class::Base with { $t2 = time; $e = shift; }; isa_ok($e, 'RT::Client::REST::RequestTimedOutException'); ok($t2 - $t1 >= $timeout, "Timed out after $timeout seconds"); } } elsif (defined($pid)) { my $buf; my $client = $server->accept; 1 while ($client->read($buf, 1024)); } else { die "Could not fork: $!"; } # vim:ft=perl: RT-Client-REST-0.45/t/01-use.t0000644000175000017500000000023112240632475015315 0ustar melmothmelmothuse strict; use warnings; use Test::More tests => 2; BEGIN { use_ok ('RT::Client::REST'); use_ok ('RT::Client::REST', 0.06); } # vim:ft=perl: RT-Client-REST-0.45/t/91-pod-coverage.t0000644000175000017500000000150512240632475017112 0ustar melmothmelmothuse Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; plan tests => 9; # heh, plan9! pod_coverage_ok("RT::Client::REST", { also_private => [qw(DEBUG get_links link unlink)] }); pod_coverage_ok("RT::Client::REST::Exception"); pod_coverage_ok("RT::Client::REST::Object", { trustme => [qw(autoget autosync autostore)], }); pod_coverage_ok("RT::Client::REST::Ticket"); pod_coverage_ok("RT::Client::REST::User"); pod_coverage_ok("RT::Client::REST::Queue"); pod_coverage_ok("RT::Client::REST::Attachment", { private => [qw(can count store search _attributes)], }); pod_coverage_ok("RT::Client::REST::Transaction", { private => [qw(can count store search _attributes)], }); pod_coverage_ok("RT::Client::REST::SearchResult"); # vim:ft=perl: RT-Client-REST-0.45/README0000644000175000017500000000214312240632475014537 0ustar melmothmelmoth# This is README file for RT::Client::REST distribution. RT::Client::REST is a set of object-oriented Perl modules designed to make communicating with RT using REST protocol easy. Most of the features have been implemented and tested with rt 3.6.0 and later. Please see POD for details on usage. To build: perl Makefile.PL make To test, you will need Test::Exception -- as this is an object-oriented distribution, a lot of tests deal with making sure that the exceptions that are thrown are correct, so I do not (and you do not) want to skip those: make test To install: make install Author: Dmitri Tikhonov RT::Client::REST is based on 'rt' command-line utility distributed with RT 3.x written by Abhijit Menon-Sen and donated to RT project. License: Original 'rt' utility is GPL, therefore so is RT::Client::REST. The rest of the modules are licensed under the usual artistic license. (I am not sure it makes sense to do this. Does GPL override artistic license? Someone let me know if you have a definite answer.) RT-Client-REST-0.45/Makefile.PL0000644000175000017500000000125012241126350015616 0ustar melmothmelmothuse inc::Module::Install 0.91; use strict; name 'RT-Client-REST'; all_from 'lib/RT/Client/REST.pm'; license 'perl'; requires 'Encode' => 0; requires 'Error' => 0; requires 'Exception::Class' => 0; requires 'HTTP::Cookies' => 0; requires 'HTTP::Request::Common' => 0; requires 'LWP' => 0; requires 'Params::Validate' => 0; requires 'DateTime' => 0; requires 'DateTime::Format::DateParse' => 0; requires 'URI' => 0; test_requires 'Test::More'; test_requires 'Test::Exception' => 0; resources repository => 'https://github.com/RT-Client-REST/RT-Client-REST.git'; WriteAll; RT-Client-REST-0.45/lib/0000755000175000017500000000000012241164166014423 5ustar melmothmelmothRT-Client-REST-0.45/lib/RT/0000755000175000017500000000000012241164166014750 5ustar melmothmelmothRT-Client-REST-0.45/lib/RT/Client/0000755000175000017500000000000012241164166016166 5ustar melmothmelmothRT-Client-REST-0.45/lib/RT/Client/REST.pm0000644000175000017500000007455212241126350017307 0ustar melmothmelmoth# $Id$ # RT::Client::REST # # Dmitri Tikhonov # April 18, 2006 # # Part of the source is Copyright (c) 2007-2008 Damien Krotkine # # This code is adapted (stolen) from /usr/bin/rt that came with RT. I just # wanted to make an actual module out of it. Therefore, this code is GPLed. # # 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 #------------------------ package RT::Client::REST; use strict; use warnings; use vars qw/$VERSION/; $VERSION = '0.45'; $VERSION = eval $VERSION; use Error qw(:try); use HTTP::Cookies; use HTTP::Request::Common; use RT::Client::REST::Exception 0.18; use RT::Client::REST::Forms; use RT::Client::REST::HTTPClient; # Generate accessors/mutators for my $method (qw(server _cookie timeout)) { no strict 'refs'; *{__PACKAGE__ . '::' . $method} = sub { my $self = shift; $self->{'_' . $method} = shift if @_; return $self->{'_' . $method}; }; } sub new { my $class = shift; $class->_assert_even(@_); my $self = bless {}, ref($class) || $class; my %opts = @_; while (my ($k, $v) = each(%opts)) { $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 RT::Client::REST::AuthenticationFailureException with { shift->rethrow; } catch RT::Client::REST::MalformedRTResponseException with { shift->rethrow; } catch RT::Client::REST::RequestTimedOutException with { shift->rethrow; } catch RT::Client::REST::HTTPException with { shift->rethrow; } catch Exception::Class::Base with { # 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, $e) = @{$$form[0]}; 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, $e) = @{$$form[0]}; if (!@$o && $c) { RT::Client::REST::Exception->_rt_content_to_exception($c)->throw; } return $k->{Attachments} =~ m/(\d+):/mg; } 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, $e) = @{$$form[0]}; 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, $e) = @{$$form[0]}; if (!@$o && $c) { RT::Client::REST::Exception->_rt_content_to_exception($c)->throw; } # Turn the links into id lists foreach my $key (keys(%$k)) { try { $self->_valid_link_type($key); my @list = split(/\s*,\s*/,$k->{$key}); #use Data::Dumper; #print STDERR Dumper(\@list); my @newlist = (); foreach my $val (@list) { 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 RT::Client::REST::InvalidParameterValueException with { # 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. 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; } 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, $e) = @{$$form[0]}; 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 $r = $self->_submit("search/$type", { query => $query, (defined($orderby) ? (orderby => $orderby) : ()), }); 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{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) } 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 DEBUG { shift; print STDERR @_ } 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, "", Content => $content] ]; } elsif (ref $content eq 'HASH') { my @data; foreach my $k (keys %$content) { if (ref $content->{$k} eq 'ARRAY') { foreach 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. #DEBUG(3, $req->as_string); my $res = $self->_ua->request($req); #DEBUG(3, $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, @headers) = split /\n/, $head; $text =~ s/\n*$/\n/ if ($text); # "RT/3.0.1 401 Credentials required" if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) { RT::Client::REST::MalformedRTResponseException->throw( "Malformed RT response received from " . $self->server, ); } # 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::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) =~ /read timeout/ ) { RT::Client::REST::RequestTimedOutException->throw( "Your request to " . $self->server . " timed out", ); } else { RT::Client::REST::HTTPException->throw( code => $res->code, message => $res->message, ); } return $res; } sub _ua { my $self = shift; unless (exists($self->{_ua})) { $self->{_ua} = RT::Client::REST::HTTPClient->new( agent => $self->_ua_string, env_proxy => 1, ); 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 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}; } # 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 { $VERSION } 1; __END__ =pod =head1 NAME RT::Client::REST -- talk to RT installation using REST protocol. =head1 SYNOPSIS use Error qw(:try); 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 Exception::Class::Base with { die "problem logging in: ", shift->message; }; try { # Get ticket #10 $ticket = $rt->show(type => 'ticket', id => 10); } catch RT::Client::REST::UnauthorizedActionException with { print "You are not authorized to view ticket #10\n"; } catch RT::Client::REST::Exception with { # something went wrong. }; =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. =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); } =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 prodive 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, %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: =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 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', ids => [$id]); print "Subject: ", $t->{Subject}, "\n"; } =item comment (ticket_id => $id, message => $message, %opts) Comment on a ticket with ID B<$id>. Optionally takes arguments B and B which are references to lists of e-mail addresses and B which is a list of filenames to be attached to the ticket. $rt->comment( ticket_id => 5, message => "Wild thing, you make my heart sing", cc => [qw(dmitri@localhost some@otherdude.com)], ); =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>. =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_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 wtih. 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): =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'). =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. =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 Error.pm's B mechanism to catch them, but you may also use simple B. The former will give you flexibility to catch just the exceptions you want. 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 Error =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 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 VERSION This is version 0.40 of B. =head1 AUTHORS Original /usr/bin/rt was written by Abhijit Menon-Sen . rt was later converted to this module by Dmitri Tikhonov . In January of 2008, Damien "dams" Krotkine joined as the project's co-maintainer. JLMARTIN has become co-maintainer as of March 2010. =head1 LICENSE Since original rt is licensed under GPL, so is this module. =cut RT-Client-REST-0.45/lib/RT/Client/REST/0000755000175000017500000000000012241164166016743 5ustar melmothmelmothRT-Client-REST-0.45/lib/RT/Client/REST/HTTPClient.pm0000644000175000017500000000101412240632475021215 0ustar melmothmelmoth# $Id$ # # Subclass LWP::UserAgent in order to support basic authentication. package RT::Client::REST::HTTPClient; use strict; use warnings; use vars qw($VERSION); $VERSION = '0.01'; use base '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; RT-Client-REST-0.45/lib/RT/Client/REST/SearchResult.pm0000644000175000017500000000616712240632475021721 0ustar melmothmelmoth# $Id$ # # RT::Client::REST::SearchResult -- search results object. package RT::Client::REST::SearchResult; use strict; use warnings; use vars qw($VERSION); $VERSION = 0.03; 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__ =head1 NAME RT::Client::REST::SearchResult -- Search results representation. =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 Dmitri Tikhonov =cut RT-Client-REST-0.45/lib/RT/Client/REST/Attachment.pm0000644000175000017500000001211312240632475021371 0ustar melmothmelmoth# $Id$ # # RT::Client::REST::Attachment -- attachment object representation. package RT::Client::REST::Attachment; use strict; use warnings; use vars qw($VERSION); $VERSION = 0.03; use Params::Validate qw(:types); use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.03; use base 'RT::Client::REST::Object'; sub _attributes {{ id => { 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'; *$method = sub { my $self = shift; RT::Client::REST::Object::IllegalMethodException->throw( ref($self) . " does not support '$method' method", ); }; } sub can { my ($self, $method) = @_; if (grep { $_ eq $method } @unsupported) { return; } return $self->SUPER::can($method); } __PACKAGE__->_generate_methods; 1; __END__ =head1 NAME RT::Client::REST::Attachment -- this object represents an attachment. =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 Returns 'attachment'. =back =head1 SEE ALSO L, L. =head1 AUTHOR Dmitri Tikhonov =head1 LICENSE Perl license with the exception of L, which is GPLed. =cut RT-Client-REST-0.45/lib/RT/Client/REST/Group.pm0000644000175000017500000000465712240632475020413 0ustar melmothmelmoth# RT::Client::REST::Group -- group object representation. package RT::Client::REST::Group; use strict; use warnings; use vars qw($VERSION); $VERSION = 0.03; use Params::Validate qw(:types); use RT::Client::REST 0.14; use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.01; use RT::Client::REST::SearchResult 0.02; use base 'RT::Client::REST::Object'; =head1 NAME RT::Client::REST::Group -- group object representation. =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. =cut 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, } }} =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'. =cut sub rt_type { 'group' } =back =head1 SEE ALSO L, L, L. =head1 AUTHOR Miquel Ruiz =head1 LICENSE Perl license with the exception of L, which is GPLed. =cut __PACKAGE__->_generate_methods; 1; RT-Client-REST-0.45/lib/RT/Client/REST/Queue.pm0000644000175000017500000000755712240632475020405 0ustar melmothmelmoth# $Id$ # # RT::Client::REST::Queue -- queue object representation. package RT::Client::REST::Queue; use strict; use warnings; use vars qw($VERSION); $VERSION = '0.02'; use Params::Validate qw(:types); use RT::Client::REST 0.20; use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.01; use RT::Client::REST::SearchResult 0.02; use RT::Client::REST::Ticket; use base 'RT::Client::REST::Object'; =head1 NAME RT::Client::REST::Queue -- queue object representation. =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. =cut 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', }, }} =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. =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. =cut 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}, ]); } =back =head1 INTERNAL METHODS =over 2 =item B Returns 'queue'. =cut sub rt_type { 'queue' } =back =head1 SEE ALSO L, L, L, L. =head1 AUTHOR Dmitri Tikhonov =head1 LICENSE Perl license with the exception of L, which is GPLed. =cut __PACKAGE__->_generate_methods; 1; RT-Client-REST-0.45/lib/RT/Client/REST/Forms.pm0000644000175000017500000001435212240632475020376 0ustar melmothmelmoth# $Id$ # # 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. package RT::Client::REST::Forms; use strict; use warnings; use Exporter; use vars qw(@EXPORT @ISA $VERSION); @ISA = qw(Exporter); @EXPORT = qw(expand_list form_parse form_compose vpush vsplit); $VERSION = .02; my $CF_name = qr%[\s\w:()?/-]+%; my $field = qr/[a-z][\w-]*|C(?:ustom)?F(?:ield)?-$CF_name|CF\.{$CF_name}/i; sub expand_list { my ($list) = @_; my ($elt, @elts, %elts); foreach $elt (split /,/, $list) { if ($elt =~ /^(\d+)-(\d+)$/) { push @elts, ($1..$2) } else { push @elts, $elt } } @elts{@elts}=(); return sort {$a<=>$b} keys %elts; } # Returns a reference to an array of parsed forms. sub form_parse { my $state = 0; my @forms = (); my @lines = split /\n/, $_[0]; my ($c, $o, $k, $e) = ("", [], {}, ""); LINE: while (@lines) { my $line = shift @lines; next LINE if $line eq ''; if ($line eq '--') { # 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; } elsif ($state != -1) { if ($state == 0 && $line =~ /^#/) { # Read an optional block of comments (only) at the start # of the form. $state = 1; $c = $line; while (@lines && $lines[0] =~ /^#/) { $c .= "\n".shift @lines; } $c .= "\n"; } elsif ($state <= 1 && $line =~ /^($field):(?:\s+(.*))?$/) { # Read a field: value specification. my $f = $1; my @v = ($2 || ()); # Read continuation lines, if any. while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) { push @v, shift @lines; } pop @v while (@v && $v[-1] eq ''); # Strip longest common leading indent from text. my ($ws, $ls) = (""); foreach $ls (map {/^(\s+)/} @v[1..$#v]) { $ws = $ls if (!$ws || length($ls) < length($ws)); } s/^$ws// foreach @v; push(@$o, $f) unless exists $k->{$f}; vpush($k, $f, join("\n", @v)); $state = 1; } elsif ($line !~ /^#/) { # We've found a syntax error, so we'll reconstruct the # form parsed thus far, and add an error marker. (>>) $state = -1; $e = form_compose([[ "", $o, $k, "" ]]); $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n"; } } 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); my $l; foreach $l (keys %$k) { $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY'); } return \@forms; } # Returns text representing a set of forms. sub form_compose { my ($forms) = @_; my (@text, $form); foreach $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, $key); foreach $key (@$o) { my ($line, $sp, $v); my @values = (ref $k->{$key} eq 'ARRAY') ? @{ $k->{$key} } : $k->{$key}; $sp = " "x(length("$key: ")); $sp = " "x4 if length($sp) > 16; foreach $v (@values) { if ($v =~ /\n/) { $v =~ s/^/$sp/gm; $v =~ s/^$sp//; if ($line) { push @lines, "$line\n\n"; $line = ""; } elsif (@lines && $lines[-1] !~ /\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 =~ /\n/) { if (@lines && $lines[-1] !~ /\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; } # Add a value to a (possibly multi-valued) hash key. 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; } } # "Normalise" a hash key that's known to be multi-valued. sub vsplit { my ($val) = @_; my ($line, $word, @words); foreach $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; } 1; RT-Client-REST-0.45/lib/RT/Client/REST/Object/0000755000175000017500000000000012241164166020151 5ustar melmothmelmothRT-Client-REST-0.45/lib/RT/Client/REST/Object/Exception.pm0000644000175000017500000000320512240632475022447 0ustar melmothmelmoth# $Id$ # RT::Client::REST::Object::Exception package RT::Client::REST::Object::Exception; use base qw(RT::Client::REST::Exception); use strict; use warnings; use vars qw($VERSION); $VERSION = '0.05'; 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; RT-Client-REST-0.45/lib/RT/Client/REST/Object.pm0000644000175000017500000005352612240632475020524 0ustar melmothmelmoth# $Id$ package RT::Client::REST::Object; =head1 NAME RT::Client::REST::Object -- base class for RT objects. =head1 SYNOPSIS # Create a new type package RT::Client::REST::MyType; use base 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 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 =head1 SPECIAL ATTRIBUTES B and B are special attributes. They are used by various DB-related methods and are especially relied upon by B, B, and B features. =head1 METHODS =over 2 =cut use strict; use warnings; use vars qw($VERSION); $VERSION = '0.09'; use Error qw(:try); use Params::Validate; use RT::Client::REST::Object::Exception 0.04; use RT::Client::REST::SearchResult 0.02; use DateTime; use DateTime::Format::DateParse; =item new Constructor =cut 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; } =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 }, }, =cut sub _generate_methods { my $class = shift; my $attributes = $class->_attributes; while (my ($method, $settings) = each(%$attributes)) { no strict 'refs'; *{$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; my $real_method = $class.'::'.$method; 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]); }; } } } =item _mark_dirty($attrname) Mark an attribute as dirty. =cut sub _mark_dirty { my ($self, $attr) = @_; $self->{__dirty}{$attr} = 1; } =item _dirty Return the list of dirty attributes. =cut sub _dirty { my $self = shift; if (exists($self->{__dirty})) { return keys %{$self->{__dirty}}; } return; } =item _mark_dirty_cf($attrname) Mark an custom flag as dirty. =cut sub _mark_dirty_cf { my ($self, $cf) = @_; $self->{__dirty_cf}{$cf} = 1; } =item _dirty_cf Return the list of dirty custom flags. =cut sub _dirty_cf { my $self = shift; if (exists($self->{__dirty_cf})) { return keys %{$self->{__dirty_cf}}; } return; } =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. =cut 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 : 'Not set'); } $hash{$rest_name} = $value; } my @cfs = ($all ? $self->cf : $self->_dirty_cf); for my $cf (@cfs) { $hash{'CF-' . $cf} = $self->cf($cf); } return \%hash; } =item from_form Set object's attributes from form received from RT server. =cut 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( "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, $value) = each(%$attributes)) { my $rest_name = (exists($attributes->{$attr}{rest_name}) ? lc($attributes->{$attr}{rest_name}) : $attr); $rest2attr{$rest_name} = $attr; } # Now set attributes: while (my ($key, $value) = each(%$hash)) { # Handle custom fields, ideally /(?(1)})/ would be appened to RE if( $key =~ m%^(?:cf|customfield)(?:-|\.{)([\s\w_:()?/-]+)% ){ $key = $1; # XXX very sketchy. Will fail on long form data e.g; wiki CF if ($value =~ /,/) { $value = [ split(/\s*,\s*/, $value) ]; } $self->cf($key, $value); next; } unless (exists($rest2attr{$key})) { warn "Unknown key: $key\n"; next; } if ($value =~ m/not set/i) { $value = undef; } my $method = $rest2attr{$key}; if (exists($attributes->{$method}{form2value})) { $value = $attributes->{$method}{form2value}($value); } elsif ($attributes->{$method}{list}) { $value = [split(/\s*,\s*/, $value)], } $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 RT::Clite::REST::Object::InvalidAttributeException with { RT::Client::REST::Object::InvalidSearchParametersException ->throw(shift->message); }; 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 RT::Clite::REST::Object::InvalidAttributeException with { RT::Client::REST::Object::InvalidSearchParametersException->throw( shift->message, ); }; my $rt = $self->rt; my @results; try { @results = $rt->search( type => $self->rt_type, query => $query, orderby => $orderby, ); } catch RT::Client::REST::InvalidQueryException with { RT::Client::REST::Object::InvalidSearchParametersException->throw; }; 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"); } } =item param($name, $value) Set an arbitrary parameter. =cut sub param { my $self = shift; unless (@_) { RT::Client::REST::Object::NoValuesProvidedException->throw; } my $name = shift; if (@_) { $self->{__param}{$name} = shift; } return $self->{__param}{$name}; } =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. =cut 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}; } } =item rt Get or set the 'rt' object, which should be of type L. =cut 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}; } =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). =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 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); =cut sub use_single_rt { my ($class, $rt) = @_; unless (UNIVERSAL::isa($rt, 'RT::Client::REST')) { RT::Client::REST::Object::InvalidValueException->throw; } no strict 'refs'; no warnings 'redefine'; *{(ref($class) || $class) . '::rt'} = sub { $rt }; } =item use_autostore Turn autostoring on and off. Autostoring 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(). =cut sub autostore {} sub use_autostore { my ($class, $autostore) = @_; no strict 'refs'; no warnings 'redefine'; *{(ref($class) || $class) . '::autostore'} = sub { $autostore }; } sub DESTROY { my $self = shift; $self->autostore && $self->can('store') && $self->store; } =item use_autoget Turn autoget 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; =cut sub autoget {} sub use_autoget { my ($class, $autoget) = @_; no strict 'refs'; no warnings 'redefine'; *{(ref($class) || $class) . '::autoget'} = sub { $autoget }; } =item use_autosync Turn autosync feature on or off (off by default). When set, every time an attribute is changed, C method is invoked. This may be pretty expensive. =cut sub autosync {} sub use_autosync { my ($class, $autosync) = @_; no strict 'refs'; no warnings 'redefine'; *{(ref($class) || $class) . '::autosync'} = sub { $autosync }; } =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. =cut sub be_transparent { my ($class, $rt) = @_; $class->use_autosync(1); $class->use_autoget(1); $class->use_single_rt($rt); } =back =head1 SEE ALSO L, L. =head1 AUTHOR Dmitri Tikhonov =cut 1; RT-Client-REST-0.45/lib/RT/Client/REST/Exception.pm0000644000175000017500000002367412240632475021255 0ustar melmothmelmoth# $Id$ # # We are going to throw exceptions, because we're cool like that. package RT::Client::REST::Exception; use base qw(Exception::Class); use strict; use warnings; use vars qw($VERSION); $VERSION = '0.19'; use Error; use Exception::Class ( 'RT::Client::REST::OddNumberOfArgumentsException' => { isa => __PACKAGE__, description => "This means that we wanted name/value pairs", }, '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 =~ /not found|\d+ does not exist|[Ii]nvalid attachment id/) { return 'RT::Client::REST::ObjectNotFoundException'; } elsif ($content =~ /not create/) { return 'RT::Client::REST::CouldNotCreateObjectException'; } elsif ($content =~ /[Uu]nknown custom field/) { return 'RT::Client::REST::UnknownCustomFieldException'; } elsif ($content =~ /[Ii]nvalid query/) { return 'RT::Client::REST::InvalidQueryException'; } elsif ($content =~ /could not be set to/) { return 'RT::Client::REST::CouldNotSetAttributeException'; } elsif ($content =~ /not a valid email address/) { return 'RT::Client::REST::InvalidEmailAddressException'; } elsif ($content =~ /is already the current value/) { return 'RT::Client::REST::AlreadyCurrentValueException'; } elsif ($content =~ /[Ii]mmutable field/) { return 'RT::Client::REST::ImmutableFieldException'; } elsif ($content =~ /[Ii]llegal value/) { return 'RT::Client::REST::IllegalValueException'; } elsif ($content =~ /[Yy]ou are not allowed/) { return 'RT::Client::REST::UnauthorizedActionException'; } elsif ($content =~ /[Yy]ou already own this ticket/ || $content =~ /[Tt]hat user already owns that ticket/) { return 'RT::Client::REST::AlreadyTicketOwnerException'; } else { 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'; push @{__PACKAGE__ . '::ISA'}, 'Exception::Class::Base'; push @Exception::Class::Base::ISA, 'Error' unless Exception::Class::Base->isa('Error'); } 1; __END__ =head1 NAME RT::Client::REST::Exception -- exceptions thrown by RT::Client::REST methods. =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 Dmitri Tikhonov =cut RT-Client-REST-0.45/lib/RT/Client/REST/Transaction.pm0000644000175000017500000001142112240632475021567 0ustar melmothmelmoth# $Id$ # # RT::Client::REST::Transaction -- transaction object representation. package RT::Client::REST::Transaction; use strict; use warnings; use vars qw($VERSION); $VERSION = 0.01; use Params::Validate qw(:types); use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.03; use base 'RT::Client::REST::Object'; sub _attributes {{ id => { 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'; *$method = sub { my $self = shift; RT::Client::REST::Object::IllegalMethodException->throw( ref($self) . " does not support '$method' method", ); }; } __PACKAGE__->_generate_methods; 1; __END__ =head1 NAME RT::Client::REST::Transaction -- this object represents a transaction. =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 referer 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 Dmitri Tikhonov =head1 LICENSE Perl license with the exception of L, which is GPLed. =cut RT-Client-REST-0.45/lib/RT/Client/REST/User.pm0000644000175000017500000001304512240632475020224 0ustar melmothmelmoth# $Id$ # # RT::Client::REST::User -- user object representation. package RT::Client::REST::User; use strict; use warnings; use vars qw($VERSION); $VERSION = 0.03; use Params::Validate qw(:types); use RT::Client::REST 0.14; use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.01; use RT::Client::REST::SearchResult 0.02; use base 'RT::Client::REST::Object'; =head1 NAME RT::Client::REST::User -- user object representation. =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. =cut 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', }, }} =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. =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. =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'. =cut sub rt_type { 'user' } =back =head1 SEE ALSO L, L, L. =head1 AUTHOR Dmitri Tikhonov =head1 LICENSE Perl license with the exception of L, which is GPLed. =cut __PACKAGE__->_generate_methods; 1; RT-Client-REST-0.45/lib/RT/Client/REST/Ticket.pm0000644000175000017500000002764512240632475020544 0ustar melmothmelmoth# $Id$ # # RT::Client::REST::Ticket -- ticket object representation. package RT::Client::REST::Ticket; use strict; use warnings; use vars qw($VERSION); $VERSION = 0.10; use Error qw(:try); use Params::Validate qw(:types); use RT::Client::REST 0.18; use RT::Client::REST::Attachment; use RT::Client::REST::Object 0.01; use RT::Client::REST::Object::Exception 0.04; use RT::Client::REST::SearchResult 0.02; use RT::Client::REST::Transaction; use base 'RT::Client::REST::Object'; =head1 NAME RT::Client::REST::Ticket -- this object represents a ticket. =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. =cut 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, }, }, 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, }, }} =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 =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 autoreply 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> (eg., 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). =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. =cut # comment and correspond are really the same method, so we save ourselves # some duplication here. for my $method (qw(comment correspond)) { no strict 'refs'; *$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; }; } =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. =cut 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, ); }, ); } =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). =cut 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, ); }, ); } =item B Take this ticket. If you already the owner of this ticket, C will be thrown. =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. =cut for my $method (qw(take untake steal)) { no strict 'refs'; *$method = sub { my $self = shift; $self->_assert_rt_and_id($method); try { $self->rt->$method(id => $self->id); } catch RT::Client::REST::AlreadyTicketOwnerException with { # Rename the exception. RT::Client::REST::Object::NoopOperationException ->throw(shift->message); }; return; }; } =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'. =cut sub rt_type { 'ticket' } =back =head1 SEE ALSO L, L, L, L, L. =head1 AUTHOR Dmitri Tikhonov =head1 LICENSE Perl license with the exception of L, which is GPLed. =cut __PACKAGE__->_generate_methods; 1; RT-Client-REST-0.45/MYMETA.json0000644000175000017500000000277212241164062015547 0ustar melmothmelmoth{ "abstract" : "talk to RT installation using REST protocol.", "author" : [ "Original /usr/bin/rt was written by Abhijit Menon-Sen . rt" ], "dynamic_config" : 0, "generated_by" : "Module::Install version 1.06, CPAN::Meta::Converter version 2.132140", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "RT-Client-REST", "no_index" : { "directory" : [ "examples", "inc", "t" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "6.36", "Test::Exception" : "0", "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.36" } }, "runtime" : { "requires" : { "DateTime" : "0", "DateTime::Format::DateParse" : "0", "Encode" : "0", "Error" : "0", "Exception::Class" : "0", "HTTP::Cookies" : "0", "HTTP::Request::Common" : "0", "LWP" : "0", "Params::Validate" : "0", "URI" : "0" } } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/RT-Client-REST/RT-Client-REST.git" } }, "version" : "0.45" } RT-Client-REST-0.45/inc/0000755000175000017500000000000012241164166014426 5ustar melmothmelmothRT-Client-REST-0.45/inc/Module/0000755000175000017500000000000012241164166015653 5ustar melmothmelmothRT-Client-REST-0.45/inc/Module/Install.pm0000644000175000017500000003013512241164061017613 0ustar melmothmelmoth#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. RT-Client-REST-0.45/inc/Module/Install/0000755000175000017500000000000012241164166017261 5ustar melmothmelmothRT-Client-REST-0.45/inc/Module/Install/Fetch.pm0000644000175000017500000000462712241164062020654 0ustar melmothmelmoth#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; RT-Client-REST-0.45/inc/Module/Install/Base.pm0000644000175000017500000000214712241164061020467 0ustar melmothmelmoth#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 RT-Client-REST-0.45/inc/Module/Install/Win32.pm0000644000175000017500000000340312241164062020514 0ustar melmothmelmoth#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; RT-Client-REST-0.45/inc/Module/Install/Makefile.pm0000644000175000017500000002743712241164061021343 0ustar melmothmelmoth#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 RT-Client-REST-0.45/inc/Module/Install/Can.pm0000644000175000017500000000615712241164062020324 0ustar melmothmelmoth#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 RT-Client-REST-0.45/inc/Module/Install/Metadata.pm0000644000175000017500000004327712241164061021346 0ustar melmothmelmoth#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; RT-Client-REST-0.45/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612241164062021345 0ustar melmothmelmoth#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; RT-Client-REST-0.45/CHANGES0000644000175000017500000004377412241162356014666 0ustar melmothmelmothRevision history for Perl module RT::Client::REST 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 "Sbastien 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: