FS/FS/cust_main/Packages.pm

   1 package FS::cust_main::Packages;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me );
   5 use List::Util qw( min );
   6 use FS::UID qw( dbh );
   7 use FS::Record qw( qsearch qsearchs );
   8 use FS::cust_pkg;
   9 use FS::cust_svc;
  10 use FS::contact;       # for attach_pkgs
  11 use FS::cust_location; #
  12
  13 $DEBUG = 0;
  14 $me = '[FS::cust_main::Packages]';
  15
  16 =head1 NAME
  17
  18 FS::cust_main::Packages - Packages mixin for cust_main
  19
  20 =head1 SYNOPSIS
  21
  22 =head1 DESCRIPTION
  23
  24 These methods are available on FS::cust_main objects;
  25
  26 =head1 METHODS
  27
  28 =over 4
  29
  30 =item order_pkg HASHREF | OPTION => VALUE ...
  31
  32 Orders a single package.
  33
  34 Note that if the package definition has supplemental packages, those will
  35 be ordered as well.
  36
  37 Options may be passed as a list of key/value pairs or as a hash reference.
  38 Options are:
  39
  40 =over 4
  41
  42 =item cust_pkg
  43
  44 FS::cust_pkg object
  45
  46 =item cust_location
  47
  48 Optional FS::cust_location object.  If not specified, the customer's
  49 ship_location will be used.
  50
  51 =item svcs
  52
  53 Optional arryaref of FS::svc_* service objects.
  54
  55 =item depend_jobnum
  56
  57 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
  58 jobs will have a dependancy on the supplied job (they will not run until the
  59 specific job completes).  This can be used to defer provisioning until some
  60 action completes (such as running the customer's credit card successfully).
  61
  62 =item ticket_subject
  63
  64 Optional subject for a ticket created and attached to this customer
  65
  66 =item ticket_queue
  67
  68 Optional queue name for ticket additions
  69
  70 =back
  71
  72 =cut
  73
  74 sub order_pkg {
  75   my $self = shift;
  76   my $opt = ref($_[0]) ? shift : { @_ };
  77
  78   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
  79
  80   warn "$me order_pkg called with options ".
  81        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
  82     if $DEBUG;
  83
  84   my $cust_pkg = $opt->{'cust_pkg'};
  85   my $svcs     = $opt->{'svcs'} || [];
  86
  87   my %svc_options = ();
  88   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
  89     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
  90
  91   my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
  92                           qw( ticket_subject ticket_queue allow_pkgpart );
  93
  94   local $SIG{HUP} = 'IGNORE';
  95   local $SIG{INT} = 'IGNORE';
  96   local $SIG{QUIT} = 'IGNORE';
  97   local $SIG{TERM} = 'IGNORE';
  98   local $SIG{TSTP} = 'IGNORE';
  99   local $SIG{PIPE} = 'IGNORE';
 100
 101   my $oldAutoCommit = $FS::UID::AutoCommit;
 102   local $FS::UID::AutoCommit = 0;
 103   my $dbh = dbh;
 104
 105   if ( $opt->{'contactnum'} and $opt->{'contactnum'} != -1 ) {
 106
 107     $cust_pkg->contactnum($opt->{'contactnum'});
 108
 109   } elsif ( $opt->{'contact'} ) {
 110
 111     if ( ! $opt->{'contact'}->contactnum ) {
 112       # not inserted yet
 113       my $error = $opt->{'contact'}->insert;
 114       if ( $error ) {
 115         $dbh->rollback if $oldAutoCommit;
 116         return "inserting contact (transaction rolled back): $error";
 117       }
 118     }
 119     $cust_pkg->contactnum($opt->{'contact'}->contactnum);
 120
 121   #} else {
 122   #
 123   #  $cust_pkg->contactnum();
 124
 125   }
 126
 127   if ( $opt->{'locationnum'} and $opt->{'locationnum'} != -1 ) {
 128
 129     $cust_pkg->locationnum($opt->{'locationnum'});
 130
 131   } elsif ( $opt->{'cust_location'} ) {
 132
 133     if ( ! $opt->{'cust_location'}->locationnum ) {
 134       # not inserted yet
 135       my $error = $opt->{'cust_location'}->insert;
 136       if ( $error ) {
 137         $dbh->rollback if $oldAutoCommit;
 138         return "inserting cust_location (transaction rolled back): $error";
 139       }
 140     }
 141     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
 142
 143   } else {
 144
 145     $cust_pkg->locationnum($self->ship_locationnum);
 146
 147   }
 148
 149   $cust_pkg->custnum( $self->custnum );
 150
 151   my $error = $cust_pkg->insert( %insert_params );
 152   if ( $error ) {
 153     $dbh->rollback if $oldAutoCommit;
 154     return "inserting cust_pkg (transaction rolled back): $error";
 155   }
 156
 157   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
 158     if ( $svc_something->svcnum ) {
 159       my $old_cust_svc = $svc_something->cust_svc;
 160       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 161       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 162       $error = $new_cust_svc->replace($old_cust_svc);
 163     } else {
 164       $svc_something->pkgnum( $cust_pkg->pkgnum );
 165       if ( $svc_something->isa('FS::svc_acct') ) {
 166         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
 167                        qw( seconds upbytes downbytes totalbytes )      ) {
 168           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
 169           ${ $opt->{$_.'_ref'} } = 0;
 170         }
 171       }
 172       $error = $svc_something->insert(%svc_options);
 173     }
 174     if ( $error ) {
 175       $dbh->rollback if $oldAutoCommit;
 176       return "inserting svc_ (transaction rolled back): $error";
 177     }
 178   }
 179
 180   # add supplemental packages, if any are needed
 181   my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
 182   foreach my $link ($part_pkg->supp_part_pkg_link) {
 183     #warn "inserting supplemental package ".$link->dst_pkgpart;
 184     my $pkg = FS::cust_pkg->new({
 185         'pkgpart'       => $link->dst_pkgpart,
 186         'pkglinknum'    => $link->pkglinknum,
 187         'custnum'       => $self->custnum,
 188         'main_pkgnum'   => $cust_pkg->pkgnum,
 189         'locationnum'   => $cust_pkg->locationnum,
 190         # try to prevent as many surprises as possible
 191         'pkgbatch'      => $cust_pkg->pkgbatch,
 192         'start_date'    => $cust_pkg->start_date,
 193         'order_date'    => $cust_pkg->order_date,
 194         'expire'        => $cust_pkg->expire,
 195         'adjourn'       => $cust_pkg->adjourn,
 196         'contract_end'  => $cust_pkg->contract_end,
 197         'refnum'        => $cust_pkg->refnum,
 198         'discountnum'   => $cust_pkg->discountnum,
 199         'waive_setup'   => $cust_pkg->waive_setup,
 200         'allow_pkgpart' => $opt->{'allow_pkgpart'},
 201     });
 202     $error = $self->order_pkg('cust_pkg' => $pkg);
 203     if ( $error ) {
 204       $dbh->rollback if $oldAutoCommit;
 205       return "inserting supplemental package: $error";
 206     }
 207   }
 208
 209   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 210   ''; #no error
 211
 212 }
 213
 214 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 215
 216 Like the insert method on an existing record, this method orders multiple
 217 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 218 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 219 There should be a better explanation of this, but until then, here's an
 220 example:
 221
 222   use Tie::RefHash;
 223   tie %hash, 'Tie::RefHash'; #this part is important
 224   %hash = (
 225     $cust_pkg => [ $svc_acct ],
 226     ...
 227   );
 228   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 229
 230 Services can be new, in which case they are inserted, or existing unaudited
 231 services, in which case they are linked to the newly-created package.
 232
 233 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 234 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 235
 236 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 237 on the supplied jobnum (they will not run until the specific job completes).
 238 This can be used to defer provisioning until some action completes (such
 239 as running the customer's credit card successfully).
 240
 241 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 242 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 243 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 244 on the cust_main object is not recommended, as existing services will also be
 245 reexported.)
 246
 247 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 248 provided, the scalars (provided by references) will be incremented by the
 249 values of the prepaid card.`
 250
 251 =cut
 252
 253 sub order_pkgs {
 254   my $self = shift;
 255   my $cust_pkgs = shift;
 256   my %options = @_;
 257
 258   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 259
 260   warn "$me order_pkgs called with options ".
 261        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 262     if $DEBUG;
 263
 264   local $SIG{HUP} = 'IGNORE';
 265   local $SIG{INT} = 'IGNORE';
 266   local $SIG{QUIT} = 'IGNORE';
 267   local $SIG{TERM} = 'IGNORE';
 268   local $SIG{TSTP} = 'IGNORE';
 269   local $SIG{PIPE} = 'IGNORE';
 270
 271   my $oldAutoCommit = $FS::UID::AutoCommit;
 272   local $FS::UID::AutoCommit = 0;
 273   my $dbh = dbh;
 274
 275   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 276
 277   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 278
 279     my $error = $self->order_pkg(
 280       'cust_pkg'     => $cust_pkg,
 281       'svcs'         => $cust_pkgs->{$cust_pkg},
 282       map { $_ => $options{$_} }
 283         qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum )
 284     );
 285     if ( $error ) {
 286       $dbh->rollback if $oldAutoCommit;
 287       return $error;
 288     }
 289
 290   }
 291
 292   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 293   ''; #no error
 294 }
 295
 296 =item attach_pkgs
 297
 298 Merges this customer's package's into the target customer and then cancels them.
 299
 300 =cut
 301
 302 sub attach_pkgs {
 303   my( $self, $new_custnum ) = @_;
 304
 305   #mostly false laziness w/ merge
 306
 307   return "Can't attach packages to self" if $self->custnum == $new_custnum;
 308
 309   my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
 310     or return "Invalid new customer number: $new_custnum";
 311
 312   return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
 313     if $self->agentnum != $new_cust_main->agentnum
 314     && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
 315
 316   local $SIG{HUP} = 'IGNORE';
 317   local $SIG{INT} = 'IGNORE';
 318   local $SIG{QUIT} = 'IGNORE';
 319   local $SIG{TERM} = 'IGNORE';
 320   local $SIG{TSTP} = 'IGNORE';
 321   local $SIG{PIPE} = 'IGNORE';
 322
 323   my $oldAutoCommit = $FS::UID::AutoCommit;
 324   local $FS::UID::AutoCommit = 0;
 325   my $dbh = dbh;
 326
 327   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
 328      $dbh->rollback if $oldAutoCommit;
 329      return "Can't merge a master agent customer";
 330   }
 331
 332   #use FS::access_user
 333   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
 334      $dbh->rollback if $oldAutoCommit;
 335      return "Can't merge a master employee customer";
 336   }
 337
 338   if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
 339                                      'status'  => { op=>'!=', value=>'done' },
 340                                    }
 341               )
 342   ) {
 343      $dbh->rollback if $oldAutoCommit;
 344      return "Can't merge a customer with pending payments";
 345   }
 346
 347   #end of false laziness
 348
 349   #pull in contact
 350
 351   my %contact_hash = ( 'first'    => $self->first,
 352                        'last'     => $self->get('last'),
 353                        'custnum'  => $new_custnum,
 354                        'disabled' => '',
 355                      );
 356
 357   my $contact = qsearchs(  'contact', \%contact_hash)
 358                  || new FS::contact   \%contact_hash;
 359   unless ( $contact->contactnum ) {
 360     my $error = $contact->insert;
 361     if ( $error ) {
 362       $dbh->rollback if $oldAutoCommit;
 363       return $error;
 364     }
 365   }
 366
 367   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 368
 369     my $cust_location = $cust_pkg->cust_location || $self->ship_location;
 370     my %loc_hash = $cust_location->hash;
 371     $loc_hash{'locationnum'} = '';
 372     $loc_hash{'custnum'}     = $new_custnum;
 373     $loc_hash{'disabled'}    = '';
 374     my $new_cust_location = qsearchs(  'cust_location', \%loc_hash)
 375                              || new FS::cust_location   \%loc_hash;
 376
 377     my $pkg_or_error = $cust_pkg->change( {
 378       'keep_dates'    => 1,
 379       'cust_main'     => $new_cust_main,
 380       'contactnum'    => $contact->contactnum,
 381       'cust_location' => $new_cust_location,
 382     } );
 383
 384     my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
 385
 386     if ( $error ) {
 387       $dbh->rollback if $oldAutoCommit;
 388       return $error;
 389     }
 390
 391   }
 392
 393   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 394   ''; #no error
 395
 396 }
 397
 398 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
 399
 400 Returns all packages (see L<FS::cust_pkg>) for this customer.
 401
 402 =cut
 403
 404 sub all_pkgs {
 405   my $self = shift;
 406   my $extra_qsearch = ref($_[0]) ? shift : { @_ };
 407
 408   return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
 409
 410   my @cust_pkg = ();
 411   if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
 412     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
 413   } else {
 414     @cust_pkg = $self->_cust_pkg($extra_qsearch);
 415   }
 416
 417   map { $_ } sort sort_packages @cust_pkg;
 418 }
 419
 420 =item cust_pkg
 421
 422 Synonym for B<all_pkgs>.
 423
 424 =cut
 425
 426 sub cust_pkg {
 427   shift->all_pkgs(@_);
 428 }
 429
 430 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
 431
 432 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 433
 434 =cut
 435
 436 sub ncancelled_pkgs {
 437   my $self = shift;
 438   my $extra_qsearch = ref($_[0]) ? shift : {};
 439
 440   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 441
 442   return $self->num_ncancelled_pkgs unless wantarray;
 443
 444   my @cust_pkg = ();
 445   if ( $self->{'_pkgnum'} ) {
 446
 447     warn "$me ncancelled_pkgs: returning cached objects"
 448       if $DEBUG > 1;
 449
 450     @cust_pkg = grep { ! $_->getfield('cancel') }
 451                 values %{ $self->{'_pkgnum'}->cache };
 452
 453   } else {
 454
 455     warn "$me ncancelled_pkgs: searching for packages with custnum ".
 456          $self->custnum. "\n"
 457       if $DEBUG > 1;
 458
 459     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
 460
 461     @cust_pkg = $self->_cust_pkg($extra_qsearch);
 462
 463   }
 464
 465   sort sort_packages @cust_pkg;
 466
 467 }
 468
 469 sub _cust_pkg {
 470   my $self = shift;
 471   my $extra_qsearch = ref($_[0]) ? shift : {};
 472
 473   $extra_qsearch->{'select'} ||= '*';
 474   $extra_qsearch->{'select'} .=
 475    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
 476      AS _num_cust_svc';
 477
 478   map {
 479         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
 480         $_;
 481       }
 482   qsearch({
 483     %$extra_qsearch,
 484     'table'   => 'cust_pkg',
 485     'hashref' => { 'custnum' => $self->custnum },
 486   });
 487
 488 }
 489
 490 # This should be generalized to use config options to determine order.
 491 sub sort_packages {
 492
 493   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
 494   return $locationsort if $locationsort;
 495
 496   if ( $a->get('cancel') xor $b->get('cancel') ) {
 497     return -1 if $b->get('cancel');
 498     return  1 if $a->get('cancel');
 499     #shouldn't get here...
 500     return 0;
 501   } else {
 502     my $a_num_cust_svc = $a->num_cust_svc;
 503     my $b_num_cust_svc = $b->num_cust_svc;
 504     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
 505     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
 506     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
 507     my @a_cust_svc = $a->cust_svc;
 508     my @b_cust_svc = $b->cust_svc;
 509     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
 510     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
 511     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
 512     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
 513   }
 514
 515 }
 516
 517 =item suspended_pkgs
 518
 519 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 520
 521 =cut
 522
 523 sub suspended_pkgs {
 524   my $self = shift;
 525   return $self->num_suspended_pkgs unless wantarray;
 526   grep { $_->susp } $self->ncancelled_pkgs;
 527 }
 528
 529 =item unflagged_suspended_pkgs
 530
 531 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 532 customer (thouse packages without the `manual_flag' set).
 533
 534 =cut
 535
 536 sub unflagged_suspended_pkgs {
 537   my $self = shift;
 538   return $self->suspended_pkgs
 539     unless dbdef->table('cust_pkg')->column('manual_flag');
 540   grep { ! $_->manual_flag } $self->suspended_pkgs;
 541 }
 542
 543 =item unsuspended_pkgs
 544
 545 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 546 this customer.
 547
 548 =cut
 549
 550 sub unsuspended_pkgs {
 551   my $self = shift;
 552   return $self->num_unsuspended_pkgs unless wantarray;
 553   grep { ! $_->susp } $self->ncancelled_pkgs;
 554 }
 555
 556 =item active_pkgs
 557
 558 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 559 this customer that are active (recurring).
 560
 561 =cut
 562
 563 sub active_pkgs {
 564   my $self = shift;
 565   grep { my $part_pkg = $_->part_pkg;
 566          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 567        }
 568        $self->unsuspended_pkgs;
 569 }
 570
 571 =item billing_pkgs
 572
 573 Returns active packages, and also any suspended packages which are set to
 574 continue billing while suspended.
 575
 576 =cut
 577
 578 sub billing_pkgs {
 579   my $self = shift;
 580   grep { my $part_pkg = $_->part_pkg;
 581          $part_pkg->freq ne '' && $part_pkg->freq ne '0'
 582            && ( ! $_->susp || $_->option('suspend_bill',1)
 583                            || ( $part_pkg->option('suspend_bill', 1)
 584                                   && ! $_->option('no_suspend_bill',1)
 585                               )
 586               );
 587        }
 588        $self->ncancelled_pkgs;
 589 }
 590
 591 =item next_bill_date
 592
 593 Returns the next date this customer will be billed, as a UNIX timestamp, or
 594 undef if no billing package has a next bill date.
 595
 596 =cut
 597
 598 sub next_bill_date {
 599   my $self = shift;
 600   min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
 601 }
 602
 603 =item num_cancelled_pkgs
 604
 605 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
 606 customer.
 607
 608 =cut
 609
 610 sub num_cancelled_pkgs {
 611   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
 612 }
 613
 614 sub num_ncancelled_pkgs {
 615   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
 616 }
 617
 618 sub num_suspended_pkgs {
 619   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 620                     AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0   ");
 621 }
 622
 623 sub num_unsuspended_pkgs {
 624   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 625                     AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 ) ");
 626 }
 627
 628 sub num_pkgs {
 629   my( $self ) = shift;
 630   my $sql = scalar(@_) ? shift : '';
 631   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
 632   my $sth = dbh->prepare(
 633     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
 634   ) or die dbh->errstr;
 635   $sth->execute($self->custnum) or die $sth->errstr;
 636   $sth->fetchrow_arrayref->[0];
 637 }
 638
 639 =back
 640
 641 =head1 BUGS
 642
 643 =head1 SEE ALSO
 644
 645 L<FS::cust_main>, L<FS::cust_pkg>
 646
 647 =cut
 648
 649 1;
 650