FS/FS/cust_main/Packages.pm

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