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_subject
  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   grep { $_->susp } $self->ncancelled_pkgs;
 359 }
 360
 361 =item unflagged_suspended_pkgs
 362
 363 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 364 customer (thouse packages without the `manual_flag' set).
 365
 366 =cut
 367
 368 sub unflagged_suspended_pkgs {
 369   my $self = shift;
 370   return $self->suspended_pkgs
 371     unless dbdef->table('cust_pkg')->column('manual_flag');
 372   grep { ! $_->manual_flag } $self->suspended_pkgs;
 373 }
 374
 375 =item unsuspended_pkgs
 376
 377 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 378 this customer.
 379
 380 =cut
 381
 382 sub unsuspended_pkgs {
 383   my $self = shift;
 384   grep { ! $_->susp } $self->ncancelled_pkgs;
 385 }
 386
 387 =item active_pkgs
 388
 389 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 390 this customer that are active (recurring).
 391
 392 =cut
 393
 394 sub active_pkgs {
 395   my $self = shift;
 396   grep { my $part_pkg = $_->part_pkg;
 397          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 398        }
 399        $self->unsuspended_pkgs;
 400 }
 401
 402 =item billing_pkgs
 403
 404 Returns active packages, and also any suspended packages which are set to
 405 continue billing while suspended.
 406
 407 =cut
 408
 409 sub billing_pkgs {
 410   my $self = shift;
 411   grep { my $part_pkg = $_->part_pkg;
 412          $part_pkg->freq ne '' && $part_pkg->freq ne '0'
 413            && ( ! $_->susp || $part_pkg->option('suspend_bill', 1) );
 414        }
 415        $self->ncancelled_pkgs;
 416 }
 417
 418 =item next_bill_date
 419
 420 Returns the next date this customer will be billed, as a UNIX timestamp, or
 421 undef if no billing package has a next bill date.
 422
 423 =cut
 424
 425 sub next_bill_date {
 426   my $self = shift;
 427   min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
 428 }
 429
 430 =item num_cancelled_pkgs
 431
 432 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
 433 customer.
 434
 435 =cut
 436
 437 sub num_cancelled_pkgs {
 438   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
 439 }
 440
 441 sub num_ncancelled_pkgs {
 442   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
 443 }
 444
 445 sub num_pkgs {
 446   my( $self ) = shift;
 447   my $sql = scalar(@_) ? shift : '';
 448   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
 449   my $sth = dbh->prepare(
 450     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
 451   ) or die dbh->errstr;
 452   $sth->execute($self->custnum) or die $sth->errstr;
 453   $sth->fetchrow_arrayref->[0];
 454 }
 455
 456 =back
 457
 458 =head1 BUGS
 459
 460 =head1 SEE ALSO
 461
 462 L<FS::cust_main>, L<FS::cust_pkg>
 463
 464 =cut
 465
 466 1;
 467