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
9 #use FS::Record qw( qsearch qsearchs );
10 use FS::Schema qw( dbdef );
14 tie my %options, 'Tie::IxHash',
15 'xmlrpc_url' => { label => 'XML-RPC URL', },
16 'param_style' => { label => 'Parameter style',
18 options => [ 'Individual values',
19 'Struct of name/value pairs',
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', },
36 'desc' => 'Configurable provisioning of accounts via the XML-RPC protocol',
37 'options' => \%options,
39 Configurable, real-time export of accounts via the XML-RPC protocol.<BR>
41 If using "Individual values" parameter style, specify one parameter per line.<BR>
43 If using "Struct of name/value pairs" parameter style, specify one name and
44 value on each line, separated by whitespace.<BR>
46 The following variables are available for interpolation (prefixed with new_ or
47 old_ for replace operations):
49 <LI><code>$username</code>
50 <LI><code>$domain</code>
51 <LI><code>$email</code> - username@domain
52 <LI><code>$_password</code>
53 <LI><code>$crypt_password</code> - encrypted password
54 <LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4")
57 <LI><code>$finger</code> - Real name
58 <LI><code>$dir</code> - home directory
59 <LI><code>$shell</code>
60 <LI><code>$quota</code>
61 <LI><code>@radius_groups</code>
62 <!-- <LI><code>$reasonnum (when suspending)</code>
63 <LI><code>$reasontext (when suspending)</code>
64 <LI><code>$reasontypenum (when suspending)</code>
65 <LI><code>$reasontypetext (when suspending)</code>
68 <LI><code>$pkgnum</code>
69 <LI><code>$custnum</code>
71 <LI>All other fields in <b>svc_acct</b> are also available.
72 <!-- <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. -->
78 sub _export_insert { shift->_export_command('insert', @_) }
79 sub _export_delete { shift->_export_command('delete', @_) }
80 sub _export_suspend { shift->_export_command('suspend', @_) }
81 sub _export_unsuspend { shift->_export_command('unsuspend', @_) }
84 my ( $self, $action, $svc_acct) = (shift, shift, shift);
85 my $method = $self->option($action.'_method');
86 return '' if $method =~ /^\s*$/;
88 my @params = split("\n", $self->option($action.'_params') );
92 foreach my $param (@params) {
94 my($name, $value) = ('', '');
95 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
96 ($name, $value) = split(/\s+/, $param);
97 } else { #'Individual values'
101 if ( $value =~ /^\s*(\$|\@)(\w+)\s*$/ ) {
102 $value = $self->_export_value($2, $svc_acct);
105 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
106 $x_struct{$name} = $value;
107 } else { #'Individual values'
108 push @x_param, $value;
114 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
116 } else { #'Individual values'
120 #option to queue (or not) ?
122 my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
124 my $result = $conn->call($method, @x);
126 #XXX error checking? $result? from the call?
130 sub _export_replace {
131 my( $self, $new, $old ) = (shift, shift, shift);
133 my $method = $self->option('replace_method');
134 return '' if $method =~ /^\s*$/;
136 my @params = split("\n", $self->option('replace_params') );
139 my( %x_struct ) = ();
140 foreach my $param (@params) {
142 my($name, $value) = ('', '');
143 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
144 ($name, $value) = split(/\s+/, $param);
145 } else { #'Individual values'
149 if ( $value =~ /^\s*(\$|\@)(old|new)_(\w+)\s*$/ ) {
151 $value = $self->_export_value($3, $old);
152 } elsif ( $2 eq 'new' ) {
153 $value = $self->_export_value($3, $new);
155 die 'guru meditation stella blue';
159 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
160 $x_struct{$name} = $value;
161 } else { #'Individual values'
162 push @x_param, $value;
168 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
170 } else { #'Individual values'
174 #option to queue (or not) ?
176 my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
178 my $result = $conn->call($method, @x);
180 #XXX error checking? $result? from the call?
185 #comceptual false laziness w/shellcommands.pm
187 my( $self, $value, $svc_acct) = (shift, shift, shift);
189 my %fields = map { $_=>1 } $svc_acct->fields;
191 if ( $fields{$value} ) {
192 my $type = dbdef->table('svc_acct')->column($value)->type;
193 if ( $type =~ /^(int|serial)/i ) {
194 return Frontier::RPC2::Integer->new( $svc_acct->$value() );
195 } elsif ( $value =~ /^last_log/ ) {
196 return Frontier::RPC2::DateTime::ISO8601->new( $svc_acct->$value() ); #conversion?
198 return Frontier::RPC2::String->new( $svc_acct->$value() );
200 } elsif ( $value =~ /^(domain|email)$/ ) {
201 return Frontier::RPC2::String->new( $svc_acct->$value() );
202 } elsif ( $value eq 'crypt_password' ) {
203 return Frontier::RPC2::String->new( $svc_acct->crypt_password( $self->option('crypt') ) );
204 } elsif ( $value eq 'ldap_password' ) {
205 return Frontier::RPC2::String->new( $svc_acct->ldap_password($self->option('crypt') ) );
206 } elsif ( $value eq 'radius_groups' ) {
207 my @radius_groups = $svc_acct->radius_groups;
211 #this is the "cust_main" email, not svc_acct->email
212 # my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
217 # foreach my $custf (qw( company address1 address2 city state zip country
218 # daytime night fax otaker agent_custid locale
221 # ${$custf} = $cust_pkg->cust_main->$custf();
224 # $email = ( grep { $_ !~ /^(POST|FAX)$/ } $cust_pkg->cust_main->invoicing_list )[0];
229 # my ($reasonnum, $reasontext, $reasontypenum, $reasontypetext);
230 # if ( $cust_pkg && $action eq 'suspend' &&
231 # (my $r = $cust_pkg->last_reason('susp')) )
233 # $reasonnum = $r->reasonnum;
234 # $reasontext = $r->reason;
235 # $reasontypenum = $r->reason_type;
236 # $reasontypetext = $r->reasontype->type;
238 # my %reasonmap = $self->_groups_susp_reason_map;
240 # $userspec = $reasonmap{$reasonnum}
241 # if exists($reasonmap{$reasonnum});
242 # $userspec = $reasonmap{$reasontext}
243 # if (!$userspec && exists($reasonmap{$reasontext}));
246 # if ( $userspec =~ /^\d+$/ ) {
247 # $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
248 # } elsif ( $userspec =~ /^\S+\@\S+$/ ) {
249 # my ($username,$domain) = split(/\@/, $userspec);
250 # for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
251 # $suspend_user = $user if $userspec eq $user->email;
253 # } elsif ($userspec) {
254 # $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
257 # @radius_groups = $suspend_user->radius_groups
261 # $reasonnum = $reasontext = $reasontypenum = $reasontypetext = '';
264 # $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : '';
265 # $custnum = $cust_pkg ? $cust_pkg->custnum : '';