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

[autrijus at pallas.eruditorum.org]

Author: autrijus
Date: Wed May 12 09:03:32 2004
New Revision: 877

Modified:
   RT-Client/   (props changed)
   RT-Client/lib/RT/Client.pm
   RT-Client/lib/RT/Client/Base.pm
   RT-Client/t/1-procedural.t
Log:
 ----------------------------------------------------------------------
 r4788 at not:  autrijus | 2004-05-12T13:02:51.402966Z
 
 * finished testing for ->current_user().
 * more refactoring as usual.
 ----------------------------------------------------------------------


Modified: RT-Client/lib/RT/Client.pm
==============================================================================
--- RT-Client/lib/RT/Client.pm	(original)
+++ RT-Client/lib/RT/Client.pm	Wed May 12 09:03:32 2004
@@ -23,7 +23,7 @@
 
 field path      => '/Atom/0.3/';
 field server    => 'localhost';
-field encoding  => 'utf-8';
+field encoding  => 'UTF-8';
 field 'ua';
 field 'current_user';
 field 'status';
@@ -54,7 +54,19 @@
 
 sub munge_request {
     my $req = shift;
-    $req->header( 'Accept' => 'application/x.atom+xml, application/xml, text/xml, */*' );
+    $req->header(
+        'Accept' => join(
+            ', ',
+            'application/x.atom+xml', 'application/xml', 'text/xml', '*/*',
+        )
+    );
+    $req->header(
+        'Content-Type' => join(
+            '; ',
+            ($req->content_type || 'text/plain'),
+            'charset='.$self->encoding
+        )
+    );
     $req->header( 'Accept-Charset' => $self->encoding );
     $req->header( 'X-RT-CurrentUser' => $self->current_user );
     return $req;
@@ -65,24 +77,36 @@
     entry   => 'RT::Client::Object',
 };
 
-sub describe {
-    my $res = $self->_request(@_, method => 'OPTIONS') or return undef;
+sub _spawn {
+    my $res = shift;
     $res->content =~ /<(\w+)/ or return $res->content;
 
     my $class = $self->_describe_map->{$1} or die "Sorry, type $1 not handled yet";
     return $class->new(Client => $self, Stream => \$res->content, URI => $res->base);
 }
 
+sub describe {
+    my $res = $self->_request(@_, method => 'OPTIONS') or return undef;
+    return $self->_spawn($res);
+}
+
+stub 'search';
+
 sub get {
-    my $res = $self->_request(@_, method => 'GET') or return undef;
-    $res = $self->_request(@_, method => 'GET') or return undef; # XXX - investigate cache issues
-    $res->content =~ /<(\w+)/ or return $res->content;
+    my $res = $self->_request(@_, method => 'OPTIONS'); # XXX - ditch this asap
+    $res = $self->_request(@_, method => 'GET') or return undef;
+    return $self->_spawn($res);
 }
 
 sub set {
     splice(@_, 1, 0, 'content') if (@_ == 2 and $_[0] ne 'URI');
     my $res = $self->_request(@_, method => 'PUT') or return undef;
-    $res->content =~ /<(\w+)/ or return $res->content;
+    return $self->_spawn($res);
+}
+
+sub remove {
+    my $res = $self->_request(@_, method => 'DELETE') or return undef;
+    return $self->_spawn($res);
 }
 
 sub add {
@@ -139,7 +163,7 @@
     my $res = $self->make_request($req);
     $self->status($res->code);
 
-    if ($res->code >= 400) {
+    if ($res->is_error) {
         $self->errstr($res->content);
         return;
     }

Modified: RT-Client/lib/RT/Client/Base.pm
==============================================================================
--- RT-Client/lib/RT/Client/Base.pm	(original)
+++ RT-Client/lib/RT/Client/Base.pm	Wed May 12 09:03:32 2004
@@ -42,7 +42,10 @@
 	my ($member, $action) = split(/!/, $link->title, 2);
 	next if $member =~ /^_/;
 
-	XXX("member link not handled") if $member;
+	if ($member) {
+	    next;
+	    XXX("member link not handled");
+	}
 
 	$action ||= $self->_rel_map->{$rel} or die "rel not handled: $rel";
 	$self->actions->{$action} = $link->href;

Modified: RT-Client/t/1-procedural.t
==============================================================================
--- RT-Client/t/1-procedural.t	(original)
+++ RT-Client/t/1-procedural.t	Wed May 12 09:03:32 2004
@@ -35,6 +35,8 @@
 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->get("$uri/Requestors.Count"), 1, '->get(Requestors.Count)');
+is($rt->get("$uri/Requestors/*1.Name"), 'root', '->get(Requestors/*1.Name) is root');
 
 is($rt->set("$uri.Subject", 'Set0'), 'Set0', '->set(.Subject)');
 is($rt->get("$uri.Subject"), 'Set0', '->set(.Subject) really happened');
@@ -49,26 +51,33 @@
 ok($rt->update($uri, Subject => { set => [ 'Fnord', 'Set4' ] }), '->update with set + multival');
 is($rt->get("$uri.Subject"), 'Set4', '->update really happened');
 
-exit;
-
-__END__
-my $queue = $rt->get($rt->get("$uri.QueueObj"));
-isa_ok($queue, 'RT::Client::Object');
+my $queue = $rt->get("$uri.QueueObj");
+isa_ok($queue, 'RT::Client::Object', '->QueueObj');
+is($rt->get($queue->uri.".Id"), 1, '->QueueObj has an Id');
 
 # 1.1 Independent of CLI login credentials, need ability to specify
 # "requestor" field so that replies are sent to the requestor.
 
-my $email = 'rand-' . rand() . '@example.com';
-is($ticket->Requestor->search->count, 1);
-$ticket->addRequestor($email);
-is($ticket->Requestor->search->count, 2);
+$rt->current_user('RT_System');
+$ticket = $rt->add('Tickets', Queue => 1, Subject => 'By System');
+is($rt->current_user, 'RT_System', 'current_user persists over a request');
+$rt->current_user($rt->username);
+
+isa_ok($ticket, 'RT::Client::Object');
+$uri = $ticket->uri;
+isnt($uri, undef, 'New Ticket has a URI: '.$uri);
+is($rt->get("$uri/Requestors/*1.Name"), 'RT_System', '->get(Requestors/*1.Name) is RT_System');
 
 # 1.2 Ability to post a ticket to a specific queue.
 
-$ticket = $queue->Tickets->add( Subject => 'Testing' );
+$ticket = $rt->add('Tickets', Queue => 'General', Subject => 'Queue ByName');
 isa_ok($ticket, 'RT::Client::Object');
-is($ticket->Subject, 'Testing');
+$uri = $ticket->uri;
+isnt($uri, undef, 'New Ticket has a URI: '.$uri);
+is($rt->get("$uri.Queue"), 1, 'posted to the 1st queue');
 
+exit;
+__END__
 # 1.3 Ability to specify message body. May contain utf8 OR localized
 # charset.