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 =back
 132
 133 Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps;
 134 see L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for
 135 conversion functions.
 136
 137 =head1 METHODS
 138
 139 =over 4
 140
 141 =item new HASHREF
 142
 143 Create a new billing item.  To add the item to the database, see L<"insert">.
 144
 145 =cut
 146
 147 sub table { 'cust_pkg'; }
 148 sub cust_linked { $_[0]->cust_main_custnum; }
 149 sub cust_unlinked_msg {
 150   my $self = shift;
 151   "WARNING: can't find cust_main.custnum ". $self->custnum.
 152   ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
 153 }
 154
 155 =item insert [ OPTION => VALUE ... ]
 156
 157 Adds this billing item to the database ("Orders" the item).  If there is an
 158 error, returns the error, otherwise returns false.
 159
 160 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
 161 will be used to look up the package definition and agent restrictions will be
 162 ignored.
 163
 164 If the additional field I<refnum> is defined, an FS::pkg_referral record will
 165 be created and inserted.  Multiple FS::pkg_referral records can be created by
 166 setting I<refnum> to an array reference of refnums or a hash reference with
 167 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
 168 record will be created corresponding to cust_main.refnum.
 169
 170 The following options are available: I<change>
 171
 172 I<change>, if set true, supresses any referral credit to a referring customer.
 173
 174 =cut
 175
 176 sub insert {
 177   my( $self, %options ) = @_;
 178
 179   local $SIG{HUP} = 'IGNORE';
 180   local $SIG{INT} = 'IGNORE';
 181   local $SIG{QUIT} = 'IGNORE';
 182   local $SIG{TERM} = 'IGNORE';
 183   local $SIG{TSTP} = 'IGNORE';
 184   local $SIG{PIPE} = 'IGNORE';
 185
 186   my $oldAutoCommit = $FS::UID::AutoCommit;
 187   local $FS::UID::AutoCommit = 0;
 188   my $dbh = dbh;
 189
 190   my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
 191   if ( $error ) {
 192     $dbh->rollback if $oldAutoCommit;
 193     return $error;
 194   }
 195
 196   $self->refnum($self->cust_main->refnum) unless $self->refnum;
 197   $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
 198   $self->process_m2m( 'link_table'   => 'pkg_referral',
 199                       'target_table' => 'part_referral',
 200                       'params'       => $self->refnum,
 201                     );
 202
 203   #if ( $self->reg_code ) {
 204   #  my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
 205   #  $error = $reg_code->delete;
 206   #  if ( $error ) {
 207   #    $dbh->rollback if $oldAutoCommit;
 208   #    return $error;
 209   #  }
 210   #}
 211
 212   my $conf = new FS::Conf;
 213   my $cust_main = $self->cust_main;
 214   my $part_pkg = $self->part_pkg;
 215   if ( $conf->exists('referral_credit')
 216        && $cust_main->referral_custnum
 217        && ! $options{'change'}
 218        && $part_pkg->freq !~ /^0\D?$/
 219      )
 220   {
 221     my $referring_cust_main = $cust_main->referring_cust_main;
 222     if ( $referring_cust_main->status ne 'cancelled' ) {
 223       my $error;
 224       if ( $part_pkg->freq !~ /^\d+$/ ) {
 225         warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
 226              ' for package '. $self->pkgnum.
 227              ' ( customer '. $self->custnum. ')'.
 228              ' - One-time referral credits not (yet) available for '.
 229              ' packages with '. $part_pkg->freq_pretty. ' frequency';
 230       } else {
 231
 232         my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
 233         my $error =
 234           $referring_cust_main->
 235             credit( $amount,
 236                     'Referral credit for '.$cust_main->name,
 237                     'reason_type' => $conf->config('referral_credit_type')
 238                   );
 239         if ( $error ) {
 240           $dbh->rollback if $oldAutoCommit;
 241           return "Error crediting customer ". $cust_main->referral_custnum.
 242                " for referral: $error";
 243         }
 244
 245       }
 246
 247     }
 248   }
 249
 250   if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
 251     my $queue = new FS::queue {
 252       'job'     => 'FS::cust_main::queueable_print',
 253     };
 254     $error = $queue->insert(
 255       'custnum'  => $self->custnum,
 256       'template' => 'welcome_letter',
 257     );
 258
 259     if ($error) {
 260       warn "can't send welcome letter: $error";
 261     }
 262
 263   }
 264
 265   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 266   '';
 267
 268 }
 269
 270 =item delete
 271
 272 This method now works but you probably shouldn't use it.
 273
 274 You don't want to delete billing items, because there would then be no record
 275 the customer ever purchased the item.  Instead, see the cancel method.
 276
 277 =cut
 278
 279 #sub delete {
 280 #  return "Can't delete cust_pkg records!";
 281 #}
 282
 283 =item replace OLD_RECORD
 284
 285 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 286 returns the error, otherwise returns false.
 287
 288 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
 289
 290 Changing pkgpart may have disasterous effects.  See the order subroutine.
 291
 292 setup and bill are normally updated by calling the bill method of a customer
 293 object (see L<FS::cust_main>).
 294
 295 suspend is normally updated by the suspend and unsuspend methods.
 296
 297 cancel is normally updated by the cancel method (and also the order subroutine
 298 in some cases).
 299
 300 Calls
 301
 302 =cut
 303
 304 sub replace {
 305   my $new = shift;
 306
 307   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 308               ? shift
 309               : $new->replace_old;
 310
 311   my $options =
 312     ( ref($_[0]) eq 'HASH' )
 313       ? shift
 314       : { @_ };
 315
 316   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
 317   return "Can't change otaker!" if $old->otaker ne $new->otaker;
 318
 319   #allow this *sigh*
 320   #return "Can't change setup once it exists!"
 321   #  if $old->getfield('setup') &&
 322   #     $old->getfield('setup') != $new->getfield('setup');
 323
 324   #some logic for bill, susp, cancel?
 325
 326   local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
 327
 328   local $SIG{HUP} = 'IGNORE';
 329   local $SIG{INT} = 'IGNORE';
 330   local $SIG{QUIT} = 'IGNORE';
 331   local $SIG{TERM} = 'IGNORE';
 332   local $SIG{TSTP} = 'IGNORE';
 333   local $SIG{PIPE} = 'IGNORE';
 334
 335   my $oldAutoCommit = $FS::UID::AutoCommit;
 336   local $FS::UID::AutoCommit = 0;
 337   my $dbh = dbh;
 338
 339   foreach my $method ( qw(adjourn expire) ) {  # How many reasons?
 340     if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
 341       my $error = $new->insert_reason( 'reason' => $options->{'reason'},
 342                                        'date'   => $new->$method,
 343                                      );
 344       if ( $error ) {
 345         dbh->rollback if $oldAutoCommit;
 346         return "Error inserting cust_pkg_reason: $error";
 347       }
 348     }
 349   }
 350
 351   #save off and freeze RADIUS attributes for any associated svc_acct records
 352   my @svc_acct = ();
 353   if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
 354
 355                 #also check for specific exports?
 356                 # to avoid spurious modify export events
 357     @svc_acct = map  { $_->svc_x }
 358                 grep { $_->part_svc->svcdb eq 'svc_acct' }
 359                      $old->cust_svc;
 360
 361     $_->snapshot foreach @svc_acct;
 362
 363   }
 364
 365   my $error = $new->SUPER::replace($old,
 366                                    $options->{options} ? $options->{options} : ()
 367                                   );
 368   if ( $error ) {
 369     $dbh->rollback if $oldAutoCommit;
 370     return $error;
 371   }
 372
 373   #for prepaid packages,
 374   #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
 375   foreach my $old_svc_acct ( @svc_acct ) {
 376     my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
 377     my $s_error = $new_svc_acct->replace($old_svc_acct);
 378     if ( $s_error ) {
 379       $dbh->rollback if $oldAutoCommit;
 380       return $s_error;
 381     }
 382   }
 383
 384   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 385   '';
 386
 387 }
 388
 389 =item check
 390
 391 Checks all fields to make sure this is a valid billing item.  If there is an
 392 error, returns the error, otherwise returns false.  Called by the insert and
 393 replace methods.
 394
 395 =cut
 396
 397 sub check {
 398   my $self = shift;
 399
 400   my $error =
 401     $self->ut_numbern('pkgnum')
 402     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
 403     || $self->ut_numbern('pkgpart')
 404     || $self->ut_numbern('setup')
 405     || $self->ut_numbern('bill')
 406     || $self->ut_numbern('susp')
 407     || $self->ut_numbern('cancel')
 408     || $self->ut_numbern('adjourn')
 409     || $self->ut_numbern('expire')
 410   ;
 411   return $error if $error;
 412
 413   if ( $self->reg_code ) {
 414
 415     unless ( grep { $self->pkgpart == $_->pkgpart }
 416              map  { $_->reg_code_pkg }
 417              qsearchs( 'reg_code', { 'code'     => $self->reg_code,
 418                                      'agentnum' => $self->cust_main->agentnum })
 419            ) {
 420       return "Unknown registration code";
 421     }
 422
 423   } elsif ( $self->promo_code ) {
 424
 425     my $promo_part_pkg =
 426       qsearchs('part_pkg', {
 427         'pkgpart'    => $self->pkgpart,
 428         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
 429       } );
 430     return 'Unknown promotional code' unless $promo_part_pkg;
 431
 432   } else {
 433
 434     unless ( $disable_agentcheck ) {
 435       my $agent =
 436         qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
 437       my $pkgpart_href = $agent->pkgpart_hashref;
 438       return "agent ". $agent->agentnum.
 439              " can't purchase pkgpart ". $self->pkgpart
 440         unless $pkgpart_href->{ $self->pkgpart };
 441     }
 442
 443     $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
 444     return $error if $error;
 445
 446   }
 447
 448   $self->otaker(getotaker) unless $self->otaker;
 449   $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
 450   $self->otaker($1);
 451
 452   if ( $self->dbdef_table->column('manual_flag') ) {
 453     $self->manual_flag('') if $self->manual_flag eq ' ';
 454     $self->manual_flag =~ /^([01]?)$/
 455       or return "Illegal manual_flag ". $self->manual_flag;
 456     $self->manual_flag($1);
 457   }
 458
 459   $self->SUPER::check;
 460 }
 461
 462 =item cancel [ OPTION => VALUE ... ]
 463
 464 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 465 in this package, then cancels the package itself (sets the cancel field to
 466 now).
 467
 468 Available options are:
 469
 470 =over 4
 471
 472 =item quiet - can be set true to supress email cancellation notices.
 473
 474 =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.
 475
 476 =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.
 477
 478 =back
 479
 480 If there is an error, returns the error, otherwise returns false.
 481
 482 =cut
 483
 484 sub cancel {
 485   my( $self, %options ) = @_;
 486
 487   warn "cust_pkg::cancel called with options".
 488        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 489     if $DEBUG;
 490
 491   local $SIG{HUP} = 'IGNORE';
 492   local $SIG{INT} = 'IGNORE';
 493   local $SIG{QUIT} = 'IGNORE';
 494   local $SIG{TERM} = 'IGNORE';
 495   local $SIG{TSTP} = 'IGNORE';
 496   local $SIG{PIPE} = 'IGNORE';
 497
 498   my $oldAutoCommit = $FS::UID::AutoCommit;
 499   local $FS::UID::AutoCommit = 0;
 500   my $dbh = dbh;
 501
 502   my $cancel_time = $options{'time'} || time;
 503
 504   my $error;
 505
 506   if ( $options{'reason'} ) {
 507     $error = $self->insert_reason( 'reason' => $options{'reason'} );
 508     if ( $error ) {
 509       dbh->rollback if $oldAutoCommit;
 510       return "Error inserting cust_pkg_reason: $error";
 511     }
 512   }
 513
 514   my %svc;
 515   foreach my $cust_svc (
 516     #schwartz
 517     map  { $_->[0] }
 518     sort { $a->[1] <=> $b->[1] }
 519     map  { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
 520     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 521   ) {
 522
 523     my $error = $cust_svc->cancel;
 524
 525     if ( $error ) {
 526       $dbh->rollback if $oldAutoCommit;
 527       return "Error cancelling cust_svc: $error";
 528     }
 529   }
 530
 531   unless ( $self->getfield('cancel') ) {
 532     # Add a credit for remaining service
 533     my $remaining_value = $self->calc_remain(time=>$cancel_time);
 534     if ( $remaining_value > 0 && !$options{'no_credit'} ) {
 535       my $conf = new FS::Conf;
 536       my $error = $self->cust_main->credit(
 537         $remaining_value,
 538         'Credit for unused time on '. $self->part_pkg->pkg,
 539         'reason_type' => $conf->config('cancel_credit_type'),
 540       );
 541       if ($error) {
 542         $dbh->rollback if $oldAutoCommit;
 543         return "Error crediting customer \$$remaining_value for unused time on".
 544           $self->part_pkg->pkg. ": $error";
 545       }
 546     }
 547     my %hash = $self->hash;
 548     $hash{'cancel'} = $cancel_time;
 549     my $new = new FS::cust_pkg ( \%hash );
 550     $error = $new->replace( $self, options => { $self->options } );
 551     if ( $error ) {
 552       $dbh->rollback if $oldAutoCommit;
 553       return $error;
 554     }
 555   }
 556
 557   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 558
 559   my $conf = new FS::Conf;
 560   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
 561   if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
 562     my $conf = new FS::Conf;
 563     my $error = send_email(
 564       'from'    => $conf->config('invoice_from'),
 565       'to'      => \@invoicing_list,
 566       'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
 567       'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
 568     );
 569     #should this do something on errors?
 570   }
 571
 572   ''; #no errors
 573
 574 }
 575
 576 =item cancel_if_expired [ NOW_TIMESTAMP ]
 577
 578 Cancels this package if its expire date has been reached.
 579
 580 =cut
 581
 582 sub cancel_if_expired {
 583   my $self = shift;
 584   my $time = shift || time;
 585   return '' unless $self->expire && $self->expire <= $time;
 586   my $error = $self->cancel;
 587   if ( $error ) {
 588     return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
 589            $self->custnum. ": $error";
 590   }
 591   '';
 592 }
 593
 594 =item suspend  [ OPTION => VALUE ... ]
 595
 596 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 597 package, then suspends the package itself (sets the susp field to now).
 598
 599 Available options are:
 600
 601 =over 4
 602
 603 =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.
 604
 605 =back
 606
 607 If there is an error, returns the error, otherwise returns false.
 608
 609 =cut
 610
 611 sub suspend {
 612   my( $self, %options ) = @_;
 613
 614   local $SIG{HUP} = 'IGNORE';
 615   local $SIG{INT} = 'IGNORE';
 616   local $SIG{QUIT} = 'IGNORE';
 617   local $SIG{TERM} = 'IGNORE';
 618   local $SIG{TSTP} = 'IGNORE';
 619   local $SIG{PIPE} = 'IGNORE';
 620
 621   my $oldAutoCommit = $FS::UID::AutoCommit;
 622   local $FS::UID::AutoCommit = 0;
 623   my $dbh = dbh;
 624
 625   my $error;
 626
 627   if ( $options{'reason'} ) {
 628     $error = $self->insert_reason( 'reason' => $options{'reason'} );
 629     if ( $error ) {
 630       dbh->rollback if $oldAutoCommit;
 631       return "Error inserting cust_pkg_reason: $error";
 632     }
 633   }
 634
 635   foreach my $cust_svc (
 636     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 637   ) {
 638     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 639
 640     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 641       $dbh->rollback if $oldAutoCommit;
 642       return "Illegal svcdb value in part_svc!";
 643     };
 644     my $svcdb = $1;
 645     require "FS/$svcdb.pm";
 646
 647     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 648     if ($svc) {
 649       $error = $svc->suspend;
 650       if ( $error ) {
 651         $dbh->rollback if $oldAutoCommit;
 652         return $error;
 653       }
 654     }
 655
 656   }
 657
 658   unless ( $self->getfield('susp') ) {
 659     my %hash = $self->hash;
 660     $hash{'susp'} = time;
 661     my $new = new FS::cust_pkg ( \%hash );
 662     $error = $new->replace( $self, options => { $self->options } );
 663     if ( $error ) {
 664       $dbh->rollback if $oldAutoCommit;
 665       return $error;
 666     }
 667   }
 668
 669   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 670
 671   ''; #no errors
 672 }
 673
 674 =item unsuspend [ OPTION => VALUE ... ]
 675
 676 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 677 package, then unsuspends the package itself (clears the susp field and the
 678 adjourn field if it is in the past).
 679
 680 Available options are: I<adjust_next_bill>.
 681
 682 I<adjust_next_bill> can be set true to adjust the next bill date forward by
 683 the amount of time the account was inactive.  This was set true by default
 684 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
 685 explicitly requested.  Price plans for which this makes sense (anniversary-date
 686 based than prorate or subscription) could have an option to enable this
 687 behaviour?
 688
 689 If there is an error, returns the error, otherwise returns false.
 690
 691 =cut
 692
 693 sub unsuspend {
 694   my( $self, %opt ) = @_;
 695   my $error;
 696
 697   local $SIG{HUP} = 'IGNORE';
 698   local $SIG{INT} = 'IGNORE';
 699   local $SIG{QUIT} = 'IGNORE';
 700   local $SIG{TERM} = 'IGNORE';
 701   local $SIG{TSTP} = 'IGNORE';
 702   local $SIG{PIPE} = 'IGNORE';
 703
 704   my $oldAutoCommit = $FS::UID::AutoCommit;
 705   local $FS::UID::AutoCommit = 0;
 706   my $dbh = dbh;
 707
 708   foreach my $cust_svc (
 709     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
 710   ) {
 711     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 712
 713     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 714       $dbh->rollback if $oldAutoCommit;
 715       return "Illegal svcdb value in part_svc!";
 716     };
 717     my $svcdb = $1;
 718     require "FS/$svcdb.pm";
 719
 720     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 721     if ($svc) {
 722       $error = $svc->unsuspend;
 723       if ( $error ) {
 724         $dbh->rollback if $oldAutoCommit;
 725         return $error;
 726       }
 727     }
 728
 729   }
 730
 731   unless ( ! $self->getfield('susp') ) {
 732     my %hash = $self->hash;
 733     my $inactive = time - $hash{'susp'};
 734
 735     my $conf = new FS::Conf;
 736
 737     $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
 738       if ( $opt{'adjust_next_bill'}
 739            || $conf->config('unsuspend-always_adjust_next_bill_date') )
 740       && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
 741
 742     $hash{'susp'} = '';
 743     $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
 744     my $new = new FS::cust_pkg ( \%hash );
 745     $error = $new->replace( $self, options => { $self->options } );
 746     if ( $error ) {
 747       $dbh->rollback if $oldAutoCommit;
 748       return $error;
 749     }
 750   }
 751
 752   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 753
 754   ''; #no errors
 755 }
 756
 757 =item last_bill
 758
 759 Returns the last bill date, or if there is no last bill date, the setup date.
 760 Useful for billing metered services.
 761
 762 =cut
 763
 764 sub last_bill {
 765   my $self = shift;
 766   if ( $self->dbdef_table->column('last_bill') ) {
 767     return $self->setfield('last_bill', $_[0]) if @_;
 768     return $self->getfield('last_bill') if $self->getfield('last_bill');
 769   }
 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 transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1341
1342 Transfers as many services as possible from this package to another package.
1343
1344 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1345 object.  The destination package must already exist.
1346
1347 Services are moved only if the destination allows services with the correct
1348 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
1349 this option with caution!  No provision is made for export differences
1350 between the old and new service definitions.  Probably only should be used
1351 when your exports for all service definitions of a given svcdb are identical.
1352 (attempt a transfer without it first, to move all possible svcpart-matching
1353 services)
1354
1355 Any services that can't be moved remain in the original package.
1356
1357 Returns an error, if there is one; otherwise, returns the number of services
1358 that couldn't be moved.
1359
1360 =cut
1361
1362 sub transfer {
1363   my ($self, $dest_pkgnum, %opt) = @_;
1364
1365   my $remaining = 0;
1366   my $dest;
1367   my %target;
1368
1369   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1370     $dest = $dest_pkgnum;
1371     $dest_pkgnum = $dest->pkgnum;
1372   } else {
1373     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1374   }
1375
1376   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1377
1378   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1379     $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1380   }
1381
1382   foreach my $cust_svc ($dest->cust_svc) {
1383     $target{$cust_svc->svcpart}--;
1384   }
1385
1386   my %svcpart2svcparts = ();
1387   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1388     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1389     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1390       next if exists $svcpart2svcparts{$svcpart};
1391       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1392       $svcpart2svcparts{$svcpart} = [
1393         map  { $_->[0] }
1394         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
1395         map {
1396               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1397                                                    'svcpart' => $_          } );
1398               [ $_,
1399                 $pkg_svc ? $pkg_svc->primary_svc : '',
1400                 $pkg_svc ? $pkg_svc->quantity : 0,
1401               ];
1402             }
1403
1404         grep { $_ != $svcpart }
1405         map  { $_->svcpart }
1406         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1407       ];
1408       warn "alternates for svcpart $svcpart: ".
1409            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1410         if $DEBUG;
1411     }
1412   }
1413
1414   foreach my $cust_svc ($self->cust_svc) {
1415     if($target{$cust_svc->svcpart} > 0) {
1416       $target{$cust_svc->svcpart}--;
1417       my $new = new FS::cust_svc { $cust_svc->hash };
1418       $new->pkgnum($dest_pkgnum);
1419       my $error = $new->replace($cust_svc);
1420       return $error if $error;
1421     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1422       if ( $DEBUG ) {
1423         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1424         warn "alternates to consider: ".
1425              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1426       }
1427       my @alternate = grep {
1428                              warn "considering alternate svcpart $_: ".
1429                                   "$target{$_} available in new package\n"
1430                                if $DEBUG;
1431                              $target{$_} > 0;
1432                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
1433       if ( @alternate ) {
1434         warn "alternate(s) found\n" if $DEBUG;
1435         my $change_svcpart = $alternate[0];
1436         $target{$change_svcpart}--;
1437         my $new = new FS::cust_svc { $cust_svc->hash };
1438         $new->svcpart($change_svcpart);
1439         $new->pkgnum($dest_pkgnum);
1440         my $error = $new->replace($cust_svc);
1441         return $error if $error;
1442       } else {
1443         $remaining++;
1444       }
1445     } else {
1446       $remaining++
1447     }
1448   }
1449   return $remaining;
1450 }
1451
1452 =item reexport
1453
1454 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1455 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
1456
1457 =cut
1458
1459 sub reexport {
1460   my $self = shift;
1461
1462   local $SIG{HUP} = 'IGNORE';
1463   local $SIG{INT} = 'IGNORE';
1464   local $SIG{QUIT} = 'IGNORE';
1465   local $SIG{TERM} = 'IGNORE';
1466   local $SIG{TSTP} = 'IGNORE';
1467   local $SIG{PIPE} = 'IGNORE';
1468
1469   my $oldAutoCommit = $FS::UID::AutoCommit;
1470   local $FS::UID::AutoCommit = 0;
1471   my $dbh = dbh;
1472
1473   foreach my $cust_svc ( $self->cust_svc ) {
1474     #false laziness w/svc_Common::insert
1475     my $svc_x = $cust_svc->svc_x;
1476     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
1477       my $error = $part_export->export_insert($svc_x);
1478       if ( $error ) {
1479         $dbh->rollback if $oldAutoCommit;
1480         return $error;
1481       }
1482     }
1483   }
1484
1485   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1486   '';
1487
1488 }
1489
1490 =back
1491
1492 =head1 CLASS METHODS
1493
1494 =over 4
1495
1496 =item recurring_sql
1497
1498 Returns an SQL expression identifying recurring packages.
1499
1500 =cut
1501
1502 sub recurring_sql { "
1503   '0' != ( select freq from part_pkg
1504              where cust_pkg.pkgpart = part_pkg.pkgpart )
1505 "; }
1506
1507 =item onetime_sql
1508
1509 Returns an SQL expression identifying one-time packages.
1510
1511 =cut
1512
1513 sub onetime_sql { "
1514   '0' = ( select freq from part_pkg
1515             where cust_pkg.pkgpart = part_pkg.pkgpart )
1516 "; }
1517
1518 =item active_sql
1519
1520 Returns an SQL expression identifying active packages.
1521
1522 =cut
1523
1524 sub active_sql { "
1525   ". $_[0]->recurring_sql(). "
1526   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1527   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
1528 "; }
1529
1530 =item inactive_sql
1531
1532 Returns an SQL expression identifying inactive packages (one-time packages
1533 that are otherwise unsuspended/uncancelled).
1534
1535 =cut
1536
1537 sub inactive_sql { "
1538   ". $_[0]->onetime_sql(). "
1539   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1540   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
1541 "; }
1542
1543 =item susp_sql
1544 =item suspended_sql
1545
1546 Returns an SQL expression identifying suspended packages.
1547
1548 =cut
1549
1550 sub suspended_sql { susp_sql(@_); }
1551 sub susp_sql {
1552   #$_[0]->recurring_sql(). ' AND '.
1553   "
1554         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
1555     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
1556   ";
1557 }
1558
1559 =item cancel_sql
1560 =item cancelled_sql
1561
1562 Returns an SQL exprression identifying cancelled packages.
1563
1564 =cut
1565
1566 sub cancelled_sql { cancel_sql(@_); }
1567 sub cancel_sql {
1568   #$_[0]->recurring_sql(). ' AND '.
1569   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
1570 }
1571
1572 =item search_sql HREF
1573
1574 Returns a qsearch hash expression to search for parameters specified in HREF.
1575 Valid parameters are
1576
1577 =over 4
1578 =item agentnum
1579 =item magic - /^(active|inactive|suspended|cancell?ed)$/
1580 =item status - /^(active|inactive|suspended|one-time charge|inactive|cancell?ed)$/
1581 =item classnum
1582 =item pkgpart - list specified how?
1583 =item setup     - arrayref of beginning and ending epoch date
1584 =item last_bill - arrayref of beginning and ending epoch date
1585 =item bill      - arrayref of beginning and ending epoch date
1586 =item adjourn   - arrayref of beginning and ending epoch date
1587 =item susp      - arrayref of beginning and ending epoch date
1588 =item expire    - arrayref of beginning and ending epoch date
1589 =item cancel    - arrayref of beginning and ending epoch date
1590 =item query - /^(pkgnum/APKG_pkgnum)$/
1591 =item cust_fields - a value suited to passing to FS::UI::Web::cust_header
1592 =item CurrentUser - specifies the user for agent virtualization
1593 =back
1594
1595 =cut
1596
1597 sub search_sql {
1598   my ($class, $params) = @_;
1599   my @where = ();
1600
1601   ##
1602   # parse agent
1603   ##
1604
1605   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
1606     push @where,
1607       "cust_main.agentnum = $1";
1608   }
1609
1610   ##
1611   # parse status
1612   ##
1613
1614   if (    $params->{'magic'}  eq 'active'
1615        || $params->{'status'} eq 'active' ) {
1616
1617     push @where, FS::cust_pkg->active_sql();
1618
1619   } elsif (    $params->{'magic'}  eq 'inactive'
1620             || $params->{'status'} eq 'inactive' ) {
1621
1622     push @where, FS::cust_pkg->inactive_sql();
1623
1624   } elsif (    $params->{'magic'}  eq 'suspended'
1625             || $params->{'status'} eq 'suspended'  ) {
1626
1627     push @where, FS::cust_pkg->suspended_sql();
1628
1629   } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
1630             || $params->{'status'} =~ /^cancell?ed$/ ) {
1631
1632     push @where, FS::cust_pkg->cancelled_sql();
1633
1634   } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
1635
1636     push @where, FS::cust_pkg->inactive_sql();
1637
1638   }
1639
1640   ###
1641   # parse package class
1642   ###
1643
1644   #false lazinessish w/graph/cust_bill_pkg.cgi
1645   my $classnum = 0;
1646   my @pkg_class = ();
1647   if ( exists($params->{'classnum'})
1648        && $params->{'classnum'} =~ /^(\d*)$/
1649      )
1650   {
1651     $classnum = $1;
1652     if ( $classnum ) { #a specific class
1653       push @where, "classnum = $classnum";
1654
1655       #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
1656       #die "classnum $classnum not found!" unless $pkg_class[0];
1657       #$title .= $pkg_class[0]->classname.' ';
1658
1659     } elsif ( $classnum eq '' ) { #the empty class
1660
1661       push @where, "classnum IS NULL";
1662       #$title .= 'Empty class ';
1663       #@pkg_class = ( '(empty class)' );
1664     } elsif ( $classnum eq '0' ) {
1665       #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
1666       #push @pkg_class, '(empty class)';
1667     } else {
1668       die "illegal classnum";
1669     }
1670   }
1671   #eslaf
1672
1673   ###
1674   # parse part_pkg
1675   ###
1676
1677   my $pkgpart = join (' OR pkgpart=',
1678                       grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
1679   push @where,  '(pkgpart=' . $pkgpart . ')' if $pkgpart;
1680
1681   ###
1682   # parse dates
1683   ###
1684
1685   my $orderby = '';
1686
1687   #false laziness w/report_cust_pkg.html
1688   my %disable = (
1689     'all'             => {},
1690     'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
1691     'active'          => { 'susp'=>1, 'cancel'=>1 },
1692     'suspended'       => { 'cancel' => 1 },
1693     'cancelled'       => {},
1694     ''                => {},
1695   );
1696
1697   foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
1698
1699     next unless exists($params->{$field});
1700
1701     my($beginning, $ending) = @{$params->{$field}};
1702
1703     next if $beginning == 0 && $ending == 4294967295;
1704
1705     push @where,
1706       "cust_pkg.$field IS NOT NULL",
1707       "cust_pkg.$field >= $beginning",
1708       "cust_pkg.$field <= $ending";
1709
1710     $orderby ||= "ORDER BY cust_pkg.$field";
1711
1712   }
1713
1714   $orderby ||= 'ORDER BY bill';
1715
1716   ###
1717   # parse magic, legacy, etc.
1718   ###
1719
1720   if ( $params->{'magic'} &&
1721        $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
1722   ) {
1723
1724     $orderby = 'ORDER BY pkgnum';
1725
1726     if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
1727       push @where, "pkgpart = $1";
1728     }
1729
1730   } elsif ( $params->{'query'} eq 'pkgnum' ) {
1731
1732     $orderby = 'ORDER BY pkgnum';
1733
1734   } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
1735
1736     $orderby = 'ORDER BY pkgnum';
1737
1738     push @where, '0 < (
1739       SELECT count(*) FROM pkg_svc
1740        WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
1741          AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
1742                                    WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
1743                                      AND cust_svc.svcpart = pkg_svc.svcpart
1744                                 )
1745     )';
1746
1747   }
1748
1749   ##
1750   # setup queries, links, subs, etc. for the search
1751   ##
1752
1753   # here is the agent virtualization
1754   if ($params->{CurrentUser}) {
1755     my $access_user =
1756       qsearchs('access_user', { username => $params->{CurrentUser} });
1757
1758     if ($access_user) {
1759       push @where, $access_user->agentnums_sql('table'=>'cust_main');
1760     }else{
1761       push @where, "1=0";
1762     }
1763   }else{
1764     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
1765   }
1766
1767   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1768
1769   my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
1770                   'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
1771                   'LEFT JOIN pkg_class USING ( classnum ) ';
1772
1773   my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
1774
1775   my $sql_query = {
1776     'table'       => 'cust_pkg',
1777     'hashref'     => {},
1778     'select'      => join(', ',
1779                                 'cust_pkg.*',
1780                                 ( map "part_pkg.$_", qw( pkg freq ) ),
1781                                 'pkg_class.classname',
1782                                 'cust_main.custnum as cust_main_custnum',
1783                                 FS::UI::Web::cust_sql_fields(
1784                                   $params->{'cust_fields'}
1785                                 ),
1786                      ),
1787     'extra_sql'   => "$extra_sql $orderby",
1788     'addl_from'   => $addl_from,
1789     'count_query' => $count_query,
1790   };
1791
1792 }
1793
1794 =head1 SUBROUTINES
1795
1796 =over 4
1797
1798 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
1799
1800 CUSTNUM is a customer (see L<FS::cust_main>)
1801
1802 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
1803 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
1804 permitted.
1805
1806 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
1807 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
1808 new billing items.  An error is returned if this is not possible (see
1809 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
1810 parameter.
1811
1812 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
1813 newly-created cust_pkg objects.
1814
1815 REFNUM, if specified, will specify the FS::pkg_referral record to be created
1816 and inserted.  Multiple FS::pkg_referral records can be created by
1817 setting I<refnum> to an array reference of refnums or a hash reference with
1818 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
1819 record will be created corresponding to cust_main.refnum.
1820
1821 =cut
1822
1823 sub order {
1824   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1825
1826   my $conf = new FS::Conf;
1827
1828   # Transactionize this whole mess
1829   local $SIG{HUP} = 'IGNORE';
1830   local $SIG{INT} = 'IGNORE';
1831   local $SIG{QUIT} = 'IGNORE';
1832   local $SIG{TERM} = 'IGNORE';
1833   local $SIG{TSTP} = 'IGNORE';
1834   local $SIG{PIPE} = 'IGNORE';
1835
1836   my $oldAutoCommit = $FS::UID::AutoCommit;
1837   local $FS::UID::AutoCommit = 0;
1838   my $dbh = dbh;
1839
1840   my $error;
1841   my $cust_main = qsearchs('cust_main', { custnum => $custnum });
1842   return "Customer not found: $custnum" unless $cust_main;
1843
1844   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
1845                          @$remove_pkgnum;
1846
1847   my $change = scalar(@old_cust_pkg) != 0;
1848
1849   my %hash = ();
1850   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
1851
1852     my $time = time;
1853
1854     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
1855
1856     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
1857     $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
1858
1859     $hash{'change_date'} = $time;
1860     $hash{"change_$_"}  = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
1861   }
1862
1863   # Create the new packages.
1864   foreach my $pkgpart (@$pkgparts) {
1865     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
1866                                       pkgpart => $pkgpart,
1867                                       refnum  => $refnum,
1868                                       %hash,
1869                                     };
1870     $error = $cust_pkg->insert( 'change' => $change );
1871     if ($error) {
1872       $dbh->rollback if $oldAutoCommit;
1873       return $error;
1874     }
1875     push @$return_cust_pkg, $cust_pkg;
1876   }
1877   # $return_cust_pkg now contains refs to all of the newly
1878   # created packages.
1879
1880   # Transfer services and cancel old packages.
1881   foreach my $old_pkg (@old_cust_pkg) {
1882
1883     foreach my $new_pkg (@$return_cust_pkg) {
1884       $error = $old_pkg->transfer($new_pkg);
1885       if ($error and $error == 0) {
1886         # $old_pkg->transfer failed.
1887         $dbh->rollback if $oldAutoCommit;
1888         return $error;
1889       }
1890     }
1891
1892     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1893       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1894       foreach my $new_pkg (@$return_cust_pkg) {
1895         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
1896         if ($error and $error == 0) {
1897           # $old_pkg->transfer failed.
1898         $dbh->rollback if $oldAutoCommit;
1899         return $error;
1900         }
1901       }
1902     }
1903
1904     if ($error > 0) {
1905       # Transfers were successful, but we went through all of the
1906       # new packages and still had services left on the old package.
1907       # We can't cancel the package under the circumstances, so abort.
1908       $dbh->rollback if $oldAutoCommit;
1909       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
1910     }
1911     $error = $old_pkg->cancel( quiet=>1 );
1912     if ($error) {
1913       $dbh->rollback;
1914       return $error;
1915     }
1916   }
1917   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1918   '';
1919 }
1920
1921 =item insert_reason
1922
1923 Associates this package with a (suspension or cancellation) reason (see
1924 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
1925 L<FS::reason>).
1926
1927 Available options are:
1928
1929 =over 4
1930
1931 =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.
1932
1933 =item date
1934
1935 =back
1936
1937 If there is an error, returns the error, otherwise returns false.
1938
1939 =cut
1940
1941 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
1942
1943 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
1944 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
1945 permitted.
1946
1947 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
1948 replace.  The services (see L<FS::cust_svc>) are moved to the
1949 new billing items.  An error is returned if this is not possible (see
1950 L<FS::pkg_svc>).
1951
1952 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
1953 newly-created cust_pkg objects.
1954
1955 =cut
1956
1957 sub bulk_change {
1958   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
1959
1960   # Transactionize this whole mess
1961   local $SIG{HUP} = 'IGNORE';
1962   local $SIG{INT} = 'IGNORE';
1963   local $SIG{QUIT} = 'IGNORE';
1964   local $SIG{TERM} = 'IGNORE';
1965   local $SIG{TSTP} = 'IGNORE';
1966   local $SIG{PIPE} = 'IGNORE';
1967
1968   my $oldAutoCommit = $FS::UID::AutoCommit;
1969   local $FS::UID::AutoCommit = 0;
1970   my $dbh = dbh;
1971
1972   my @errors;
1973   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
1974                          @$remove_pkgnum;
1975
1976   while(scalar(@old_cust_pkg)) {
1977     my @return = ();
1978     my $custnum = $old_cust_pkg[0]->custnum;
1979     my (@remove) = map { $_->pkgnum }
1980                    grep { $_->custnum == $custnum } @old_cust_pkg;
1981     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
1982
1983     my $error = order $custnum, $pkgparts, \@remove, \@return;
1984
1985     push @errors, $error
1986       if $error;
1987     push @$return_cust_pkg, @return;
1988   }
1989
1990   if (scalar(@errors)) {
1991     $dbh->rollback if $oldAutoCommit;
1992     return join(' / ', @errors);
1993   }
1994
1995   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1996   '';
1997 }
1998
1999 sub insert_reason {
2000   my ($self, %options) = @_;
2001
2002   my $otaker = $FS::CurrentUser::CurrentUser->username;
2003
2004   my $reasonnum;
2005   if ( $options{'reason'} =~ /^(\d+)$/ ) {
2006
2007     $reasonnum = $1;
2008
2009   } elsif ( ref($options{'reason'}) ) {
2010
2011     return 'Enter a new reason (or select an existing one)'
2012       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2013
2014     my $reason = new FS::reason({
2015       'reason_type' => $options{'reason'}->{'typenum'},
2016       'reason'      => $options{'reason'}->{'reason'},
2017     });
2018     my $error = $reason->insert;
2019     return $error if $error;
2020
2021     $reasonnum = $reason->reasonnum;
2022
2023   } else {
2024     return "Unparsable reason: ". $options{'reason'};
2025   }
2026
2027   my $cust_pkg_reason =
2028     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
2029                               'reasonnum' => $reasonnum,
2030                               'otaker'    => $otaker,
2031                               'date'      => $options{'date'}
2032                                                ? $options{'date'}
2033                                                : time,
2034                             });
2035
2036   $cust_pkg_reason->insert;
2037 }
2038
2039 =item set_usage USAGE_VALUE_HASHREF
2040
2041 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2042 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2043 upbytes, downbytes, and totalbytes are appropriate keys.
2044
2045 All svc_accts which are part of this package have their values reset.
2046
2047 =cut
2048
2049 sub set_usage {
2050   my ($self, $valueref) = @_;
2051
2052   foreach my $cust_svc ($self->cust_svc){
2053     my $svc_x = $cust_svc->svc_x;
2054     $svc_x->set_usage($valueref)
2055       if $svc_x->can("set_usage");
2056   }
2057 }
2058
2059 =item recharge USAGE_VALUE_HASHREF
2060
2061 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2062 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2063 upbytes, downbytes, and totalbytes are appropriate keys.
2064
2065 All svc_accts which are part of this package have their values incremented.
2066
2067 =cut
2068
2069 sub recharge {
2070   my ($self, $valueref) = @_;
2071
2072   foreach my $cust_svc ($self->cust_svc){
2073     my $svc_x = $cust_svc->svc_x;
2074     $svc_x->recharge($valueref)
2075       if $svc_x->can("recharge");
2076   }
2077 }
2078
2079 =back
2080
2081 =head1 BUGS
2082
2083 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
2084
2085 In sub order, the @pkgparts array (passed by reference) is clobbered.
2086
2087 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
2088 method to pass dates to the recur_prog expression, it should do so.
2089
2090 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2091 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2092 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2093 configuration values.  Probably need a subroutine which decides what to do
2094 based on whether or not we've fetched the user yet, rather than a hash.  See
2095 FS::UID and the TODO.
2096
2097 Now that things are transactional should the check in the insert method be
2098 moved to check ?
2099
2100 =head1 SEE ALSO
2101
2102 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2103 L<FS::pkg_svc>, schema.html from the base documentation
2104
2105 =cut
2106
2107 1;
2108