1 package FS::part_export::acct_xmlrpc;
2 use base qw( FS::part_export );
4 use vars qw( %info ); # $DEBUG );
7 use Frontier::Client; #to avoid adding a dependency on RPC::XML just now
8 #use FS::Record qw( qsearch qsearchs );
9 use FS::Schema qw( dbdef );
13 tie my %options, 'Tie::IxHash',
14 'xmlrpc_url' => { label => 'XML-RPC URL', },
15 'param_style' => { label => 'Parameter style',
17 options => [ 'Individual values',
18 'Struct of name/value pairs',
21 'insert_method' => { label => 'Insert method', },
22 'insert_params' => { label => 'Insert parameters', type=>'textarea', },
23 'replace_method' => { label => 'Replace method', },
24 'replace_params' => { label => 'Replace parameters', type=>'textarea', },
25 'delete_method' => { label => 'Delete method', },
26 'delete_params' => { label => 'Delete parameters', type=>'textarea', },
27 'suspend_method' => { label => 'Suspend method', },
28 'suspend_params' => { label => 'Suspend parameters', type=>'textarea', },
29 'unsuspend_method' => { label => 'Unsuspend method', },
30 'unsuspend_params' => { label => 'Unsuspend parameters', type=>'textarea', },
35 'desc' => 'Configurable provisioning of accounts via the XML-RPC protocol',
36 'options' => \%options,
38 Configurable, real-time export of accounts via the XML-RPC protocol.<BR>
40 If using "Individual values" parameter style, specfify one parameter per line.<BR>
42 If using "Struct of name/value pairs" parameter style, specify one name and
43 value on each line, separated by whitespace.<BR>
45 The following variables are available for interpolation (prefixed with new_ or
46 old_ for replace operations):
48 <LI><code>$username</code>
49 <LI><code>$_password</code>
50 <LI><code>$crypt_password</code> - encrypted password
51 <LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4")
54 <LI><code>$finger</code> - Real name
55 <LI><code>$dir</code> - home directory
56 <LI><code>$shell</code>
57 <LI><code>$quota</code>
58 <LI><code>@radius_groups</code>
59 <!-- <LI><code>$reasonnum (when suspending)</code>
60 <LI><code>$reasontext (when suspending)</code>
61 <LI><code>$reasontypenum (when suspending)</code>
62 <LI><code>$reasontypetext (when suspending)</code>
65 <LI><code>$pkgnum</code>
66 <LI><code>$custnum</code>
68 <LI>All other fields in <b>svc_acct</b> are also available.
69 <!-- <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. -->
75 sub _export_insert { shift->_export_command('insert', @_) }
76 sub _export_delete { shift->_export_command('delete', @_) }
77 sub _export_suspend { shift->_export_command('suspend', @_) }
78 sub _export_unsuspend { shift->_export_command('unsuspend', @_) }
81 my ( $self, $action, $svc_acct) = (shift, shift, shift);
82 my $method = $self->option($action.'_method');
83 return '' if $method =~ /^\s*$/;
85 my @params = split("\n", $self->option($action.'_params') );
89 foreach my $param (@params) {
91 my($name, $value) = ('', '');
92 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
93 ($name, $value) = split(/\s+/, $param);
94 } else { #'Individual values'
98 if ( $value =~ /^\s*(\$|\@)(\w+)\s*$/ ) {
99 $value = $self->_export_value($2, $svc_acct);
102 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
103 $x_struct{$name} = $value;
104 } else { #'Individual values'
105 push @x_param, $value;
111 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
113 } else { #'Individual values'
117 #option to queue (or not) ?
119 my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
121 my $result = $conn->call($method, @x);
123 #XXX error checking? $result? from the call?
127 sub _export_replace {
128 my( $self, $new, $old ) = (shift, shift, shift);
130 my $method = $self->option($action.'_method');
131 return '' if $method =~ /^\s*$/;
133 my @params = split("\n", $self->option($action.'_params') );
136 my( %x_struct ) = ();
137 foreach my $param (@params) {
139 my($name, $value) = ('', '');
140 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
141 ($name, $value) = split(/\s+/, $param);
142 } else { #'Individual values'
146 if ( $value =~ /^\s*(\$|\@)(old|new)_(\w+)\s*$/ ) {
148 $value = $self->_export_value($3, $old);
149 } elsif ( $2 eq 'new' ) {
150 $value = $self->_export_value($3, $new);
152 die 'guru meditation stella blue';
156 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
157 $x_struct{$name} = $value;
158 } else { #'Individual values'
159 push @x_param, $value;
165 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
167 } else { #'Individual values'
171 #option to queue (or not) ?
173 my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
175 my $result = $conn->call($method, @x);
177 #XXX error checking? $result? from the call?
182 #comceptual false laziness w/shellcommands.pm
184 my( $self, $value, $svc_acct) = (shift, shift, shift);
186 my %fields = map { $_=>1 } $svc_acct->fields;
188 if ( $fields{$value} ) {
189 my $type = dbdef->table('svc_acct')->column($value)->type;
190 if ( $type =~ /^(int|serial)/i ) {
191 return Frontier::Client->new->int( $svc_acct->$value() );
192 } elsif ( $value =~ /^last_log/ ) {
193 return Frontier::Client->new->date_time( $svc_acct->$value() ); #conversion?
195 return Frontier::Client->new->string( $svc_acct->$value() );
197 } elsif ( $value eq 'domain' ) {
198 return Frontier::Client->new->string( $svc_acct->domain );
199 } elsif ( $value eq 'crypt_password' ) {
200 return Frontier::Client->new->string( $svc_acct->crypt_password( $self->option('crypt') ) );
201 } elsif ( $value eq 'ldap_password' ) {
202 return Frontier::Client->new->string( $svc_acct->ldap_password($self->option('crypt') ) );
203 } elsif ( $value eq 'radius_groups' ) {
204 my @radius_groups = $svc_acct->radius_groups;
208 # my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
213 # foreach my $custf (qw( company address1 address2 city state zip country
214 # daytime night fax otaker agent_custid locale
217 # ${$custf} = $cust_pkg->cust_main->$custf();
220 # $email = ( grep { $_ !~ /^(POST|FAX)$/ } $cust_pkg->cust_main->invoicing_list )[0];
225 # my ($reasonnum, $reasontext, $reasontypenum, $reasontypetext);
226 # if ( $cust_pkg && $action eq 'suspend' &&
227 # (my $r = $cust_pkg->last_reason('susp')) )
229 # $reasonnum = $r->reasonnum;
230 # $reasontext = $r->reason;
231 # $reasontypenum = $r->reason_type;
232 # $reasontypetext = $r->reasontype->type;
234 # my %reasonmap = $self->_groups_susp_reason_map;
236 # $userspec = $reasonmap{$reasonnum}
237 # if exists($reasonmap{$reasonnum});
238 # $userspec = $reasonmap{$reasontext}
239 # if (!$userspec && exists($reasonmap{$reasontext}));
242 # if ( $userspec =~ /^\d+$/ ) {
243 # $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
244 # } elsif ( $userspec =~ /^\S+\@\S+$/ ) {
245 # my ($username,$domain) = split(/\@/, $userspec);
246 # for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
247 # $suspend_user = $user if $userspec eq $user->email;
249 # } elsif ($userspec) {
250 # $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
253 # @radius_groups = $suspend_user->radius_groups
257 # $reasonnum = $reasontext = $reasontypenum = $reasontypetext = '';
260 # $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : '';
261 # $custnum = $cust_pkg ? $cust_pkg->custnum : '';