From 7a0add6a84e1c3aa8826c98bbef70c07db5e1203 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 8 Aug 2005 15:03:34 +0000 Subject: [PATCH] initial import --- Changes | 6 + MANIFEST | 14 ++ Makefile.PL | 16 +++ README | 31 +++++ lib/Net/XRC.pm | 309 ++++++++++++++++++++++++++++++++++++++++++++ lib/Net/XRC/Data.pm | 34 +++++ lib/Net/XRC/Data/boolean.pm | 13 ++ lib/Net/XRC/Data/bytes.pm | 12 ++ lib/Net/XRC/Data/complex.pm | 22 ++++ lib/Net/XRC/Data/int.pm | 12 ++ lib/Net/XRC/Data/list.pm | 20 +++ lib/Net/XRC/Data/null.pm | 12 ++ lib/Net/XRC/Data/string.pm | 15 +++ lib/Net/XRC/Response.pm | 224 ++++++++++++++++++++++++++++++++ t/Net-XRC.t | 104 +++++++++++++++ 15 files changed, 844 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/Net/XRC.pm create mode 100644 lib/Net/XRC/Data.pm create mode 100644 lib/Net/XRC/Data/boolean.pm create mode 100644 lib/Net/XRC/Data/bytes.pm create mode 100644 lib/Net/XRC/Data/complex.pm create mode 100644 lib/Net/XRC/Data/int.pm create mode 100644 lib/Net/XRC/Data/list.pm create mode 100644 lib/Net/XRC/Data/null.pm create mode 100644 lib/Net/XRC/Data/string.pm create mode 100644 lib/Net/XRC/Response.pm create mode 100644 t/Net-XRC.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..1264d5b --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension Net::XRC. + +0.01 Sun Aug 7 03:53:08 2005 + - original version; created by h2xs 1.23 with options + -X -b 5.5.0 -n Net::XRC -v 0.01 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..70d5250 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,14 @@ +Changes +Makefile.PL +MANIFEST +README +t/Net-XRC.t +lib/Net/XRC.pm +lib/Net/XRC/Data.pm +lib/Net/XRC/Response.pm +lib/Net/XRC/Data/int.pm +lib/Net/XRC/Data/string.pm +lib/Net/XRC/Data/boolean.pm +lib/Net/XRC/Data/bytes.pm +lib/Net/XRC/Data/list.pm +lib/Net/XRC/Data/complex.pm diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..132a02c --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,16 @@ +use 5.005; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + NAME => 'Net::XRC', + VERSION_FROM => 'lib/Net/XRC.pm', # finds $VERSION + PREREQ_PM => { # e.g., Module::Name => 1.1 + 'LWP' => 0, + 'Crypt::SSLeay' => 0, + 'Data::Dumper' => 0, + }, + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'lib/Net/XRC.pm', # retrieve abstract from module + AUTHOR => 'Ivan Kohler ') : ()), +); diff --git a/README b/README new file mode 100644 index 0000000..05cfc55 --- /dev/null +++ b/README @@ -0,0 +1,31 @@ +Net-XRC version 0.01 +==================== + +THis module implements a client interface to Everyone.net's XRC protocol, +enabling a perl application to talk to Everyone.net's XRC server. + +This module is not sponsored or endorsed by Everyone.net. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + LWP + +COPYRIGHT AND LICENCE + +Copyright (C) 2005 Ivan Kohler + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + + diff --git a/lib/Net/XRC.pm b/lib/Net/XRC.pm new file mode 100644 index 0000000..b37f03d --- /dev/null +++ b/lib/Net/XRC.pm @@ -0,0 +1,309 @@ +package Net::XRC; + +use 5.005; +use strict; + +use vars qw( $VERSION @ISA $AUTOLOAD $DEBUG $PROTO_VERSION $POST_URL + @EXPORT_OK %EXPORT_TAGS ); # @EXPORT + +use Exporter; + +use LWP; + +use Data::Dumper; + +use Net::XRC::Response; + +use Net::XRC::Data::list; + +#use Net::XRC::Data::int; +use Net::XRC::Data::string; +use Net::XRC::Data::boolean; +#use Net::XRC::Data::null; +use Net::XRC::Data::bytes; +#use Net::XRC::Data::list; +use Net::XRC::Data::complex; + +@ISA = qw(Exporter); + +# Items to export into callers namespace by default. Note: do not export +# names by default without a very good reason. Use EXPORT_OK instead. +# Do not simply export all your public functions/methods/constants. + +# This allows declaration use Net::XRC ':all'; +# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK +# will save memory. +%EXPORT_TAGS = ( 'types' => [ qw( + string boolean bytes complex +) ] ); + +@EXPORT_OK = ( @{ $EXPORT_TAGS{'types'} } ); + +#@EXPORT = qw( +# +#); + +$VERSION = '0.01'; + +$PROTO_VERSION = '1'; +$POST_URL = 'https://xrc.everyone.net/ccc/xrc'; + +$DEBUG = 0; + +my $ua = LWP::UserAgent->new; +$ua->agent("Net::XRC/$VERSION"); + +=head1 NAME + +Net::XRC - Perl extension for Everyone.net XRC Remote API + +=head1 SYNOPSIS + + use Net::XRC qw(:types); # pulls in type subroutines: + # string, boolean, bytes + + my $xrc = new Net::XRC ( + 'clientID' => '1551978', + 'password' => 'password', + ); + + # noop + + my $response = $xrc->noop; #returns Net::XRC::Response object + die $response->error unless $response->is_success; + + # isAccountName + + my $username = 'tofu_beast'; + my $response = $xrc->isAccountName( $clientID, $username ); + die $response->error unless $response->is_success; + my $available = $res->content; + if ( $available ) { + print "$username is available\n"; + } else { + print "$username is not available\n"; + } + + # isAccountName (numeric) + # note the use of string() to force the datatype to string, which would + # otherwise be (incorrectly) auto-typed as int + + my $numeric_username = '54321'; + my $response = $xrc->isAccountName( $clientID, string($numeric_username) ); + die $response->error unless $response->is_success; + my $available = $res->content; + if ( $available ) { + print "$numeric_username is available\n"; + } else { + print "$numeric_username is not available\n"; + } + + # createUser + + my $username = 'tofu_beast'; + my $response = $xrc->createUser( $clientID, [], $username, 'password' ); + die $response->error unless $response->is_success; + my $uid = $response->content; + print "$username created: uid $uid\n"; + + # createUser (numeric) + # note the use of string() to force the datatype to string, which would + # otherwise be (incorrectly) auto-typed as int + + my $numeric_username = '54321'; + my $response = $xrc->createUser( $clientID, + [], + string($numeric_username), + 'password' + ); + die $response->error unless $response->is_success; + my $uid = $response->content; + print "$numeric_username created: uid $uid\n"; + + # setUserPassword + + $response = $src->setUserPassword( $clientID, 'username', 'new_password' ); + if ( $response->is_success ) { + print "password change sucessful"; + } else { + print "error changing password: ". $response->error; + } + + # suspendUser + + $response = $src->suspendUser( $clientID, 'username' ); + if ( $response->is_success ) { + print "user suspended"; + } else { + print "error suspending user: ". $response->error; + } + + # unsuspendUser + + $response = $src->unsuspendUser( $clientID, 'username' ); + if ( $response->is_success ) { + print "user unsuspended"; + } else { + print "error unsuspending user: ". $response->error; + } + + # deleteUser + + $response = $src->deleteUser( $clientID, 'username' ); + if ( $response->is_success ) { + print "user deleted"; + } else { + print "error deleting user: ". $response->error; + } + + +=head1 DESCRIPTION + +This module implements a client interface to Everyone.net's XRC Remote API, +enabling a perl application to talk to Everyone.net's XRC server. +This documentation assumes that you are familiar with the XRC documentation +available from Everyone.net (XRC-1.0.5.html or later). + +A new Net::XRC object must be created with the I method. Once this has +been done, all XRC commands are accessed via method calls on the object. + +=head1 METHODS + +=over 4 + +=item new OPTION => VALUE ... + +Creates a new Net::XRC object. The I and I options are +required. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { 'version' => $PROTO_VERSION, + @_, + }; + bless($self, $class); +} + +=item AUTOLOADed methods + +All XRC methods are available. See the XRC documentation for methods, +arguments and return values. + +Responses are returned as B objects. See +L. + +XRC I arguments are auto-recognized as numeric perl scalars. + +XRC I arguments are auto-recognized as all other perl scalars, or +you can import and use the B subroutine to ensure your string is +not mistaken as an I. + +XRC I are auto-recognized as undefined ("undef") perl scalars. + +XRC I arguements must be explicitly specified as B. + +XRC I arguments must be explicitly specified as B. + +XRC I arguments are passed and returned as perl array references. + +XRC I arguments are passed and returned as perl hash references, +with an additional I<_type> key denotating the argument type +(I, I, I, I). +Optionally, you may use the B subroutine to construct them, as in: +C. + +=cut + +sub AUTOLOAD { + + my $self = shift; + $AUTOLOAD =~ s/.*://; + return if $AUTOLOAD eq 'DESTROY'; + + my $req = HTTP::Request->new( 'POST' => $POST_URL ); + $req->content_type('application/x-eon-xrc-request'); + + $req->content( + join("\n", map { "$_:". $self->{$_} } keys %$self). #metadata + "\n\n". + $AUTOLOAD. # ' '. + Net::XRC::Data::list->new(\@_)->encode + ); + + warn "\nPOST $POST_URL\n". $req->content. "\n" + if $DEBUG; + + my $res = $ua->request($req); + + # Check the outcome of the response + if ($res->is_success) { + + warn "\nRESPONSE:\n". $res->content + if $DEBUG; + + my $response = new Net::XRC::Response $res->content; + + warn Dumper( $response ) + if $DEBUG; + + $response; + } + else { + #print $res->status_line, "\n"; + die $res->status_line, "\n"; + } + +} + +sub string { new Net::XRC::Data::string( shift ); } +sub boolean { new Net::XRC::Data::boolean( shift ); } +sub bytes { new Net::XRC::Data::bytes( shift ); } +sub complex { + my $hr; + if ( ref($_[0]) ) { + $hr = shift; + } else { + $hr = { '_type' => shift, + %{shift()}, + }; + } + new Net::XRC::Data::complex( $hr ); +} + +=back + +=head1 BUGS + +Needs better documentation. + +Data type auto-guessing can get things wrong for all-numeric strings. I +and I types must be specified explicitly. Ideally each method should +have a type signature so manually specifying data types would never be +necessary. + +The "complex" data types (I, I, +I, I) are untested. + +=head1 SEE ALSO + +L, +Everyone.net XRC Remote API documentation (XRC-1.0.5.html or later) + +=head1 AUTHOR + +Ivan Kohler Eivan-xrc@420.amE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2005 Ivan Kohler + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; + diff --git a/lib/Net/XRC/Data.pm b/lib/Net/XRC/Data.pm new file mode 100644 index 0000000..6f26400 --- /dev/null +++ b/lib/Net/XRC/Data.pm @@ -0,0 +1,34 @@ +package Net::XRC::Data; + +use strict; + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $data = shift; + my $self = ref($data) ? $data : \$data; + warn "$proto->($self [$data])\n" + if $Net::XRC::DEBUG > 1; + + if ( $class eq 'Net::XRC::Data' ) { #take a guess + if ( ref($self) eq 'HASH' ) { + $class .= '::complex'; + } elsif ( ref($self) eq 'ARRAY' ) { + $class .= '::list'; + } elsif ( !defined($$self) ) { + $class .= '::null'; + + # now just guess... no good way to distinguish + # (bool and bytes are never guessed) + } elsif ( $$self =~ /^-?\d+$/ ) { + $class .= '::int'; + } else { + $class .= '::string'; + } + eval "use $class;"; + die $@ if $@; + } + bless($self, $class); +} + +1; diff --git a/lib/Net/XRC/Data/boolean.pm b/lib/Net/XRC/Data/boolean.pm new file mode 100644 index 0000000..7587cf1 --- /dev/null +++ b/lib/Net/XRC/Data/boolean.pm @@ -0,0 +1,13 @@ +package Net::XRC::Data::boolean; + +use strict; +use vars qw(@ISA); +use Net::XRC::Data; + +@ISA = qw(Net::XRC::Data); + +sub encode { + my $self = shift; + $$self ? '/T' : '/F'; +} + diff --git a/lib/Net/XRC/Data/bytes.pm b/lib/Net/XRC/Data/bytes.pm new file mode 100644 index 0000000..ccf02a1 --- /dev/null +++ b/lib/Net/XRC/Data/bytes.pm @@ -0,0 +1,12 @@ +package Net::XRC::Data::bytes; + +use strict; +use vars qw(@ISA); +use Net::XRC::Data; + +@ISA = qw(Net::XRC::Data); + +sub encode { + my $self = shift; + '{'. length($$self). '}'. $$self; +} diff --git a/lib/Net/XRC/Data/complex.pm b/lib/Net/XRC/Data/complex.pm new file mode 100644 index 0000000..5c0e5b6 --- /dev/null +++ b/lib/Net/XRC/Data/complex.pm @@ -0,0 +1,22 @@ +package Net::XRC::Data::complex; + +use strict; +use vars qw(@ISA); +use Net::XRC::Data; + +@ISA = qw(Net::XRC::Data); + +sub encode { + my $self = shift; + my %hash = %$self; + my $typename = delete $hash{_type}; + ":$typename(". join("\n", map { + "$_ ". + isa( $hash{$_}, 'Net::XRC::Data' ) + ? $hash{$_}->encode + : Net::XRC::Data->new($hash{$_})->encode + } + keys %hash + ). + ")"; +} diff --git a/lib/Net/XRC/Data/int.pm b/lib/Net/XRC/Data/int.pm new file mode 100644 index 0000000..7150872 --- /dev/null +++ b/lib/Net/XRC/Data/int.pm @@ -0,0 +1,12 @@ +package Net::XRC::Data::int; + +use strict; +use vars qw(@ISA); +use Net::XRC::Data; + +@ISA = qw(Net::XRC::Data); + +sub encode { + my $self = shift; + $$self; +} diff --git a/lib/Net/XRC/Data/list.pm b/lib/Net/XRC/Data/list.pm new file mode 100644 index 0000000..093a2fd --- /dev/null +++ b/lib/Net/XRC/Data/list.pm @@ -0,0 +1,20 @@ +package Net::XRC::Data::list; + +use strict; +use vars qw(@ISA); +use Net::XRC::Data; + +@ISA = qw(Net::XRC::Data); + +sub encode { + my $self = shift; + '('. join(' ', map { + ref($_) =~ /^Net::XRC::Data/ + ? $_->encode + : Net::XRC::Data->new($_)->encode + } + @$self + ). + ')'; +} + diff --git a/lib/Net/XRC/Data/null.pm b/lib/Net/XRC/Data/null.pm new file mode 100644 index 0000000..adf597e --- /dev/null +++ b/lib/Net/XRC/Data/null.pm @@ -0,0 +1,12 @@ +package Net::XRC::Data::null; + +use strict; +use vars qw(@ISA); +use Net::XRC::Data; + +@ISA = qw(Net::XRC::Data); + +sub encode { + my $self = shift; + '/NULL'; +} diff --git a/lib/Net/XRC/Data/string.pm b/lib/Net/XRC/Data/string.pm new file mode 100644 index 0000000..df27b03 --- /dev/null +++ b/lib/Net/XRC/Data/string.pm @@ -0,0 +1,15 @@ +package Net::XRC::Data::string; + +use strict; +use vars qw(@ISA); +use Net::XRC::Data; + +@ISA = qw(Net::XRC::Data); + +sub encode { + my $self = shift; + my $string = $$self; + $string =~ s/(["\\])/\\$1/g; + qq("$string"); +} + diff --git a/lib/Net/XRC/Response.pm b/lib/Net/XRC/Response.pm new file mode 100644 index 0000000..98d225a --- /dev/null +++ b/lib/Net/XRC/Response.pm @@ -0,0 +1,224 @@ +package Net::XRC::Response; + +use strict; +use vars qw($AUTOLOAD); + +my %exception = ( + 1 => 'PROTOCOL', + 2 => 'UNKNOWN_COMMAND', + 4 => 'IO', + 5 => 'AUTHENTICATION_FAILURE', + 6 => 'SYSTEM_FAILURE', + 7 => 'PERMISSION_DENIED', + 8 => 'ARGUMENT_TYPE_MISMATCH', + 10 => 'UNKNOWN_TYPE', + 11 => 'SYNTAX', + 13 => 'SERIALIZE', + 200 => 'INVALID_ARGUMENT', + 201 => 'EMAIL_SERVICE_ALREADY_SETUP', + 202 => 'WEBMAIL_HOSTNAME_NOT_READY', + 203 => 'EMAIL_DOMAIN_NAME_NOT_READY', + 204 => 'WEBMAIL_HOSTNAME_TAKEN', + 205 => 'EMAIL_DOMAIN_NAME_TAKEN', + 206 => 'ACCOUNT_NAME_TAKEN', + 207 => 'CLIENT_DOES_NOT_EXIST', + 208 => 'INVALID_PASSWORD', + 209 => 'INVALID_ADDRESS', + 210 => 'EMAIL_SERVICE_NOT_READY', + 211 => 'INVALID_WEBMAIL_HOSTNAME', + 212 => 'INVALID_EMAIL_DOMAIN', + 213 => 'USER_DOES_NOT_EXIST', + 214 => 'INVALID_ACCOUNT_NAME', + 215 => 'OFFER_NOT_AVAILABLE', + 216 => 'ALIAS_DOES_NOT_EXIST', + 217 => 'USER_NO_MAILBOX', + 218 => 'EMAIL_SERVICE_NOT_FOUND', + 219 => 'ACCOUNT_NOT_SUSPENDED', +); + +my %exception_long = ( + 1 => 'EOF while reading metadata, '. + 'a metadata line exceeded 8192 bytes, '. + 'missing a required metadata key-value pair, '. + 'metadata value malformed, or '. + 'missing method name and/or method arguments.', + 2 => 'The method name does not match a known method.', + 4 => 'IO error or premature EOF while parsing method arguments', + 5 => 'Credentials offered in metadata are not valid.', + 6 => 'An internal error in the XRC server. Everyone.net is automatically notified.', + 7 => 'The caller does not have necessary rights.', + 8 => 'One or more of the method arguments was not of the correct type, or the number of arguments to the method was incorrect.', + 10 => 'The name of a complex type is not known.', + 11 => 'An error in the format of the XRC request.', + 13 => 'A value of a complex type was of the wrong type or failed to meet the requirements of the type specification.', + 200 => 'An argument to a method did not meet the requirements of the specification.', + 201 => 'An attempt was made to setup an email service for a client that already has an email service.', + 202 => 'The webmail hostname is not properly configured. See DNS Requirements.', + 203 => 'The email domain is not properly configured. See DNS Requirements.', + 204 => 'The webmail hostname is in use by another client.', + 205 => 'The email domain is in use by another client.', + 206 => 'The username or alias name is in use.', + 207 => 'An operation was attempted on a client that cannot be found.', + 208 => 'The password is not valid. See Name Restrictions.', + 209 => 'An email address was not of legal form.', + 210 => 'The MX records of the email service have not been validated.', + 211 => 'The webmail hostname is not valid. See Name Restrictions.', + 212 => 'The email domain is not valid. See Name Restrictions.', + 213 => 'An operation was attempted on a user that cannot be found.', + 214 => 'The username or alias name is not valid. See Name Restrictions.', + 215 => 'The distributor attempted to apply an offer to a user or client that does not exist, applies to the wrong beneficiary, or does not belong to the distributor.', + 216 => 'An operation was attempted on an alias that cannot be found.', + 217 => 'The user does not have a mailbox.', + 218 => 'The client does not have an email service.', + 219 => 'The user mailbox cannot be purged because the user account is not in suspended mode.', +); + +=head1 NAME + +Net::XRC::Response - XRC response object + +=head1 SYNOPSIS + + my $response = $xrc->some_method( $and, $args ); + + #response meta-data + my $server = $response->server; + my $timestamp = $response->server; + + if ( $response->is_success ) { + + my $content = $response->content; + #... + + } else { + + my $status = $response->status; #error code + my $error = $response->error; #error message + #... + } + +=head1 DESCRIPTION + +The "Net::XRC::Response" class represents XRC responses. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless($self, $class); + + my $data = shift; + + while ( $data =~ s/^(\w+):\s*(.*)$//m ) { #metadata + warn "response metadata: $1 => $2\n" + if $Net::XRC::DEBUG; + $self->{$1} = $2; + } + + $self->{'content'} = $self->decode(\$data) + if $self->is_success; + + $self; +} + +sub is_success { + my $self = shift; + ! $self->{'status'}; +} + +sub error { + my $self = shift; + $exception{ $self->{'status'} }. ': '. $exception_long{ $self->{'status'} }. + ' - '. $self->{'errorDescription'}; +} + +sub AUTOLOAD { + my $self = shift; + $AUTOLOAD =~ s/.*://; + $self->{$AUTOLOAD}; +} +#sub content { $self->{'content'}; } +#sub status { $self->{'status'}; } +#sub errorDescription { $self->{'errorDescription'}; } +#sub server { $self->{'server'}; } +#sub timestamp { $self->{'timestamp'}; } + +sub decode { + my( $self, $s ) = @_; + + warn "starting to parse response: ". $$s + if $Net::XRC::DEBUG > 1; + + $$s =~ s/^[\s\n]+//g; #trim leading newlines and whitespace + + if ( $$s =~ /^[\-\d]/ ) { #int + $$s =~ s/^(\-?\d+)// and $1 + or die "can't parse (int) response: ". $$s. "\n"; + } elsif ( $$s =~ /^"/ ) { #string + $$s =~ s/^"(([^"\\]|\\"|\\\\)+)"// + or die "can't parse (string) response: ". $$s. "\n"; + my $str = $1; + $str =~ s(\\")(")g; + $str =~ s(\\\\)(\\)g; + $str; + } elsif ( $$s =~ /^\/[TF]/ ) { #boolean + $$s =~ s/^\/([TF])// + or die "can't parse (bool) response: ". $$s. "\n"; + $1 eq 'T' ? 1 : 0; + } elsif ( $$s =~ s/^\/NULL// ) { #NULL + undef; + } elsif ( $$s =~ /^\{/ ) { #bytes + $$s =~ s/^\{(\d+)\}// + or die "can't parse (bytes) response: ". $$s. "\n"; + substr($$s, 0, $1, ''); + } elsif ( $$s =~ /^\(/ ) { #list + $$s =~ s/^\([\s\n]*// + or die "can't parse (list) reponse: ". $$s. "\n"; + my @list = (); + until ( $$s =~ s/^[\s\n]*\)// ) { + push @list, $self->decode($s); + die "unterminated list\n" if $s =~ /^[\s\n]*$/; + } + \@list; + } elsif ( $$s =~ /^:/ ) { #complex + $$s =~ s/^:(\w+)[\s\n]*// + or die "can't parse (complex) response: ". $$s. "\n"; + my %hash = ( '_type' => $1 ); + until ( $$s =~ s/^[\s\n]*\)// ) { + $$s =~ s/^[\s\n]*(\w+)// + or die "can't parse ($hash{_type}) response: ". $$s. "\n"; + $hash{$1} = $self->decode($s); + die "unterminated $hash{_type}\n" if $s =~ /^[\s\n]*$/; + } + \%hash; + } else { + die "can't parse response: ". $$s. "\n"; + } + +} + +=head1 BUGS + +Needs better documentation. + +=head1 SEE ALSO + +L, +Everyone.net XRC Remote API documentation (XRC-1.0.5.html or later) + +=head1 AUTHOR + +Ivan Kohler Eivan-xrc@420.amE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2005 Ivan Kohler + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; diff --git a/t/Net-XRC.t b/t/Net-XRC.t new file mode 100644 index 0000000..a3629dd --- /dev/null +++ b/t/Net-XRC.t @@ -0,0 +1,104 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Net-XRC.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +#use Test; +#BEGIN { plan tests => 3 }; + +use Test::More tests => 17; +BEGIN{ use_ok('Net::XRC', qw(:types)) } + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + + $Net::XRC::DEBUG = 0; + + my $clientID = '1551978'; + my $password = 'password'; + + my $xrc = new Net::XRC ( + 'clientID' => $clientID, + 'password' => $password, + ); + + my $domain = 'SISD.EVERY1.NET'; + + # noop + + my $res = $xrc->noop; + ok( $res->is_success, 'noop sucessful' ) + or diag( $res->error ); + ok( ! defined($res->content), 'noop returns undef' ); + + # lookupMXReadyClientIDByEmailDomain + + $res = $xrc->lookupMXReadyClientIDByEmailDomain($domain); + ok( $res->is_success, 'lookupMXReadyClientIDByEmailDomain sucessful' ) + or diag( $res->error ); + my $domain_clientID = $res->content; + ok( $domain_clientID != -1, 'lookupMXReadyClientIDByEmailDomain' ); + + # isAccountName + + my @set = ( 'a'..'z', '0'..'9' ); + my $username = join('', map { $set[int(rand(scalar(@set)))] } ( 1..32 ) ); + $res = $xrc->isAccountNameAvailable( $domain_clientID, $username ); + ok( $res->is_success, 'isAccountName sucessful' ) + or diag( $res->error ); + ok( $res->content, 'isAccountName returns true' ); + + # isAccountName (numeric) + + my @nset = ( '0'..'9' ); + my $nusername = join('', map { $nset[int(rand(scalar(@nset)))] } ( 1..32 ) ); + $res = $xrc->isAccountNameAvailable( $domain_clientID, string($nusername) ); + ok( $res->is_success, 'isAccountName (numeric) sucessful' ) + or diag( $res->error ); + ok( $res->content, 'isAccountName (numeric) returns true' ); + + # createUser + + $res = $xrc->createUser( $domain_clientID, [], $username, 'password' ); + ok( $res->is_success, 'createUser sucessful' ) + or diag( $res->error ); + ok( $res->content, 'createUser returns uid' ); + + # createUser (numeric) + + $res = $xrc->createUser( $domain_clientID, [], string($nusername), 'password' ); + ok( $res->is_success, 'createUser (numeric) sucessful' ) + or diag( $res->error ); + ok( $res->content, 'createUser (numeric) returns uid' ); + + + # setUserPassword + + $res = $xrc->setUserPassword ( $domain_clientID, $username, 'newpassword' ); + ok( $res->is_success, 'setUserPassword sucessful' ) + or diag( $res->error ); + + # suspendUser + + $res = $xrc->suspendUser( $domain_clientID, $username ); + ok( $res->is_success, 'suspendUser sucessful' ) + or diag( $res->error ); + + # unsuspendUser + + $res = $xrc->unsuspendUser( $domain_clientID, $username ); + ok( $res->is_success, 'unsuspendUser sucessful' ) + or diag( $res->error ); + + + # deleteUser + + $res = $xrc->deleteUser( $domain_clientID, $username ); + ok( $res->is_success, 'deleteUser sucessful' ) + or diag( $res->error ); + + -- 2.11.0