[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