FS/FS/cust_pkg.pm

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