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