FS/FS/part_export/acct_xmlrpc.pm

   1 package FS::part_export::acct_xmlrpc;
   2 use base qw( FS::part_export );
   3
   4 use vars qw( %info ); # $DEBUG );
   5 #use Data::Dumper;
   6 use Tie::IxHash;
   7 use Frontier::Client; #to avoid adding a dependency on RPC::XML just now
   8 use Frontier::RPC2;
   9 #use FS::Record qw( qsearch qsearchs );
  10 use FS::Schema qw( dbdef );
  11
  12 #$DEBUG = 1;
  13
  14 tie my %options, 'Tie::IxHash',
  15   'xmlrpc_url'       => { label => 'XML-RPC URL', },
  16   'param_style'      => { label   => 'Parameter style',
  17                           type    => 'select',
  18                           options => [ 'Individual values',
  19                                        'Struct of name/value pairs',
  20                                      ],
  21                         },
  22   'insert_method'    => { label => 'Insert method', },
  23   'insert_params'    => { label => 'Insert parameters', type=>'textarea', },
  24   'replace_method'   => { label => 'Replace method', },
  25   'replace_params'   => { label => 'Replace parameters', type=>'textarea', },
  26   'delete_method'    => { label => 'Delete method', },
  27   'delete_params'    => { label => 'Delete parameters', type=>'textarea', },
  28   'suspend_method'   => { label => 'Suspend method', },
  29   'suspend_params'   => { label => 'Suspend parameters', type=>'textarea', },
  30   'unsuspend_method' => { label => 'Unsuspend method', },
  31   'unsuspend_params' => { label => 'Unsuspend parameters', type=>'textarea', },
  32 ;
  33
  34 %info = (
  35   'svc'     => 'svc_acct',
  36   'desc'    => 'Configurable provisioning of accounts via the XML-RPC protocol',
  37   'options' => \%options,
  38   'no_machine' => 1,
  39   'notes'   => <<'END',
  40 Configurable, real-time export of accounts via the XML-RPC protocol.<BR>
  41 <BR>
  42 If using "Individual values" parameter style, specify one parameter per line.<BR>
  43 <BR>
  44 If using "Struct of name/value pairs" parameter style, specify one name and
  45 value on each line, separated by whitespace.<BR>
  46 <BR>
  47 The following variables are available for interpolation (prefixed with new_ or
  48 old_ for replace operations):
  49 <UL>
  50   <LI><code>$username</code>
  51   <LI><code>$domain</code>
  52   <LI><code>$email</code> - username@domain
  53   <LI><code>$_password</code>
  54   <LI><code>$crypt_password</code> - encrypted password
  55   <LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4")
  56   <LI><code>$uid</code>
  57   <LI><code>$gid</code>
  58   <LI><code>$finger</code> - Real name
  59   <LI><code>$dir</code> - home directory
  60   <LI><code>$shell</code>
  61   <LI><code>$quota</code>
  62   <LI><code>@radius_groups</code>
  63 <!--  <LI><code>$reasonnum (when suspending)</code>
  64   <LI><code>$reasontext (when suspending)</code>
  65   <LI><code>$reasontypenum (when suspending)</code>
  66   <LI><code>$reasontypetext (when suspending)</code>
  67 -->
  68 <!--
  69   <LI><code>$pkgnum</code>
  70   <LI><code>$custnum</code>
  71 -->
  72   <LI>All other fields in <b>svc_acct</b> are also available.
  73 <!--  <LI>The following fields from <b>cust_main</b> are also available (except during replace): company, address1, address2, city, state, zip, county, daytime, night, fax, otaker, agent_custid, locale. -->
  74 </UL>
  75
  76 END
  77 );
  78
  79 sub _export_insert    { shift->_export_command('insert',    @_) }
  80 sub _export_delete    { shift->_export_command('delete',    @_) }
  81 sub _export_suspend   { shift->_export_command('suspend',   @_) }
  82 sub _export_unsuspend { shift->_export_command('unsuspend', @_) }
  83
  84 sub _export_command {
  85   my ( $self, $action, $svc_acct) = (shift, shift, shift);
  86   my $method = $self->option($action.'_method');
  87   return '' if $method =~ /^\s*$/;
  88
  89   my @params = split("\n", $self->option($action.'_params') );
  90
  91   my( @x_param ) = ();
  92   my( %x_struct ) = ();
  93   foreach my $param (@params) {
  94
  95     my($name, $value) = ('', '');
  96     if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
  97       ($name, $value) = split(/\s+/, $param);
  98     } else { #'Individual values'
  99       $value = $param;
 100     }
 101
 102     if ( $value =~ /^\s*(\$|\@)(\w+)\s*$/ ) {
 103       $value = $self->_export_value($2, $svc_acct);
 104     }
 105
 106     if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
 107       $x_struct{$name} = $value;
 108     } else { #'Individual values'
 109       push @x_param, $value;
 110     }
 111
 112   }
 113
 114   my @x = ();
 115   if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
 116     @x = ( \%x_struct );
 117   } else { #'Individual values'
 118     @x = @x_param;
 119   }
 120
 121   #option to queue (or not) ?
 122
 123   my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
 124
 125   my $result = $conn->call($method, @x);
 126
 127   #XXX error checking?  $result?  from the call?
 128   '';
 129 }
 130
 131 sub _export_replace {
 132   my( $self, $new, $old ) = (shift, shift, shift);
 133
 134   my $method = $self->option('replace_method');
 135   return '' if $method =~ /^\s*$/;
 136
 137   my @params = split("\n", $self->option('replace_params') );
 138
 139   my( @x_param ) = ();
 140   my( %x_struct ) = ();
 141   foreach my $param (@params) {
 142
 143     my($name, $value) = ('', '');
 144     if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
 145       ($name, $value) = split(/\s+/, $param);
 146     } else { #'Individual values'
 147       $value = $param;
 148     }
 149
 150     if ( $value =~ /^\s*(\$|\@)(old|new)_(\w+)\s*$/ ) {
 151       if ($2 eq 'old' ) {
 152         $value = $self->_export_value($3, $old);
 153       } elsif ( $2 eq 'new' ) {
 154         $value = $self->_export_value($3, $new);
 155       } else {
 156         die 'guru meditation stella blue';
 157       }
 158     }
 159
 160     if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
 161       $x_struct{$name} = $value;
 162     } else { #'Individual values'
 163       push @x_param, $value;
 164     }
 165
 166   }
 167
 168   my @x = ();
 169   if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
 170     @x = ( \%x_struct );
 171   } else { #'Individual values'
 172     @x = @x_param;
 173   }
 174
 175   #option to queue (or not) ?
 176
 177   my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
 178
 179   my $result = $conn->call($method, @x);
 180
 181   #XXX error checking?  $result?  from the call?
 182   '';
 183
 184 }
 185
 186 #comceptual false laziness w/shellcommands.pm
 187 sub _export_value {
 188   my( $self, $value, $svc_acct) = (shift, shift, shift);
 189
 190   my %fields = map { $_=>1 } $svc_acct->fields;
 191
 192   if ( $fields{$value} ) {
 193     my $type = dbdef->table('svc_acct')->column($value)->type;
 194     if ( $type =~ /^(int|serial)/i ) {
 195       return Frontier::RPC2::Integer->new( $svc_acct->$value() );
 196     } elsif ( $value =~ /^last_log/ ) {
 197       return Frontier::RPC2::DateTime::ISO8601->new( $svc_acct->$value() ); #conversion?
 198     } else {
 199       return Frontier::RPC2::String->new( $svc_acct->$value() );
 200     }
 201   } elsif ( $value =~ /^(domain|email)$/ ) {
 202     return Frontier::RPC2::String->new( $svc_acct->$value() );
 203   } elsif ( $value eq 'crypt_password' ) {
 204     return Frontier::RPC2::String->new( $svc_acct->crypt_password( $self->option('crypt') ) );
 205   } elsif ( $value eq 'ldap_password' ) {
 206     return Frontier::RPC2::String->new( $svc_acct->ldap_password($self->option('crypt') ) );
 207   } elsif ( $value eq 'radius_groups' ) {
 208     my @radius_groups = $svc_acct->radius_groups;
 209     #XXX
 210   }
 211
 212 #this is the "cust_main" email, not svc_acct->email
 213 #  my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
 214 #  if ( $cust_pkg ) {
 215 #    no strict 'vars';
 216 #    {
 217 #      no strict 'refs';
 218 #      foreach my $custf (qw( company address1 address2 city state zip country
 219 #                             daytime night fax otaker agent_custid locale
 220 #                        ))
 221 #      {
 222 #        ${$custf} = $cust_pkg->cust_main->$custf();
 223 #      }
 224 #    }
 225 #    $email = ( grep { $_ !~ /^(POST|FAX)$/ } $cust_pkg->cust_main->invoicing_list )[0];
 226 #  } else {
 227 #    $email = '';
 228 #  }
 229
 230 #  my ($reasonnum, $reasontext, $reasontypenum, $reasontypetext);
 231 #  if ( $cust_pkg && $action eq 'suspend' &&
 232 #       (my $r = $cust_pkg->last_reason('susp')) )
 233 #  {
 234 #    $reasonnum = $r->reasonnum;
 235 #    $reasontext = $r->reason;
 236 #    $reasontypenum = $r->reason_type;
 237 #    $reasontypetext = $r->reasontype->type;
 238 #
 239 #    my %reasonmap = $self->_groups_susp_reason_map;
 240 #    my $userspec = '';
 241 #    $userspec = $reasonmap{$reasonnum}
 242 #      if exists($reasonmap{$reasonnum});
 243 #    $userspec = $reasonmap{$reasontext}
 244 #      if (!$userspec && exists($reasonmap{$reasontext}));
 245 #
 246 #    my $suspend_user;
 247 #    if ( $userspec =~ /^\d+$/ ) {
 248 #      $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
 249 #    } elsif ( $userspec =~ /^\S+\@\S+$/ ) {
 250 #      my ($username,$domain) = split(/\@/, $userspec);
 251 #      for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
 252 #        $suspend_user = $user if $userspec eq $user->email;
 253 #      }
 254 #    } elsif ($userspec) {
 255 #      $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
 256 #    }
 257 #
 258 #  @radius_groups = $suspend_user->radius_groups
 259 #    if $suspend_user;
 260 #
 261 #  } else {
 262 #    $reasonnum = $reasontext = $reasontypenum = $reasontypetext = '';
 263 #  }
 264
 265 #  $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : '';
 266 #  $custnum = $cust_pkg ? $cust_pkg->custnum : '';
 267
 268   '';
 269
 270 }
 271
 272 1;
 273