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 OPTION => VALUE ...
 574
 575 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 576
 577 Currently supports one option, I<reason_type>, which if set to a typenum,
 578 limits the results to packages which were suspended for reasons of this type.
 579 (Does not currently work in scalar context; i.e. when just asking for a count.)
 580
 581 =cut
 582
 583 sub suspended_pkgs {
 584   my $self = shift;
 585   my %opt = @_;
 586
 587   return $self->num_suspended_pkgs unless wantarray; #XXX opt in scalar context
 588
 589   my @pkgs = grep { $_->susp } $self->ncancelled_pkgs;
 590
 591   if ( $opt{reason_type} ) {
 592     @pkgs = grep { my $r = $_->last_reason('susp');
 593                    $r && $r->reason_type == $opt{reason_type};
 594                  }
 595               @pkgs;
 596   }
 597
 598   @pkgs;
 599 }
 600
 601 =item unsuspended_pkgs
 602
 603 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 604 this customer.
 605
 606 =cut
 607
 608 sub unsuspended_pkgs {
 609   my $self = shift;
 610   return $self->num_unsuspended_pkgs unless wantarray;
 611   grep { ! $_->susp } $self->ncancelled_pkgs;
 612 }
 613
 614 =item active_pkgs
 615
 616 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 617 this customer that are active (recurring).
 618
 619 =cut
 620
 621 #recurring_pkgs?  different from cust_pkg idea of "active" which has
 622 # a setup vs not_yet_billed which doesn't
 623 sub active_pkgs {
 624   my $self = shift;
 625   grep { my $part_pkg = $_->part_pkg;
 626          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 627        }
 628        $self->unsuspended_pkgs;
 629 }
 630
 631 =item ncancelled_active_pkgs
 632
 633 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer that
 634 are active (recurring).
 635
 636 =cut
 637
 638 #ncancelled_recurring_pkgs?  different from cust_pkg idea of "active" which has
 639 # a setup vs not_yet_billed which doesn't
 640 sub ncancelled_active_pkgs {
 641   my $self = shift;
 642   grep { my $part_pkg = $_->part_pkg;
 643          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 644        }
 645        $self->ncancelled_pkgs;
 646 }
 647
 648 =item billing_pkgs
 649
 650 Returns active packages, and also any suspended packages which are set to
 651 continue billing while suspended.
 652
 653 =cut
 654
 655 sub billing_pkgs {
 656   my $self = shift;
 657   grep { my $part_pkg = $_->part_pkg;
 658          $part_pkg->freq ne '' && $part_pkg->freq ne '0'
 659            && ( ! $_->susp || $_->option('suspend_bill',1)
 660                            || ( $part_pkg->option('suspend_bill', 1)
 661                                   && ! $_->option('no_suspend_bill',1)
 662                               )
 663               );
 664        }
 665        $self->ncancelled_pkgs;
 666 }
 667
 668 =item next_bill_date
 669
 670 Returns the next date this customer will be billed, as a UNIX timestamp, or
 671 undef if no billing package has a next bill date.
 672
 673 =cut
 674
 675 sub next_bill_date {
 676   my $self = shift;
 677
 678 #  super inefficient with lots of packages
 679 #  min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
 680
 681   my $custnum = $self->custnum;
 682
 683   $self->scalar_sql("
 684     SELECT MIN(bill) FROM cust_pkg
 685       LEFT JOIN cust_pkg_option AS cust_suspend_bill_option
 686         ON (     cust_pkg.pkgnum = cust_suspend_bill_option.pkgnum
 687              AND cust_suspend_bill_option.optionname = 'suspend_bill' )
 688       LEFT JOIN cust_pkg_option AS cust_no_suspend_bill_option
 689         ON (     cust_pkg.pkgnum = cust_no_suspend_bill_option.pkgnum
 690              AND cust_no_suspend_bill_option.optionname = 'no_suspend_bill' )
 691       LEFT JOIN part_pkg USING (pkgpart)
 692         LEFT JOIN part_pkg_option AS part_suspend_bill_option
 693           ON (     part_pkg.pkgpart = part_suspend_bill_option.pkgpart
 694                AND part_suspend_bill_option.optionname = 'suspend_bill' )
 695     WHERE custnum = $custnum
 696       AND bill IS NOT NULL AND bill != 0
 697       AND ( cancel IS NULL OR cancel = 0 )
 698       AND part_pkg.freq != '' AND part_pkg.freq != '0'
 699       AND (    ( susp IS NULL OR susp = 0 )
 700             OR COALESCE(cust_suspend_bill_option.optionvalue,'0') = '1'
 701             OR (     COALESCE(part_suspend_bill_option.optionvalue,'0') = '1'
 702                  AND COALESCE(cust_no_suspend_bill_option.optionvalue,'0') = '0'
 703                )
 704           )
 705   ");
 706
 707 }
 708
 709 =item num_cancelled_pkgs
 710
 711 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
 712 customer.
 713
 714 =cut
 715
 716 sub num_cancelled_pkgs {
 717   my $self = shift;
 718   my $opt = shift || {};
 719   $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
 720   $opt->{extra_sql} .= "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
 721   $self->num_pkgs($opt);
 722 }
 723
 724 =item num_ncancelled_pkgs
 725
 726 Returns the number of packages that have not been cancelled (see L<FS::cust_pkg>) for this
 727 customer.
 728
 729 =cut
 730
 731 sub num_ncancelled_pkgs {
 732   my $self = shift;
 733   my $opt = shift || {};
 734   $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
 735   $opt->{extra_sql} .= "( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )";
 736   $self->num_pkgs($opt);
 737 }
 738
 739 =item num_billing_pkgs
 740
 741 Returns the number of packages that have not been cancelled
 742 and have a non-zero billing frequency (see L<FS::cust_pkg>)
 743 for this customer.
 744
 745 =cut
 746
 747 sub num_billing_pkgs {
 748   my $self = shift;
 749   my $opt = shift || {};
 750   $opt->{addl_from} .= ' LEFT JOIN part_pkg USING (pkgpart)';
 751   $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
 752   $opt->{extra_sql} .= "freq IS NOT NULL AND freq != '0'";
 753   $self->num_ncancelled_pkgs($opt);
 754 }
 755
 756 sub num_suspended_pkgs {
 757   my $self = shift;
 758   my $opt = shift || {};
 759   $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
 760   $opt->{extra_sql} .= "    ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 761                         AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0  ";
 762   $self->num_pkgs($opt);
 763 }
 764
 765 sub num_unsuspended_pkgs {
 766   my $self = shift;
 767   my $opt = shift || {};
 768   $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
 769   $opt->{extra_sql} .= "    ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 770                         AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )";
 771   $self->num_pkgs($opt);
 772 }
 773
 774 sub num_pkgs {
 775   my( $self ) = shift;
 776   my $addl_from = '';
 777   my $sql = '';
 778   if ( @_ ) {
 779     if ( ref($_[0]) ) {
 780       my $opt = shift;
 781       $sql       = $opt->{extra_sql} if exists($opt->{extra_sql});
 782       $addl_from = $opt->{addl_from} if exists($opt->{addl_from});
 783     } else {
 784       $sql = shift;
 785     }
 786   }
 787   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
 788   my $sth = dbh->prepare(
 789     "SELECT COUNT(*) FROM cust_pkg $addl_from WHERE cust_pkg.custnum = ? $sql"
 790   ) or die dbh->errstr;
 791   $sth->execute($self->custnum) or die $sth->errstr;
 792   $sth->fetchrow_arrayref->[0];
 793 }
 794
 795 =item num_usage_pkgs
 796
 797 Returns the number of packages for this customer that have services that
 798 can have RADIUS usage statistics.
 799
 800 =cut
 801
 802 sub num_usage_pkgs {
 803   my $self = shift;
 804   # have to enumerate exportnums but it's not bad
 805   my @exportnums = map { $_->exportnum }
 806                    grep { $_->can('usage_sessions') }
 807                    qsearch('part_export');
 808   return 0 if !@exportnums;
 809   my $in_exportnums = join(',', @exportnums);
 810   my $sql = "SELECT COUNT(DISTINCT pkgnum) FROM cust_pkg
 811     JOIN cust_svc USING (pkgnum)
 812     JOIN export_svc USING (svcpart)
 813     WHERE exportnum IN( $in_exportnums ) AND custnum = ?";
 814   FS::Record->scalar_sql($sql, $self->custnum);
 815 }
 816
 817 =item display_recurring
 818
 819 Returns an array of hash references, one for each recurring freq
 820 on billable customer packages, with keys of freq, freq_pretty and amount
 821 (the amount that this customer will next be charged at the given frequency.)
 822
 823 Results will be numerically sorted by freq.
 824
 825 Only intended for display purposes, not used for actual billing.
 826
 827 =cut
 828
 829 sub display_recurring {
 830   my $cust_main = shift;
 831
 832   my $sth = dbh->prepare("
 833     SELECT DISTINCT freq FROM cust_pkg LEFT JOIN part_pkg USING (pkgpart)
 834       WHERE freq IS NOT NULL AND freq != '0'
 835         AND ( cancel IS NULL OR cancel = 0 )
 836         AND custnum = ?
 837   ") or die $DBI::errstr;
 838
 839   $sth->execute($cust_main->custnum) or die $sth->errstr;
 840
 841   #not really a numeric sort because freqs can actually be all sorts of things
 842   # but good enough for the 99% cases of ordering monthly quarterly annually
 843   my @freqs = sort { $a <=> $b } map { $_->[0] } @{ $sth->fetchall_arrayref };
 844
 845   $sth->finish;
 846
 847   my @out;
 848
 849   foreach my $freq (@freqs) {
 850
 851     my @cust_pkg = qsearch({
 852       'table'     => 'cust_pkg',
 853       'addl_from' => 'LEFT JOIN part_pkg USING (pkgpart)',
 854       'hashref'   => { 'custnum' => $cust_main->custnum, },
 855       'extra_sql' => 'AND ( cancel IS NULL OR cancel = 0 )
 856                       AND freq = '. dbh->quote($freq),
 857       'order_by'  => 'ORDER BY COALESCE(start_date,0), pkgnum', # to ensure old pkgs come before change_to_pkg
 858     }) or next;
 859
 860     my $freq_pretty = $cust_pkg[0]->part_pkg->freq_pretty;
 861
 862     my $amount = 0;
 863     my $skip_pkg = {};
 864     foreach my $cust_pkg (@cust_pkg) {
 865       my $part_pkg = $cust_pkg->part_pkg;
 866       next if $cust_pkg->susp
 867            && ! $cust_pkg->option('suspend_bill')
 868            && ( ! $part_pkg->option('suspend_bill')
 869                 || $cust_pkg->option('no_suspend_bill')
 870               );
 871
 872       #pkg change handling
 873       next if $skip_pkg->{$cust_pkg->pkgnum};
 874       if ($cust_pkg->change_to_pkgnum) {
 875         #if change is on or before next bill date, use new pkg
 876         next if $cust_pkg->expire <= $cust_pkg->bill;
 877         #if change is after next bill date, use old (this) pkg
 878         $skip_pkg->{$cust_pkg->change_to_pkgnum} = 1;
 879       }
 880
 881       my $pkg_amount = 0;
 882
 883       #add recurring amounts for this package and its billing add-ons
 884       foreach my $l_part_pkg ( $part_pkg->self_and_bill_linked ) {
 885         $pkg_amount += $l_part_pkg->base_recur($cust_pkg);
 886       }
 887
 888       #subtract amounts for any active discounts
 889       #(there should only be one at the moment, otherwise this makes no sense)
 890       foreach my $cust_pkg_discount ( $cust_pkg->cust_pkg_discount_active ) {
 891         my $discount = $cust_pkg_discount->discount;
 892         #and only one of these for each
 893         $pkg_amount -= $discount->amount;
 894         $pkg_amount -= $pkg_amount * $discount->percent/100;
 895       }
 896
 897       $pkg_amount *= ( $cust_pkg->quantity || 1 );
 898
 899       $amount += $pkg_amount;
 900
 901     } #foreach $cust_pkg
 902
 903     next unless $amount;
 904     push @out, {
 905       'freq'        => $freq,
 906       'freq_pretty' => $freq_pretty,
 907       'amount'      => $amount,
 908     };
 909
 910   } #foreach $freq
 911
 912   return @out;
 913 }
 914
 915 =back
 916
 917 =head1 BUGS
 918
 919 =head1 SEE ALSO
 920
 921 L<FS::cust_main>, L<FS::cust_pkg>
 922
 923 =cut
 924
 925 1;
 926