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