[Rt-commit] [svn] r869 - in RT-Client: . lib/RT lib/RT/Client t

autrijus at pallas.eruditorum.org autrijus at pallas.eruditorum.org
Tue May 11 15:47:28 EDT 2004


Author: autrijus
Date: Tue May 11 15:47:28 2004
New Revision: 869

Modified:
   RT-Client/   (props changed)
   RT-Client/lib/RT/Client.pm
   RT-Client/lib/RT/Client/Container.pm
   RT-Client/t/1-procedural.t
Log:
 ----------------------------------------------------------------------
 r4782 at not:  autrijus | 2004-05-11T19:47:22.387626Z
 
 * PUT with content now works.
 ----------------------------------------------------------------------


Modified: RT-Client/lib/RT/Client.pm
==============================================================================
--- RT-Client/lib/RT/Client.pm	(original)
+++ RT-Client/lib/RT/Client.pm	Tue May 11 15:47:28 2004
@@ -66,9 +66,7 @@
 };
 
 sub describe {
-    my $res = $self->_request(@_, _method => 'OPTIONS') or return;
-
-    # spawn a new object based on the $res type
+    my $res = $self->_request(@_, method => 'OPTIONS') or return;
     $res->content =~ /<(\w+)/ or return $res->content;
 
     my $class = $self->_describe_map->{$1} or die "Sorry, type $1 not handled yet";
@@ -76,9 +74,13 @@
 }
 
 sub get {
-    my $res = $self->_request(@_, _method => 'GET') or return;
+    my $res = $self->_request(@_, method => 'GET') or return;
+    $res->content =~ /<(\w+)/ or return $res->content;
+}
 
-    # spawn a new object based on the $res type
+sub set {
+    splice(@_, 1, 0, 'content') if (@_ == 2 and $_[0] ne 'URI');
+    my $res = $self->_request(@_, method => 'PUT') or return;
     $res->content =~ /<(\w+)/ or return $res->content;
 }
 
@@ -97,7 +99,7 @@
 sub _request {
     my ($uri, %args) = $self->_parse_args(@_);
 
-    my $method = delete $args{_method};
+    my $method = delete $args{method};
     my $req;
 
     if ($method eq 'POST') {
@@ -105,6 +107,7 @@
     }
     else {
         $req = HTTP::Request::Common::_simple_req($method => $uri);
+        $req->content(delete $args{content}) if exists $args{content};
     }
 
     my $res = $self->make_request($req);

Modified: RT-Client/lib/RT/Client/Container.pm
==============================================================================
--- RT-Client/lib/RT/Client/Container.pm	(original)
+++ RT-Client/lib/RT/Client/Container.pm	Tue May 11 15:47:28 2004
@@ -12,7 +12,7 @@
 
 sub add {
     my $uri = $self->actions->{add};
-    my $res = $self->client->_request($uri, @_, _method => 'POST') or return;
+    my $res = $self->client->_request($uri, @_, method => 'POST') or return;
     return $self->client->describe($res->header('Location'));
 }
 

Modified: RT-Client/t/1-procedural.t
==============================================================================
--- RT-Client/t/1-procedural.t	(original)
+++ RT-Client/t/1-procedural.t	Tue May 11 15:47:28 2004
@@ -11,31 +11,7 @@
 my $rt = RT::Client->new('http://root:password@localhost');
 isa_ok($rt, 'RT::Client', 'Client');
 
-# some way to RaiseError!
-
-=begin comment
-
-Goal: Do the possibly most simple thing.
-
-$rt->add('Tickets') means:
-    - my $obj = $rt->describe('Tickets');
-              ==> OPTIONS /Atom/0.3/Tickets
-              <== PostURI: (ditto)
-      $obj ~~ { actions => { add => '/Atom/0.3/Tickets' }, schema... }
-      ref($obj) eq RT::Client::Container
-    - $obj->add('Tickets')
-              ==> POST $obj->{actions}{add}
-	          url-encoded ''
-					- $Ticket->Create()
-					- returns: (0, 0, errstr)
-              <== 400
-	          errstr
-      $obj->status == 400
-      $obj->errstr == 'Cannot create ticket', etc
-
-FIRST MAKE THIS WORK, THEN THINK ABOUT OTHERS.
-
-=cut
+# XXX - Some way to RaiseError
 
 # Requirements:
 # 1. Ticket Creation and Modification via an External Interface
@@ -56,15 +32,15 @@
 my $uri = $ticket->uri;
 isnt($uri, undef, 'New Ticket has a URI: '.$uri);
 
-is($rt->get(URI => "$uri.Subject"), 'Testing', '.Subject works');
-is($rt->get("$uri.Subject"), 'Testing', '.Subject works');
-is($rt->get("$uri.Queue"), 1, '.Queue works');
+is($rt->get(URI => "$uri.Subject"), 'Testing', '->get(URI => .Subject)');
+is($rt->get("$uri.Subject"), 'Testing', '->get(.Subject)');
+is($rt->get("$uri.Queue"), 1, '->get(.Queue)');
+
+is($rt->set("$uri.Subject", 'Set0'), 'Set0', '->set(.Subject)');
 
-exit;
 __END__
 
 # exercise different update syntaxes
-is($rt->set("$uri.Subject", 'Set0'), 'Set0');
 is($rt->update($uri, Subject => 'Set1'), 'Set1');
 is($rt->update($uri, Subject => [ 'Fnord', 'Set2' ]), 'Set2');
 is($rt->update($uri, Subject => { set => 'Set3' }), 'Set3');


More information about the Rt-commit mailing list