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