lib/Net/XRC.pm

   1 package Net::XRC;
   2
   3 use 5.005;
   4 use strict;
   5
   6 use vars qw( $VERSION @ISA $AUTOLOAD $DEBUG $PROTO_VERSION $POST_URL
   7              @EXPORT_OK %EXPORT_TAGS ); # @EXPORT
   8
   9 use Exporter;
  10
  11 use LWP;
  12
  13 use Data::Dumper;
  14
  15 use Net::XRC::Response;
  16
  17 use Net::XRC::Data::list;
  18
  19 #use Net::XRC::Data::int;
  20 use Net::XRC::Data::string;
  21 use Net::XRC::Data::boolean;
  22 #use Net::XRC::Data::null;
  23 use Net::XRC::Data::bytes;
  24 #use Net::XRC::Data::list;
  25 use Net::XRC::Data::complex;
  26
  27 @ISA = qw(Exporter);
  28
  29 # Items to export into callers namespace by default. Note: do not export
  30 # names by default without a very good reason. Use EXPORT_OK instead.
  31 # Do not simply export all your public functions/methods/constants.
  32
  33 # This allows declaration       use Net::XRC ':all';
  34 # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
  35 # will save memory.
  36 %EXPORT_TAGS = ( 'types' => [ qw(
  37   string boolean bytes complex
  38 ) ] );
  39
  40 @EXPORT_OK = ( @{ $EXPORT_TAGS{'types'} } );
  41
  42 #@EXPORT = qw(
  43 #
  44 #);
  45
  46 $VERSION = '0.01';
  47
  48 $PROTO_VERSION = '1';
  49 $POST_URL = 'https://xrc.everyone.net/ccc/xrc';
  50
  51 $DEBUG = 0;
  52
  53 my $ua = LWP::UserAgent->new;
  54 $ua->agent("Net::XRC/$VERSION");
  55
  56 =head1 NAME
  57
  58 Net::XRC - Perl extension for Everyone.net XRC Remote API
  59
  60 =head1 SYNOPSIS
  61
  62   use Net::XRC qw(:types);  # pulls in type subroutines:
  63                             # string, boolean, bytes
  64
  65   my $xrc = new Net::XRC (
  66     'clientID' => '1551978',
  67     'password' => 'password',
  68   );
  69
  70   # noop
  71
  72   my $response = $xrc->noop; #returns Net::XRC::Response object
  73   die $response->error unless $response->is_success;
  74
  75   # isAccountName
  76
  77   my $username = 'tofu_beast';
  78   my $response = $xrc->isAccountName( $clientID, $username );
  79   die $response->error unless $response->is_success;
  80   my $available = $res->content;
  81   if ( $available ) {
  82     print "$username is available\n";
  83   } else {
  84     print "$username is not available\n";
  85   }
  86
  87   # isAccountName (numeric)
  88   # note the use of string() to force the datatype to string, which would
  89   # otherwise be (incorrectly) auto-typed as int
  90
  91   my $numeric_username = '54321';
  92   my $response = $xrc->isAccountName( $clientID, string($numeric_username) );
  93   die $response->error unless $response->is_success;
  94   my $available = $res->content;
  95   if ( $available ) {
  96     print "$numeric_username is available\n";
  97   } else {
  98     print "$numeric_username is not available\n";
  99   }
 100
 101   # createUser
 102
 103   my $username = 'tofu_beast';
 104   my $response = $xrc->createUser( $clientID, [], $username, 'password' );
 105   die $response->error unless $response->is_success;
 106   my $uid = $response->content;
 107   print "$username created: uid $uid\n";
 108
 109   # createUser (numeric)
 110   # note the use of string() to force the datatype to string, which would
 111   # otherwise be (incorrectly) auto-typed as int
 112
 113   my $numeric_username = '54321';
 114   my $response = $xrc->createUser( $clientID,
 115                                    [],
 116                                    string($numeric_username),
 117                                    'password'
 118                                  );
 119   die $response->error unless $response->is_success;
 120   my $uid = $response->content;
 121   print "$numeric_username created: uid $uid\n";
 122
 123   # setUserPassword
 124
 125   $response = $src->setUserPassword( $clientID, 'username', 'new_password' );
 126   if ( $response->is_success ) {
 127     print "password change sucessful";
 128   } else {
 129     print "error changing password: ". $response->error;
 130   }
 131
 132   # suspendUser
 133
 134   $response = $src->suspendUser( $clientID, 'username' );
 135   if ( $response->is_success ) {
 136     print "user suspended";
 137   } else {
 138     print "error suspending user: ". $response->error;
 139   }
 140
 141   # unsuspendUser
 142
 143   $response = $src->unsuspendUser( $clientID, 'username' );
 144   if ( $response->is_success ) {
 145     print "user unsuspended";
 146   } else {
 147     print "error unsuspending user: ". $response->error;
 148   }
 149
 150   # deleteUser
 151
 152   $response = $src->deleteUser( $clientID, 'username' );
 153   if ( $response->is_success ) {
 154     print "user deleted";
 155   } else {
 156     print "error deleting user: ". $response->error;
 157   }
 158
 159
 160 =head1 DESCRIPTION
 161
 162 This module implements a client interface to Everyone.net's XRC Remote API,
 163 enabling a perl application to talk to Everyone.net's XRC server.
 164 This documentation assumes that you are familiar with the XRC documentation
 165 available from Everyone.net (XRC-1.0.5.html or later).
 166
 167 A new Net::XRC object must be created with the I<new> method.  Once this has
 168 been done, all XRC commands are accessed via method calls on the object.
 169
 170 =head1 METHODS
 171
 172 =over 4
 173
 174 =item new OPTION => VALUE ...
 175
 176 Creates a new Net::XRC object.  The I<clientID> and I<password> options are
 177 required.
 178
 179 =cut
 180
 181 sub new {
 182   my $proto = shift;
 183   my $class = ref($proto) || $proto;
 184   my $self = { 'version' => $PROTO_VERSION,
 185                @_,
 186              };
 187   bless($self, $class);
 188 }
 189
 190 =item AUTOLOADed methods
 191
 192 All XRC methods are available.  See the XRC documentation for methods,
 193 arguments and return values.
 194
 195 Responses are returned as B<Net::XRC::Response> objects.  See
 196 L<Net::XRC::Response>.
 197
 198 XRC I<int> arguments are auto-recognized as numeric perl scalars.
 199
 200 XRC I<string> arguments are auto-recognized as all other perl scalars, or
 201 you can import and use the B<string()> subroutine to ensure your string is
 202 not mistaken as an I<int>.
 203
 204 XRC I<null> are auto-recognized as undefined ("undef") perl scalars.
 205
 206 XRC I<boolean> arguements must be explicitly specified as B<boolean()>.
 207
 208 XRC I<bytes> arguments must be explicitly specified as B<bytes()>.
 209
 210 XRC I<list> arguments are passed and returned as perl array references.
 211
 212 XRC I<complex> arguments are passed and returned as perl hash references,
 213 with an additional I<_type> key denotating the argument type
 214 (I<AliasInfo>, I<EmailClientSummary>, I<WebmailPresentation>, I<Letter>).
 215 Optionally, you may use the B<complex()> subroutine to construct them, as in:
 216 C<complex('typename', \%hash)>.
 217
 218 =cut
 219
 220 sub AUTOLOAD {
 221
 222   my $self = shift;
 223   $AUTOLOAD =~ s/.*://;
 224   return if $AUTOLOAD eq 'DESTROY';
 225
 226   my $req = HTTP::Request->new( 'POST' => $POST_URL );
 227   $req->content_type('application/x-eon-xrc-request');
 228
 229   $req->content(
 230     join("\n", map { "$_:". $self->{$_} } keys %$self). #metadata
 231     "\n\n".
 232     $AUTOLOAD. # ' '.
 233     Net::XRC::Data::list->new(\@_)->encode
 234   );
 235
 236   warn "\nPOST $POST_URL\n". $req->content. "\n"
 237     if $DEBUG;
 238
 239   my $res = $ua->request($req);
 240
 241   # Check the outcome of the response
 242   if ($res->is_success) {
 243
 244     warn "\nRESPONSE:\n". $res->content
 245       if $DEBUG;
 246
 247     my $response = new Net::XRC::Response $res->content;
 248
 249     warn Dumper( $response )
 250       if $DEBUG;
 251
 252     $response;
 253   }
 254   else {
 255     #print $res->status_line, "\n";
 256     die $res->status_line, "\n";
 257   }
 258
 259 }
 260
 261 sub string   { new Net::XRC::Data::string(  shift ); }
 262 sub boolean  { new Net::XRC::Data::boolean( shift ); }
 263 sub bytes    { new Net::XRC::Data::bytes(   shift ); }
 264 sub complex  {
 265   my $hr;
 266   if ( ref($_[0]) ) {
 267     $hr = shift;
 268   } else {
 269     $hr = { '_type' => shift,
 270             %{shift()},
 271           };
 272   }
 273   new Net::XRC::Data::complex( $hr );
 274 }
 275
 276 =back
 277
 278 =head1 BUGS
 279
 280 Needs better documentation.
 281
 282 Data type auto-guessing can get things wrong for all-numeric strings.  I<bool>
 283 and I<bytes> types must be specified explicitly.  Ideally each method should
 284 have a type signature so manually specifying data types would never be
 285 necessary.
 286
 287 The "complex" data types (I<AliasInfo>, I<EmailClientSummary>,
 288 I<WebmailPresentation>, I<Letter>) are untested.
 289
 290 =head1 SEE ALSO
 291
 292 L<Net::XRC::Response>,
 293 Everyone.net XRC Remote API documentation (XRC-1.0.5.html or later)
 294
 295 =head1 AUTHOR
 296
 297 Ivan Kohler E<lt>ivan-xrc@420.amE<gt>
 298
 299 =head1 COPYRIGHT AND LICENSE
 300
 301 Copyright (C) 2005 Ivan Kohler
 302
 303 This library is free software; you can redistribute it and/or modify
 304 it under the same terms as Perl itself.
 305
 306 =cut
 307
 308 1;
 309