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_subject
  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 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
 146 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 147
 148 Like the insert method on an existing record, this method orders multiple
 149 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 150 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 151 There should be a better explanation of this, but until then, here's an
 152 example:
 153
 154   use Tie::RefHash;
 155   tie %hash, 'Tie::RefHash'; #this part is important
 156   %hash = (
 157     $cust_pkg => [ $svc_acct ],
 158     ...
 159   );
 160   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 161
 162 Services can be new, in which case they are inserted, or existing unaudited
 163 services, in which case they are linked to the newly-created package.
 164
 165 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 166 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 167
 168 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 169 on the supplied jobnum (they will not run until the specific job completes).
 170 This can be used to defer provisioning until some action completes (such
 171 as running the customer's credit card successfully).
 172
 173 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 174 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 175 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 176 on the cust_main object is not recommended, as existing services will also be
 177 reexported.)
 178
 179 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 180 provided, the scalars (provided by references) will be incremented by the
 181 values of the prepaid card.`
 182
 183 =cut
 184
 185 sub order_pkgs {
 186   my $self = shift;
 187   my $cust_pkgs = shift;
 188   my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
 189   my %options = @_;
 190   $seconds_ref ||= $options{'seconds_ref'};
 191
 192   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 193
 194   warn "$me order_pkgs called with options ".
 195        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 196     if $DEBUG;
 197
 198   local $SIG{HUP} = 'IGNORE';
 199   local $SIG{INT} = 'IGNORE';
 200   local $SIG{QUIT} = 'IGNORE';
 201   local $SIG{TERM} = 'IGNORE';
 202   local $SIG{TSTP} = 'IGNORE';
 203   local $SIG{PIPE} = 'IGNORE';
 204
 205   my $oldAutoCommit = $FS::UID::AutoCommit;
 206   local $FS::UID::AutoCommit = 0;
 207   my $dbh = dbh;
 208
 209   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 210
 211   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 212
 213     my $error = $self->order_pkg(
 214       'cust_pkg'     => $cust_pkg,
 215       'svcs'         => $cust_pkgs->{$cust_pkg},
 216       'seconds_ref'  => $seconds_ref,
 217       map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
 218                                      depend_jobnum
 219                                    )
 220     );
 221     if ( $error ) {
 222       $dbh->rollback if $oldAutoCommit;
 223       return $error;
 224     }
 225
 226   }
 227
 228   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 229   ''; #no error
 230 }
 231
 232 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
 233
 234 Returns all packages (see L<FS::cust_pkg>) for this customer.
 235
 236 =cut
 237
 238 sub all_pkgs {
 239   my $self = shift;
 240   my $extra_qsearch = ref($_[0]) ? shift : { @_ };
 241
 242   return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
 243
 244   my @cust_pkg = ();
 245   if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
 246     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
 247   } else {
 248     @cust_pkg = $self->_cust_pkg($extra_qsearch);
 249   }
 250
 251   map { $_ } sort sort_packages @cust_pkg;
 252 }
 253
 254 =item cust_pkg
 255
 256 Synonym for B<all_pkgs>.
 257
 258 =cut
 259
 260 sub cust_pkg {
 261   shift->all_pkgs(@_);
 262 }
 263
 264 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
 265
 266 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 267
 268 =cut
 269
 270 sub ncancelled_pkgs {
 271   my $self = shift;
 272   my $extra_qsearch = ref($_[0]) ? shift : {};
 273
 274   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 275
 276   return $self->num_ncancelled_pkgs unless wantarray;
 277
 278   my @cust_pkg = ();
 279   if ( $self->{'_pkgnum'} ) {
 280
 281     warn "$me ncancelled_pkgs: returning cached objects"
 282       if $DEBUG > 1;
 283
 284     @cust_pkg = grep { ! $_->getfield('cancel') }
 285                 values %{ $self->{'_pkgnum'}->cache };
 286
 287   } else {
 288
 289     warn "$me ncancelled_pkgs: searching for packages with custnum ".
 290          $self->custnum. "\n"
 291       if $DEBUG > 1;
 292
 293     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
 294
 295     @cust_pkg = $self->_cust_pkg($extra_qsearch);
 296
 297   }
 298
 299   sort sort_packages @cust_pkg;
 300
 301 }
 302
 303 sub _cust_pkg {
 304   my $self = shift;
 305   my $extra_qsearch = ref($_[0]) ? shift : {};
 306
 307   $extra_qsearch->{'select'} ||= '*';
 308   $extra_qsearch->{'select'} .=
 309    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
 310      AS _num_cust_svc';
 311
 312   map {
 313         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
 314         $_;
 315       }
 316   qsearch({
 317     %$extra_qsearch,
 318     'table'   => 'cust_pkg',
 319     'hashref' => { 'custnum' => $self->custnum },
 320   });
 321
 322 }
 323
 324 # This should be generalized to use config options to determine order.
 325 sub sort_packages {
 326
 327   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
 328   return $locationsort if $locationsort;
 329
 330   if ( $a->get('cancel') xor $b->get('cancel') ) {
 331     return -1 if $b->get('cancel');
 332     return  1 if $a->get('cancel');
 333     #shouldn't get here...
 334     return 0;
 335   } else {
 336     my $a_num_cust_svc = $a->num_cust_svc;
 337     my $b_num_cust_svc = $b->num_cust_svc;
 338     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
 339     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
 340     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
 341     my @a_cust_svc = $a->cust_svc;
 342     my @b_cust_svc = $b->cust_svc;
 343     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
 344     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
 345     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
 346     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
 347   }
 348
 349 }
 350
 351 =item suspended_pkgs
 352
 353 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 354
 355 =cut
 356
 357 sub suspended_pkgs {
 358   my $self = shift;
 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   grep { ! $_->susp } $self->ncancelled_pkgs;
 386 }
 387
 388 =item active_pkgs
 389
 390 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 391 this customer that are active (recurring).
 392
 393 =cut
 394
 395 sub active_pkgs {
 396   my $self = shift;
 397   grep { my $part_pkg = $_->part_pkg;
 398          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
 399        }
 400        $self->unsuspended_pkgs;
 401 }
 402
 403 =item next_bill_date
 404
 405 Returns the next date this customer will be billed, as a UNIX timestamp, or
 406 undef if no active package has a next bill date.
 407
 408 =cut
 409
 410 sub next_bill_date {
 411   my $self = shift;
 412   min( map $_->get('bill'), grep $_->get('bill'), $self->active_pkgs );
 413 }
 414
 415 =item num_cancelled_pkgs
 416
 417 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
 418 customer.
 419
 420 =cut
 421
 422 sub num_cancelled_pkgs {
 423   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
 424 }
 425
 426 sub num_ncancelled_pkgs {
 427   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
 428 }
 429
 430 sub num_pkgs {
 431   my( $self ) = shift;
 432   my $sql = scalar(@_) ? shift : '';
 433   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
 434   my $sth = dbh->prepare(
 435     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
 436   ) or die dbh->errstr;
 437   $sth->execute($self->custnum) or die $sth->errstr;
 438   $sth->fetchrow_arrayref->[0];
 439 }
 440
 441 =back
 442
 443 =head1 BUGS
 444
 445 =head1 SEE ALSO
 446
 447 L<FS::cust_main>, L<FS::cust_pkg>
 448
 449 =cut
 450
 451 1;
 452