FS/FS/cust_pkg.pm

   1 package FS::cust_pkg;
   2
   3 use strict;
   4 use vars qw(@ISA $disable_agentcheck $DEBUG);
   5 use Scalar::Util qw( blessed );
   6 use List::Util qw(max);
   7 use Tie::IxHash;
   8 use FS::UID qw( getotaker dbh );
   9 use FS::Misc qw( send_email );
  10 use FS::Record qw( qsearch qsearchs );
  11 use FS::m2m_Common;
  12 use FS::cust_main_Mixin;
  13 use FS::cust_svc;
  14 use FS::part_pkg;
  15 use FS::cust_main;
  16 use FS::type_pkgs;
  17 use FS::pkg_svc;
  18 use FS::cust_bill_pkg;
  19 use FS::cust_event;
  20 use FS::h_cust_svc;
  21 use FS::reg_code;
  22 use FS::part_svc;
  23 use FS::cust_pkg_reason;
  24 use FS::reason;
  25 use FS::UI::Web;
  26
  27 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
  28 # setup }
  29 # because they load configuration by setting FS::UID::callback (see TODO)
  30 use FS::svc_acct;
  31 use FS::svc_domain;
  32 use FS::svc_www;
  33 use FS::svc_forward;
  34
  35 # for sending cancel emails in sub cancel
  36 use FS::Conf;
  37
  38 @ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
  39
  40 $DEBUG = 0;
  41
  42 $disable_agentcheck = 0;
  43
  44 sub _cache {
  45   my $self = shift;
  46   my ( $hashref, $cache ) = @_;
  47   #if ( $hashref->{'pkgpart'} ) {
  48   if ( $hashref->{'pkg'} ) {
  49     # #@{ $self->{'_pkgnum'} } = ();
  50     # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
  51     # $self->{'_pkgpart'} = $subcache;
  52     # #push @{ $self->{'_pkgnum'} },
  53     #   FS::part_pkg->new_or_cached($hashref, $subcache);
  54     $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
  55   }
  56   if ( exists $hashref->{'svcnum'} ) {
  57     #@{ $self->{'_pkgnum'} } = ();
  58     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
  59     $self->{'_svcnum'} = $subcache;
  60     #push @{ $self->{'_pkgnum'} },
  61     FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
  62   }
  63 }
  64
  65 =head1 NAME
  66
  67 FS::cust_pkg - Object methods for cust_pkg objects
  68
  69 =head1 SYNOPSIS
  70
  71   use FS::cust_pkg;
  72
  73   $record = new FS::cust_pkg \%hash;
  74   $record = new FS::cust_pkg { 'column' => 'value' };
  75
  76   $error = $record->insert;
  77
  78   $error = $new_record->replace($old_record);
  79
  80   $error = $record->delete;
  81
  82   $error = $record->check;
  83
  84   $error = $record->cancel;
  85
  86   $error = $record->suspend;
  87
  88   $error = $record->unsuspend;
  89
  90   $part_pkg = $record->part_pkg;
  91
  92   @labels = $record->labels;
  93
  94   $seconds = $record->seconds_since($timestamp);
  95
  96   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
  97   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
  98
  99 =head1 DESCRIPTION
 100
 101 An FS::cust_pkg object represents a customer billing item.  FS::cust_pkg
 102 inherits from FS::Record.  The following fields are currently supported:
 103
 104 =over 4
 105
 106 =item pkgnum - primary key (assigned automatically for new billing items)
 107
 108 =item custnum - Customer (see L<FS::cust_main>)
 109
 110 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
 111
 112 =item setup - date
 113
 114 =item bill - date (next bill date)
 115
 116 =item last_bill - last bill date
 117
 118 =item adjourn - date
 119
 120 =item susp - date
 121
 122 =item expire - date
 123
 124 =item cancel - date
 125
 126 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
 127
 128 =item manual_flag - If this field is set to 1, disables the automatic
 129 unsuspension of this package when using the B<unsuspendauto> config file.
 130
 131 =item quantity - If not set, defaults to 1
 132
 133 =back
 134
 135 Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps;
 136 see L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for
 137 conversion functions.
 138
 139 =head1 METHODS
 140
 141 =over 4
 142
 143 =item new HASHREF
 144
 145 Create a new billing item.  To add the item to the database, see L<"insert">.
 146
 147 =cut
 148
 149 sub table { 'cust_pkg'; }
 150 sub cust_linked { $_[0]->cust_main_custnum; }
 151 sub cust_unlinked_msg {
 152   my $self = shift;
 153   "WARNING: can't find cust_main.custnum ". $self->custnum.
 154   ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
 155 }
 156
 157 =item insert [ OPTION => VALUE ... ]
 158
 159 Adds this billing item to the database ("Orders" the item).  If there is an
 160 error, returns the error, otherwise returns false.
 161
 162 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
 163 will be used to look up the package definition and agent restrictions will be
 164 ignored.
 165
 166 If the additional field I<refnum> is defined, an FS::pkg_referral record will
 167 be created and inserted.  Multiple FS::pkg_referral records can be created by
 168 setting I<refnum> to an array reference of refnums or a hash reference with
 169 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
 170 record will be created corresponding to cust_main.refnum.
 171
 172 The following options are available: I<change>
 173
 174 I<change>, if set true, supresses any referral credit to a referring customer.
 175
 176 =cut
 177
 178 sub insert {
 179   my( $self, %options ) = @_;
 180
 181   local $SIG{HUP} = 'IGNORE';
 182   local $SIG{INT} = 'IGNORE';
 183   local $SIG{QUIT} = 'IGNORE';
 184   local $SIG{TERM} = 'IGNORE';
 185   local $SIG{TSTP} = 'IGNORE';
 186   local $SIG{PIPE} = 'IGNORE';
 187
 188   my $oldAutoCommit = $FS::UID::AutoCommit;
 189   local $FS::UID::AutoCommit = 0;
 190   my $dbh = dbh;
 191
 192   my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
 193   if ( $error ) {
 194     $dbh->rollback if $oldAutoCommit;
 195     return $error;
 196   }
 197
 198   $self->refnum($self->cust_main->refnum) unless $self->refnum;
 199   $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
 200   $self->process_m2m( 'link_table'   => 'pkg_referral',
 201                       'target_table' => 'part_referral',
 202                       'params'       => $self->refnum,
 203                     );
 204
 205   #if ( $self->reg_code ) {
 206   #  my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
 207   #  $error = $reg_code->delete;
 208   #  if ( $error ) {
 209   #    $dbh->rollback if $oldAutoCommit;
 210   #    return $error;
 211   #  }
 212   #}
 213
 214   my $conf = new FS::Conf;
 215   my $cust_main = $self->cust_main;
 216   my $part_pkg = $self->part_pkg;
 217   if ( $conf->exists('referral_credit')
 218        && $cust_main->referral_custnum
 219        && ! $options{'change'}
 220        && $part_pkg->freq !~ /^0\D?$/
 221      )
 222   {
 223     my $referring_cust_main = $cust_main->referring_cust_main;
 224     if ( $referring_cust_main->status ne 'cancelled' ) {
 225       my $error;
 226       if ( $part_pkg->freq !~ /^\d+$/ ) {
 227         warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
 228              ' for package '. $self->pkgnum.
 229              ' ( customer '. $self->custnum. ')'.
 230              ' - One-time referral credits not (yet) available for '.
 231              ' packages with '. $part_pkg->freq_pretty. ' frequency';
 232       } else {
 233
 234         my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
 235         my $error =
 236           $referring_cust_main->
 237             credit( $amount,
 238                     'Referral credit for '.$cust_main->name,
 239                     'reason_type' => $conf->config('referral_credit_type')
 240                   );
 241         if ( $error ) {
 242           $dbh->rollback if $oldAutoCommit;
 243           return "Error crediting customer ". $cust_main->referral_custnum.
 244                " for referral: $error";
 245         }
 246
 247       }
 248
 249     }
 250   }
 251
 252   if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
 253     my $queue = new FS::queue {
 254       'job'     => 'FS::cust_main::queueable_print',
 255     };
 256     $error = $queue->insert(
 257       'custnum'  => $self->custnum,
 258       'template' => 'welcome_letter',
 259     );
 260
 261     if ($error) {
 262       warn "can't send welcome letter: $error";
 263     }
 264
 265   }
 266
 267   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 268   '';
 269
 270 }
 271
 272 =item delete
 273
 274 This method now works but you probably shouldn't use it.
 275
 276 You don't want to delete billing items, because there would then be no record
 277 the customer ever purchased the item.  Instead, see the cancel method.
 278
 279 =cut
 280
 281 #sub delete {
 282 #  return "Can't delete cust_pkg records!";
 283 #}
 284
 285 =item replace OLD_RECORD
 286
 287 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 288 returns the error, otherwise returns false.
 289
 290 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
 291
 292 Changing pkgpart may have disasterous effects.  See the order subroutine.
 293
 294 setup and bill are normally updated by calling the bill method of a customer
 295 object (see L<FS::cust_main>).
 296
 297 suspend is normally updated by the suspend and unsuspend methods.
 298
 299 cancel is normally updated by the cancel method (and also the order subroutine
 300 in some cases).
 301
 302 Calls
 303
 304 =cut
 305
 306 sub replace {
 307   my $new = shift;
 308
 309   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 310               ? shift
 311               : $new->replace_old;
 312
 313   my $options =
 314     ( ref($_[0]) eq 'HASH' )
 315       ? shift
 316       : { @_ };
 317
 318   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
 319   return "Can't change otaker!" if $old->otaker ne $new->otaker;
 320
 321   #allow this *sigh*
 322   #return "Can't change setup once it exists!"
 323   #  if $old->getfield('setup') &&
 324   #     $old->getfield('setup') != $new->getfield('setup');
 325
 326   #some logic for bill, susp, cancel?
 327
 328   local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
 329
 330   local $SIG{HUP} = 'IGNORE';
 331   local $SIG{INT} = 'IGNORE';
 332   local $SIG{QUIT} = 'IGNORE';
 333   local $SIG{TERM} = 'IGNORE';
 334   local $SIG{TSTP} = 'IGNORE';
 335   local $SIG{PIPE} = 'IGNORE';
 336
 337   my $oldAutoCommit = $FS::UID::AutoCommit;
 338   local $FS::UID::AutoCommit = 0;
 339   my $dbh = dbh;
 340
 341   foreach my $method ( qw(adjourn expire) ) {  # How many reasons?
 342     if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
 343       my $error = $new->insert_reason( 'reason' => $options->{'reason'},
 344                                        'date'   => $new->$method,
 345                                      );
 346       if ( $error ) {
 347         dbh->rollback if $oldAutoCommit;
 348         return "Error inserting cust_pkg_reason: $error";
 349       }
 350     }
 351   }
 352
 353   #save off and freeze RADIUS attributes for any associated svc_acct records
 354   my @svc_acct = ();
 355   if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
 356
 357                 #also check for specific exports?
 358                 # to avoid spurious modify export events
 359     @svc_acct = map  { $_->svc_x }
 360                 grep { $_->part_svc->svcdb eq 'svc_acct' }
 361                      $old->cust_svc;
 362
 363     $_->snapshot foreach @svc_acct;
 364
 365   }
 366
 367   my $error = $new->SUPER::replace($old,
 368                                    $options->{options} ? $options->{options} : ()
 369                                   );
 370   if ( $error ) {
 371     $dbh->rollback if $oldAutoCommit;
 372     return $error;
 373   }
 374
 375   #for prepaid packages,
 376   #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
 377   foreach my $old_svc_acct ( @svc_acct ) {
 378     my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
 379     my $s_error = $new_svc_acct->replace($old_svc_acct);
 380     if ( $s_error ) {
 381       $dbh->rollback if $oldAutoCommit;
 382       return $s_error;
 383     }
 384   }
 385
 386   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 387   '';
 388
 389 }
 390
 391 =item check
 392
 393 Checks all fields to make sure this is a valid billing item.  If there is an
 394 error, returns the error, otherwise returns false.  Called by the insert and
 395 replace methods.
 396
 397 =cut
 398
 399 sub check {
 400   my $self = shift;
 401
 402   my $error =
 403     $self->ut_numbern('pkgnum')
 404     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
 405     || $self->ut_numbern('pkgpart')
 406     || $self->ut_numbern('setup')
 407     || $self->ut_numbern('bill')
 408     || $self->ut_numbern('susp')
 409     || $self->ut_numbern('cancel')
 410     || $self->ut_numbern('adjourn')
 411     || $self->ut_numbern('expire')
 412   ;
 413   return $error if $error;
 414
 415   if ( $self->reg_code ) {
 416
 417     unless ( grep { $self->pkgpart == $_->pkgpart }
 418              map  { $_->reg_code_pkg }
 419              qsearchs( 'reg_code', { 'code'     => $self->reg_code,
 420                                      'agentnum' => $self->cust_main->agentnum })
 421            ) {
 422       return "Unknown registration code";
 423     }
 424
 425   } elsif ( $self->promo_code ) {
 426
 427     my $promo_part_pkg =
 428       qsearchs('part_pkg', {
 429         'pkgpart'    => $self->pkgpart,
 430         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
 431       } );
 432     return 'Unknown promotional code' unless $promo_part_pkg;
 433
 434   } else {
 435
 436     unless ( $disable_agentcheck ) {
 437       my $agent =
 438         qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
 439       my $pkgpart_href = $agent->pkgpart_hashref;
 440       return "agent ". $agent->agentnum.
 441              " can't purchase pkgpart ". $self->pkgpart
 442         unless $pkgpart_href->{ $self->pkgpart };
 443     }
 444
 445     $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
 446     return $error if $error;
 447
 448   }
 449
 450   $self->otaker(getotaker) unless $self->otaker;
 451   $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
 452   $self->otaker($1);
 453
 454   if ( $self->dbdef_table->column('manual_flag') ) {
 455     $self->manual_flag('') if $self->manual_flag eq ' ';
 456     $self->manual_flag =~ /^([01]?)$/
 457       or return "Illegal manual_flag ". $self->manual_flag;
 458     $self->manual_flag($1);
 459   }
 460
 461   $self->SUPER::check;
 462 }
 463
 464 =item cancel [ OPTION => VALUE ... ]
 465
 466 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 467 in this package, then cancels the package itself (sets the cancel field to
 468 now).
 469
 470 Available options are:
 471
 472 =over 4
 473
 474 =item quiet - can be set true to supress email cancellation notices.
 475
 476 =item time -  can be set to cancel the package based on a specific future or historical date.  Using time ensures that the remaining amount is calculated correctly.  Note however that this is an immediate cancel and just changes the date.  You are PROBABLY looking to expire the account instead of using this.
 477
 478 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
 479
 480 =back
 481
 482 If there is an error, returns the error, otherwise returns false.
 483
 484 =cut
 485
 486 sub cancel {
 487   my( $self, %options ) = @_;
 488
 489   warn "cust_pkg::cancel called with options".
 490        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 491     if $DEBUG;
 492
 493   local $SIG{HUP} = 'IGNORE';
 494   local $SIG{INT} = 'IGNORE';
 495   local $SIG{QUIT} = 'IGNORE';
 496   local $SIG{TERM} = 'IGNORE';
 497   local $SIG{TSTP} = 'IGNORE';
 498   local $SIG{PIPE} = 'IGNORE';
 499
 500   my $oldAutoCommit = $FS::UID::AutoCommit;
 501   local $FS::UID::AutoCommit = 0;
 502   my $dbh = dbh;
 503
 504   my $cancel_time = $options{'time'} || time;
 505
 506   my $error;
 507
 508   if ( $options{'reason'} ) {
 509     $error = $self->insert_reason( 'reason' => $options{'reason'} );
 510     if ( $error ) {
 511       dbh->rollback if $oldAutoCommit;
 512       return "Error inserting cust_pkg_reason: $error";
 513     }
 514   }
 515
 516   my %svc;
 517   foreach my $cust_svc (
 518     #schwartz
 519     map  { $_->[0] }
 520     sort { $a->[1] <=> $b->[1] }
 521     map  { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
 522     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 523   ) {
 524
 525     my $error = $cust_svc->cancel;
 526
 527     if ( $error ) {
 528       $dbh->rollback if $oldAutoCommit;
 529       return "Error cancelling cust_svc: $error";
 530     }
 531   }
 532
 533   unless ( $self->getfield('cancel') ) {
 534     # Add a credit for remaining service
 535     my $remaining_value = $self->calc_remain(time=>$cancel_time);
 536     if ( $remaining_value > 0 && !$options{'no_credit'} ) {
 537       my $conf = new FS::Conf;
 538       my $error = $self->cust_main->credit(
 539         $remaining_value,
 540         'Credit for unused time on '. $self->part_pkg->pkg,
 541         'reason_type' => $conf->config('cancel_credit_type'),
 542       );
 543       if ($error) {
 544         $dbh->rollback if $oldAutoCommit;
 545         return "Error crediting customer \$$remaining_value for unused time on".
 546           $self->part_pkg->pkg. ": $error";
 547       }
 548     }
 549     my %hash = $self->hash;
 550     $hash{'cancel'} = $cancel_time;
 551     my $new = new FS::cust_pkg ( \%hash );
 552     $error = $new->replace( $self, options => { $self->options } );
 553     if ( $error ) {
 554       $dbh->rollback if $oldAutoCommit;
 555       return $error;
 556     }
 557   }
 558
 559   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 560
 561   my $conf = new FS::Conf;
 562   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
 563   if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
 564     my $conf = new FS::Conf;
 565     my $error = send_email(
 566       'from'    => $conf->config('invoice_from'),
 567       'to'      => \@invoicing_list,
 568       'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
 569       'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
 570     );
 571     #should this do something on errors?
 572   }
 573
 574   ''; #no errors
 575
 576 }
 577
 578 =item cancel_if_expired [ NOW_TIMESTAMP ]
 579
 580 Cancels this package if its expire date has been reached.
 581
 582 =cut
 583
 584 sub cancel_if_expired {
 585   my $self = shift;
 586   my $time = shift || time;
 587   return '' unless $self->expire && $self->expire <= $time;
 588   my $error = $self->cancel;
 589   if ( $error ) {
 590     return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
 591            $self->custnum. ": $error";
 592   }
 593   '';
 594 }
 595
 596 =item suspend  [ OPTION => VALUE ... ]
 597
 598 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 599 package, then suspends the package itself (sets the susp field to now).
 600
 601 Available options are:
 602
 603 =over 4
 604
 605 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
 606
 607 =back
 608
 609 If there is an error, returns the error, otherwise returns false.
 610
 611 =cut
 612
 613 sub suspend {
 614   my( $self, %options ) = @_;
 615
 616   local $SIG{HUP} = 'IGNORE';
 617   local $SIG{INT} = 'IGNORE';
 618   local $SIG{QUIT} = 'IGNORE';
 619   local $SIG{TERM} = 'IGNORE';
 620   local $SIG{TSTP} = 'IGNORE';
 621   local $SIG{PIPE} = 'IGNORE';
 622
 623   my $oldAutoCommit = $FS::UID::AutoCommit;
 624   local $FS::UID::AutoCommit = 0;
 625   my $dbh = dbh;
 626
 627   my $error;
 628
 629   if ( $options{'reason'} ) {
 630     $error = $self->insert_reason( 'reason' => $options{'reason'} );
 631     if ( $error ) {
 632       dbh->rollback if $oldAutoCommit;
 633       return "Error inserting cust_pkg_reason: $error";
 634     }
 635   }
 636
 637   foreach my $cust_svc (
 638     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 639   ) {
 640     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 641
 642     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 643       $dbh->rollback if $oldAutoCommit;
 644       return "Illegal svcdb value in part_svc!";
 645     };
 646     my $svcdb = $1;
 647     require "FS/$svcdb.pm";
 648
 649     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 650     if ($svc) {
 651       $error = $svc->suspend;
 652       if ( $error ) {
 653         $dbh->rollback if $oldAutoCommit;
 654         return $error;
 655       }
 656     }
 657
 658   }
 659
 660   unless ( $self->getfield('susp') ) {
 661     my %hash = $self->hash;
 662     $hash{'susp'} = time;
 663     my $new = new FS::cust_pkg ( \%hash );
 664     $error = $new->replace( $self, options => { $self->options } );
 665     if ( $error ) {
 666       $dbh->rollback if $oldAutoCommit;
 667       return $error;
 668     }
 669   }
 670
 671   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 672
 673   ''; #no errors
 674 }
 675
 676 =item unsuspend [ OPTION => VALUE ... ]
 677
 678 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 679 package, then unsuspends the package itself (clears the susp field and the
 680 adjourn field if it is in the past).
 681
 682 Available options are: I<adjust_next_bill>.
 683
 684 I<adjust_next_bill> can be set true to adjust the next bill date forward by
 685 the amount of time the account was inactive.  This was set true by default
 686 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
 687 explicitly requested.  Price plans for which this makes sense (anniversary-date
 688 based than prorate or subscription) could have an option to enable this
 689 behaviour?
 690
 691 If there is an error, returns the error, otherwise returns false.
 692
 693 =cut
 694
 695 sub unsuspend {
 696   my( $self, %opt ) = @_;
 697   my $error;
 698
 699   local $SIG{HUP} = 'IGNORE';
 700   local $SIG{INT} = 'IGNORE';
 701   local $SIG{QUIT} = 'IGNORE';
 702   local $SIG{TERM} = 'IGNORE';
 703   local $SIG{TSTP} = 'IGNORE';
 704   local $SIG{PIPE} = 'IGNORE';
 705
 706   my $oldAutoCommit = $FS::UID::AutoCommit;
 707   local $FS::UID::AutoCommit = 0;
 708   my $dbh = dbh;
 709
 710   foreach my $cust_svc (
 711     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
 712   ) {
 713     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 714
 715     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 716       $dbh->rollback if $oldAutoCommit;
 717       return "Illegal svcdb value in part_svc!";
 718     };
 719     my $svcdb = $1;
 720     require "FS/$svcdb.pm";
 721
 722     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 723     if ($svc) {
 724       $error = $svc->unsuspend;
 725       if ( $error ) {
 726         $dbh->rollback if $oldAutoCommit;
 727         return $error;
 728       }
 729     }
 730
 731   }
 732
 733   unless ( ! $self->getfield('susp') ) {
 734     my %hash = $self->hash;
 735     my $inactive = time - $hash{'susp'};
 736
 737     my $conf = new FS::Conf;
 738
 739     $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
 740       if ( $opt{'adjust_next_bill'}
 741            || $conf->config('unsuspend-always_adjust_next_bill_date') )
 742       && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
 743
 744     $hash{'susp'} = '';
 745     $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
 746     my $new = new FS::cust_pkg ( \%hash );
 747     $error = $new->replace( $self, options => { $self->options } );
 748     if ( $error ) {
 749       $dbh->rollback if $oldAutoCommit;
 750       return $error;
 751     }
 752   }
 753
 754   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 755
 756   ''; #no errors
 757 }
 758
 759 =item last_bill
 760
 761 Returns the last bill date, or if there is no last bill date, the setup date.
 762 Useful for billing metered services.
 763
 764 =cut
 765
 766 sub last_bill {
 767   my $self = shift;
 768   return $self->setfield('last_bill', $_[0]) if @_;
 769   return $self->getfield('last_bill') if $self->getfield('last_bill');
 770   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
 771                                                   'edate'  => $self->bill,  } );
 772   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
 773 }
 774
 775 =item last_cust_pkg_reason
 776
 777 Returns the most recent FS::reason associated with the package.
 778
 779 =cut
 780
 781 sub last_cust_pkg_reason {
 782   my $self = shift;
 783   qsearchs( {
 784               'table' => 'cust_pkg_reason',
 785               'hashref' => { 'pkgnum' => $self->pkgnum, },
 786               'extra_sql'=> "AND date <= ". time,
 787               'order_by' => 'ORDER BY date DESC LIMIT 1',
 788            } );
 789 }
 790
 791 =item last_reason
 792
 793 Returns the most recent FS::reason associated with the package.
 794
 795 =cut
 796
 797 sub last_reason {
 798   my $cust_pkg_reason = shift->last_cust_pkg_reason;
 799   $cust_pkg_reason->reason
 800     if $cust_pkg_reason;
 801 }
 802
 803 =item part_pkg
 804
 805 Returns the definition for this billing item, as an FS::part_pkg object (see
 806 L<FS::part_pkg>).
 807
 808 =cut
 809
 810 sub part_pkg {
 811   my $self = shift;
 812   #exists( $self->{'_pkgpart'} )
 813   $self->{'_pkgpart'}
 814     ? $self->{'_pkgpart'}
 815     : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 816 }
 817
 818 =item old_cust_pkg
 819
 820 Returns the cancelled package this package was changed from, if any.
 821
 822 =cut
 823
 824 sub old_cust_pkg {
 825   my $self = shift;
 826   return '' unless $self->change_pkgnum;
 827   qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
 828 }
 829
 830 =item calc_setup
 831
 832 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
 833 item.
 834
 835 =cut
 836
 837 sub calc_setup {
 838   my $self = shift;
 839   $self->part_pkg->calc_setup($self, @_);
 840 }
 841
 842 =item calc_recur
 843
 844 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
 845 item.
 846
 847 =cut
 848
 849 sub calc_recur {
 850   my $self = shift;
 851   $self->part_pkg->calc_recur($self, @_);
 852 }
 853
 854 =item calc_remain
 855
 856 Calls the I<calc_remain> of the FS::part_pkg object associated with this
 857 billing item.
 858
 859 =cut
 860
 861 sub calc_remain {
 862   my $self = shift;
 863   $self->part_pkg->calc_remain($self, @_);
 864 }
 865
 866 =item calc_cancel
 867
 868 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
 869 billing item.
 870
 871 =cut
 872
 873 sub calc_cancel {
 874   my $self = shift;
 875   $self->part_pkg->calc_cancel($self, @_);
 876 }
 877
 878 =item cust_bill_pkg
 879
 880 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
 881
 882 =cut
 883
 884 sub cust_bill_pkg {
 885   my $self = shift;
 886   qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
 887 }
 888
 889 =item cust_event
 890
 891 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
 892
 893 =cut
 894
 895 #false laziness w/cust_bill.pm
 896 sub cust_event {
 897   my $self = shift;
 898   qsearch({
 899     'table'     => 'cust_event',
 900     'addl_from' => 'JOIN part_event USING ( eventpart )',
 901     'hashref'   => { 'tablenum' => $self->pkgnum },
 902     'extra_sql' => " AND eventtable = 'cust_pkg' ",
 903   });
 904 }
 905
 906 =item num_cust_event
 907
 908 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
 909
 910 =cut
 911
 912 #false laziness w/cust_bill.pm
 913 sub num_cust_event {
 914   my $self = shift;
 915   my $sql =
 916     "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
 917     "  WHERE tablenum = ? AND eventtable = 'cust_pkg'";
 918   my $sth = dbh->prepare($sql) or die  dbh->errstr. " preparing $sql";
 919   $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
 920   $sth->fetchrow_arrayref->[0];
 921 }
 922
 923 =item cust_svc [ SVCPART ]
 924
 925 Returns the services for this package, as FS::cust_svc objects (see
 926 L<FS::cust_svc>).  If a svcpart is specified, return only the matching
 927 services.
 928
 929 =cut
 930
 931 sub cust_svc {
 932   my $self = shift;
 933
 934   if ( @_ ) {
 935     return qsearch( 'cust_svc', { 'pkgnum'  => $self->pkgnum,
 936                                   'svcpart' => shift,          } );
 937   }
 938
 939   #if ( $self->{'_svcnum'} ) {
 940   #  values %{ $self->{'_svcnum'}->cache };
 941   #} else {
 942     $self->_sort_cust_svc(
 943       [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
 944     );
 945   #}
 946
 947 }
 948
 949 =item overlimit [ SVCPART ]
 950
 951 Returns the services for this package which have exceeded their
 952 usage limit as FS::cust_svc objects (see L<FS::cust_svc>).  If a svcpart
 953 is specified, return only the matching services.
 954
 955 =cut
 956
 957 sub overlimit {
 958   my $self = shift;
 959   grep { $_->overlimit } $self->cust_svc;
 960 }
 961
 962 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
 963
 964 Returns historical services for this package created before END TIMESTAMP and
 965 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
 966 (see L<FS::h_cust_svc>).
 967
 968 =cut
 969
 970 sub h_cust_svc {
 971   my $self = shift;
 972
 973   $self->_sort_cust_svc(
 974     [ qsearch( 'h_cust_svc',
 975                { 'pkgnum' => $self->pkgnum, },
 976                FS::h_cust_svc->sql_h_search(@_),
 977              )
 978     ]
 979   );
 980 }
 981
 982 sub _sort_cust_svc {
 983   my( $self, $arrayref ) = @_;
 984
 985   map  { $_->[0] }
 986   sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
 987   map {
 988         my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
 989                                              'svcpart' => $_->svcpart     } );
 990         [ $_,
 991           $pkg_svc ? $pkg_svc->primary_svc : '',
 992           $pkg_svc ? $pkg_svc->quantity : 0,
 993         ];
 994       }
 995   @$arrayref;
 996
 997 }
 998
 999 =item num_cust_svc [ SVCPART ]
