[Rt-commit] [svn] r780 - in RT-Client: . lib lib/RT
autrijus at pallas.eruditorum.org
autrijus at pallas.eruditorum.org
Fri Apr 30 23:21:26 EDT 2004
Author: autrijus
Date: Fri Apr 30 23:21:25 2004
New Revision: 780
Added:
RT-Client/lib/
RT-Client/lib/RT/
RT-Client/lib/RT/Client.pm
Modified:
RT-Client/ (props changed)
RT-Client/MANIFEST
RT-Client/MANIFEST.SKIP
RT-Client/META.yml
RT-Client/Makefile.PL
Log:
----------------------------------------------------------------------
r4307 at not: autrijus | 2004-05-01T03:21:24.166390Z
* Initial commit of a more generic RT::Client.
----------------------------------------------------------------------
Modified: RT-Client/MANIFEST
==============================================================================
--- RT-Client/MANIFEST (original)
+++ RT-Client/MANIFEST Fri Apr 30 23:21:25 2004
@@ -1,4 +1,3 @@
-MANIFEST.SKIP
bin/rt
inc/ExtUtils/AutoInstall.pm
inc/Module/Install.pm
@@ -12,7 +11,9 @@
inc/Module/Install/Scripts.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
+lib/RT/Client.pm
Makefile.PL
MANIFEST
+MANIFEST.SKIP
META.yml
SIGNATURE
Modified: RT-Client/MANIFEST.SKIP
==============================================================================
--- RT-Client/MANIFEST.SKIP (original)
+++ RT-Client/MANIFEST.SKIP Fri Apr 30 23:21:25 2004
@@ -2,7 +2,7 @@
\bCVS\b
,v$
\B\.svn\b
-^MANIFEST\.
+^MANIFEST\.bak
^Makefile$
^blib/
^MakeMaker-\d
Modified: RT-Client/META.yml
==============================================================================
--- RT-Client/META.yml (original)
+++ RT-Client/META.yml Fri Apr 30 23:21:25 2004
@@ -1,12 +1,13 @@
-name: RT-Client-Commandline
-version: 0.01
-abstract: A command line interface for RT from Best Practical Solutions
+name: RT-Client
+version: 0.02
+abstract: A client of RT from Best Practical Solutions
author: Jesse Vincent <jesse at bestpractical.com>
license: perl
distribution_type: module
requires:
Text::ParseWords: 0
HTTP::Request::Common: 0
+ XML::Atom: 0.05
no_index:
directory:
- inc
Modified: RT-Client/Makefile.PL
==============================================================================
--- RT-Client/Makefile.PL (original)
+++ RT-Client/Makefile.PL Fri Apr 30 23:21:25 2004
@@ -2,16 +2,17 @@
use inc::Module::Install;
-name ('RT-Client-Commandline');
+name ('RT-Client');
author ('Jesse Vincent <jesse at bestpractical.com>');
-abstract ('A command line interface for RT from Best Practical Solutions');
+abstract ('A client of RT from Best Practical Solutions');
license ('perl');
-version ('0.01');
+version ('0.02');
install_script ('bin/rt');
requires(
Text::ParseWords => '0',
HTTP::Request::Common => '0',
+ XML::Atom => '0.05',
);
include('ExtUtils::AutoInstall');
auto_install();
Added: RT-Client/lib/RT/Client.pm
==============================================================================
--- (empty file)
+++ RT-Client/lib/RT/Client.pm Fri Apr 30 23:21:25 2004
@@ -0,0 +1,147 @@
+package RT::Client;
+
+use 5.006;
+our $VERSION = 0.01;
+our @ISA = 'XML::Atom::Client';
+
+use strict;
+use warnings;
+use HTTP::Request;
+use XML::Atom::Client;
+
+use Digest::MD5 qw( md5_hex );
+use Digest::SHA1 qw( sha1_hex );
+use constant BASE_URI => 'REST/2.0';
+
+=head1 NAME
+
+RT::Client - A client of RT from Best Practical Solutions
+
+=head1 SYNOPSIS
+
+ use RT::Client;
+
+ my $rt = RT::Client->new;
+ $rt->username('root');
+ $rt->password('password');
+ $rt->server('http://localhost');
+
+ # search / list
+ my $tickets = $rt->search(
+ URI => 'tickets',
+ Limit => "Priority > 5 and Status='new'",
+ OrderBy => 'Subject',
+ Order => 'DESC',
+ );
+
+ # narrow search scope
+ $tickets->search(Limit => "Owner='autrijus'");
+
+ # perform actions
+ $tickets->delete(); # perform action
+
+ # get / show -- single parameter means URI implicitly
+ my $user = $rt->get( 'users/autrijus' );
+
+ # update / edit
+ my $group = $rt->edit(
+ URI => 'groups/3',
+ Set => { Disabled => 1 },
+ Add => {},
+ Delete => {},
+ );
+
+ # create / insert
+ my $queue = $rt->create(
+ URI => 'queues',
+ Set => { Name => 'Test Queue' },
+ );
+
+=head1 DESCRIPTION
+
+This module implements a client API for RT, based on the Atom API.
+
+The dependency on L<XML::Atom> is coincidential and may one day be
+dropped in favor of a lighter-weight framework.
+
+=cut
+
+BEGIN {
+ my @delegate_map = qw(
+ search list getFeed
+ get show getEntry
+ update edit updateEntry
+ create insert createEntry
+ delete remove deleteEntry
+ );
+ while (my ($key1, $key2, $value) = splice(@delegate_map, 0, 3)) {
+ my $method = "SUPER::$value";
+
+ no strict 'refs';
+ *$key1 = *$key2 = sub {
+ my $self = shift;
+ my $uri = shift;
+ return $self->can($method)->(
+ $self,
+ $self->server_uri($uri),
+ @_,
+ );
+ };
+ }
+}
+
+sub password {
+ my $self = shift;
+
+ my $realm = $self->realm;
+ my $username = $self->username;
+
+ if (@_) {
+ $self->SUPER::password(@_);
+ defined $realm or return;
+ defined $username or return;
+ }
+ elsif (!defined $realm) {
+ die 'Must set $self->server before retrieving $self->password';
+ }
+ elsif (!defined $username) {
+ die 'Must set $self->username before retrieving $self->password';
+ }
+
+ return sha1_hex(join(':', $username, $realm, md5_hex($self->{password})));
+}
+
+sub realm {
+ my $self = shift;
+ $self->{realm} = shift if @_;
+ return $self->{realm};
+}
+
+sub server {
+ my $self = shift;
+ if (@_) {
+ $self->{server} = shift;
+ $self->realm($self->server_realm);
+ }
+ return $self->{server};
+}
+
+sub server_uri {
+ my $self = shift;
+ return join('/', $self->server, $self->BASE_URI, @_ ? @_ : '');
+}
+
+sub server_realm {
+ my $self = shift;
+ my $req = HTTP::Request->new(GET => $self->server_uri);
+ my $res = $self->{ua}->request($req);
+
+ my $wsse = $res->header('WWW-Authenticate')
+ or die "Bad RT server";
+ $wsse =~ /\bWSSE (?=.*\bprofile="UsernameToken").*?\brealm="(.*?)"/
+ or die "Bad WWW-Authenticate";
+
+ return $1;
+}
+
+1;
More information about the Rt-commit
mailing list