[Rt-commit] [svn] r867 - in RT-Client: . lib/LWP lib/LWP/Authen
lib/LWP/UserAgent lib/RT lib/RT/Client t
autrijus at pallas.eruditorum.org
autrijus at pallas.eruditorum.org
Tue May 11 15:19:11 EDT 2004
Author: autrijus
Date: Tue May 11 15:19:11 2004
New Revision: 867
Added:
RT-Client/lib/LWP/
RT-Client/lib/LWP/Authen/
RT-Client/lib/LWP/Authen/Wsse.pm
RT-Client/lib/LWP/UserAgent/
RT-Client/lib/LWP/UserAgent/AtomClient.pm
RT-Client/lib/RT/Client/
RT-Client/lib/RT/Client/Base.pm
RT-Client/lib/RT/Client/Container.pm
RT-Client/lib/RT/Client/Object.pm
RT-Client/lib/RT/Client/Property.pm
RT-Client/lib/RT/Client/ResultSet.pm
RT-Client/t/1-procedural.t
Modified:
RT-Client/ (props changed)
RT-Client/META.yml
RT-Client/Makefile.PL
RT-Client/lib/RT/Client.pm
RT-Client/t/spec.t
Log:
----------------------------------------------------------------------
r4763 at not: autrijus | 2004-05-11T16:59:02.152256Z
* use Spiffy as our class framework.
* refactor tests to 1-procedural.t first.
----------------------------------------------------------------------
r4764 at not: autrijus | 2004-05-11T17:30:00.725671Z
* creation failure passed.
----------------------------------------------------------------------
r4765 at not: autrijus | 2004-05-11T18:15:01.449456Z
* creates a real ticket.
----------------------------------------------------------------------
r4768 at not: autrijus | 2004-05-11T19:19:02.411349Z
* Snapshot: "get" and "add" and "describe" now work in 1-procedural.t.
----------------------------------------------------------------------
Modified: RT-Client/META.yml
==============================================================================
--- RT-Client/META.yml (original)
+++ RT-Client/META.yml Tue May 11 15:19:11 2004
@@ -8,6 +8,7 @@
Text::ParseWords: 0
HTTP::Request::Common: 0
XML::Atom: 0.05
+ Spiffy: 0.16
no_index:
directory:
- inc
Modified: RT-Client/Makefile.PL
==============================================================================
--- RT-Client/Makefile.PL (original)
+++ RT-Client/Makefile.PL Tue May 11 15:19:11 2004
@@ -1,5 +1,6 @@
#!/usr/bin/perl
+use strict;
use inc::Module::Install;
name ('RT-Client');
@@ -9,11 +10,14 @@
version ('0.02');
install_script ('bin/rt');
-requires(
- Text::ParseWords => '0',
- HTTP::Request::Common => '0',
- XML::Atom => '0.05',
-);
+requires(qw(
+ Text::ParseWords 0
+ HTTP::Request::Common 0
+ XML::Atom 0.05
+ Spiffy 0.16
+ Filter::Include 1.4
+));
+
include('ExtUtils::AutoInstall');
auto_install();
Added: RT-Client/lib/LWP/Authen/Wsse.pm
==============================================================================
--- (empty file)
+++ RT-Client/lib/LWP/Authen/Wsse.pm Tue May 11 15:19:11 2004
@@ -0,0 +1,61 @@
+package LWP::Authen::Wsse;
+use strict;
+
+require Digest::MD5;
+require Digest::SHA1;
+require MIME::Base64;
+
+sub authenticate {
+ my($class, $ua, $proxy, $auth_param, $response,
+ $request, $arg, $size) = @_;
+
+ my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm},
+ $request->url, $proxy);
+ return $response unless defined $user and defined $pass;
+
+ my $nonce = $class->make_nonce;
+ my $nonce_enc = MIME::Base64::encode_base64($nonce, '');
+ my $now = DateTime->now->iso8601 . 'Z';
+ my $digest = MIME::Base64::encode_base64(
+ Digest::SHA1::sha1($nonce . $now . ($pass || '')), ''
+ );
+
+ my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
+ my $wsse_value = sprintf(
+ qq(UsernameToken Username="%s", PasswordDigest="%s", Nonce="%s", Created="%s"),
+ $user || '',
+ $digest,
+ $nonce_enc,
+ $now,
+ );
+
+ my $referral = $request->clone;
+
+ # Need to check this isn't a repeated fail!
+ my $r = $response;
+ while ($r) {
+ my $wsse = $r->request->header('X-WSSE');
+ if ($wsse && $wsse eq $wsse_value) {
+ # here we know this failed before
+ $response->header("Client-Warning" =>
+ "Credentials for '$user' failed before");
+ return $response;
+ }
+ $r = $r->previous;
+ }
+
+ $referral->header($auth_header, 'WSSE profile="UsernameToken"');
+ $referral->header('X-WSSE' => $wsse_value);
+
+ # we shouldn't really do this, but...
+ $referral->{digest_user_pass} = [$user, $pass];
+
+ return $ua->request($referral, $arg, $size, $response);
+}
+
+sub make_nonce {
+ my $app = shift;
+ Digest::SHA1::sha1(Digest::SHA1::sha1(time() . {} . rand() . $$));
+}
+
+1;
Added: RT-Client/lib/LWP/UserAgent/AtomClient.pm
==============================================================================
--- (empty file)
+++ RT-Client/lib/LWP/UserAgent/AtomClient.pm Tue May 11 15:19:11 2004
@@ -0,0 +1,35 @@
+package LWP::UserAgent::AtomClient;
+
+use strict;
+our @ISA = 'LWP::UserAgent';
+require Digest::MD5;
+require LWP::UserAgent;
+
+my %ClientOf;
+
+sub new {
+ my ($class, $client) = @_;
+ my $ua = $client->{ua};
+ my $new_ua = bless($ua, $class);
+ $ClientOf{$new_ua} = $client;
+ return $new_ua;
+}
+
+sub get_basic_credentials {
+ my ($self, $realm, $url, $proxy) = @_;
+ my $client = $ClientOf{$self} or die "Cannot find $self";
+ return $client->username, Digest::MD5::md5_hex(
+ join(':',
+ $client->username,
+ $realm,
+ Digest::MD5::md5_hex($client->password)
+ )
+ );
+}
+
+sub DESTROY {
+ my $self = shift;
+ delete $ClientOf{$self};
+}
+
+1;
Modified: RT-Client/lib/RT/Client.pm
==============================================================================
--- RT-Client/lib/RT/Client.pm (original)
+++ RT-Client/lib/RT/Client.pm Tue May 11 15:19:11 2004
@@ -8,10 +8,119 @@
use strict;
use warnings;
-use HTTP::Request;
+use Spiffy '-Base';
+use URI;
+use HTTP::Request::Common;
use XML::Atom::Client;
+use LWP::UserAgent::AtomClient;
-use Digest::MD5 qw( md5_hex );
+use RT::Client::Object;
+use RT::Client::Property;
+use RT::Client::Container;
+use RT::Client::ResultSet;
+
+*XXX = *Spiffy::XXX;
+
+field path => '/Atom/0.3/';
+field server => 'localhost';
+field encoding => 'utf-8';
+field 'ua';
+field 'current_user';
+field 'status';
+field 'errstr';
+
+sub new {
+ my %args = (@_ % 2) ? (URI => @_) : @_;
+
+ if (my $uri = delete $args{URI}) {
+ require URI;
+ $uri = URI->new($uri);
+ @args{'Username', 'Password'} = split(/:/, $uri->userinfo||'', 2);
+ $args{Server} = $uri->scheme . '://' .$uri->host_port;
+ $args{Path} = ($uri->path =~ m{^/*$}) ? undef : $uri->path;
+ }
+
+ my $rv = $self->SUPER::new(%args);
+
+ foreach my $attr (qw( username password server path )) {
+ $rv->$attr($args{"\u$attr"}) if defined $args{"\u$attr"};
+ }
+
+ $rv->ua( LWP::UserAgent::AtomClient->new($rv) );
+ $rv->ua->{requests_redirectable} = [ qw( GET HEAD OPTIONS ) ];
+
+ return $rv;
+}
+
+sub munge_request {
+ my $req = shift;
+ $req->header( 'Accept' => 'application/x.atom+xml, application/xml, text/xml, */*' );
+ $req->header( 'Accept-Charset' => $self->encoding );
+ $req->header( 'X-RT-CurrentUser' => $self->current_user );
+ return $req;
+}
+
+const _describe_map => {
+ feed => 'RT::Client::Container',
+ entry => 'RT::Client::Object',
+};
+
+sub describe {
+ my $res = $self->_request(@_, _method => 'OPTIONS') or return;
+
+ # spawn a new object based on the $res type
+ $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 get {
+ my $res = $self->_request(@_, _method => 'GET') or return;
+
+ # spawn a new object based on the $res type
+ $res->content =~ /<(\w+)/ or return $res->content;
+}
+
+sub add {
+ my ($uri, %args) = $self->_parse_args(@_);
+ return $self->describe($uri)->add(%args);
+}
+
+sub _parse_args {
+ my %args = (@_ % 2) ? (URI => @_) : @_;
+ my $uri = delete $args{URI} or die "Must pass a URI";
+ $uri = URI->new_abs( $uri, join('/', $self->server . $self->path) );
+ return($uri, %args);
+}
+
+sub _request {
+ my ($uri, %args) = $self->_parse_args(@_);
+
+ my $method = delete $args{_method};
+ my $req;
+
+ if ($method eq 'POST') {
+ $req = HTTP::Request::Common::POST($uri, \%args);
+ }
+ else {
+ $req = HTTP::Request::Common::_simple_req($method => $uri);
+ }
+
+ my $res = $self->make_request($req);
+ $self->status($res->code);
+
+ if ($res->code >= 400) {
+ $self->errstr($res->content);
+ return;
+ }
+
+ return $res;
+}
+
+1;
+
+__END__
=head1 NAME
@@ -61,6 +170,8 @@
=cut
BEGIN {
+ no strict 'refs';
+
my @delegate_map = qw(
add createEntry
remove deleteEntry
@@ -72,13 +183,10 @@
describe getDescription
);
while (my ($key, $value) = splice(@delegate_map, 0, 2)) {
- my $method = "SUPER::$value";
-
- no strict 'refs';
- *$key = sub {
+ *{"_$key"} = sub {
my $self = shift;
my %args = (@_ > 1) ? @_ : (URI => $_[0]);
- return $self->can($method)->(
+ return $self->can($value)->(
$self,
$self->server_uri($args{URI}),
%args,
@@ -87,104 +195,22 @@
}
}
-sub new {
- my $class = shift;
- unshift @_, 'URI' if @_ == 1;
-
- my %args = @_;
- if (my $uri = delete $args{URI}) {
- require URI;
- $uri = URI->new($uri);
- @args{'Username', 'Password'} = split(/:/, $uri->userinfo||'', 2);
- $args{Server} = $uri->scheme . '://' .$uri->host_port;
- $args{Path} = ($uri->path =~ m{^/+$}) ? '' : $uri->path;
- }
-
- my $self = $class->SUPER::new(%args);
-
- $self->username($args{Username}) if defined $args{Username};
- $self->password($args{Password}) if defined $args{Password};
- $self->server($args{Server}) if defined $args{Server};
- $self->path($args{Path}) if defined $args{Path};
-
- $self->{ua} = LWP::UserAgent::AtomClient->new($self);
-
- return $self;
-}
-
-sub path {
- my $self = shift;
- $self->{path} = shift if @_;
- return $self->{path} || '/Atom/0.3';
-}
-
-sub current_user {
- my $self = shift;
- $self->{current_user} = shift if @_;
- return $self->{current_user};
-}
-
-sub encoding {
- my $self = shift;
- $self->{encoding} = shift if @_;
- return $self->{encoding};
-}
-
-sub server {
- my $self = shift;
- $self->{server} = shift if @_;
- return $self->{server};
-}
-
-sub server_uri {
- my $self = shift;
- return join('/', $self->server . $self->path, @_ ? @_ : '');
-}
-
-sub munge_request {
- my ($self, $req) = @_;
- $req->header(
- Accept => 'application/x.atom+xml, application/xml, text/xml, */*',
- );
- $req->header(
- 'X-RT-CurrentUser' => $self->current_user,
- );
- $req->header(
- 'Accept-Charset' => $self->encoding,
- );
- return $req;
+sub get {
+ $self->_get(@_);
}
sub munge_response {
- my ($self, $res) = @_;
-
+ my $res = shift;
$self->current_user($res->header( 'X-RT-CurrentUser' ));
return $self->SUPER::munge_response($res);
}
-# For example, the main page has following links:
-#
-# Groups-feed http://localhost/Atom/0.3/RT-Groups
-# Groups-post http://localhost/Atom/0.3/RT-Groups!add
-#
-# Hence the {links} hash will contain:
-#
-# $rt->{links} = {
-# Groups => bless(
-# {
-# uri => 'http://localhost/Atom/0.3/RT-Groups'
-# actions => {
-# add => 'http://localhost/Atom/0.3/RT-Groups!add'
-# }
-# },
-# 'RT::Client::Container'
-# ),
-# }
-
+sub top {
+ RT::Client::Container->new( client => $self, uri => '/' );
+}
our $AUTOLOAD;
sub AUTOLOAD {
- my $self = shift;
$AUTOLOAD =~ s/.*:://;
my $links = $self->{links} ||= {};
$self->munge_links($links) unless $links->{$AUTOLOAD};
@@ -192,105 +218,7 @@
}
sub munge_links {
- my ($self, $links) = @_;
-}
-
-package LWP::UserAgent::AtomClient;
-
-use strict;
-our @ISA = 'LWP::UserAgent';
-require Digest::MD5;
-require LWP::UserAgent;
-
-my %ClientOf;
-
-sub new {
- my ($class, $client) = @_;
- my $ua = $client->{ua};
- my $new_ua = bless($ua, $class);
- $ClientOf{$new_ua} = $client;
- return $new_ua;
-}
-
-sub get_basic_credentials {
- my ($self, $realm, $url, $proxy) = @_;
- my $client = $ClientOf{$self} or die "Cannot find $self";
- return $client->username, Digest::MD5::md5_hex(
- join(':',
- $client->username,
- $realm,
- Digest::MD5::md5_hex($client->password)
- )
- );
-}
-
-sub DESTROY {
- my $self = shift;
- delete $ClientOf{$self};
-}
-
-package LWP::Authen::Wsse;
-use strict;
-
-require Digest::MD5;
-require Digest::SHA1;
-require MIME::Base64;
-
-sub authenticate {
- my($class, $ua, $proxy, $auth_param, $response,
- $request, $arg, $size) = @_;
-
- my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm},
- $request->url, $proxy);
- return $response unless defined $user and defined $pass;
-
- my $nonce = $class->make_nonce;
- my $nonce_enc = MIME::Base64::encode_base64($nonce, '');
- my $now = DateTime->now->iso8601 . 'Z';
- my $digest = MIME::Base64::encode_base64(
- Digest::SHA1::sha1($nonce . $now . ($pass || '')), ''
- );
-
- my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
- my $wsse_value = sprintf(
- qq(UsernameToken Username="%s", PasswordDigest="%s", Nonce="%s", Created="%s"),
- $user || '',
- $digest,
- $nonce_enc,
- $now,
- );
-
- my $referral = $request->clone;
-
- # Need to check this isn't a repeated fail!
- my $r = $response;
- while ($r) {
- my $wsse = $r->request->header('X-WSSE');
- if ($wsse && $wsse eq $wsse_value) {
- # here we know this failed before
- $response->header("Client-Warning" =>
- "Credentials for '$user' failed before");
- return $response;
- }
- $r = $r->previous;
- }
-
- $referral->header($auth_header, 'WSSE profile="UsernameToken"');
- $referral->header('X-WSSE' => $wsse_value);
-
- # we shouldn't really do this, but...
- $referral->{digest_user_pass} = [$user, $pass];
-
- return $ua->request($referral, $arg, $size, $response);
-}
-
-sub make_nonce {
- my $app = shift;
- Digest::SHA1::sha1(Digest::SHA1::sha1(time() . {} . rand() . $$));
+ my $links = shift;
}
1;
-
-my $rt = RT::Client->new('http://root:password@localhost/');
-print $rt->search('Queues');#->as_xml;
-
Added: RT-Client/lib/RT/Client/Base.pm
==============================================================================
--- (empty file)
+++ RT-Client/lib/RT/Client/Base.pm Tue May 11 15:19:11 2004
@@ -0,0 +1,39 @@
+# Yes, the lack of a 'package' is deliberate.
+
+use strict;
+use warnings;
+
+field 'uri';
+field 'doc';
+field 'client';
+
+field members => {};
+field actions => {};
+field prototypes => {};
+
+*XXX = *Spiffy::XXX;
+
+sub status { $self->client->status(@_) }
+sub errstr { $self->client->errstr(@_) }
+
+sub new {
+ my %args = @_;
+ my $rv = $args{Stream} ? $self->SUPER::new(%args) : {};
+ bless($rv, $self);
+
+ $rv->uri($args{URI}) or die 'Missing URI';
+ $rv->client($args{Client}) or die 'Missing Client';
+
+ return $rv;
+}
+
+sub init {
+ $self->SUPER::init(@_);
+ return if $self->{init}++;
+
+ $self->_init_links;
+ $self->_init_entries;
+ return $self;
+}
+
+1;
Added: RT-Client/lib/RT/Client/Container.pm
==============================================================================
--- (empty file)
+++ RT-Client/lib/RT/Client/Container.pm Tue May 11 15:19:11 2004
@@ -0,0 +1,61 @@
+package RT::Client::Container;
+
+use strict;
+use warnings;
+use Filter::Include;
+use Spiffy '-Base';
+use XML::Simple ();
+use XML::Atom::Feed;
+
+include RT::Client::Base;
+our @ISA = 'XML::Atom::Feed';
+
+sub add {
+ my $uri = $self->actions->{add};
+ my $res = $self->client->_request($uri, @_, _method => 'POST') or return;
+ 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) {
+ $self->_init_entry($entry);
+ }
+ else {
+ $self->_init_entry_prototype($entry);
+ }
+ }
+}
+
+stub '_init_entry';
+
+sub _init_entry_prototype {
+ my $entry = shift;
+ my $body = XML::Simple::XMLin($entry->content->body);
+ my $action = delete($body->{action}) or die "No action specified";
+
+ $self->prototypes->{$action} = $body;
+}
+
+1;
+
Added: RT-Client/lib/RT/Client/Object.pm
==============================================================================
--- (empty file)
+++ RT-Client/lib/RT/Client/Object.pm Tue May 11 15:19:11 2004
@@ -0,0 +1,13 @@
+package RT::Client::Object;
+
+use strict;
+use warnings;
+use Filter::Include;
+use Spiffy '-Base';
+use XML::Simple ();
+use XML::Atom::Entry;
+
+include RT::Client::Base;
+our @ISA = 'XML::Atom::Entry';
+
+1;
Added: RT-Client/lib/RT/Client/Property.pm
==============================================================================
--- (empty file)
+++ RT-Client/lib/RT/Client/Property.pm Tue May 11 15:19:11 2004
@@ -0,0 +1,9 @@
+package RT::Client::Property;
+
+use strict;
+use warnings;
+
+use Spiffy '-Base';
+use XML::Simple ();
+
+1;
Added: RT-Client/lib/RT/Client/ResultSet.pm
==============================================================================
--- (empty file)
+++ RT-Client/lib/RT/Client/ResultSet.pm Tue May 11 15:19:11 2004
@@ -0,0 +1,11 @@
+package RT::Client::ResultSet;
+
+use strict;
+use warnings;
+
+our @ISA = qw( XML::Atom::Feed );
+use Spiffy '-Base';
+use XML::Simple ();
+use XML::Atom::Feed;
+
+1;
Added: RT-Client/t/1-procedural.t
==============================================================================
--- (empty file)
+++ RT-Client/t/1-procedural.t Tue May 11 15:19:11 2004
@@ -0,0 +1,157 @@
+#!/usr/bin/perl
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::More 'no_plan';
+
+$SIG{__WARN__} = sub { use Carp; Carp::cluck(@_) };
+$SIG{__DIE__} = sub { use Carp; Carp::confess(@_) };
+
+use_ok('RT::Client');
+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
+
+# Requirements:
+# 1. Ticket Creation and Modification via an External Interface
+
+my $tickets = $rt->describe('Tickets');
+isa_ok($tickets, 'RT::Client::Container', '->describe($uri)');
+isnt($tickets->uri, undef, 'Tickets has a URI: '.$tickets->uri);
+isa_ok($rt->describe(URI => 'Tickets'), 'RT::Client::Container', '->describe(URI => $uri)');
+is($rt->errstr, undef, 'Nothing bad had happened yet');
+is($rt->status, 200, 'Status code is 200');
+is($rt->add('Tickets'), undef, 'Adding an empty ticket shall fail');
+is($rt->status, 400, 'Status code is 400');
+isnt($rt->errstr, undef, 'Error message is in ->errstr: '. $rt->errstr);
+
+my $ticket = $rt->add('Tickets', Queue => 1, Subject => 'Testing');
+isa_ok($ticket, 'RT::Client::Object');
+
+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');
+
+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');
+is($rt->update($uri, Subject => { set => [ 'Fnord', 'Set4' ] }), 'Set4');
+
+my $queue = $rt->get($rt->get("$uri.QueueObj"));
+isa_ok($queue, 'RT::Client::Object');
+
+# 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);
+
+# 1.2 Ability to post a ticket to a specific queue.
+
+$ticket = $queue->Tickets->add( Subject => 'Testing' );
+isa_ok($ticket, 'RT::Client::Object');
+is($ticket->Subject, 'Testing');
+
+# 1.3 Ability to specify message body. May contain utf8 OR localized
+# charset.
+
+$ticket->_encoding('hz');
+is($ticket->_encoding, $rt->encoding, '->_encoding is global');
+$ticket->setSubject('~{1jLb~}');
+$ticket->_encoding('gbk');
+is(length($ticket->Subject), 4);
+$ticket->_encoding('utf-8');
+
+# 1.4 Ability to set values in n existing custom fields.
+
+my $cf = $queue->CustomFields->add(
+ Name => 'CFTest',
+ Type => 'SelectSingle',
+);
+
+$cf->addValues( Name => 'foo', Description => 'Foo Option' );
+
+# 1.5 Ability to set values in "Select One Value" and "Enter One Value"
+# -type custom fields
+
+# RT-Tickets/5/CustomFieldValues/9/1.Content
+# RT-Tickets/5/CustomFieldValues/9/1.Content
+$ticket->CustomFieldValues($cf)->set( Content => 'foo');
+
+is($ticket->CustomFieldsValues($cf)->count, 1);
+is($ticket->CustomFieldsValues($cf)->first->Content, 'foo');
+
+# 1.6 For modifications, need to identify ticket number. We'd prefer to
+# identify modifying user as well if possible.
+
+my $id = $ticket->Id;
+$rt->current_user('Nobody');
+is($ticket->_current_user, $rt->current_user, '->_current_user is global');
+$rt->Tickets($id)->comment( Content => "Hello!" );
+$rt->current_user($rt->username);
+
+# 2. Ability to Close a Ticket via an External Interface
+
+$ticket->setStatus('resolved');
+
+# 2.1 Ability to close a ticket based on ticket number. We'd prefer to
+# identify closing user as well if possible.
+
+$ticket->current_user('Nobody');
+$ticket->comment( Content => 'reopen!' );
+is($ticket->Status, 'open');
+$ticket->setStatus('resolved');
+$ticket->current_user($rt->username);
+
+# 3. General CLI Requirements
+
+# 3.1 Error Responses: CLI must return status and error responses
+# instead of end-user help text.
+
+$ticket->setStatus('open');
+is($rt->_status, 200);
+is($ticket->_status, 200);
+$ticket->setOwner('no_such_user' . rand());
+is($rt->_status, 200);
+is($ticket->_status, 400);
+isnt($ticket->_errstr, undef);
+
+# 3.2 Environment: Support perl 5.6.1.
+
+cmp_ok($], '>=', 5.006001);
+
Modified: RT-Client/t/spec.t
==============================================================================
--- RT-Client/t/spec.t (original)
+++ RT-Client/t/spec.t Tue May 11 15:19:11 2004
@@ -4,8 +4,12 @@
use lib "$FindBin::Bin/../lib";
use Test::More 'no_plan';
+$SIG{__WARN__} = sub { use Carp; Carp::cluck(@_) };
+$SIG{__DIE__} = sub { use Carp; Carp::confess(@_) };
+
use_ok('RT::Client');
-my $rt = RT::Client->new('http://root:password@localhost');
+my $rt = RT::Client->new('http://root:password@localhost')->top;
+isa_ok($rt, 'RT::Client::Container', 'Toplevel');
# some way to RaiseError!
@@ -13,15 +17,15 @@
# 1. Ticket Creation and Modification via an External Interface
my $tickets = $rt->Tickets;
-isa_ok($rt, 'RT::Client');
+isa_ok($tickets, 'RT::Client::Container', 'Tickets');
-exit;
-isa_ok($tickets, 'RT::Client::Container');
can_ok($tickets, 'search');
can_ok($tickets, 'add');
my $results = $tickets->search;
isa_ok($results, 'RT::Client::ResultSet');
+exit;
+
can_ok($results, 'remove');
can_ok($results, 'update');
More information about the Rt-commit
mailing list