RT# 82087 - updated saisei documentation
[freeside.git] / 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