FS/FS/ClientAPI/Signup.pm

   1 package FS::ClientAPI::Signup;
   2
   3 use strict;
   4 use vars qw($DEBUG $me);
   5 use Data::Dumper;
   6 use Tie::RefHash;
   7 use FS::Conf;
   8 use FS::Record qw(qsearch qsearchs dbdef);
   9 use FS::Msgcat qw(gettext);
  10 use FS::Misc qw(card_types);
  11 use FS::ClientAPI_SessionCache;
  12 use FS::agent;
  13 use FS::cust_main_county;
  14 use FS::part_pkg;
  15 use FS::svc_acct_pop;
  16 use FS::cust_main;
  17 use FS::cust_pkg;
  18 use FS::svc_acct;
  19 use FS::svc_phone;
  20 use FS::acct_snarf;
  21 use FS::queue;
  22 use FS::reg_code;
  23
  24 $DEBUG = 0;
  25 $me = '[FS::ClientAPI::Signup]';
  26
  27 sub signup_info {
  28   my $packet = shift;
  29
  30   warn "$me signup_info called on $packet\n" if $DEBUG;
  31
  32   my $conf = new FS::Conf;
  33   my $svc_x = $conf->config('signup_server-service') || 'svc_acct';
  34
  35   my $cache = new FS::ClientAPI_SessionCache( {
  36     'namespace' => 'FS::ClientAPI::Signup',
  37   } );
  38   my $signup_info_cache = $cache->get('signup_info_cache');
  39
  40   if ( $signup_info_cache ) {
  41
  42     warn "$me loading cached signup info\n" if $DEBUG > 1;
  43
  44   } else {
  45
  46     warn "$me populating signup info cache\n" if $DEBUG > 1;
  47
  48     my $agentnum2part_pkg =
  49       {
  50         map {
  51           my $href = $_->pkgpart_hashref;
  52           $_->agentnum =>
  53             [
  54               map { { 'payby'       => [ $_->payby ],
  55                       'freq_pretty' => $_->freq_pretty,
  56                       'options'     => { $_->options },
  57                       %{$_->hashref}
  58                   } }
  59                 grep { $_->svcpart($svc_x) && $href->{ $_->pkgpart } }
  60                   qsearch( 'part_pkg', { 'disabled' => '' } )
  61             ];
  62         } qsearch('agent', { 'disabled' => '' })
  63       };
  64
  65     my $msgcat = { map { $_=>gettext($_) }
  66                        qw( passwords_dont_match invalid_card unknown_card_type
  67                            not_a empty_password illegal_or_empty_text )
  68                  };
  69     warn "msgcat: ". Dumper($msgcat). "\n" if $DEBUG > 2;
  70
  71     my $label = { map { $_ => FS::Msgcat::_gettext($_) }
  72                       qw( stateid stateid_state )
  73                 };
  74     warn "label: ". Dumper($label). "\n" if $DEBUG > 2;
  75
  76     $signup_info_cache = {
  77       'cust_main_county' => [ map $_->hashref,
  78                                   qsearch('cust_main_county', {} )
  79                             ],
  80
  81       'agent' => [ map $_->hashref,
  82                        qsearch('agent', { 'disabled' => '' } )
  83                  ],
  84
  85       'part_referral' => [ map $_->hashref,
  86                                qsearch('part_referral', { 'disabled' => '' } )
  87                          ],
  88
  89       'agentnum2part_pkg' => $agentnum2part_pkg,
  90
  91       'svc_acct_pop' => [ map $_->hashref, qsearch('svc_acct_pop',{} ) ],
  92
  93       'emailinvoiceonly' => $conf->exists('emailinvoiceonly'),
  94
  95       'security_phrase' => $conf->exists('security_phrase'),
  96
  97       'payby' => [ $conf->config('signup_server-payby') ],
  98
  99       'card_types' => card_types(),
 100
 101       'paytypes' => [ @FS::cust_main::paytypes ],
 102
 103       'cvv_enabled' => 1,
 104
 105       'stateid_enabled' => $conf->exists('show_stateid'),
 106
 107       'paystate_enabled' => $conf->exists('show_bankstate'),
 108
 109       'ship_enabled' => 1,
 110
 111       'msgcat' => $msgcat,
 112
 113       'label' => $label,
 114
 115       'statedefault' => scalar($conf->config('statedefault')) || 'CA',
 116
 117       'countrydefault' => scalar($conf->config('countrydefault')) || 'US',
 118
 119       'refnum' => scalar($conf->config('signup_server-default_refnum')),
 120
 121       'default_pkgpart' => scalar($conf->config('signup_server-default_pkgpart')),
 122
 123       'signup_service' => $svc_x,
 124       'default_svcpart' => scalar($conf->config('signup_server-default_svcpart')),
 125
 126     };
 127
 128     $cache->set('signup_info_cache', $signup_info_cache);
 129
 130   }
 131
 132   my $signup_info = { %$signup_info_cache };
 133   warn "$me signup info loaded\n" if $DEBUG > 1;
 134   warn Dumper($signup_info). "\n" if $DEBUG > 2;
 135
 136   my @addl = qw( signup_server-classnum2 signup_server-classnum3 );
 137
 138   if ( grep { $conf->exists($_) } @addl ) {
 139
 140     $signup_info->{optional_packages} = [];
 141
 142     foreach my $addl ( @addl ) {
 143
 144       warn "$me adding optional package info\n" if $DEBUG > 1;
 145
 146       my $classnum = $conf->config($addl) or next;
 147
 148       my @pkgs = map { {
 149                          'freq_pretty' => $_->freq_pretty,
 150                          'options'     => { $_->options },
 151                          %{ $_->hashref }
 152                        };
 153                      }
 154                      qsearch( 'part_pkg', { classnum => $classnum } );
 155
 156       push @{$signup_info->{optional_packages}}, \@pkgs;
 157
 158       warn "$me done adding opt. package info for $classnum\n" if $DEBUG > 1;
 159
 160     }
 161
 162   }
 163
 164   my $agentnum = $packet->{'agentnum'}
 165                  || $conf->config('signup_server-default_agentnum');
 166   $agentnum =~ /^(\d*)$/ or die "illegal agentnum";
 167   $agentnum = $1;
 168
 169   my $session = '';
 170   if ( exists $packet->{'session_id'} ) {
 171
 172     warn "$me loading agent session\n" if $DEBUG > 1;
 173     my $cache = new FS::ClientAPI_SessionCache( {
 174       'namespace' => 'FS::ClientAPI::Agent',
 175     } );
 176     $session = $cache->get($packet->{'session_id'});
 177     if ( $session ) {
 178       $agentnum = $session->{'agentnum'};
 179     } else {
 180       return { 'error' => "Can't resume session" }; #better error message
 181     }
 182     warn "$me done loading agent session\n" if $DEBUG > 1;
 183
 184   } elsif ( exists $packet->{'customer_session_id'} ) {
 185
 186     warn "$me loading customer session\n" if $DEBUG > 1;
 187     my $cache = new FS::ClientAPI_SessionCache( {
 188       'namespace' => 'FS::ClientAPI::MyAccount',
 189     } );
 190     $session = $cache->get($packet->{'customer_session_id'});
 191     if ( $session ) {
 192       my $custnum = $session->{'custnum'};
 193       my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum });
 194       return { 'error' => "Can't find your customer record" } unless $cust_main;
 195       $agentnum = $cust_main->agentnum;
 196     } else {
 197       return { 'error' => "Can't resume session" }; #better error message
 198     }
 199     warn "$me done loading customer session\n" if $DEBUG > 1;
 200
 201   }
 202
 203   $signup_info->{'part_pkg'} = [];
 204
 205   if ( $packet->{'reg_code'} ) {
 206
 207     warn "$me setting package list via reg_code\n" if $DEBUG > 1;
 208
 209     $signup_info->{'part_pkg'} =
 210       [ map { { 'payby'       => [ $_->payby ],
 211                 'freq_pretty' => $_->freq_pretty,
 212                 'options'     => { $_->options },
 213                 %{$_->hashref}
 214               };
 215             }
 216           grep { $_->svcpart($svc_x) }
 217           map { $_->part_pkg }
 218             qsearchs( 'reg_code', { 'code'     => $packet->{'reg_code'},
 219                                     'agentnum' => $agentnum,              } )
 220
 221       ];
 222
 223     $signup_info->{'error'} = 'Unknown registration code'
 224       unless @{ $signup_info->{'part_pkg'} };
 225
 226     warn "$me done setting package list via reg_code\n" if $DEBUG > 1;
 227
 228   } elsif ( $packet->{'promo_code'} ) {
 229
 230     warn "$me setting package list via promo_code\n" if $DEBUG > 1;
 231
 232     $signup_info->{'part_pkg'} =
 233       [ map { { 'payby'   => [ $_->payby ],
 234                 'freq_pretty' => $_->freq_pretty,
 235                 'options'     => { $_->options },
 236                 %{$_->hashref}
 237             } }
 238           grep { $_->svcpart($svc_x) }
 239             qsearch( 'part_pkg', { 'promo_code' => {
 240                                      op=>'ILIKE',
 241                                      value=>$packet->{'promo_code'}
 242                                    },
 243                                    'disabled'   => '',                  } )
 244       ];
 245
 246     $signup_info->{'error'} = 'Unknown promotional code'
 247       unless @{ $signup_info->{'part_pkg'} };
 248
 249     warn "$me done setting package list via promo_code\n" if $DEBUG > 1;
 250   }
 251
 252   if ( $agentnum ) {
 253
 254     warn "$me setting agent-specific package list\n" if $DEBUG > 1;
 255     $signup_info->{'part_pkg'} = $signup_info->{'agentnum2part_pkg'}{$agentnum}
 256       unless @{ $signup_info->{'part_pkg'} };
 257     warn "$me done setting agent-specific package list\n" if $DEBUG > 1;
 258
 259     warn "$me setting agent-specific adv. source list\n" if $DEBUG > 1;
 260     $signup_info->{'part_referral'} =
 261       [
 262         map { $_->hashref }
 263           qsearch( {
 264                      'table'     => 'part_referral',
 265                      'hashref'   => { 'disabled' => '' },
 266                      'extra_sql' => "AND (    agentnum = $agentnum  ".
 267                                     "      OR agentnum IS NULL    ) ",
 268                    },
 269                  )
 270       ];
 271     warn "$me done setting agent-specific adv. source list\n" if $DEBUG > 1;
 272
 273   }
 274   # else {
 275   # delete $signup_info->{'part_pkg'};
 276   #}
 277
 278   warn "$me sorting package list\n" if $DEBUG > 1;
 279   $signup_info->{'part_pkg'} = [ sort { $a->{pkg} cmp $b->{pkg} }  # case?
 280                                       @{ $signup_info->{'part_pkg'} }
 281                                ];
 282   warn "$me done sorting package list\n" if $DEBUG > 1;
 283
 284   if ( exists $packet->{'session_id'} ) {
 285     my $agent_signup_info = { %$signup_info };
 286     delete $agent_signup_info->{agentnum2part_pkg};
 287     $agent_signup_info->{'agent'} = $session->{'agent'};
 288     $agent_signup_info;
 289   } else {
 290     $signup_info;
 291   }
 292
 293 }
 294
 295 sub domain_select_hash {
 296   my $packet = shift;
 297
 298   my $response = {};
 299
 300   if ($packet->{pkgpart}) {
 301     my $part_pkg = qsearchs('part_pkg' => { 'pkgpart' => $packet->{pkgpart} } );
 302     #$packet->{svcpart} = $part_pkg->svcpart('svc_acct')
 303     $packet->{svcpart} = $part_pkg->svcpart
 304       if $part_pkg;
 305   }
 306
 307   if ($packet->{svcpart}) {
 308     my $part_svc = qsearchs('part_svc' => { 'svcpart' => $packet->{svcpart} } );
 309     $response->{'domsvc'} = $part_svc->part_svc_column('domsvc')->columnvalue
 310       if ($part_svc && $part_svc->part_svc_column('domsvc')->columnflag  eq 'D');
 311   }
 312
 313   $response->{'domains'}
 314     = { domain_select_hash FS::svc_acct( map { $_ => $packet->{$_} }
 315                                                  qw(svcpart pkgnum)
 316                                        ) };
 317
 318   $response;
 319 }
 320
 321 sub new_customer {
 322   my $packet = shift;
 323
 324   my $conf = new FS::Conf;
 325   my $svc_x = $conf->config('signup_server-service') || 'svc_acct';
 326
 327   if ( $svc_x eq 'svc_acct' ) {
 328
 329     #things that aren't necessary in base class, but are for signup server
 330       #return "Passwords don't match"
 331       #  if $hashref->{'_password'} ne $hashref->{'_password2'}
 332     return { 'error' => gettext('empty_password') }
 333       unless length($packet->{'_password'});
 334     # a bit inefficient for large numbers of pops
 335     return { 'error' => gettext('no_access_number_selected') }
 336       unless $packet->{'popnum'} || !scalar(qsearch('svc_acct_pop',{} ));
 337
 338   }
 339
 340   my $agentnum;
 341   if ( exists $packet->{'session_id'} ) {
 342     my $cache = new FS::ClientAPI_SessionCache( {
 343       'namespace' => 'FS::ClientAPI::Agent',
 344     } );
 345     my $session = $cache->get($packet->{'session_id'});
 346     if ( $session ) {
 347       $agentnum = $session->{'agentnum'};
 348     } else {
 349       return { 'error' => "Can't resume session" }; #better error message
 350     }
 351   } else {
 352     $agentnum = $packet->{agentnum}
 353                 || $conf->config('signup_server-default_agentnum');
 354   }
 355
 356   #shares some stuff with htdocs/edit/process/cust_main.cgi... take any
 357   # common that are still here and library them.
 358   my $cust_main = new FS::cust_main ( {
 359     #'custnum'          => '',
 360     'agentnum'      => $agentnum,
 361     'refnum'        => $packet->{refnum}
 362                        || $conf->config('signup_server-default_refnum'),
 363
 364     map { $_ => $packet->{$_} } qw(
 365
 366       last first ss company address1 address2
 367       city county state zip country
 368       daytime night fax stateid stateid_state
 369
 370       ship_last ship_first ship_ss ship_company ship_address1 ship_address2
 371       ship_city ship_county ship_state ship_zip ship_country
 372       ship_daytime ship_night ship_fax
 373
 374       payby
 375       payinfo paycvv paydate payname paystate paytype
 376       paystart_month paystart_year payissue
 377       payip
 378
 379       referral_custnum comments
 380     )
 381
 382   } );
 383
 384   return { 'error' => "Illegal payment type" }
 385     unless grep { $_ eq $packet->{'payby'} }
 386                 $conf->config('signup_server-payby');
 387
 388   $cust_main->payinfo($cust_main->daytime)
 389     if $cust_main->payby eq 'LECB' && ! $cust_main->payinfo;
 390
 391   my @invoicing_list = $packet->{'invoicing_list'}
 392                          ? split( /\s*\,\s*/, $packet->{'invoicing_list'} )
 393                          : ();
 394
 395   $packet->{'pkgpart'} =~ /^(\d+)$/ or '' =~ /^()$/;
 396   my $pkgpart = $1;
 397   return { 'error' => 'Please select a package' } unless $pkgpart; #msgcat
 398
 399   my $part_pkg =
 400     qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } )
 401       or return { 'error' => "WARNING: unknown pkgpart: $pkgpart" };
 402   my $svcpart = $part_pkg->svcpart($svc_x);
 403
 404   my $reg_code = '';
 405   if ( $packet->{'reg_code'} ) {
 406     $reg_code = qsearchs( 'reg_code', { 'code'     => $packet->{'reg_code'},
 407                                         'agentnum' => $agentnum,             } )
 408       or return { 'error' => 'Unknown registration code' };
 409   }
 410
 411   my $cust_pkg = new FS::cust_pkg ( {
 412     #later#'custnum' => $custnum,
 413     'pkgpart'    => $packet->{'pkgpart'},
 414     'promo_code' => $packet->{'promo_code'},
 415     'reg_code'   => $packet->{'reg_code'},
 416   } );
 417   #my $error = $cust_pkg->check;
 418   #return { 'error' => $error } if $error;
 419
 420   #should be all auto-magic and shit
 421   my $svc;
 422   if ( $svc_x eq 'svc_acct' ) {
 423
 424     $svc = new FS::svc_acct ( {
 425       'svcpart'   => $svcpart,
 426       map { $_ => $packet->{$_} }
 427         qw( username _password sec_phrase popnum ),
 428     } );
 429
 430     my @acct_snarf;
 431     my $snarfnum = 1;
 432     while (    exists($packet->{"snarf_machine$snarfnum"})
 433             && length($packet->{"snarf_machine$snarfnum"}) ) {
 434       my $acct_snarf = new FS::acct_snarf ( {
 435         'machine'   => $packet->{"snarf_machine$snarfnum"},
 436         'protocol'  => $packet->{"snarf_protocol$snarfnum"},
 437         'username'  => $packet->{"snarf_username$snarfnum"},
 438         '_password' => $packet->{"snarf_password$snarfnum"},
 439       } );
 440       $snarfnum++;
 441       push @acct_snarf, $acct_snarf;
 442     }
 443     $svc->child_objects( \@acct_snarf );
 444
 445   } elsif ( $svc_x eq 'svc_phone' ) {
 446
 447     $svc = new FS::svc_phone ( {
 448       'svcpart' => $svcpart,
 449        map { $_ => $packet->{$_} }
 450          qw( countrycode phonenum sip_password pin ),
 451     } );
 452
 453   } else {
 454     die "unknown signup service $svc_x";
 455   }
 456
 457   my $y = $svc->setdefault; # arguably should be in new method
 458   return { 'error' => $y } if $y && !ref($y);
 459
 460   #$error = $svc->check;
 461   #return { 'error' => $error } if $error;
 462
 463   #setup a job dependancy to delay provisioning
 464   my $placeholder = new FS::queue ( {
 465     'job'    => 'FS::ClientAPI::Signup::__placeholder',
 466     'status' => 'locked',
 467   } );
 468   my $error = $placeholder->insert;
 469   return { 'error' => $error } if $error;
 470
 471   use Tie::RefHash;
 472   tie my %hash, 'Tie::RefHash';
 473   %hash = ( $cust_pkg => [ $svc ] );
 474   #msgcat
 475   $error = $cust_main->insert(
 476     \%hash,
 477     \@invoicing_list,
 478     'depend_jobnum' => $placeholder->jobnum,
 479   );
 480   if ( $error ) {
 481     my $perror = $placeholder->delete;
 482     $error .= " (Additionally, error removing placeholder: $perror)" if $perror;
 483     return { 'error' => $error };
 484   }
 485
 486   if ( $conf->exists('signup_server-realtime') ) {
 487
 488     #warn "[fs_signup_server] Billing customer...\n" if $Debug;
 489
 490     my $bill_error = $cust_main->bill;
 491     #warn "[fs_signup_server] error billing new customer: $bill_error"
 492     #  if $bill_error;
 493
 494     $bill_error = $cust_main->apply_payments_and_credits;
 495     #warn "[fs_signup_server] error applying payments and credits for".
 496     #     " new customer: $bill_error"
 497     #  if $bill_error;
 498
 499     $bill_error = $cust_main->collect('realtime' => 1);
 500     #warn "[fs_signup_server] error collecting from new customer: $bill_error"
 501     #  if $bill_error;
 502
 503     if ( $cust_main->balance > 0 ) {
 504
 505       #this makes sense.  credit is "un-doing" the invoice
 506       $cust_main->credit( $cust_main->balance, 'signup server decline',
 507                           'reason_type' => $conf->config('signup_credit_type'),
 508                         );
 509       $cust_main->apply_credits;
 510
 511       #should check list for errors...
 512       #$cust_main->suspend;
 513       local $FS::svc_Common::noexport_hack = 1;
 514       $cust_main->cancel('quiet'=>1);
 515
 516       my $perror = $placeholder->depended_delete;
 517       warn "error removing provisioning jobs after decline: $perror" if $perror;
 518       unless ( $perror ) {
 519         $perror = $placeholder->delete;
 520         warn "error removing placeholder after decline: $perror" if $perror;
 521       }
 522
 523       return { 'error' => '_decline' };
 524     }
 525
 526   }
 527
 528   if ( $reg_code ) {
 529     $error = $reg_code->delete;
 530     return { 'error' => $error } if $error;
 531   }
 532
 533   $error = $placeholder->delete;
 534   return { 'error' => $error } if $error;
 535
 536   my %return = ( 'error'          => '',
 537                  'signup_service' => $svc_x,
 538                );
 539
 540   if ( $svc_x eq 'svc_acct' ) {
 541     $return{$_} = $svc->$_() for qw( username _password );
 542   } elsif ( $svc_x eq 'svc_phone' ) {
 543     $return{$_} = $svc->$_() for qw( countrycode phonenum sip_password pin );
 544   } else {
 545     die "unknown signup service $svc_x";
 546   }
 547
 548   return \%return;
 549
 550 }
 551
 552 1;