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