#29052 Fix Aradial replace operations
[freeside.git] / FS / FS / part_export / acct_freeside.pm
1 package FS::part_export::acct_freeside;
2
3 use vars qw( @ISA %info $DEBUG );
4 use Data::Dumper;
5 use Tie::IxHash;
6 use FS::part_export;
7 #use FS::Record qw( qsearch qsearchs );
8 use Frontier::Client;
9
10 @ISA = qw(FS::part_export);
11
12 $DEBUG = 1;
13
14 tie my %options, 'Tie::IxHash',
15   'xmlrpc_url'  => { label => 'Full URL to target Freeside xmlrpc.cgi', },
16   'ss_username' => { label => 'Self-service username', },
17   'ss_domain'   => { label => 'Self-service domain',   },
18   'ss_password' => { label => 'Self-service password', },
19   'domsvc'      => { label => 'Domain svcnum on target machine', },
20   'pkgnum'      => { label => 'Customer package pkgnum on target machine', },
21   'svcpart'     => { label => 'Service definition svcpart on target machine', },
22 ;
23
24 %info = (
25   'svc'     => 'svc_acct',
26   'desc'    => 'Real-time export to another Freeside server',
27   'options' => \%options,
28   'notes'   => <<END
29 Real-time export to another Freeside server via self-service.
30 Requires installation of
31 <a href="http://search.cpan.org/dist/Frontier-Client">Frontier::Client</a>
32 from CPAN and setup of an appropriate bulk customer on the other Freeside server.
33 END
34 );
35
36 sub _export_insert {
37   my($self, $svc_acct) = (shift, shift);
38
39   my $result = $self->_freeside_command('provision_acct',
40     'pkgnum'     => $self->option('pkgnum'),
41     'svcpart'    => $self->option('svcpart'),
42     'username'   => $svc_acct->username,
43     '_password'  => $svc_acct->_password,
44     '_password2' => $svc_acct->_password,
45     'domsvc'     => $self->option('domsvc'),
46   );
47
48   $result->{error} || '';
49
50 }
51
52 sub _export_replace {
53   my( $self, $new, $old ) = (shift, shift, shift);
54
55   my $svcnum = $self->_freeside_find_svc( $old );
56   return $svcnum unless $svcnum =~ /^(\d+)$/;
57
58   #only pw change supported for now...
59   my $result = $self->_freeside_command( 'myaccount_passwd',
60                                              'svcnum'        => $svcnum,
61                                              'new_password'  => $new->_password,
62                                              'new_password2' => $new->_password,
63                                        );
64
65   $result->{error} || '';
66 }
67
68 sub _export_delete {
69   my( $self, $svc_acct ) = (shift, shift);
70
71   my $svcnum = $self->_freeside_find_svc( $svc_acct );
72   return $svcnum unless $svcnum =~ /^(\d+)$/;
73
74   my $result = $self->_freeside_command( 'unprovision_svc', 'svcnum'=>$svcnum );
75
76   $result->{'error'} || '';
77
78 }
79
80 sub _freeside_find_svc {
81   my( $self, $svc_acct ) = ( shift, shift );
82
83   my $list_svcs = $self->_freeside_command( 'list_svcs', 'svcdb'=>'svc_acct' );
84   my @svc = grep {    $svc_acct->username eq $_->{username}
85                    #&& compare domains
86                  } @{ $list_svcs->{svcs} };
87
88   return 'multiple services found on target FS' if scalar(@svc) > 1;
89   return 'no service found on target FS' if scalar(@svc) == 0; #shouldn't be fatal?
90
91   $svc[0]->{'svcnum'};
92
93 }
94
95 sub _freeside_command {
96   my( $self, $method, @args ) = @_;
97
98   my %login = (
99     'username' => $self->option('ss_username'),
100     'domain'   => $self->option('ss_domain'),
101     'password' => $self->option('ss_password'),
102   );
103   my $login_result = $self->_do_freeside_command( 'login', %login );
104   return $login_result if $login_result->{error};
105   my $session_id = $login_result->{session_id};
106
107   #could reuse $session id for replace & delete where we have to find then delete..
108
109   my %command = (
110     session_id => $session_id,
111     @args
112   );
113   my $result = $self->_do_freeside_command( $method, %command );
114
115   $result;
116
117 }
118
119 sub _do_freeside_command {
120   my( $self, $method, %args ) = @_;
121
122   # a questionable choice...  but it'll do for now.
123   eval "use Frontier::Client;";
124   die $@ if $@;
125
126   #reuse?
127   my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
128
129   warn "sending FS selfservice $method: ". Dumper(\%args)
130     if $DEBUG;
131   my $result = $conn->call("FS.SelfService.XMLRPC.$method", \%args);
132   warn "FS selfservice $method response: ". Dumper($result)
133     if $DEBUG;
134
135   $result;
136
137 }
138
139 1;