promo codes and separate signup addresses for hdn
[freeside.git] / FS / FS / ClientAPI / Signup.pm
1 package FS::ClientAPI::Signup;
2
3 use strict;
4 use Tie::RefHash;
5 use FS::Conf;
6 use FS::Record qw(qsearch qsearchs dbdef);
7 use FS::Msgcat qw(gettext);
8 use FS::agent;
9 use FS::cust_main_county;
10 use FS::part_pkg;
11 use FS::svc_acct_pop;
12 use FS::cust_main;
13 use FS::cust_pkg;
14 use FS::svc_acct;
15 use FS::acct_snarf;
16 use FS::queue;
17
18 use FS::ClientAPI; #hmm
19 FS::ClientAPI->register_handlers(
20   'Signup/signup_info'  => \&signup_info,
21   'Signup/new_customer' => \&new_customer,
22 );
23
24 sub signup_info {
25   my $packet = shift;
26
27   my $conf = new FS::Conf;
28
29   use vars qw($signup_info); #cache for performance;
30   $signup_info ||= {
31
32     'cust_main_county' =>
33       [ map { $_->hashref } qsearch('cust_main_county', {}) ],
34
35     'agent' =>
36       [
37         map { $_->hashref }
38           qsearch('agent', dbdef->table('agent')->column('disabled')
39                              ? { 'disabled' => '' }
40                              : {}
41                  )
42       ],
43
44     'part_referral' =>
45       [
46         map { $_->hashref }
47           qsearch('part_referral',
48                     dbdef->table('part_referral')->column('disabled')
49                       ? { 'disabled' => '' }
50                       : {}
51                  )
52       ],
53
54     'agentnum2part_pkg' =>
55       {
56         map {
57           my $href = $_->pkgpart_hashref;
58           $_->agentnum =>
59             [
60               map { { 'payby' => [ $_->payby ], %{$_->hashref} } }
61                 grep { $_->svcpart('svc_acct') && $href->{ $_->pkgpart } }
62                   qsearch( 'part_pkg', { 'disabled' => '' } )
63             ];
64         } qsearch('agent', dbdef->table('agent')->column('disabled')
65                              ? { 'disabled' => '' }
66                              : {}
67                  )
68       },
69
70     'svc_acct_pop' => [ map { $_->hashref } qsearch('svc_acct_pop',{} ) ],
71
72     'security_phrase' => $conf->exists('security_phrase'),
73
74     'payby' => [ $conf->config('signup_server-payby') ],
75
76     'cvv_enabled' => defined dbdef->table('cust_main')->column('paycvv'),
77
78     'ship_enabled' => defined dbdef->table('cust_main')->column('ship_last'),
79
80     'msgcat' => { map { $_=>gettext($_) } qw(
81       passwords_dont_match invalid_card unknown_card_type not_a empty_password
82     ) },
83
84     'statedefault' => $conf->config('statedefault') || 'CA',
85
86     'countrydefault' => $conf->config('countrydefault') || 'US',
87
88     'refnum' => $conf->config('signup_server-default_refnum'),
89
90   };
91
92   my $agentnum = $conf->config('signup_server-default_agentnum');
93
94   my $session = '';
95   if ( exists $packet->{'session_id'} ) {
96     my $cache = new Cache::SharedMemoryCache( {
97       'namespace' => 'FS::ClientAPI::Agent',
98     } );
99     $session = $cache->get($packet->{'session_id'});
100     if ( $session ) {
101       $agentnum = $session->{'agentnum'};
102     } else {
103       return { 'error' => "Can't resume session" }; #better error message
104     }
105   }
106
107   $signup_info->{'part_pkg'} = [];
108   if ( $packet->{'promo_code'} ) {
109     $signup_info->{'part_pkg'} =
110       [ map { { 'payby'   => [ $_->payby ], %{$_->hashref} } }
111           grep { $_->svcpart('svc_acct') }
112             qsearch( 'part_pkg', { 'promo_code' => {
113                                      op=>'ILIKE',
114                                      value=>$packet->{'promo_code'}
115                                    },
116                                    'disabled'   => '',                  } )
117       ];
118
119     $signup_info->{'error'} = 'Unknown promotional code'
120       unless @{ $signup_info->{'part_pkg'} };
121   }
122
123   if ( $agentnum && ! @{ $signup_info->{'part_pkg'} } ) {
124     $signup_info->{'part_pkg'} = $signup_info->{'agentnum2part_pkg'}{$agentnum};
125   }
126   # else {
127   # delete $signup_info->{'part_pkg'};
128   #}
129
130   if ( $session ) {
131     my $agent_signup_info = { %$signup_info };
132     delete $agent_signup_info->{agentnum2part_pkg};
133     $agent_signup_info->{'agent'} = $session->{'agent'};
134     $agent_signup_info;
135   } else {
136     $signup_info;
137   }
138
139 }
140
141 sub new_customer {
142   my $packet = shift;
143
144   my $conf = new FS::Conf;
145   
146   #things that aren't necessary in base class, but are for signup server
147     #return "Passwords don't match"
148     #  if $hashref->{'_password'} ne $hashref->{'_password2'}
149   return { 'error' => gettext('empty_password') }
150     unless length($packet->{'_password'});
151   # a bit inefficient for large numbers of pops
152   return { 'error' => gettext('no_access_number_selected') }
153     unless $packet->{'popnum'} || !scalar(qsearch('svc_acct_pop',{} ));
154
155   my $agentnum;
156   if ( exists $packet->{'session_id'} ) {
157     my $cache = new Cache::SharedMemoryCache( {
158       'namespace' => 'FS::ClientAPI::Agent',
159     } );
160     my $session = $cache->get($packet->{'session_id'});
161     if ( $session ) {
162       $agentnum = $session->{'agentnum'};
163     } else {
164       return { 'error' => "Can't resume session" }; #better error message
165     }
166   } else {
167     $agentnum = $packet->{agentnum}
168                 || $conf->config('signup_server-default_agentnum');
169   }
170
171   #shares some stuff with htdocs/edit/process/cust_main.cgi... take any
172   # common that are still here and library them.
173   my $cust_main = new FS::cust_main ( {
174     #'custnum'          => '',
175     'agentnum'      => $agentnum,
176     'refnum'        => $packet->{refnum}
177                        || $conf->config('signup_server-default_refnum'),
178
179     map { $_ => $packet->{$_} } qw(
180
181       last first ss company address1 address2
182       city county state zip country
183       daytime night fax
184
185       ship_last ship_first ship_ss ship_company ship_address1 ship_address2
186       ship_city ship_county ship_state ship_zip ship_country
187       ship_daytime ship_night ship_fax
188
189       payby payinfo paycvv paydate payname referral_custnum comments
190     )
191
192   } );
193
194   return { 'error' => "Illegal payment type" }
195     unless grep { $_ eq $packet->{'payby'} }
196                 $conf->config('signup_server-payby');
197
198   $cust_main->payinfo($cust_main->daytime)
199     if $cust_main->payby eq 'LECB' && ! $cust_main->payinfo;
200
201   my @invoicing_list = split( /\s*\,\s*/, $packet->{'invoicing_list'} );
202
203   $packet->{'pkgpart'} =~ /^(\d+)$/ or '' =~ /^()$/;
204   my $pkgpart = $1;
205   return { 'error' => 'Please select a package' } unless $pkgpart; #msgcat
206
207   my $part_pkg =
208     qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } )
209       or return { 'error' => "WARNING: unknown pkgpart: $pkgpart" };
210   my $svcpart = $part_pkg->svcpart('svc_acct');
211
212   my $cust_pkg = new FS::cust_pkg ( {
213     #later#'custnum' => $custnum,
214     'pkgpart'    => $packet->{'pkgpart'},
215     'promo_code' => $packet->{'promo_code'},
216   } );
217   #my $error = $cust_pkg->check;
218   #return { 'error' => $error } if $error;
219
220   my $svc_acct = new FS::svc_acct ( {
221     'svcpart'   => $svcpart,
222     map { $_ => $packet->{$_} }
223       qw( username _password sec_phrase popnum ),
224   } );
225
226   my @acct_snarf;
227   my $snarfnum = 1;
228   while (    exists($packet->{"snarf_machine$snarfnum"})
229           && length($packet->{"snarf_machine$snarfnum"}) ) {
230     my $acct_snarf = new FS::acct_snarf ( {
231       'machine'   => $packet->{"snarf_machine$snarfnum"},
232       'protocol'  => $packet->{"snarf_protocol$snarfnum"},
233       'username'  => $packet->{"snarf_username$snarfnum"},
234       '_password' => $packet->{"snarf_password$snarfnum"},
235     } );
236     $snarfnum++;
237     push @acct_snarf, $acct_snarf;
238   }
239   $svc_acct->child_objects( \@acct_snarf );
240
241   my $y = $svc_acct->setdefault; # arguably should be in new method
242   return { 'error' => $y } if $y && !ref($y);
243
244   #$error = $svc_acct->check;
245   #return { 'error' => $error } if $error;
246
247   #setup a job dependancy to delay provisioning
248   my $placeholder = new FS::queue ( {
249     'job'    => 'FS::ClientAPI::Signup::__placeholder',
250     'status' => 'locked',
251   } );
252   my $error = $placeholder->insert;
253   return { 'error' => $error } if $error;
254
255   use Tie::RefHash;
256   tie my %hash, 'Tie::RefHash';
257   %hash = ( $cust_pkg => [ $svc_acct ] );
258   #msgcat
259   $error = $cust_main->insert(
260     \%hash,
261     \@invoicing_list,
262     'depend_jobnum' => $placeholder->jobnum,
263   );
264   if ( $error ) {
265     my $perror = $placeholder->delete;
266     $error .= " (Additionally, error removing placeholder: $perror)" if $perror;
267     return { 'error' => $error };
268   }
269
270   if ( $conf->exists('signup_server-realtime') ) {
271
272     #warn "[fs_signup_server] Billing customer...\n" if $Debug;
273
274     my $bill_error = $cust_main->bill;
275     #warn "[fs_signup_server] error billing new customer: $bill_error"
276     #  if $bill_error;
277
278     $cust_main->apply_payments;
279     $cust_main->apply_credits;
280
281     $bill_error = $cust_main->collect;
282     #warn "[fs_signup_server] error collecting from new customer: $bill_error"
283     #  if $bill_error;
284
285     if ( $cust_main->balance > 0 ) {
286
287       #this makes sense.  credit is "un-doing" the invoice
288       $cust_main->credit( $cust_main->balance, 'signup server decline' );
289       $cust_main->apply_credits;
290
291       #should check list for errors...
292       #$cust_main->suspend;
293       local $FS::svc_Common::noexport_hack = 1;
294       $cust_main->cancel('quiet'=>1);
295
296       my $perror = $placeholder->depended_delete;
297       warn "error removing provisioning jobs after decline: $perror" if $perror;
298       unless ( $perror ) {
299         $perror = $placeholder->delete;
300         warn "error removing placeholder after decline: $perror" if $perror;
301       }
302
303       return { 'error' => '_decline' };
304     }
305
306   }
307
308   $error = $placeholder->delete;
309   return { 'error' => $error } if $error;
310
311   return { error => '' };
312
313 }
314
315 1;