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