1000
1001 Returns the number of provisioned services for this package.  If a svcpart is
1002 specified, counts only the matching services.
1003
1004 =cut
1005
1006 sub num_cust_svc {
1007   my $self = shift;
1008   my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1009   $sql .= ' AND svcpart = ?' if @_;
1010   my $sth = dbh->prepare($sql) or die dbh->errstr;
1011   $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1012   $sth->fetchrow_arrayref->[0];
1013 }
1014
1015 =item available_part_svc
1016
1017 Returns a list of FS::part_svc objects representing services included in this
1018 package but not yet provisioned.  Each FS::part_svc object also has an extra
1019 field, I<num_avail>, which specifies the number of available services.
1020
1021 =cut
1022
1023 sub available_part_svc {
1024   my $self = shift;
1025   grep { $_->num_avail > 0 }
1026     map {
1027           my $part_svc = $_->part_svc;
1028           $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1029             $_->quantity - $self->num_cust_svc($_->svcpart);
1030           $part_svc;
1031         }
1032       $self->part_pkg->pkg_svc;
1033 }
1034
1035 =item part_svc
1036
1037 Returns a list of FS::part_svc objects representing provisioned and available
1038 services included in this package.  Each FS::part_svc object also has the
1039 following extra fields:
1040
1041 =over 4
1042
1043 =item num_cust_svc  (count)
1044
1045 =item num_avail     (quantity - count)
1046
1047 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1048
1049 svcnum
1050 label -> ($cust_svc->label)[1]
1051
1052 =back
1053
1054 =cut
1055
1056 sub part_svc {
1057   my $self = shift;
1058
1059   #XXX some sort of sort order besides numeric by svcpart...
1060   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1061     my $pkg_svc = $_;
1062     my $part_svc = $pkg_svc->part_svc;
1063     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1064     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1065     $part_svc->{'Hash'}{'num_avail'}    =
1066       max( 0, $pkg_svc->quantity - $num_cust_svc );
1067     $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1068     $part_svc;
1069   } $self->part_pkg->pkg_svc;
1070
1071   #extras
1072   push @part_svc, map {
1073     my $part_svc = $_;
1074     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1075     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1076     $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
1077     $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1078     $part_svc;
1079   } $self->extra_part_svc;
1080
1081   @part_svc;
1082
1083 }
1084
1085 =item extra_part_svc
1086
1087 Returns a list of FS::part_svc objects corresponding to services in this
1088 package which are still provisioned but not (any longer) available in the
1089 package definition.
1090
1091 =cut
1092
1093 sub extra_part_svc {
1094   my $self = shift;
1095
1096   my $pkgnum  = $self->pkgnum;
1097   my $pkgpart = $self->pkgpart;
1098
1099   qsearch( {
1100     'table'     => 'part_svc',
1101     'hashref'   => {},
1102     'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1103                                   WHERE pkg_svc.svcpart = part_svc.svcpart
1104                                     AND pkg_svc.pkgpart = $pkgpart
1105                                     AND quantity > 0
1106                               )
1107                       AND 0 < ( SELECT count(*)
1108                                   FROM cust_svc
1109                                     LEFT JOIN cust_pkg using ( pkgnum )
1110                                   WHERE cust_svc.svcpart = part_svc.svcpart
1111                                     AND pkgnum = $pkgnum
1112                               )",
1113   } );
1114 }
1115
1116 =item status
1117
1118 Returns a short status string for this package, currently:
1119
1120 =over 4
1121
1122 =item not yet billed
1123
1124 =item one-time charge
1125
1126 =item active
1127
1128 =item suspended
1129
1130 =item cancelled
1131
1132 =back
1133
1134 =cut
1135
1136 sub status {
1137   my $self = shift;
1138
1139   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1140
1141   return 'cancelled' if $self->get('cancel');
1142   return 'suspended' if $self->susp;
1143   return 'not yet billed' unless $self->setup;
1144   return 'one-time charge' if $freq =~ /^(0|$)/;
1145   return 'active';
1146 }
1147
1148 =item statuses
1149
1150 Class method that returns the list of possible status strings for packages
1151 (see L<the status method|/status>).  For example:
1152
1153   @statuses = FS::cust_pkg->statuses();
1154
1155 =cut
1156
1157 tie my %statuscolor, 'Tie::IxHash',
1158   'not yet billed'  => '000000',
1159   'one-time charge' => '000000',
1160   'active'          => '00CC00',
1161   'suspended'       => 'FF9900',
1162   'cancelled'       => 'FF0000',
1163 ;
1164
1165 sub statuses {
1166   my $self = shift; #could be class...
1167   grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1168                                       # mayble split btw one-time vs. recur
1169     keys %statuscolor;
1170 }
1171
1172 =item statuscolor
1173
1174 Returns a hex triplet color string for this package's status.
1175
1176 =cut
1177
1178 sub statuscolor {
1179   my $self = shift;
1180   $statuscolor{$self->status};
1181 }
1182
1183 =item labels
1184
1185 Returns a list of lists, calling the label method for all services
1186 (see L<FS::cust_svc>) of this billing item.
1187
1188 =cut
1189
1190 sub labels {
1191   my $self = shift;
1192   map { [ $_->label ] } $self->cust_svc;
1193 }
1194
1195 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1196
1197 Like the labels method, but returns historical information on services that
1198 were active as of END_TIMESTAMP and (optionally) not cancelled before
1199 START_TIMESTAMP.
1200
1201 Returns a list of lists, calling the label method for all (historical) services
1202 (see L<FS::h_cust_svc>) of this billing item.
1203
1204 =cut
1205
1206 sub h_labels {
1207   my $self = shift;
1208   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1209 }
1210
1211 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1212
1213 Like h_labels, except returns a simple flat list, and shortens long
1214 (currently >5) lists of identical services to one line that lists the service
1215 label and the number of individual services rather than individual items.
1216
1217 =cut
1218
1219 sub h_labels_short {
1220   my $self = shift;
1221
1222   my %labels;
1223   #tie %labels, 'Tie::IxHash';
1224   push @{ $labels{$_->[0]} }, $_->[1]
1225     foreach $self->h_labels(@_);
1226   my @labels;
1227   foreach my $label ( keys %labels ) {
1228     my @values = @{ $labels{$label} };
1229     my $num = scalar(@values);
1230     if ( $num > 5 ) {
1231       push @labels, "$label ($num)";
1232     } else {
1233       push @labels, map { "$label: $_" } @values;
1234     }
1235   }
1236
1237  @labels;
1238
1239 }
1240
1241 =item cust_main
1242
1243 Returns the parent customer object (see L<FS::cust_main>).
1244
1245 =cut
1246
1247 sub cust_main {
1248   my $self = shift;
1249   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1250 }
1251
1252 =item seconds_since TIMESTAMP
1253
1254 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1255 package have been online since TIMESTAMP, according to the session monitor.
1256
1257 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
1258 L<Time::Local> and L<Date::Parse> for conversion functions.
1259
1260 =cut
1261
1262 sub seconds_since {
1263   my($self, $since) = @_;
1264   my $seconds = 0;
1265
1266   foreach my $cust_svc (
1267     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1268   ) {
1269     $seconds += $cust_svc->seconds_since($since);
1270   }
1271
1272   $seconds;
1273
1274 }
1275
1276 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1277
1278 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1279 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1280 (exclusive).
1281
1282 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1283 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
1284 functions.
1285
1286
1287 =cut
1288
1289 sub seconds_since_sqlradacct {
1290   my($self, $start, $end) = @_;
1291
1292   my $seconds = 0;
1293
1294   foreach my $cust_svc (
1295     grep {
1296       my $part_svc = $_->part_svc;
1297       $part_svc->svcdb eq 'svc_acct'
1298         && scalar($part_svc->part_export('sqlradius'));
1299     } $self->cust_svc
1300   ) {
1301     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1302   }
1303
1304   $seconds;
1305
1306 }
1307
1308 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1309
1310 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1311 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1312 TIMESTAMP_END
1313 (exclusive).
1314
1315 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1316 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
1317 functions.
1318
1319 =cut
1320
1321 sub attribute_since_sqlradacct {
1322   my($self, $start, $end, $attrib) = @_;
1323
1324   my $sum = 0;
1325
1326   foreach my $cust_svc (
1327     grep {
1328       my $part_svc = $_->part_svc;
1329       $part_svc->svcdb eq 'svc_acct'
1330         && scalar($part_svc->part_export('sqlradius'));
1331     } $self->cust_svc
1332   ) {
1333     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1334   }
1335
1336   $sum;
1337
1338 }
1339
1340 =item quantity
1341
1342 =cut
1343
1344 sub quantity {
1345   my( $self, $value ) = @_;
1346   if ( defined($value) ) {
1347     $self->setfield('quantity', $value);
1348   }
1349   $self->getfield('quantity') || 1;
1350 }
1351
1352 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1353
1354 Transfers as many services as possible from this package to another package.
1355
1356 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1357 object.  The destination package must already exist.
1358
1359 Services are moved only if the destination allows services with the correct
1360 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
1361 this option with caution!  No provision is made for export differences
1362 between the old and new service definitions.  Probably only should be used
1363 when your exports for all service definitions of a given svcdb are identical.
1364 (attempt a transfer without it first, to move all possible svcpart-matching
1365 services)
1366
1367 Any services that can't be moved remain in the original package.
1368
1369 Returns an error, if there is one; otherwise, returns the number of services
1370 that couldn't be moved.
1371
1372 =cut
1373
1374 sub transfer {
1375   my ($self, $dest_pkgnum, %opt) = @_;
1376
1377   my $remaining = 0;
1378   my $dest;
1379   my %target;
1380
1381   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1382     $dest = $dest_pkgnum;
1383     $dest_pkgnum = $dest->pkgnum;
1384   } else {
1385     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1386   }
1387
1388   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1389
1390   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1391     $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1392   }
1393
1394   foreach my $cust_svc ($dest->cust_svc) {
1395     $target{$cust_svc->svcpart}--;
1396   }
1397
1398   my %svcpart2svcparts = ();
1399   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1400     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1401     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1402       next if exists $svcpart2svcparts{$svcpart};
1403       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1404       $svcpart2svcparts{$svcpart} = [
1405         map  { $_->[0] }
1406         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
1407         map {
1408               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1409                                                    'svcpart' => $_          } );
1410               [ $_,
1411                 $pkg_svc ? $pkg_svc->primary_svc : '',
1412                 $pkg_svc ? $pkg_svc->quantity : 0,
1413               ];
1414             }
1415
1416         grep { $_ != $svcpart }
1417         map  { $_->svcpart }
1418         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1419       ];
1420       warn "alternates for svcpart $svcpart: ".
1421            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1422         if $DEBUG;
1423     }
1424   }
1425
1426   foreach my $cust_svc ($self->cust_svc) {
1427     if($target{$cust_svc->svcpart} > 0) {
1428       $target{$cust_svc->svcpart}--;
1429       my $new = new FS::cust_svc { $cust_svc->hash };
1430       $new->pkgnum($dest_pkgnum);
1431       my $error = $new->replace($cust_svc);
1432       return $error if $error;
1433     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1434       if ( $DEBUG ) {
1435         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1436         warn "alternates to consider: ".
1437              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1438       }
1439       my @alternate = grep {
1440                              warn "considering alternate svcpart $_: ".
1441                                   "$target{$_} available in new package\n"
1442                                if $DEBUG;
1443                              $target{$_} > 0;
1444                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
1445       if ( @alternate ) {
1446         warn "alternate(s) found\n" if $DEBUG;
1447         my $change_svcpart = $alternate[0];
1448         $target{$change_svcpart}--;
1449         my $new = new FS::cust_svc { $cust_svc->hash };
1450         $new->svcpart($change_svcpart);
1451         $new->pkgnum($dest_pkgnum);
1452         my $error = $new->replace($cust_svc);
1453         return $error if $error;
1454       } else {
1455         $remaining++;
1456       }
1457     } else {
1458       $remaining++
1459     }
1460   }
1461   return $remaining;
1462 }
1463
1464 =item reexport
1465
1466 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1467 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
1468
1469 =cut
1470
1471 sub reexport {
1472   my $self = shift;
1473
1474   local $SIG{HUP} = 'IGNORE';
1475   local $SIG{INT} = 'IGNORE';
1476   local $SIG{QUIT} = 'IGNORE';
1477   local $SIG{TERM} = 'IGNORE';
1478   local $SIG{TSTP} = 'IGNORE';
1479   local $SIG{PIPE} = 'IGNORE';
1480
1481   my $oldAutoCommit = $FS::UID::AutoCommit;
1482   local $FS::UID::AutoCommit = 0;
1483   my $dbh = dbh;
1484
1485   foreach my $cust_svc ( $self->cust_svc ) {
1486     #false laziness w/svc_Common::insert
1487     my $svc_x = $cust_svc->svc_x;
1488     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
1489       my $error = $part_export->export_insert($svc_x);
1490       if ( $error ) {
1491         $dbh->rollback if $oldAutoCommit;
1492         return $error;
1493       }
1494     }
1495   }
1496
1497   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1498   '';
1499
1500 }
1501
1502 =back
1503
1504 =head1 CLASS METHODS
1505
1506 =over 4
1507
1508 =item recurring_sql
1509
1510 Returns an SQL expression identifying recurring packages.
1511
1512 =cut
1513
1514 sub recurring_sql { "
1515   '0' != ( select freq from part_pkg
1516              where cust_pkg.pkgpart = part_pkg.pkgpart )
1517 "; }
1518
1519 =item onetime_sql
1520
1521 Returns an SQL expression identifying one-time packages.
1522
1523 =cut
1524
1525 sub onetime_sql { "
1526   '0' = ( select freq from part_pkg
1527             where cust_pkg.pkgpart = part_pkg.pkgpart )
1528 "; }
1529
1530 =item active_sql
1531
1532 Returns an SQL expression identifying active packages.
1533
1534 =cut
1535
1536 sub active_sql { "
1537   ". $_[0]->recurring_sql(). "
1538   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1539   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
1540 "; }
1541
1542 =item inactive_sql
1543
1544 Returns an SQL expression identifying inactive packages (one-time packages
1545 that are otherwise unsuspended/uncancelled).
1546
1547 =cut
1548
1549 sub inactive_sql { "
1550   ". $_[0]->onetime_sql(). "
1551   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1552   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
1553 "; }
1554
1555 =item susp_sql
1556 =item suspended_sql
1557
1558 Returns an SQL expression identifying suspended packages.
1559
1560 =cut
1561
1562 sub suspended_sql { susp_sql(@_); }
1563 sub susp_sql {
1564   #$_[0]->recurring_sql(). ' AND '.
1565   "
1566         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
1567     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
1568   ";
1569 }
1570
1571 =item cancel_sql
1572 =item cancelled_sql
1573
1574 Returns an SQL exprression identifying cancelled packages.
1575
1576 =cut
1577
1578 sub cancelled_sql { cancel_sql(@_); }
1579 sub cancel_sql {
1580   #$_[0]->recurring_sql(). ' AND '.
1581   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
1582 }
1583
1584 =item search_sql HREF
1585
1586 Returns a qsearch hash expression to search for parameters specified in HREF.
1587 Valid parameters are
1588
1589 =over 4
1590 =item agentnum
1591 =item magic - /^(active|inactive|suspended|cancell?ed)$/
1592 =item status - /^(active|inactive|suspended|one-time charge|inactive|cancell?ed)$/
1593 =item classnum
1594 =item pkgpart - list specified how?
1595 =item setup     - arrayref of beginning and ending epoch date
1596 =item last_bill - arrayref of beginning and ending epoch date
1597 =item bill      - arrayref of beginning and ending epoch date
1598 =item adjourn   - arrayref of beginning and ending epoch date
1599 =item susp      - arrayref of beginning and ending epoch date
1600 =item expire    - arrayref of beginning and ending epoch date
1601 =item cancel    - arrayref of beginning and ending epoch date
1602 =item query - /^(pkgnum/APKG_pkgnum)$/
1603 =item cust_fields - a value suited to passing to FS::UI::Web::cust_header
1604 =item CurrentUser - specifies the user for agent virtualization
1605 =back
1606
1607 =cut
1608
1609 sub search_sql {
1610   my ($class, $params) = @_;
1611   my @where = ();
1612
1613   ##
1614   # parse agent
1615   ##
1616
1617   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
1618     push @where,
1619       "cust_main.agentnum = $1";
1620   }
1621
1622   ##
1623   # parse status
1624   ##
1625
1626   if (    $params->{'magic'}  eq 'active'
1627        || $params->{'status'} eq 'active' ) {
1628
1629     push @where, FS::cust_pkg->active_sql();
1630
1631   } elsif (    $params->{'magic'}  eq 'inactive'
1632             || $params->{'status'} eq 'inactive' ) {
1633
1634     push @where, FS::cust_pkg->inactive_sql();
1635
1636   } elsif (    $params->{'magic'}  eq 'suspended'
1637             || $params->{'status'} eq 'suspended'  ) {
1638
1639     push @where, FS::cust_pkg->suspended_sql();
1640
1641   } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
1642             || $params->{'status'} =~ /^cancell?ed$/ ) {
1643
1644     push @where, FS::cust_pkg->cancelled_sql();
1645
1646   } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
1647
1648     push @where, FS::cust_pkg->inactive_sql();
1649
1650   }
1651
1652   ###
1653   # parse package class
1654   ###
1655
1656   #false lazinessish w/graph/cust_bill_pkg.cgi
1657   my $classnum = 0;
1658   my @pkg_class = ();
1659   if ( exists($params->{'classnum'})
1660        && $params->{'classnum'} =~ /^(\d*)$/
1661      )
1662   {
1663     $classnum = $1;
1664     if ( $classnum ) { #a specific class
1665       push @where, "classnum = $classnum";
1666
1667       #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
1668       #die "classnum $classnum not found!" unless $pkg_class[0];
1669       #$title .= $pkg_class[0]->classname.' ';
1670
1671     } elsif ( $classnum eq '' ) { #the empty class
1672
1673       push @where, "classnum IS NULL";
1674       #$title .= 'Empty class ';
1675       #@pkg_class = ( '(empty class)' );
1676     } elsif ( $classnum eq '0' ) {
1677       #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
1678       #push @pkg_class, '(empty class)';
1679     } else {
1680       die "illegal classnum";
1681     }
1682   }
1683   #eslaf
1684
1685   ###
1686   # parse part_pkg
1687   ###
1688
1689   my $pkgpart = join (' OR pkgpart=',
1690                       grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
1691   push @where,  '(pkgpart=' . $pkgpart . ')' if $pkgpart;
1692
1693   ###
1694   # parse dates
1695   ###
1696
1697   my $orderby = '';
1698
1699   #false laziness w/report_cust_pkg.html
1700   my %disable = (
1701     'all'             => {},
1702     'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
1703     'active'          => { 'susp'=>1, 'cancel'=>1 },
1704     'suspended'       => { 'cancel' => 1 },
1705     'cancelled'       => {},
1706     ''                => {},
1707   );
1708
1709   foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
1710
1711     next unless exists($params->{$field});
1712
1713     my($beginning, $ending) = @{$params->{$field}};
1714
1715     next if $beginning == 0 && $ending == 4294967295;
1716
1717     push @where,
1718       "cust_pkg.$field IS NOT NULL",
1719       "cust_pkg.$field >= $beginning",
1720       "cust_pkg.$field <= $ending";
1721
1722     $orderby ||= "ORDER BY cust_pkg.$field";
1723
1724   }
1725
1726   $orderby ||= 'ORDER BY bill';
1727
1728   ###
1729   # parse magic, legacy, etc.
1730   ###
1731
1732   if ( $params->{'magic'} &&
1733        $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
1734   ) {
1735
1736     $orderby = 'ORDER BY pkgnum';
1737
1738     if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
1739       push @where, "pkgpart = $1";
1740     }
1741
1742   } elsif ( $params->{'query'} eq 'pkgnum' ) {
1743
1744     $orderby = 'ORDER BY pkgnum';
1745
1746   } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
1747
1748     $orderby = 'ORDER BY pkgnum';
1749
1750     push @where, '0 < (
1751       SELECT count(*) FROM pkg_svc
1752        WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
1753          AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
1754                                    WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
1755                                      AND cust_svc.svcpart = pkg_svc.svcpart
1756                                 )
1757     )';
1758
1759   }
1760
1761   ##
1762   # setup queries, links, subs, etc. for the search
1763   ##
1764
1765   # here is the agent virtualization
1766   if ($params->{CurrentUser}) {
1767     my $access_user =
1768       qsearchs('access_user', { username => $params->{CurrentUser} });
1769
1770     if ($access_user) {
1771       push @where, $access_user->agentnums_sql('table'=>'cust_main');
1772     }else{
1773       push @where, "1=0";
1774     }
1775   }else{
1776     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
1777   }
1778
1779   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1780
1781   my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
1782                   'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
1783                   'LEFT JOIN pkg_class USING ( classnum ) ';
1784
1785   my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
1786
1787   my $sql_query = {
1788     'table'       => 'cust_pkg',
1789     'hashref'     => {},
1790     'select'      => join(', ',
1791                                 'cust_pkg.*',
1792                                 ( map "part_pkg.$_", qw( pkg freq ) ),
1793                                 'pkg_class.classname',
1794                                 'cust_main.custnum as cust_main_custnum',
1795                                 FS::UI::Web::cust_sql_fields(
1796                                   $params->{'cust_fields'}
1797                                 ),
1798                      ),
1799     'extra_sql'   => "$extra_sql $orderby",
1800     'addl_from'   => $addl_from,
1801     'count_query' => $count_query,
1802   };
1803
1804 }
1805
1806 =head1 SUBROUTINES
1807
1808 =over 4
1809
1810 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
1811
1812 CUSTNUM is a customer (see L<FS::cust_main>)
1813
1814 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
1815 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
1816 permitted.
1817
1818 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
1819 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
1820 new billing items.  An error is returned if this is not possible (see
1821 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
1822 parameter.
1823
1824 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
1825 newly-created cust_pkg objects.
1826
1827 REFNUM, if specified, will specify the FS::pkg_referral record to be created
1828 and inserted.  Multiple FS::pkg_referral records can be created by
1829 setting I<refnum> to an array reference of refnums or a hash reference with
1830 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
1831 record will be created corresponding to cust_main.refnum.
1832
1833 =cut
1834
1835 sub order {
1836   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1837
1838   my $conf = new FS::Conf;
1839
1840   # Transactionize this whole mess
1841   local $SIG{HUP} = 'IGNORE';
1842   local $SIG{INT} = 'IGNORE';
1843   local $SIG{QUIT} = 'IGNORE';
1844   local $SIG{TERM} = 'IGNORE';
1845   local $SIG{TSTP} = 'IGNORE';
1846   local $SIG{PIPE} = 'IGNORE';
1847
1848   my $oldAutoCommit = $FS::UID::AutoCommit;
1849   local $FS::UID::AutoCommit = 0;
1850   my $dbh = dbh;
1851
1852   my $error;
1853   my $cust_main = qsearchs('cust_main', { custnum => $custnum });
1854   return "Customer not found: $custnum" unless $cust_main;
1855
1856   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
1857                          @$remove_pkgnum;
1858
1859   my $change = scalar(@old_cust_pkg) != 0;
1860
1861   my %hash = ();
1862   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
1863
1864     my $time = time;
1865
1866     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
1867
1868     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
1869     $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
1870
1871     $hash{'change_date'} = $time;
1872     $hash{"change_$_"}  = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
1873   }
1874
1875   # Create the new packages.
1876   foreach my $pkgpart (@$pkgparts) {
1877     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
1878                                       pkgpart => $pkgpart,
1879                                       refnum  => $refnum,
1880                                       %hash,
1881                                     };
1882     $error = $cust_pkg->insert( 'change' => $change );
1883     if ($error) {
1884       $dbh->rollback if $oldAutoCommit;
1885       return $error;
1886     }
1887     push @$return_cust_pkg, $cust_pkg;
1888   }
1889   # $return_cust_pkg now contains refs to all of the newly
1890   # created packages.
1891
1892   # Transfer services and cancel old packages.
1893   foreach my $old_pkg (@old_cust_pkg) {
1894
1895     foreach my $new_pkg (@$return_cust_pkg) {
1896       $error = $old_pkg->transfer($new_pkg);
1897       if ($error and $error == 0) {
1898         # $old_pkg->transfer failed.
1899         $dbh->rollback if $oldAutoCommit;
1900         return $error;
1901       }
1902     }
1903
1904     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1905       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1906       foreach my $new_pkg (@$return_cust_pkg) {
1907         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
1908         if ($error and $error == 0) {
1909           # $old_pkg->transfer failed.
1910         $dbh->rollback if $oldAutoCommit;
1911         return $error;
1912         }
1913       }
1914     }
1915
1916     if ($error > 0) {
1917       # Transfers were successful, but we went through all of the
1918       # new packages and still had services left on the old package.
1919       # We can't cancel the package under the circumstances, so abort.
1920       $dbh->rollback if $oldAutoCommit;
1921       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
1922     }
1923     $error = $old_pkg->cancel( quiet=>1 );
1924     if ($error) {
1925       $dbh->rollback;
1926       return $error;
1927     }
1928   }
1929   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1930   '';
1931 }
1932
1933 =item insert_reason
1934
1935 Associates this package with a (suspension or cancellation) reason (see
1936 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
1937 L<FS::reason>).
1938
1939 Available options are:
1940
1941 =over 4
1942
1943 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
1944
1945 =item date
1946
1947 =back
1948
1949 If there is an error, returns the error, otherwise returns false.
1950
1951 =cut
1952
1953 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
1954
1955 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
1956 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
1957 permitted.
1958
1959 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
1960 replace.  The services (see L<FS::cust_svc>) are moved to the
1961 new billing items.  An error is returned if this is not possible (see
1962 L<FS::pkg_svc>).
1963
1964 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
1965 newly-created cust_pkg objects.
1966
1967 =cut
1968
1969 sub bulk_change {
1970   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
1971
1972   # Transactionize this whole mess
1973   local $SIG{HUP} = 'IGNORE';
1974   local $SIG{INT} = 'IGNORE';
1975   local $SIG{QUIT} = 'IGNORE';
1976   local $SIG{TERM} = 'IGNORE';
1977   local $SIG{TSTP} = 'IGNORE';
1978   local $SIG{PIPE} = 'IGNORE';
1979
1980   my $oldAutoCommit = $FS::UID::AutoCommit;
1981   local $FS::UID::AutoCommit = 0;
1982   my $dbh = dbh;
1983
1984   my @errors;
1985   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
1986                          @$remove_pkgnum;
1987
1988   while(scalar(@old_cust_pkg)) {
1989     my @return = ();
1990     my $custnum = $old_cust_pkg[0]->custnum;
1991     my (@remove) = map { $_->pkgnum }
1992                    grep { $_->custnum == $custnum } @old_cust_pkg;
1993     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
1994
1995     my $error = order $custnum, $pkgparts, \@remove, \@return;
1996
1997     push @errors, $error
1998       if $error;
1999     push @$return_cust_pkg, @return;
2000   }
2001
2002   if (scalar(@errors)) {
2003     $dbh->rollback if $oldAutoCommit;
2004     return join(' / ', @errors);
2005   }
2006
2007   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2008   '';
2009 }
2010
2011 sub insert_reason {
2012   my ($self, %options) = @_;
2013
2014   my $otaker = $FS::CurrentUser::CurrentUser->username;
2015
2016   my $reasonnum;
2017   if ( $options{'reason'} =~ /^(\d+)$/ ) {
2018
2019     $reasonnum = $1;
2020
2021   } elsif ( ref($options{'reason'}) ) {
2022
2023     return 'Enter a new reason (or select an existing one)'
2024       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2025
2026     my $reason = new FS::reason({
2027       'reason_type' => $options{'reason'}->{'typenum'},
2028       'reason'      => $options{'reason'}->{'reason'},
2029     });
2030     my $error = $reason->insert;
2031     return $error if $error;
2032
2033     $reasonnum = $reason->reasonnum;
2034
2035   } else {
2036     return "Unparsable reason: ". $options{'reason'};
2037   }
2038
2039   my $cust_pkg_reason =
2040     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
2041                               'reasonnum' => $reasonnum,
2042                               'otaker'    => $otaker,
2043                               'date'      => $options{'date'}
2044                                                ? $options{'date'}
2045                                                : time,
2046                             });
2047
2048   $cust_pkg_reason->insert;
2049 }
2050
2051 =item set_usage USAGE_VALUE_HASHREF
2052
2053 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2054 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2055 upbytes, downbytes, and totalbytes are appropriate keys.
2056
2057 All svc_accts which are part of this package have their values reset.
2058
2059 =cut
2060
2061 sub set_usage {
2062   my ($self, $valueref) = @_;
2063
2064   foreach my $cust_svc ($self->cust_svc){
2065     my $svc_x = $cust_svc->svc_x;
2066     $svc_x->set_usage($valueref)
2067       if $svc_x->can("set_usage");
2068   }
2069 }
2070
2071 =item recharge USAGE_VALUE_HASHREF
2072
2073 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2074 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2075 upbytes, downbytes, and totalbytes are appropriate keys.
2076
2077 All svc_accts which are part of this package have their values incremented.
2078
2079 =cut
2080
2081 sub recharge {
2082   my ($self, $valueref) = @_;
2083
2084   foreach my $cust_svc ($self->cust_svc){
2085     my $svc_x = $cust_svc->svc_x;
2086     $svc_x->recharge($valueref)
2087       if $svc_x->can("recharge");
2088   }
2089 }
2090
2091 =back
2092
2093 =head1 BUGS
2094
2095 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
2096
2097 In sub order, the @pkgparts array (passed by reference) is clobbered.
2098
2099 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
2100 method to pass dates to the recur_prog expression, it should do so.
2101
2102 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2103 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2104 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2105 configuration values.  Probably need a subroutine which decides what to do
2106 based on whether or not we've fetched the user yet, rather than a hash.  See
2107 FS::UID and the TODO.
2108
2109 Now that things are transactional should the check in the insert method be
2110 moved to check ?
2111
2112 =head1 SEE ALSO
2113
2114 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2115 L<FS::pkg_svc>, schema.html from the base documentation
2116
2117 =cut
2118
2119 1;
2120