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