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