FS/FS/cust_main/Packages.pm

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