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