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 );
   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 );
  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->{'cust_location'} &&
 104        ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
 105     my $error = $opt->{'cust_location'}->insert;
 106     if ( $error ) {
 107       $dbh->rollback if $oldAutoCommit;
 108       return "inserting cust_location (transaction rolled back): $error";
 109     }
 110     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
 111   }
 112   else {
 113     $cust_pkg->locationnum($self->ship_locationnum);
 114   }
 115
 116   $cust_pkg->custnum( $self->custnum );
 117
 118   my $error = $cust_pkg->insert( %insert_params );
 119   if ( $error ) {
 120     $dbh->rollback if $oldAutoCommit;
 121     return "inserting cust_pkg (transaction rolled back): $error";
 122   }
 123
 124   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
 125     if ( $svc_something->svcnum ) {
 126       my $old_cust_svc = $svc_something->cust_svc;
 127       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 128       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 129       $error = $new_cust_svc->replace($old_cust_svc);
 130     } else {
 131       $svc_something->pkgnum( $cust_pkg->pkgnum );
 132       if ( $svc_something->isa('FS::svc_acct') ) {
 133         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
 134                        qw( seconds upbytes downbytes totalbytes )      ) {
 135           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
 136           ${ $opt->{$_.'_ref'} } = 0;
 137         }
 138       }
 139       $error = $svc_something->insert(%svc_options);
 140     }
 141     if ( $error ) {
 142       $dbh->rollback if $oldAutoCommit;
 143       return "inserting svc_ (transaction rolled back): $error";
 144     }
 145   }
 146
 147   # add supplemental packages, if any are needed
 148   my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
 149   foreach my $link ($part_pkg->supp_part_pkg_link) {
 150     warn "inserting supplemental package ".$link->dst_pkgpart;
 151     my $pkg = FS::cust_pkg->new({
 152         'pkgpart'       => $link->dst_pkgpart,
 153         'pkglinknum'    => $link->pkglinknum,
 154         'custnum'       => $self->custnum,
 155         'main_pkgnum'   => $cust_pkg->pkgnum,
 156         'locationnum'   => $cust_pkg->locationnum,
 157         # try to prevent as many surprises as possible
 158         'pkgbatch'      => $cust_pkg->pkgbatch,
 159         'start_date'    => $cust_pkg->start_date,
 160         'order_date'    => $cust_pkg->order_date,
 161         'expire'        => $cust_pkg->expire,
 162         'adjourn'       => $cust_pkg->adjourn,
 163         'contract_end'  => $cust_pkg->contract_end,
 164         'refnum'        => $cust_pkg->refnum,
 165         'discountnum'   => $cust_pkg->discountnum,
 166         'waive_setup'   => $cust_pkg->waive_setup,
 167     });
 168     $error = $self->order_pkg('cust_pkg' => $pkg);
 169     if ( $error ) {
 170       $dbh->rollback if $oldAutoCommit;
 171       return "inserting supplemental package: $error";
 172     }
 173   }
 174
 175   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 176   ''; #no error
 177
 178 }
 179
 180 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 181
 182 Like the insert method on an existing record, this method orders multiple
 183 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 184 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 185 There should be a better explanation of this, but until then, here's an
 186 example:
 187
 188   use Tie::RefHash;
 189   tie %hash, 'Tie::RefHash'; #this part is important
 190   %hash = (
 191     $cust_pkg => [ $svc_acct ],
 192     ...
 193   );
 194   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 195
 196 Services can be new, in which case they are inserted, or existing unaudited
 197 services, in which case they are linked to the newly-created package.
 198
 199 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 200 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 201
 202 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 203 on the supplied jobnum (they will not run until the specific job completes).
 204 This can be used to defer provisioning until some action completes (such
 205 as running the customer's credit card successfully).
 206
 207 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 208 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 209 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 210 on the cust_main object is not recommended, as existing services will also be
 211 reexported.)
 212
 213 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 214 provided, the scalars (provided by references) will be incremented by the
 215 values of the prepaid card.`
 216
 217 =cut
 218
 219 sub order_pkgs {
 220   my $self = shift;
 221   my $cust_pkgs = shift;
 222   my %options = @_;
 223
 224   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 225
 226   warn "$me order_pkgs called with options ".
 227        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 228     if $DEBUG;
 229
 230   local $SIG{HUP} = 'IGNORE';
 231   local $SIG{INT} = 'IGNORE';
 232   local $SIG{QUIT} = 'IGNORE';
 233   local $SIG{TERM} = 'IGNORE';
 234   local $SIG{TSTP} = 'IGNORE';
 235   local $SIG{PIPE} = 'IGNORE';
 236
 237   my $oldAutoCommit = $FS::UID::AutoCommit;
 238   local $FS::UID::AutoCommit = 0;
 239   my $dbh = dbh;
 240
 241   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 242
 243   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 244
 245     my $error = $self->order_pkg(
 246       'cust_pkg'     => $cust_pkg,
 247       'svcs'         => $cust_pkgs->{$cust_pkg},
 248       map { $_ => $options{$_} }
 249         qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum )
 250     );
 251     if ( $error ) {
 252       $dbh->rollback if $oldAutoCommit;
 253       return $error;
 254     }
 255
 256   }
 257
 258   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 259   ''; #no error
 260 }
 261
 262 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
 263
 264 Returns all packages (see L<FS::cust_pkg>) for this customer.
 265
 266 =cut
 267
 268 sub all_pkgs {
 269   my $self = shift;
 270   my $extra_qsearch = ref($_[0]) ? shift : { @_ };
 271
 272   return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
 273
 274   my @cust_pkg = ();
 275   if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
 276     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
 277   } else {
 278     @cust_pkg = $self->_cust_pkg($extra_qsearch);
 279   }
 280
 281   map { $_ } sort sort_packages @cust_pkg;
 282 }
 283
 284 =item cust_pkg
 285
 286 Synonym for B<all_pkgs>.
 287
 288 =cut
 289
 290 sub cust_pkg {
 291   shift->all_pkgs(@_);
 292 }
 293
 294 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
 295
 296 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 297
 298 =cut
 299
 300 sub ncancelled_pkgs {
 301   my $self = shift;
 302   my $extra_qsearch = ref($_[0]) ? shift : {};
 303
 304   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 305
 306   return $self->num_ncancelled_pkgs unless wantarray;
 307
 308   my @cust_pkg = ();
 309   if ( $self->{'_pkgnum'} ) {
 310
 311     warn "$me ncancelled_pkgs: returning cached objects"
 312       if $DEBUG > 1;
 313
 314     @cust_pkg = grep { ! $_->getfield('cancel') }
 315                 values %{ $self->{'_pkgnum'}->cache };
 316
 317   } else {
 318
 319     warn "$me ncancelled_pkgs: searching for packages with custnum ".
 320          $self->custnum. "\n"
 321       if $DEBUG > 1;
 322
 323     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
 324
 325     @cust_pkg = $self->_cust_pkg($extra_qsearch);
 326
 327   }
 328
 329   sort sort_packages @cust_pkg;
 330
 331 }
 332
 333 sub _cust_pkg {
 334   my $self = shift;
 335   my $extra_qsearch = ref($_[0]) ? shift : {};
 336
 337   $extra_qsearch->{'select'} ||= '*';
 338   $extra_qsearch->{'select'} .=
 339    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
 340      AS _num_cust_svc';
 341
 342   map {
 343         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
 344         $_;
 345       }
 346   qsearch({
 347     %$extra_qsearch,
 348     'table'   => 'cust_pkg',
 349     'hashref' => { 'custnum' => $self->custnum },
 350   });
 351
 352 }
 353
 354 # This should be generalized to use config options to determine order.
 355 sub sort_packages {
 356
 357   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
 358   return $locationsort if $locationsort;
 359
 360   if ( $a->get('cancel') xor $b->get('cancel') ) {
 361     return -1 if $b->get('cancel');
 362     return  1 if $a->get('cancel');
 363     #shouldn't get here...
 364     return 0;
 365   } else {
 366     my $a_num_cust_svc = $a->num_cust_svc;
 367     my $b_num_cust_svc = $b->num_cust_svc;
 368     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
 369     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
 370     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
 371     my @a_cust_svc = $a->cust_svc;
 372     my @b_cust_svc = $b->cust_svc;
 373     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
 374     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
 375     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
 376     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
 377   }
 378
 379 }
 380
 381 =item suspended_pkgs
 382
 383 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 384
 385 =cut
 386
 387 sub suspended_pkgs {
 388   my $self = shift;
 389   return $self->num_suspended_pkgs unless wantarray;
 390   grep { $_->susp } $self->ncancelled_pkgs;
 391 }
 392
 393 =item unflagged_suspended_pkgs
 394
 395 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 396 customer (thouse packages without the `manual_flag' set).
 397
 398 =cut
 399
 400 sub unflagged_suspended_pkgs {
 401   my $self = shift;
 402   return $self->suspended_pkgs
 403     unless dbdef->table('cust_pkg')->column('manual_flag');
 404   grep { ! $_->manual_flag } $self->suspended_pkgs;
 405 }
 406
 407 =item unsuspended_pkgs
 408
 409 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 410 this customer.
 411
 412 =cut
 413
 414 sub unsuspended_pkgs {
 415   my $self = shift;
 416   return $self->num_unsuspended_pkgs unless wantarray;
 417   grep { ! $_->susp } $self->ncancelled_pkgs;
 418 }
 419
 420 =item active_pkgs
 421
 422 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 423 this customer that are active (recurring).
 424
 425 =cut
 426
 427 sub active_pkgs {
 428   my $self = shift;
 429   grep { my $part_pkg = $_->part_pkg;
 430          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 431        }
 432        $self->unsuspended_pkgs;
 433 }
 434
 435 =item billing_pkgs
 436
 437 Returns active packages, and also any suspended packages which are set to
 438 continue billing while suspended.
 439
 440 =cut
 441
 442 sub billing_pkgs {
 443   my $self = shift;
 444   grep { my $part_pkg = $_->part_pkg;
 445          $part_pkg->freq ne '' && $part_pkg->freq ne '0'
 446            && ( ! $_->susp || $_->option('suspend_bill',1)
 447                            || ( $part_pkg->option('suspend_bill', 1)
 448                                   && ! $_->option('no_suspend_bill',1)
 449                               )
 450               );
 451        }
 452        $self->ncancelled_pkgs;
 453 }
 454
 455 =item next_bill_date
 456
 457 Returns the next date this customer will be billed, as a UNIX timestamp, or
 458 undef if no billing package has a next bill date.
 459
 460 =cut
 461
 462 sub next_bill_date {
 463   my $self = shift;
 464   min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
 465 }
 466
 467 =item num_cancelled_pkgs
 468
 469 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
 470 customer.
 471
 472 =cut
 473
 474 sub num_cancelled_pkgs {
 475   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
 476 }
 477
 478 sub num_ncancelled_pkgs {
 479   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
 480 }
 481
 482 sub num_suspended_pkgs {
 483   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 484                     AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0   ");
 485 }
 486
 487 sub num_unsuspended_pkgs {
 488   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
 489                     AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 ) ");
 490 }
 491
 492 sub num_pkgs {
 493   my( $self ) = shift;
 494   my $sql = scalar(@_) ? shift : '';
 495   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
 496   my $sth = dbh->prepare(
 497     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
 498   ) or die dbh->errstr;
 499   $sth->execute($self->custnum) or die $sth->errstr;
 500   $sth->fetchrow_arrayref->[0];
 501 }
 502
 503 =back
 504
 505 =head1 BUGS
 506
 507 =head1 SEE ALSO
 508
 509 L<FS::cust_main>, L<FS::cust_pkg>
 510
 511 =cut
 512
 513 1;
 514