[Rt-commit] [svn] r870 - in RT-Client: . lib/RT lib/RT/Client t
autrijus at pallas.eruditorum.org
autrijus at pallas.eruditorum.org
Tue May 11 16:42:29 EDT 2004
Author: autrijus
Date: Tue May 11 16:42:29 2004
New Revision: 870
Modified:
RT-Client/ (props changed)
RT-Client/lib/RT/Client.pm
RT-Client/lib/RT/Client/Base.pm
RT-Client/lib/RT/Client/Container.pm
RT-Client/lib/RT/Client/Object.pm
RT-Client/t/1-procedural.t
Log:
----------------------------------------------------------------------
r4785 at not: autrijus | 2004-05-11T20:42:23.111262Z
* basic "update" 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 16:42:29 2004
@@ -14,10 +14,10 @@
use XML::Atom::Client;
use LWP::UserAgent::AtomClient;
-use RT::Client::Object;
-use RT::Client::Property;
-use RT::Client::Container;
-use RT::Client::ResultSet;
+use RT::Client::Object ();
+use RT::Client::Property ();
+use RT::Client::Container ();
+use RT::Client::ResultSet ();
*XXX = *Spiffy::XXX;
@@ -66,7 +66,7 @@
};
sub describe {
- my $res = $self->_request(@_, method => 'OPTIONS') or return;
+ my $res = $self->_request(@_, method => 'OPTIONS') or return undef;
$res->content =~ /<(\w+)/ or return $res->content;
my $class = $self->_describe_map->{$1} or die "Sorry, type $1 not handled yet";
@@ -74,19 +74,27 @@
}
sub get {
- my $res = $self->_request(@_, method => 'GET') or return;
+ 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;
}
sub set {
splice(@_, 1, 0, 'content') if (@_ == 2 and $_[0] ne 'URI');
- my $res = $self->_request(@_, method => 'PUT') or return;
+ my $res = $self->_request(@_, method => 'PUT') or return undef;
$res->content =~ /<(\w+)/ or return $res->content;
}
sub add {
my ($uri, %args) = $self->_parse_args(@_);
- return $self->describe($uri)->add(%args);
+ my $container = $self->describe($uri) or return undef;
+ return $container->add(%args);
+}
+
+sub update {
+ my ($uri, %args) = $self->_parse_args(@_);
+ my $object = $self->describe($uri) or return undef;
+ return $object->update(%args);
}
sub _parse_args {
@@ -103,6 +111,24 @@
my $req;
if ($method eq 'POST') {
+ foreach my $key (sort keys %args) {
+ next unless UNIVERSAL::isa($args{$key}, 'HASH');
+ my $val = delete $args{$key};
+ while (my ($k, $v) = each %$val) {
+ my $new_key = "$key-$k";
+ foreach my $new_val (UNIVERSAL::isa($v, 'ARRAY') ? @$v : $v) {
+ if (exists $args{$new_key}) {
+ if (UNIVERSAL::isa($args{$new_key}, 'ARRAY')) {
+ push @{$args{$new_key}}, $new_val;
+ next;
+ }
+ $args{$new_key} = [ $args{$new_key}, $new_val ];
+ next;
+ }
+ $args{$new_key} = [ $new_val ];
+ }
+ }
+ }
$req = HTTP::Request::Common::POST($uri, \%args);
}
else {
Modified: RT-Client/lib/RT/Client/Base.pm
==============================================================================
--- RT-Client/lib/RT/Client/Base.pm (original)
+++ RT-Client/lib/RT/Client/Base.pm Tue May 11 16:42:29 2004
@@ -36,4 +36,21 @@
return $self;
}
+sub _init_links {
+ foreach my $link ($self->link) {
+ my $rel = $link->rel;
+ my ($member, $action) = split(/!/, $link->title, 2);
+ next if $member =~ /^_/;
+
+ XXX("member link not handled") if $member;
+
+ $action ||= $self->_rel_map->{$rel} or die "rel not handled: $rel";
+ $self->actions->{$action} = $link->href;
+ }
+}
+
+sub _action {
+ $self->actions->{$_[0]} or die "Cannot find '$_[0]' URI for $self";
+}
+
1;
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 16:42:29 2004
@@ -10,32 +10,17 @@
include RT::Client::Base;
our @ISA = 'XML::Atom::Feed';
+const _rel_map => {
+ 'service.post' => 'add',
+ 'service.feed' => 'search',
+};
+
sub add {
- my $uri = $self->actions->{add};
- my $res = $self->client->_request($uri, @_, method => 'POST') or return;
+ my $uri = $self->_action('add');
+ my $res = $self->client->_request($uri, @_, method => 'POST') or return undef;
return $self->client->describe($res->header('Location'));
}
-sub _init_links {
- foreach my $link ($self->link) {
- my $rel = $link->rel;
- my ($member, $action) = split(/!/, $link->title, 2);
- next if $member =~ /^_/;
-
- XXX("member link not handled") if $member;
-
- if ($rel eq 'service.post') {
- $self->actions->{$action || 'add'} = $link->href;
- }
- elsif ($rel eq 'service.feed') {
- $self->actions->{$action || 'search'} = $link->href;
- }
- else {
- XXX("rel not handled: $rel");
- }
- }
-}
-
sub _init_entries {
foreach my $entry ($self->entries) {
if ($entry->id) {
Modified: RT-Client/lib/RT/Client/Object.pm
==============================================================================
--- RT-Client/lib/RT/Client/Object.pm (original)
+++ RT-Client/lib/RT/Client/Object.pm Tue May 11 16:42:29 2004
@@ -10,4 +10,16 @@
include RT::Client::Base;
our @ISA = 'XML::Atom::Entry';
+const _rel_map => {
+ 'service.post' => 'update',
+};
+
+sub update {
+ my $uri = $self->_action('update');
+ my $res = $self->client->_request($uri, @_, method => 'POST') or return undef;
+
+ # XXX - parse the update result
+ return $res->content;
+}
+
1;
Modified: RT-Client/t/1-procedural.t
==============================================================================
--- RT-Client/t/1-procedural.t (original)
+++ RT-Client/t/1-procedural.t Tue May 11 16:42:29 2004
@@ -37,15 +37,21 @@
is($rt->get("$uri.Queue"), 1, '->get(.Queue)');
is($rt->set("$uri.Subject", 'Set0'), 'Set0', '->set(.Subject)');
-
-__END__
+is($rt->get("$uri.Subject"), 'Set0', '->set(.Subject) really happened');
# exercise different update syntaxes
-is($rt->update($uri, Subject => 'Set1'), 'Set1');
-is($rt->update($uri, Subject => [ 'Fnord', 'Set2' ]), 'Set2');
-is($rt->update($uri, Subject => { set => 'Set3' }), 'Set3');
-is($rt->update($uri, Subject => { set => [ 'Fnord', 'Set4' ] }), 'Set4');
+ok($rt->update($uri, Subject => 'Set1'), '->update');
+is($rt->get("$uri.Subject"), 'Set1', '->update really happened');
+ok($rt->update($uri, Subject => ['Fnord', 'Set2']), '->update with multival');
+is($rt->get("$uri.Subject"), 'Set2', '->update really happened');
+ok($rt->update($uri, Subject => { set => 'Set3' }), '->update with explicit set');
+is($rt->get("$uri.Subject"), 'Set3', '->update really happened');
+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');
More information about the Rt-commit
mailing list