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 HASHREF
1585
1586 Returns a qsearch hash expression to search for parameters specified in HASHREF.
1587 Valid parameters are
1588
1589 =over 4
1590
1591 =item agentnum
1592
1593 =item magic
1594
1595 active, inactive, suspended, cancel (or cancelled)
1596
1597 =item status
1598
1599 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
1600
1601 =item classnum
1602
1603 =item pkgpart
1604
1605 list specified how?
1606
1607 =item setup
1608
1609 arrayref of beginning and ending epoch date
1610
1611 =item last_bill
1612
1613 arrayref of beginning and ending epoch date
1614
1615 =item bill
1616
1617 arrayref of beginning and ending epoch date
1618
1619 =item adjourn
1620
1621 arrayref of beginning and ending epoch date
1622
1623 =item susp
1624
1625 arrayref of beginning and ending epoch date
1626
1627 =item expire
1628
1629 arrayref of beginning and ending epoch date
1630
1631 =item cancel
1632
1633 arrayref of beginning and ending epoch date
1634
1635 =item query
1636
1637 pkgnum or APKG_pkgnum
1638
1639 =item cust_fields
1640
1641 a value suited to passing to FS::UI::Web::cust_header
1642
1643 =item CurrentUser
1644
1645 specifies the user for agent virtualization
1646
1647 =back
1648
1649 =cut
1650
1651 sub search_sql {
1652   my ($class, $params) = @_;
1653   my @where = ();
1654
1655   ##
1656   # parse agent
1657   ##
1658
1659   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
1660     push @where,
1661       "cust_main.agentnum = $1";
1662   }
1663
1664   ##
1665   # parse status
1666   ##
1667
1668   if (    $params->{'magic'}  eq 'active'
1669        || $params->{'status'} eq 'active' ) {
1670
1671     push @where, FS::cust_pkg->active_sql();
1672
1673   } elsif (    $params->{'magic'}  eq 'inactive'
1674             || $params->{'status'} eq 'inactive' ) {
1675
1676     push @where, FS::cust_pkg->inactive_sql();
1677
1678   } elsif (    $params->{'magic'}  eq 'suspended'
1679             || $params->{'status'} eq 'suspended'  ) {
1680
1681     push @where, FS::cust_pkg->suspended_sql();
1682
1683   } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
1684             || $params->{'status'} =~ /^cancell?ed$/ ) {
1685
1686     push @where, FS::cust_pkg->cancelled_sql();
1687
1688   } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
1689
1690     push @where, FS::cust_pkg->inactive_sql();
1691
1692   }
1693
1694   ###
1695   # parse package class
1696   ###
1697
1698   #false lazinessish w/graph/cust_bill_pkg.cgi
1699   my $classnum = 0;
1700   my @pkg_class = ();
1701   if ( exists($params->{'classnum'})
1702        && $params->{'classnum'} =~ /^(\d*)$/
1703      )
1704   {
1705     $classnum = $1;
1706     if ( $classnum ) { #a specific class
1707       push @where, "classnum = $classnum";
1708
1709       #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
1710       #die "classnum $classnum not found!" unless $pkg_class[0];
1711       #$title .= $pkg_class[0]->classname.' ';
1712
1713     } elsif ( $classnum eq '' ) { #the empty class
1714
1715       push @where, "classnum IS NULL";
1716       #$title .= 'Empty class ';
1717       #@pkg_class = ( '(empty class)' );
1718     } elsif ( $classnum eq '0' ) {
1719       #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
1720       #push @pkg_class, '(empty class)';
1721     } else {
1722       die "illegal classnum";
1723     }
1724   }
1725   #eslaf
1726
1727   ###
1728   # parse part_pkg
1729   ###
1730
1731   my $pkgpart = join (' OR pkgpart=',
1732                       grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
1733   push @where,  '(pkgpart=' . $pkgpart . ')' if $pkgpart;
1734
1735   ###
1736   # parse dates
1737   ###
1738
1739   my $orderby = '';
1740
1741   #false laziness w/report_cust_pkg.html
1742   my %disable = (
1743     'all'             => {},
1744     'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
1745     'active'          => { 'susp'=>1, 'cancel'=>1 },
1746     'suspended'       => { 'cancel' => 1 },
1747     'cancelled'       => {},
1748     ''                => {},
1749   );
1750
1751   foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
1752
1753     next unless exists($params->{$field});
1754
1755     my($beginning, $ending) = @{$params->{$field}};
1756
1757     next if $beginning == 0 && $ending == 4294967295;
1758
1759     push @where,
1760       "cust_pkg.$field IS NOT NULL",
1761       "cust_pkg.$field >= $beginning",
1762       "cust_pkg.$field <= $ending";
1763
1764     $orderby ||= "ORDER BY cust_pkg.$field";
1765
1766   }
1767
1768   $orderby ||= 'ORDER BY bill';
1769
1770   ###
1771   # parse magic, legacy, etc.
1772   ###
1773
1774   if ( $params->{'magic'} &&
1775        $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
1776   ) {
1777
1778     $orderby = 'ORDER BY pkgnum';
1779
1780     if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
1781       push @where, "pkgpart = $1";
1782     }
1783
1784   } elsif ( $params->{'query'} eq 'pkgnum' ) {
1785
1786     $orderby = 'ORDER BY pkgnum';
1787
1788   } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
1789
1790     $orderby = 'ORDER BY pkgnum';
1791
1792     push @where, '0 < (
1793       SELECT count(*) FROM pkg_svc
1794        WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
1795          AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
1796                                    WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
1797                                      AND cust_svc.svcpart = pkg_svc.svcpart
1798                                 )
1799     )';
1800
1801   }
1802
1803   ##
1804   # setup queries, links, subs, etc. for the search
1805   ##
1806
1807   # here is the agent virtualization
1808   if ($params->{CurrentUser}) {
1809     my $access_user =
1810       qsearchs('access_user', { username => $params->{CurrentUser} });
1811
1812     if ($access_user) {
1813       push @where, $access_user->agentnums_sql('table'=>'cust_main');
1814     }else{
1815       push @where, "1=0";
1816     }
1817   }else{
1818     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
1819   }
1820
1821   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1822
1823   my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
1824                   'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
1825                   'LEFT JOIN pkg_class USING ( classnum ) ';
1826
1827   my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
1828
1829   my $sql_query = {
1830     'table'       => 'cust_pkg',
1831     'hashref'     => {},
1832     'select'      => join(', ',
1833                                 'cust_pkg.*',
1834                                 ( map "part_pkg.$_", qw( pkg freq ) ),
1835                                 'pkg_class.classname',
1836                                 'cust_main.custnum as cust_main_custnum',
1837                                 FS::UI::Web::cust_sql_fields(
1838                                   $params->{'cust_fields'}
1839                                 ),
1840                      ),
1841     'extra_sql'   => "$extra_sql $orderby",
1842     'addl_from'   => $addl_from,
1843     'count_query' => $count_query,
1844   };
1845
1846 }
1847
1848 =head1 SUBROUTINES
1849
1850 =over 4
1851
1852 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
1853
1854 CUSTNUM is a customer (see L<FS::cust_main>)
1855
1856 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
1857 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
1858 permitted.
1859
1860 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
1861 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
1862 new billing items.  An error is returned if this is not possible (see
1863 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
1864 parameter.
1865
1866 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
1867 newly-created cust_pkg objects.
1868
1869 REFNUM, if specified, will specify the FS::pkg_referral record to be created
1870 and inserted.  Multiple FS::pkg_referral records can be created by
1871 setting I<refnum> to an array reference of refnums or a hash reference with
1872 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
1873 record will be created corresponding to cust_main.refnum.
1874
1875 =cut
1876
1877 sub order {
1878   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1879
1880   my $conf = new FS::Conf;
1881
1882   # Transactionize this whole mess
1883   local $SIG{HUP} = 'IGNORE';
1884   local $SIG{INT} = 'IGNORE';
1885   local $SIG{QUIT} = 'IGNORE';
1886   local $SIG{TERM} = 'IGNORE';
1887   local $SIG{TSTP} = 'IGNORE';
1888   local $SIG{PIPE} = 'IGNORE';
1889
1890   my $oldAutoCommit = $FS::UID::AutoCommit;
1891   local $FS::UID::AutoCommit = 0;
1892   my $dbh = dbh;
1893
1894   my $error;
1895   my $cust_main = qsearchs('cust_main', { custnum => $custnum });
1896   return "Customer not found: $custnum" unless $cust_main;
1897
1898   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
1899                          @$remove_pkgnum;
1900
1901   my $change = scalar(@old_cust_pkg) != 0;
1902
1903   my %hash = ();
1904   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
1905
1906     my $time = time;
1907
1908     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
1909
1910     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
1911     $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
1912
1913     $hash{'change_date'} = $time;
1914     $hash{"change_$_"}  = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
1915   }
1916
1917   # Create the new packages.
1918   foreach my $pkgpart (@$pkgparts) {
1919     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
1920                                       pkgpart => $pkgpart,
1921                                       refnum  => $refnum,
1922                                       %hash,
1923                                     };
1924     $error = $cust_pkg->insert( 'change' => $change );
1925     if ($error) {
1926       $dbh->rollback if $oldAutoCommit;
1927       return $error;
1928     }
1929     push @$return_cust_pkg, $cust_pkg;
1930   }
1931   # $return_cust_pkg now contains refs to all of the newly
1932   # created packages.
1933
1934   # Transfer services and cancel old packages.
1935   foreach my $old_pkg (@old_cust_pkg) {
1936
1937     foreach my $new_pkg (@$return_cust_pkg) {
1938       $error = $old_pkg->transfer($new_pkg);
1939       if ($error and $error == 0) {
1940         # $old_pkg->transfer failed.
1941         $dbh->rollback if $oldAutoCommit;
1942         return $error;
1943       }
1944     }
1945
1946     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1947       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1948       foreach my $new_pkg (@$return_cust_pkg) {
1949         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
1950         if ($error and $error == 0) {
1951           # $old_pkg->transfer failed.
1952         $dbh->rollback if $oldAutoCommit;
1953         return $error;
1954         }
1955       }
1956     }
1957
1958     if ($error > 0) {
1959       # Transfers were successful, but we went through all of the
1960       # new packages and still had services left on the old package.
1961       # We can't cancel the package under the circumstances, so abort.
1962       $dbh->rollback if $oldAutoCommit;
1963       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
1964     }
1965     $error = $old_pkg->cancel( quiet=>1 );
1966     if ($error) {
1967       $dbh->rollback;
1968       return $error;
1969     }
1970   }
1971   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1972   '';
1973 }
1974
1975 =item insert_reason
1976
1977 Associates this package with a (suspension or cancellation) reason (see
1978 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
1979 L<FS::reason>).
1980
1981 Available options are:
1982
1983 =over 4
1984
1985 =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.
1986
1987 =item date
1988
1989 =back
1990
1991 If there is an error, returns the error, otherwise returns false.
1992
1993 =cut
1994
1995 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
1996
1997 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
1998 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
1999 permitted.
2000
2001 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2002 replace.  The services (see L<FS::cust_svc>) are moved to the
2003 new billing items.  An error is returned if this is not possible (see
2004 L<FS::pkg_svc>).
2005
2006 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2007 newly-created cust_pkg objects.
2008
2009 =cut
2010
2011 sub bulk_change {
2012   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2013
2014   # Transactionize this whole mess
2015   local $SIG{HUP} = 'IGNORE';
2016   local $SIG{INT} = 'IGNORE';
2017   local $SIG{QUIT} = 'IGNORE';
2018   local $SIG{TERM} = 'IGNORE';
2019   local $SIG{TSTP} = 'IGNORE';
2020   local $SIG{PIPE} = 'IGNORE';
2021
2022   my $oldAutoCommit = $FS::UID::AutoCommit;
2023   local $FS::UID::AutoCommit = 0;
2024   my $dbh = dbh;
2025
2026   my @errors;
2027   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2028                          @$remove_pkgnum;
2029
2030   while(scalar(@old_cust_pkg)) {
2031     my @return = ();
2032     my $custnum = $old_cust_pkg[0]->custnum;
2033     my (@remove) = map { $_->pkgnum }
2034                    grep { $_->custnum == $custnum } @old_cust_pkg;
2035     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2036
2037     my $error = order $custnum, $pkgparts, \@remove, \@return;
2038
2039     push @errors, $error
2040       if $error;
2041     push @$return_cust_pkg, @return;
2042   }
2043
2044   if (scalar(@errors)) {
2045     $dbh->rollback if $oldAutoCommit;
2046     return join(' / ', @errors);
2047   }
2048
2049   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2050   '';
2051 }
2052
2053 sub insert_reason {
2054   my ($self, %options) = @_;
2055
2056   my $otaker = $FS::CurrentUser::CurrentUser->username;
2057
2058   my $reasonnum;
2059   if ( $options{'reason'} =~ /^(\d+)$/ ) {
2060
2061     $reasonnum = $1;
2062
2063   } elsif ( ref($options{'reason'}) ) {
2064
2065     return 'Enter a new reason (or select an existing one)'
2066       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2067
2068     my $reason = new FS::reason({
2069       'reason_type' => $options{'reason'}->{'typenum'},
2070       'reason'      => $options{'reason'}->{'reason'},
2071     });
2072     my $error = $reason->insert;
2073     return $error if $error;
2074
2075     $reasonnum = $reason->reasonnum;
2076
2077   } else {
2078     return "Unparsable reason: ". $options{'reason'};
2079   }
2080
2081   my $cust_pkg_reason =
2082     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
2083                               'reasonnum' => $reasonnum,
2084                               'otaker'    => $otaker,
2085                               'date'      => $options{'date'}
2086                                                ? $options{'date'}
2087                                                : time,
2088                             });
2089
2090   $cust_pkg_reason->insert;
2091 }
2092
2093 =item set_usage USAGE_VALUE_HASHREF
2094
2095 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2096 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2097 upbytes, downbytes, and totalbytes are appropriate keys.
2098
2099 All svc_accts which are part of this package have their values reset.
2100
2101 =cut
2102
2103 sub set_usage {
2104   my ($self, $valueref) = @_;
2105
2106   foreach my $cust_svc ($self->cust_svc){
2107     my $svc_x = $cust_svc->svc_x;
2108     $svc_x->set_usage($valueref)
2109       if $svc_x->can("set_usage");
2110   }
2111 }
2112
2113 =item recharge USAGE_VALUE_HASHREF
2114
2115 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2116 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2117 upbytes, downbytes, and totalbytes are appropriate keys.
2118
2119 All svc_accts which are part of this package have their values incremented.
2120
2121 =cut
2122
2123 sub recharge {
2124   my ($self, $valueref) = @_;
2125
2126   foreach my $cust_svc ($self->cust_svc){
2127     my $svc_x = $cust_svc->svc_x;
2128     $svc_x->recharge($valueref)
2129       if $svc_x->can("recharge");
2130   }
2131 }
2132
2133 =back
2134
2135 =head1 BUGS
2136
2137 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
2138
2139 In sub order, the @pkgparts array (passed by reference) is clobbered.
2140
2141 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
2142 method to pass dates to the recur_prog expression, it should do so.
2143
2144 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2145 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2146 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2147 configuration values.  Probably need a subroutine which decides what to do
2148 based on whether or not we've fetched the user yet, rather than a hash.  See
2149 FS::UID and the TODO.
2150
2151 Now that things are transactional should the check in the insert method be
2152 moved to check ?
2153
2154 =head1 SEE ALSO
2155
2156 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2157 L<FS::pkg_svc>, schema.html from the base documentation
2158
2159 =cut
2160
2161 1;
2162