FS/FS/part_export/everyone_net.pm

   1 package FS::part_export::everyone_net;
   2
   3 use vars qw(@ISA %info);
   4 use Tie::IxHash;
   5 use FS::part_export;
   6
   7 @ISA = qw(FS::part_export);
   8
   9 tie my %options, 'Tie::IxHash',
  10   'clientID'  => { label=>'clientID' },
  11   'password'  => { label=>'Password' },
  12   #'workgroup' => { label=>'Default Workgroup' },
  13   'debug'     => { label=>'Enable debugging',
  14                     type=>'checkbox'          },
  15 ;
  16
  17 %info = (
  18   'svc'    => 'svc_acct',
  19   'desc'   => 'Real-time export to Everyone.net outsourced mail service',
  20   'options'=> \%options,
  21   'notes'  => <<'END'
  22 Real-time export to
  23 <a href="http://www.cp.net/">Everyone.net</a> via the XRC Remote API.
  24 Requires installation of
  25 <a href="http://search.cpan.org/dist/Net-XRC">Net::XRC</a>
  26 from CPAN.
  27 END
  28 );
  29
  30 sub rebless { shift; }
  31
  32 # experiement: want the status of these right away (don't want account to
  33 # create or whatever and then get error in the queue from dup username or
  34 # something), so no queueing
  35
  36 sub _export_insert {
  37   my( $self, $svc_acct ) = (shift, shift);
  38
  39   eval "use Net::XRC qw(:types);";
  40   return $@ if $@;
  41
  42   $self->_xrc_command( 'createUser',
  43                        $svc_acct->domain,
  44                        [],
  45                        string($svc_acct->username),
  46                        string($svc_acct->_password),
  47                      );
  48 }
  49
  50 sub _xrc_command {
  51   my( $self, $method, $domain, @args ) = @_;
  52
  53   eval "use Net::XRC qw(:types);";
  54   return $@ if $@;
  55
  56   local($Net::XRC::DEBUG) = 1
  57     if $self->option('debug');
  58
  59   my $xrc = new Net::XRC (
  60     'clientID' => $self->option('clientID'),
  61     'password' => $self->option('password'),
  62   );
  63
  64   my $dresponse = $xrc->lookupMXReadyClientIDByEmailDomain( string($domain) );
  65   return $dresponse->error unless $dresponse->is_success;
  66   my $clientID = $dresponse->content;
  67   return "clientID for domain $domain not found"
  68     if $clientID == -1;
  69
  70   my $response = $xrc->$method($clientID, @args);
  71   return $response->error unless $response->is_success;
  72   '';
  73
  74 }
  75
  76 sub _export_replace {
  77   my( $self, $new, $old ) = (shift, shift, shift);
  78
  79   eval "use Net::XRC qw(:types);";
  80   return $@ if $@;
  81
  82   return "can't change domain with Everyone.net"
  83     if $old->domain ne $new->domain;
  84   return "can't change username with Everyone.net"
  85     if $old->username ne $new->username;
  86   return '' unless $old->_password ne $new->_password;
  87
  88   $self->_xrc_command( 'setUserPassword',
  89                        $new->domain,
  90                        string($new->username),
  91                        string($new->_password),
  92                      );
  93 }
  94
  95 sub _export_delete {
  96   my( $self, $svc_acct ) = (shift, shift);
  97
  98   eval "use Net::XRC qw(:types);";
  99   return $@ if $@;
 100
 101   $self->_xrc_command( 'deleteUser',
 102                        $svc_acct->domain,
 103                        string($svc_acct->username),
 104                      );
 105 }
 106
 107 sub _export_suspend {
 108   my( $self, $svc_acct ) = (shift, shift);
 109
 110   eval "use Net::XRC qw(:types);";
 111   return $@ if $@;
 112
 113   $self->_xrc_command( 'suspendUser',
 114                        $svc_acct->domain,
 115                        string($svc_acct->username),
 116                      );
 117 }
 118
 119 sub _export_unsuspend {
 120   my( $self, $svc_acct ) = (shift, shift);
 121
 122   eval "use Net::XRC qw(:types);";
 123   return $@ if $@;
 124
 125   $self->_xrc_command( 'unsuspendUser',
 126                        $svc_acct->domain,
 127                        string($svc_acct->username),
 128                      );
 129 }
 130
 131 1;
 132