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