FS/FS/cust_pkg.pm

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