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