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,
40 Configurable, real-time export of accounts via the XML-RPC protocol.<BR>
42 If using "Individual values" parameter style, specify one parameter per line.<BR>
44 If using "Struct of name/value pairs" parameter style, specify one name and
45 value on each line, separated by whitespace.<BR>
47 The following variables are available for interpolation (prefixed with new_ or
48 old_ for replace operations):
50 <LI><code>$username</code>
51 <LI><code>$_password</code>
52 <LI><code>$crypt_password</code> - encrypted password
53 <LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4")
56 <LI><code>$finger</code> - Real name
57 <LI><code>$dir</code> - home directory
58 <LI><code>$shell</code>
59 <LI><code>$quota</code>
60 <LI><code>@radius_groups</code>
61 <!-- <LI><code>$reasonnum (when suspending)</code>
62 <LI><code>$reasontext (when suspending)</code>
63 <LI><code>$reasontypenum (when suspending)</code>
64 <LI><code>$reasontypetext (when suspending)</code>
67 <LI><code>$pkgnum</code>
68 <LI><code>$custnum</code>
70 <LI>All other fields in <b>svc_acct</b> are also available.
71 <!-- <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. -->
77 sub _export_insert { shift->_export_command('insert', @_) }
78 sub _export_delete { shift->_export_command('delete', @_) }
79 sub _export_suspend { shift->_export_command('suspend', @_) }
80 sub _export_unsuspend { shift->_export_command('unsuspend', @_) }
83 my ( $self, $action, $svc_acct) = (shift, shift, shift);
84 my $method = $self->option($action.'_method');
85 return '' if $method =~ /^\s*$/;
87 my @params = split("\n", $self->option($action.'_params') );
91 foreach my $param (@params) {
93 my($name, $value) = ('', '');
94 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
95 ($name, $value) = split(/\s+/, $param);
96 } else { #'Individual values'
100 if ( $value =~ /^\s*(\$|\@)(\w+)\s*$/ ) {
101 $value = $self->_export_value($2, $svc_acct);
104 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
105 $x_struct{$name} = $value;
106 } else { #'Individual values'
107 push @x_param, $value;
113 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
115 } else { #'Individual values'
119 #option to queue (or not) ?
121 my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
123 my $result = $conn->call($method, @x);
125 #XXX error checking? $result? from the call?
129 sub _export_replace {
130 my( $self, $new, $old ) = (shift, shift, shift);
132 my $method = $self->option($action.'_method');
133 return '' if $method =~ /^\s*$/;
135 my @params = split("\n", $self->option($action.'_params') );
138 my( %x_struct ) = ();
139 foreach my $param (@params) {
141 my($name, $value) = ('', '');
142 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
143 ($name, $value) = split(/\s+/, $param);
144 } else { #'Individual values'
148 if ( $value =~ /^\s*(\$|\@)(old|new)_(\w+)\s*$/ ) {
150 $value = $self->_export_value($3, $old);
151 } elsif ( $2 eq 'new' ) {
152 $value = $self->_export_value($3, $new);
154 die 'guru meditation stella blue';
158 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
159 $x_struct{$name} = $value;
160 } else { #'Individual values'
161 push @x_param, $value;
167 if ($self->option('param_style') eq 'Struct of name/value pairs' ) {
169 } else { #'Individual values'
173 #option to queue (or not) ?
175 my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
177 my $result = $conn->call($method, @x);
179 #XXX error checking? $result? from the call?
184 #comceptual false laziness w/shellcommands.pm
186 my( $self, $value, $svc_acct) = (shift, shift, shift);
188 my %fields = map { $_=>1 } $svc_acct->fields;
190 if ( $fields{$value} ) {
191 my $type = dbdef->table('svc_acct')->column($value)->type;
192 if ( $type =~ /^(int|serial)/i ) {
193 return Frontier::RPC2::Integer->new( $svc_acct->$value() );
194 } elsif ( $value =~ /^last_log/ ) {
195 return Frontier::RPC2::DateTime::ISO8601->new( $svc_acct->$value() ); #conversion?
197 return Frontier::RPC2::String->new( $svc_acct->$value() );
199 } elsif ( $value eq 'domain' ) {
200 return Frontier::RPC2::String->new( $svc_acct->domain );
201 } elsif ( $value eq 'crypt_password' ) {
202 return Frontier::RPC2::String->new( $svc_acct->crypt_password( $self->option('crypt') ) );
203 } elsif ( $value eq 'ldap_password' ) {
204 return Frontier::RPC2::String->new( $svc_acct->ldap_password($self->option('crypt') ) );
205 } elsif ( $value eq 'radius_groups' ) {
206 my @radius_groups = $svc_acct->radius_groups;
210 # my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
215 # foreach my $custf (qw( company address1 address2 city state zip country
216 # daytime night fax otaker agent_custid locale
219 # ${$custf} = $cust_pkg->cust_main->$custf();
222 # $email = ( grep { $_ !~ /^(POST|FAX)$/ } $cust_pkg->cust_main->invoicing_list )[0];
227 # my ($reasonnum, $reasontext, $reasontypenum, $reasontypetext);
228 # if ( $cust_pkg && $action eq 'suspend' &&
229 # (my $r = $cust_pkg->last_reason('susp')) )
231 # $reasonnum = $r->reasonnum;
232 # $reasontext = $r->reason;
233 # $reasontypenum = $r->reason_type;
234 # $reasontypetext = $r->reasontype->type;
236 # my %reasonmap = $self->_groups_susp_reason_map;
238 # $userspec = $reasonmap{$reasonnum}
239 # if exists($reasonmap{$reasonnum});
240 # $userspec = $reasonmap{$reasontext}
241 # if (!$userspec && exists($reasonmap{$reasontext}));
244 # if ( $userspec =~ /^\d+$/ ) {
245 # $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
246 # } elsif ( $userspec =~ /^\S+\@\S+$/ ) {
247 # my ($username,$domain) = split(/\@/, $userspec);
248 # for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
249 # $suspend_user = $user if $userspec eq $user->email;
251 # } elsif ($userspec) {
252 # $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
255 # @radius_groups = $suspend_user->radius_groups
259 # $reasonnum = $reasontext = $reasontypenum = $reasontypetext = '';
262 # $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : '';
263 # $custnum = $cust_pkg ? $cust_pkg->custnum : '';