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
 549
 550 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 551
 552 =cut
 553
 554 sub suspended_pkgs {
 555   my $self = shift;
 556   return $self->num_suspended_pkgs unless wantarray;
 557   grep { $_->susp } $self->ncancelled_pkgs;
 558 }
 559
 560 ### This appears to be unused, will be going away
 561 #
 562 #=item unflagged_suspended_pkgs
 563 #
 564 #Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 565 #customer (thouse packages without the `manual_flag' set).
 566 #
 567 #=cut
 568
 569 sub unflagged_suspended_pkgs {
 570   my $self = shift;
 571   return $self->suspended_pkgs
 572     unless dbdef->table('cust_pkg')->column('manual_flag');
 573   grep { ! $_->manual_flag } $self->suspended_pkgs;
 574 }
 575
 576 =item unsuspended_pkgs
 577
 578 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 579 this customer.
 580
 581 =cut
 582
 583 sub unsuspended_pkgs {
 584   my $self = shift;
 585   return $self->num_unsuspended_pkgs unless wantarray;
 586   grep { ! $_->susp } $self->ncancelled_pkgs;
 587 }
 588
 589 =item active_pkgs
 590
 591 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 592 this customer that are active (recurring).
 593
 594 =cut
 595
 596 #recurring_pkgs?  different from cust_pkg idea of "active" which has
 597 # a setup vs not_yet_billed which doesn't
 598 sub active_pkgs {
 599   my $self = shift;
 600   grep { my $part_pkg = $_->part_pkg;
 601          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 602        }
 603        $self->unsuspended_pkgs;
 604 }
 605
 606 =item ncancelled_active_pkgs
 607
 608 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer that
 609 are active (recurring).
 610
 611 =cut
 612
 613 #ncancelled_recurring_pkgs?  different from cust_pkg idea of "active" which has
 614 # a setup vs not_yet_billed which doesn't
 615 sub ncancelled_active_pkgs {
 616   my $self = shift;
 617   grep { my $part_pkg = $_->part_pkg;
 618          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 619        }
 620        $self->ncancelled_pkgs;
 621 }
 622
 623 =item billing_pkgs
 624
 625 Returns active packages, and also any suspended packages which are set to
 626 continue billing while suspended.
 627
 628 =cut
 629
 630 sub billing_pkgs {
 631   my $self = shift;
 632   grep { my $part_pkg = $_->part_pkg;
 633          $part_pkg->freq ne '' && $part_pkg->freq ne '0'
 634            && ( ! $_->susp || $_->option('suspend_bill',1)
 635                            || ( $part_pkg->option('suspend_bill', 1)
 636                                   && ! $_->option('no_suspend_bill',1)
 637                               )
 638               );
 639        }
 640        $self->ncancelled_pkgs;
 641 }
 642
 643 =item next_bill_date
 644
 645 Returns the next date this customer will be billed, as a UNIX timestamp, or
 646 undef if no billing package has a next bill date.
 647
 648 =cut
 649
 650 sub next_bill_date {
 651   my $self = shift;
 652   min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
 653 }
 654
 655 =item num_cancelled_pkgs
 656
 657 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
 658 customer.
 659
 660 =cut
 661
 662 sub num_cancelled_pkgs {
 663   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
 664 }
 665
 666 =item num_ncancelled_pkgs
 667
 668 Returns the number of packages that have not been cancelled (see L<FS::cust_pkg>) for this
 669 customer.
 670
 671 =cut
 672
 673 sub num_ncancelled_pkgs {
 674   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
 675 }
 676
 677 =item num_billing_pkgs
 678
 679 Returns the number of packages that have not been cancelled
 680 and have a non-zero billing frequency (see L<FS::cust_pkg>)
 681 for this customer.
 682
 683 =cut
 684
 685 sub num_billing_pkgs {
 686   my $self = shift;
 687   my $opt = shift || {};
 688   $opt->{addl_from} .= ' LEFT JOIN part_pkg USING (pkgpart)';
 689   $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
 690   $opt->{extra_sql} .= "freq IS NOT NULL AND freq != '0'";
 691   $self->num_ncancelled_pkgs($opt);
 692 }
 693
 694 sub num_suspended_pkgs {
 695   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 696                     AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0   ");
 697 }
 698
 699 sub num_unsuspended_pkgs {
 700   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 701                     AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 ) ");
 702 }
 703
 704 sub num_pkgs {
 705   my( $self ) = shift;
 706   my $sql = scalar(@_) ? shift : '';
 707   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
 708   my $sth = dbh->prepare(
 709     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
 710   ) or die dbh->errstr;
 711   $sth->execute($self->custnum) or die $sth->errstr;
 712   $sth->fetchrow_arrayref->[0];
 713 }
 714
 715 =item num_usage_pkgs
 716
 717 Returns the number of packages for this customer that have services that
 718 can have RADIUS usage statistics.
 719
 720 =cut
 721
 722 sub num_usage_pkgs {
 723   my $self = shift;
 724   # have to enumerate exportnums but it's not bad
 725   my @exportnums = map { $_->exportnum }
 726                    grep { $_->can('usage_sessions') }
 727                    qsearch('part_export');
 728   return 0 if !@exportnums;
 729   my $in_exportnums = join(',', @exportnums);
 730   my $sql = "SELECT COUNT(DISTINCT pkgnum) FROM cust_pkg
 731     JOIN cust_svc USING (pkgnum)
 732     JOIN export_svc USING (svcpart)
 733     WHERE exportnum IN( $in_exportnums ) AND custnum = ?";
 734   FS::Record->scalar_sql($sql, $self->custnum);
 735 }
 736
 737 =item display_recurring
 738
 739 Returns an array of hash references, one for each recurring freq
 740 on billable customer packages, with keys of freq, freq_pretty and amount
 741 (the amount that this customer will next be charged at the given frequency.)
 742
 743 Results will be numerically sorted by freq.
 744
 745 Only intended for display purposes, not used for actual billing.
 746
 747 =cut
 748
 749 sub display_recurring {
 750   my $cust_main = shift;
 751
 752   my $sth = dbh->prepare("
 753     SELECT DISTINCT freq FROM cust_pkg LEFT JOIN part_pkg USING (pkgpart)
 754       WHERE freq IS NOT NULL AND freq != '0'
 755         AND ( cancel IS NULL OR cancel = 0 )
 756         AND custnum = ?
 757   ") or die $DBI::errstr;
 758
 759   $sth->execute($cust_main->custnum) or die $sth->errstr;
 760
 761   #not really a numeric sort because freqs can actually be all sorts of things
 762   # but good enough for the 99% cases of ordering monthly quarterly annually
 763   my @freqs = sort { $a <=> $b } map { $_->[0] } @{ $sth->fetchall_arrayref };
 764
 765   $sth->finish;
 766
 767   my @out;
 768
 769   foreach my $freq (@freqs) {
 770
 771     my @cust_pkg = qsearch({
 772       'table'     => 'cust_pkg',
 773       'addl_from' => 'LEFT JOIN part_pkg USING (pkgpart)',
 774       'hashref'   => { 'custnum' => $cust_main->custnum, },
 775       'extra_sql' => 'AND ( cancel IS NULL OR cancel = 0 )
 776                       AND freq = '. dbh->quote($freq),
 777       'order_by'  => 'ORDER BY COALESCE(start_date,0), pkgnum', # to ensure old pkgs come before change_to_pkg
 778     }) or next;
 779
 780     my $freq_pretty = $cust_pkg[0]->part_pkg->freq_pretty;
 781
 782     my $amount = 0;
 783     my $skip_pkg = {};
 784     foreach my $cust_pkg (@cust_pkg) {
 785       my $part_pkg = $cust_pkg->part_pkg;
 786       next if $cust_pkg->susp
 787            && ! $cust_pkg->option('suspend_bill')
 788            && ( ! $part_pkg->option('suspend_bill')
 789                 || $cust_pkg->option('no_suspend_bill')
 790               );
 791
 792       #pkg change handling
 793       next if $skip_pkg->{$cust_pkg->pkgnum};
 794       if ($cust_pkg->change_to_pkgnum) {
 795         #if change is on or before next bill date, use new pkg
 796         next if $cust_pkg->expire <= $cust_pkg->bill;
 797         #if change is after next bill date, use old (this) pkg
 798         $skip_pkg->{$cust_pkg->change_to_pkgnum} = 1;
 799       }
 800
 801       my $pkg_amount = 0;
 802
 803       #add recurring amounts for this package and its billing add-ons
 804       foreach my $l_part_pkg ( $part_pkg->self_and_bill_linked ) {
 805         $pkg_amount += $l_part_pkg->base_recur($cust_pkg);
 806       }
 807
 808       #subtract amounts for any active discounts
 809       #(there should only be one at the moment, otherwise this makes no sense)
 810       foreach my $cust_pkg_discount ( $cust_pkg->cust_pkg_discount_active ) {
 811         my $discount = $cust_pkg_discount->discount;
 812         #and only one of these for each
 813         $pkg_amount -= $discount->amount;
 814         $pkg_amount -= $pkg_amount * $discount->percent/100;
 815       }
 816
 817       $pkg_amount *= ( $cust_pkg->quantity || 1 );
 818
 819       $amount += $pkg_amount;
 820
 821     } #foreach $cust_pkg
 822
 823     next unless $amount;
 824     push @out, {
 825       'freq'        => $freq,
 826       'freq_pretty' => $freq_pretty,
 827       'amount'      => $amount,
 828     };
 829
 830   } #foreach $freq
 831
 832   return @out;
 833 }
 834
 835 =back
 836
 837 =head1 BUGS
 838
 839 =head1 SEE ALSO
 840
 841 L<FS::cust_main>, L<FS::cust_pkg>
 842
 843 =cut
 844
 845 1;
 846