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