FS/FS/cust_main/Packages.pm

   1 package FS::cust_main::Packages;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me $skip_label_sort );
   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 $skip_label_sort = 0;
  16
  17 =head1 NAME
  18
  19 FS::cust_main::Packages - Packages mixin for cust_main
  20
  21 =head1 SYNOPSIS
  22
  23 =head1 DESCRIPTION
  24
  25 These methods are available on FS::cust_main objects;
  26
  27 =head1 METHODS
  28
  29 =over 4
  30
  31 =item order_pkg HASHREF | OPTION => VALUE ...
  32
  33 Orders a single package.
  34
  35 Note that if the package definition has supplemental packages, those will
  36 be ordered as well.
  37
  38 Options may be passed as a list of key/value pairs or as a hash reference.
  39 Options are:
  40
  41 =over 4
  42
  43 =item cust_pkg
  44
  45 FS::cust_pkg object
  46
  47 =item cust_location
  48
  49 Optional FS::cust_location object.  If not specified, the customer's
  50 ship_location will be used.
  51
  52 =item svcs
  53
  54 Optional arryaref of FS::svc_* service objects.
  55
  56 =item depend_jobnum
  57
  58 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
  59 jobs will have a dependancy on the supplied job (they will not run until the
  60 specific job completes).  This can be used to defer provisioning until some
  61 action completes (such as running the customer's credit card successfully).
  62
  63 =item noexport
  64
  65 This option is option is deprecated but still works for now (use
  66 I<depend_jobnum> instead for new code).  If I<noexport> is set true, no
  67 provisioning jobs (exports) are scheduled.  (You can schedule them later with
  68 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
  69 on the cust_main object is not recommended, as existing services will also be
  70 reexported.)
  71
  72 =item ticket_subject
  73
  74 Optional subject for a ticket created and attached to this customer
  75
  76 =item ticket_queue
  77
  78 Optional queue name for ticket additions
  79
  80 =back
  81
  82 =cut
  83
  84 sub order_pkg {
  85   my $self = shift;
  86   my $opt = ref($_[0]) ? shift : { @_ };
  87
  88   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
  89
  90   warn "$me order_pkg called with options ".
  91        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
  92     if $DEBUG;
  93
  94   local $FS::svc_Common::noexport_hack = 1 if $opt->{'noexport'};
  95
  96   my $cust_pkg = $opt->{'cust_pkg'};
  97   my $svcs     = $opt->{'svcs'} || [];
  98
  99   my %svc_options = ();
 100   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
 101     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
 102
 103   my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
 104                           qw( ticket_subject ticket_queue allow_pkgpart );
 105
 106   local $SIG{HUP} = 'IGNORE';
 107   local $SIG{INT} = 'IGNORE';
 108   local $SIG{QUIT} = 'IGNORE';
 109   local $SIG{TERM} = 'IGNORE';
 110   local $SIG{TSTP} = 'IGNORE';
 111   local $SIG{PIPE} = 'IGNORE';
 112
 113   my $oldAutoCommit = $FS::UID::AutoCommit;
 114   local $FS::UID::AutoCommit = 0;
 115   my $dbh = dbh;
 116
 117   if ( $opt->{'contactnum'} and $opt->{'contactnum'} != -1 ) {
 118
 119     $cust_pkg->contactnum($opt->{'contactnum'});
 120
 121   } elsif ( $opt->{'contact'} ) {
 122
 123     if ( ! $opt->{'contact'}->contactnum ) {
 124       # not inserted yet
 125       my $error = $opt->{'contact'}->insert;
 126       if ( $error ) {
 127         $dbh->rollback if $oldAutoCommit;
 128         return "inserting contact (transaction rolled back): $error";
 129       }
 130     }
 131     $cust_pkg->contactnum($opt->{'contact'}->contactnum);
 132
 133   #} else {
 134   #
 135   #  $cust_pkg->contactnum();
 136
 137   }
 138
 139   if ( $opt->{'locationnum'} and $opt->{'locationnum'} != -1 ) {
 140
 141     $cust_pkg->locationnum($opt->{'locationnum'});
 142
 143   } elsif ( $opt->{'cust_location'} ) {
 144
 145     my $error = $opt->{'cust_location'}->find_or_insert;
 146     if ( $error ) {
 147       $dbh->rollback if $oldAutoCommit;
 148       return "inserting cust_location (transaction rolled back): $error";
 149     }
 150     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
 151
 152   } elsif ( ! $cust_pkg->locationnum ) {
 153
 154     $cust_pkg->locationnum($self->ship_locationnum);
 155
 156   }
 157
 158   $cust_pkg->custnum( $self->custnum );
 159
 160   my $error = $cust_pkg->insert( %insert_params );
 161   if ( $error ) {
 162     $dbh->rollback if $oldAutoCommit;
 163     return "inserting cust_pkg (transaction rolled back): $error";
 164   }
 165
 166   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
 167     if ( $svc_something->svcnum ) {
 168       my $old_cust_svc = $svc_something->cust_svc;
 169       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 170       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 171       $error = $new_cust_svc->replace($old_cust_svc);
 172     } else {
 173       $svc_something->pkgnum( $cust_pkg->pkgnum );
 174       if ( $svc_something->isa('FS::svc_acct') ) {
 175         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
 176                        qw( seconds upbytes downbytes totalbytes )      ) {
 177           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
 178           ${ $opt->{$_.'_ref'} } = 0;
 179         }
 180       }
 181       $error = $svc_something->insert(%svc_options);
 182     }
 183     if ( $error ) {
 184       $dbh->rollback if $oldAutoCommit;
 185       return "inserting svc_ (transaction rolled back): $error";
 186     }
 187   }
 188
 189   # add supplemental packages, if any are needed
 190   my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
 191   foreach my $link ($part_pkg->supp_part_pkg_link) {
 192     #warn "inserting supplemental package ".$link->dst_pkgpart;
 193     my $pkg = FS::cust_pkg->new({
 194         'pkgpart'       => $link->dst_pkgpart,
 195         'pkglinknum'    => $link->pkglinknum,
 196         'custnum'       => $self->custnum,
 197         'main_pkgnum'   => $cust_pkg->pkgnum,
 198         # try to prevent as many surprises as possible
 199         'allow_pkgpart' => $opt->{'allow_pkgpart'},
 200         map { $_ => $cust_pkg->$_() }
 201           qw( pkgbatch
 202               start_date order_date expire adjourn contract_end
 203               refnum discountnum waive_setup
 204             )
 205     });
 206     $error = $self->order_pkg('cust_pkg'    => $pkg,
 207                               'locationnum' => $cust_pkg->locationnum);
 208     if ( $error ) {
 209       $dbh->rollback if $oldAutoCommit;
 210       return "inserting supplemental package: $error";
 211     }
 212   }
 213
 214   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 215   ''; #no error
 216
 217 }
 218
 219 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 220
 221 Like the insert method on an existing record, this method orders multiple
 222 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 223 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 224 There should be a better explanation of this, but until then, here's an
 225 example:
 226
 227   use Tie::RefHash;
 228   tie %hash, 'Tie::RefHash'; #this part is important
 229   %hash = (
 230     $cust_pkg => [ $svc_acct ],
 231     ...
 232   );
 233   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 234
 235 Services can be new, in which case they are inserted, or existing unaudited
 236 services, in which case they are linked to the newly-created package.
 237
 238 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 239 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 240
 241 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 242 on the supplied jobnum (they will not run until the specific job completes).
 243 This can be used to defer provisioning until some action completes (such
 244 as running the customer's credit card successfully).
 245
 246 The I<noexport> option is deprecated but still works for now (use
 247 I<depend_jobnum> instead for new code).  If I<noexport> is set true, no
 248 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 249 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 250 on the cust_main object is not recommended, as existing services will also be
 251 reexported.)
 252
 253 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 254 provided, the scalars (provided by references) will be incremented by the
 255 values of the prepaid card.`
 256
 257 =cut
 258
 259 sub order_pkgs {
 260   my $self = shift;
 261   my $cust_pkgs = shift;
 262   my %options = @_;
 263
 264   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 265
 266   warn "$me order_pkgs called with options ".
 267        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 268     if $DEBUG;
 269
 270   local $SIG{HUP} = 'IGNORE';
 271   local $SIG{INT} = 'IGNORE';
 272   local $SIG{QUIT} = 'IGNORE';
 273   local $SIG{TERM} = 'IGNORE';
 274   local $SIG{TSTP} = 'IGNORE';
 275   local $SIG{PIPE} = 'IGNORE';
 276
 277   my $oldAutoCommit = $FS::UID::AutoCommit;
 278   local $FS::UID::AutoCommit = 0;
 279   my $dbh = dbh;
 280
 281   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 282
 283   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 284
 285     my $error = $self->order_pkg(
 286       'cust_pkg'     => $cust_pkg,
 287       'svcs'         => $cust_pkgs->{$cust_pkg},
 288       map { $_ => $options{$_} }
 289         qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum )
 290     );
 291     if ( $error ) {
 292       $dbh->rollback if $oldAutoCommit;
 293       return $error;
 294     }
 295
 296   }
 297
 298   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 299   ''; #no error
 300 }
 301
 302 =item attach_pkgs
 303
 304 Merges this customer's package's into the target customer and then cancels them.
 305
 306 =cut
 307
 308 sub attach_pkgs {
 309   my( $self, $new_custnum ) = @_;
 310
 311   #mostly false laziness w/ merge
 312
 313   return "Can't attach packages to self" if $self->custnum == $new_custnum;
 314
 315   my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
 316     or return "Invalid new customer number: $new_custnum";
 317
 318   return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
 319     if $self->agentnum != $new_cust_main->agentnum
 320     && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
 321
 322   local $SIG{HUP} = 'IGNORE';
 323   local $SIG{INT} = 'IGNORE';
 324   local $SIG{QUIT} = 'IGNORE';
 325   local $SIG{TERM} = 'IGNORE';
 326   local $SIG{TSTP} = 'IGNORE';
 327   local $SIG{PIPE} = 'IGNORE';
 328
 329   my $oldAutoCommit = $FS::UID::AutoCommit;
 330   local $FS::UID::AutoCommit = 0;
 331   my $dbh = dbh;
 332
 333   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
 334      $dbh->rollback if $oldAutoCommit;
 335      return "Can't merge a master agent customer";
 336   }
 337
 338   #use FS::access_user
 339   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
 340      $dbh->rollback if $oldAutoCommit;
 341      return "Can't merge a master employee customer";
 342   }
 343
 344   if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
 345                                      'status'  => { op=>'!=', value=>'done' },
 346                                    }
 347               )
 348   ) {
 349      $dbh->rollback if $oldAutoCommit;
 350      return "Can't merge a customer with pending payments";
 351   }
 352
 353   #end of false laziness
 354
 355   #pull in contact
 356
 357   my %contact_hash = ( 'first'    => $self->first,
 358                        'last'     => $self->get('last'),
 359                        'custnum'  => $new_custnum,
 360                        'disabled' => '',
 361                      );
 362
 363   my $contact = qsearchs(  'contact', \%contact_hash)
 364                  || new FS::contact   \%contact_hash;
 365   unless ( $contact->contactnum ) {
 366     my $error = $contact->insert;
 367     if ( $error ) {
 368       $dbh->rollback if $oldAutoCommit;
 369       return $error;
 370     }
 371   }
 372
 373   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 374
 375     my $cust_location = $cust_pkg->cust_location || $self->ship_location;
 376     my %loc_hash = $cust_location->hash;
 377     $loc_hash{'locationnum'} = '';
 378     $loc_hash{'custnum'}     = $new_custnum;
 379     $loc_hash{'disabled'}    = '';
 380     my $new_cust_location = qsearchs(  'cust_location', \%loc_hash)
 381                              || new FS::cust_location   \%loc_hash;
 382
 383     my $pkg_or_error = $cust_pkg->change( {
 384       'keep_dates'    => 1,
 385       'cust_main'     => $new_cust_main,
 386       'contactnum'    => $contact->contactnum,
 387       'cust_location' => $new_cust_location,
 388     } );
 389
 390     my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
 391
 392     if ( $error ) {
 393       $dbh->rollback if $oldAutoCommit;
 394       return $error;
 395     }
 396
 397   }
 398
 399   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 400   ''; #no error
 401
 402 }
 403
 404 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
 405
 406 Returns all packages (see L<FS::cust_pkg>) for this customer.
 407
 408 =cut
 409
 410 sub all_pkgs {
 411   my $self = shift;
 412   my $extra_qsearch = ref($_[0]) ? shift : { @_ };
 413
 414   return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
 415
 416   my @cust_pkg = ();
 417   if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
 418     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
 419   } else {
 420     @cust_pkg = $self->_cust_pkg($extra_qsearch);
 421   }
 422
 423   local($skip_label_sort) = 1 if $extra_qsearch->{skip_label_sort};
 424   map { $_ } sort sort_packages @cust_pkg;
 425
 426 }
 427
 428 =item cust_pkg
 429
 430 Synonym for B<all_pkgs>.
 431
 432 =cut
 433
 434 sub cust_pkg {
 435   shift->all_pkgs(@_);
 436 }
 437
 438 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
 439
 440 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 441
 442 =cut
 443
 444 sub ncancelled_pkgs {
 445   my $self = shift;
 446   my $extra_qsearch = ref($_[0]) ? shift : {};
 447
 448   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 449
 450   return $self->num_ncancelled_pkgs unless wantarray;
 451
 452   my @cust_pkg = ();
 453   if ( $self->{'_pkgnum'} ) {
 454
 455     warn "$me ncancelled_pkgs: returning cached objects"
 456       if $DEBUG > 1;
 457
 458     @cust_pkg = grep { ! $_->getfield('cancel') }
 459                 values %{ $self->{'_pkgnum'}->cache };
 460
 461   } else {
 462
 463     warn "$me ncancelled_pkgs: searching for packages with custnum ".
 464          $self->custnum. "\n"
 465       if $DEBUG > 1;
 466
 467     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
 468
 469     @cust_pkg = $self->_cust_pkg($extra_qsearch);
 470
 471   }
 472
 473   local($skip_label_sort) = 1 if $extra_qsearch->{skip_label_sort};
 474   sort sort_packages @cust_pkg;
 475
 476 }
 477
 478 =item cancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
 479
 480 Returns all cancelled packages (see L<FS::cust_pkg>) for this customer.
 481
 482 =cut
 483
 484 sub cancelled_pkgs {
 485   my $self = shift;
 486   my $extra_qsearch = ref($_[0]) ? shift : { @_ };
 487
 488   return $self->num_cancelled_pkgs($extra_qsearch) unless wantarray;
 489
 490   $extra_qsearch->{'extra_sql'} .=
 491     ' AND cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel > 0 ';
 492
 493   local($skip_label_sort) = 1 if $extra_qsearch->{skip_label_sort};
 494
 495   sort sort_packages $self->_cust_pkg($extra_qsearch);
 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 $skip_label_sort
 537              || $a_num_cust_svc + $b_num_cust_svc > 20; #for perf, just give up
 538     my @a_cust_svc = $a->cust_svc_unsorted;
 539     my @b_cust_svc = $b->cust_svc_unsorted;
 540     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
 541     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
 542     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
 543     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
 544   }
 545
 546 }
 547
 548 =item suspended_pkgs OPTION => VALUE ...
 549
 550 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 551
 552 Currently supports one option, I<reason_type>, which if set to a typenum,
 553 limits the results to packages which were suspended for reasons of this type.
 554 (Does not currently work in scalar context; i.e. when just asking for a count.)
 555
 556 =cut
 557
 558 sub suspended_pkgs {
 559   my $self = shift;
 560   my %opt = @_;
 561
 562   return $self->num_suspended_pkgs unless wantarray; #XXX opt in scalar context
 563
 564   my @pkgs = grep { $_->susp } $self->ncancelled_pkgs;
 565
 566   if ( $opt{reason_type} ) {
 567     @pkgs = grep { my $r = $_->last_reason('susp');
 568                    $r && $r->reason_type == $opt{reason_type};
 569                  }
 570               @pkgs;
 571   }
 572
 573   @pkgs;
 574 }
 575
 576 ### This appears to be unused, will be going away
 577 #
 578 #=item unflagged_suspended_pkgs
 579 #
 580 #Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 581 #customer (thouse packages without the `manual_flag' set).
 582 #
 583 #=cut
 584
 585 sub unflagged_suspended_pkgs {
 586   my $self = shift;
 587   return $self->suspended_pkgs
 588     unless dbdef->table('cust_pkg')->column('manual_flag');
 589   grep { ! $_->manual_flag } $self->suspended_pkgs;
 590 }
 591
 592 =item unsuspended_pkgs
 593
 594 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 595 this customer.
 596
 597 =cut
 598
 599 sub unsuspended_pkgs {
 600   my $self = shift;
 601   return $self->num_unsuspended_pkgs unless wantarray;
 602   grep { ! $_->susp } $self->ncancelled_pkgs;
 603 }
 604
 605 =item active_pkgs
 606
 607 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 608 this customer that are active (recurring).
 609
 610 =cut
 611
 612 #recurring_pkgs?  different from cust_pkg idea of "active" which has
 613 # a setup vs not_yet_billed which doesn't
 614 sub active_pkgs {
 615   my $self = shift;
 616   grep { my $part_pkg = $_->part_pkg;
 617          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 618        }
 619        $self->unsuspended_pkgs;
 620 }
 621
 622 =item ncancelled_active_pkgs
 623
 624 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer that
 625 are active (recurring).
 626
 627 =cut
 628
 629 #ncancelled_recurring_pkgs?  different from cust_pkg idea of "active" which has
 630 # a setup vs not_yet_billed which doesn't
 631 sub ncancelled_active_pkgs {
 632   my $self = shift;
 633   grep { my $part_pkg = $_->part_pkg;
 634          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 635        }
 636        $self->ncancelled_pkgs;
 637 }
 638
 639 =item billing_pkgs
 640
 641 Returns active packages, and also any suspended packages which are set to
 642 continue billing while suspended.
 643
 644 =cut
 645
 646 sub billing_pkgs {
 647   my $self = shift;
 648   grep { my $part_pkg = $_->part_pkg;
 649          $part_pkg->freq ne '' && $part_pkg->freq ne '0'
 650            && ( ! $_->susp || $_->option('suspend_bill',1)
 651                            || ( $part_pkg->option('suspend_bill', 1)
 652                                   && ! $_->option('no_suspend_bill',1)
 653                               )
 654               );
 655        }
 656        $self->ncancelled_pkgs;
 657 }
 658
 659 =item next_bill_date
 660
 661 Returns the next date this customer will be billed, as a UNIX timestamp, or
 662 undef if no billing package has a next bill date.
 663
 664 =cut
 665
 666 sub next_bill_date {
 667   my $self = shift;
 668   min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
 669 }
 670
 671 =item num_cancelled_pkgs
 672
 673 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
 674 customer.
 675
 676 =cut
 677
 678 sub num_cancelled_pkgs {
 679   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
 680 }
 681
 682 =item num_ncancelled_pkgs
 683
 684 Returns the number of packages that have not been cancelled (see L<FS::cust_pkg>) for this
 685 customer.
 686
 687 =cut
 688
 689 sub num_ncancelled_pkgs {
 690   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
 691 }
 692
 693 =item num_billing_pkgs
 694
 695 Returns the number of packages that have not been cancelled
 696 and have a non-zero billing frequency (see L<FS::cust_pkg>)
 697 for this customer.
 698
 699 =cut
 700
 701 sub num_billing_pkgs {
 702   my $self = shift;
 703   my $opt = shift || {};
 704   $opt->{addl_from} .= ' LEFT JOIN part_pkg USING (pkgpart)';
 705   $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
 706   $opt->{extra_sql} .= "freq IS NOT NULL AND freq != '0'";
 707   $self->num_ncancelled_pkgs($opt);
 708 }
 709
 710 sub num_suspended_pkgs {
 711   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 712                     AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0   ");
 713 }
 714
 715 sub num_unsuspended_pkgs {
 716   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 717                     AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 ) ");
 718 }
 719
 720 sub num_pkgs {
 721   my( $self ) = shift;
 722   my $sql = scalar(@_) ? shift : '';
 723   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
 724   my $sth = dbh->prepare(
 725     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
 726   ) or die dbh->errstr;
 727   $sth->execute($self->custnum) or die $sth->errstr;
 728   $sth->fetchrow_arrayref->[0];
 729 }
 730
 731 =item num_usage_pkgs
 732
 733 Returns the number of packages for this customer that have services that
 734 can have RADIUS usage statistics.
 735
 736 =cut
 737
 738 sub num_usage_pkgs {
 739   my $self = shift;
 740   # have to enumerate exportnums but it's not bad
 741   my @exportnums = map { $_->exportnum }
 742                    grep { $_->can('usage_sessions') }
 743                    qsearch('part_export');
 744   return 0 if !@exportnums;
 745   my $in_exportnums = join(',', @exportnums);
 746   my $sql = "SELECT COUNT(DISTINCT pkgnum) FROM cust_pkg
 747     JOIN cust_svc USING (pkgnum)
 748     JOIN export_svc USING (svcpart)
 749     WHERE exportnum IN( $in_exportnums ) AND custnum = ?";
 750   FS::Record->scalar_sql($sql, $self->custnum);
 751 }
 752
 753 =item display_recurring
 754
 755 Returns an array of hash references, one for each recurring freq
 756 on billable customer packages, with keys of freq, freq_pretty and amount
 757 (the amount that this customer will next be charged at the given frequency.)
 758
 759 Results will be numerically sorted by freq.
 760
 761 Only intended for display purposes, not used for actual billing.
 762
 763 =cut
 764
 765 sub display_recurring {
 766   my $cust_main = shift;
 767
 768   my $sth = dbh->prepare("
 769     SELECT DISTINCT freq FROM cust_pkg LEFT JOIN part_pkg USING (pkgpart)
 770       WHERE freq IS NOT NULL AND freq != '0'
 771         AND ( cancel IS NULL OR cancel = 0 )
 772         AND custnum = ?
 773   ") or die $DBI::errstr;
 774
 775   $sth->execute($cust_main->custnum) or die $sth->errstr;
 776
 777   #not really a numeric sort because freqs can actually be all sorts of things
 778   # but good enough for the 99% cases of ordering monthly quarterly annually
 779   my @freqs = sort { $a <=> $b } map { $_->[0] } @{ $sth->fetchall_arrayref };
 780
 781   $sth->finish;
 782
 783   my @out;
 784
 785   foreach my $freq (@freqs) {
 786
 787     my @cust_pkg = qsearch({
 788       'table'     => 'cust_pkg',
 789       'addl_from' => 'LEFT JOIN part_pkg USING (pkgpart)',
 790       'hashref'   => { 'custnum' => $cust_main->custnum, },
 791       'extra_sql' => 'AND ( cancel IS NULL OR cancel = 0 )
 792                       AND freq = '. dbh->quote($freq),
 793       'order_by'  => 'ORDER BY COALESCE(start_date,0), pkgnum', # to ensure old pkgs come before change_to_pkg
 794     }) or next;
 795
 796     my $freq_pretty = $cust_pkg[0]->part_pkg->freq_pretty;
 797
 798     my $amount = 0;
 799     my $skip_pkg = {};
 800     foreach my $cust_pkg (@cust_pkg) {
 801       my $part_pkg = $cust_pkg->part_pkg;
 802       next if $cust_pkg->susp
 803            && ! $cust_pkg->option('suspend_bill')
 804            && ( ! $part_pkg->option('suspend_bill')
 805                 || $cust_pkg->option('no_suspend_bill')
 806               );
 807
 808       #pkg change handling
 809       next if $skip_pkg->{$cust_pkg->pkgnum};
 810       if ($cust_pkg->change_to_pkgnum) {
 811         #if change is on or before next bill date, use new pkg
 812         next if $cust_pkg->expire <= $cust_pkg->bill;
 813         #if change is after next bill date, use old (this) pkg
 814         $skip_pkg->{$cust_pkg->change_to_pkgnum} = 1;
 815       }
 816
 817       my $pkg_amount = 0;
 818
 819       #add recurring amounts for this package and its billing add-ons
 820       foreach my $l_part_pkg ( $part_pkg->self_and_bill_linked ) {
 821         $pkg_amount += $l_part_pkg->base_recur($cust_pkg);
 822       }
 823
 824       #subtract amounts for any active discounts
 825       #(there should only be one at the moment, otherwise this makes no sense)
 826       foreach my $cust_pkg_discount ( $cust_pkg->cust_pkg_discount_active ) {
 827         my $discount = $cust_pkg_discount->discount;
 828         #and only one of these for each
 829         $pkg_amount -= $discount->amount;
 830         $pkg_amount -= $pkg_amount * $discount->percent/100;
 831       }
 832
 833       $pkg_amount *= ( $cust_pkg->quantity || 1 );
 834
 835       $amount += $pkg_amount;
 836
 837     } #foreach $cust_pkg
 838
 839     next unless $amount;
 840     push @out, {
 841       'freq'        => $freq,
 842       'freq_pretty' => $freq_pretty,
 843       'amount'      => $amount,
 844     };
 845
 846   } #foreach $freq
 847
 848   return @out;
 849 }
 850
 851 =back
 852
 853 =head1 BUGS
 854
 855 =head1 SEE ALSO
 856
 857 L<FS::cust_main>, L<FS::cust_pkg>
 858
 859 =cut
 860
 861 1;
 862