FS/FS/cust_pkg.pm

   1 package FS::cust_pkg;
   2
   3 use strict;
   4 use vars qw(@ISA $disable_agentcheck $DEBUG);
   5 use Carp qw(cluck);
   6 use Scalar::Util qw( blessed );
   7 use List::Util qw(max);
   8 use Tie::IxHash;
   9 use MIME::Entity;
  10 use FS::UID qw( getotaker dbh );
  11 use FS::Misc qw( send_email );
  12 use FS::Record qw( qsearch qsearchs );
  13 use FS::m2m_Common;
  14 use FS::cust_main_Mixin;
  15 use FS::cust_svc;
  16 use FS::part_pkg;
  17 use FS::cust_main;
  18 use FS::cust_location;
  19 use FS::pkg_svc;
  20 use FS::cust_bill_pkg;
  21 use FS::cust_pkg_detail;
  22 use FS::cust_event;
  23 use FS::h_cust_svc;
  24 use FS::reg_code;
  25 use FS::part_svc;
  26 use FS::cust_pkg_reason;
  27 use FS::reason;
  28 use FS::UI::Web;
  29
  30 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
  31 # setup }
  32 # because they load configuration by setting FS::UID::callback (see TODO)
  33 use FS::svc_acct;
  34 use FS::svc_domain;
  35 use FS::svc_www;
  36 use FS::svc_forward;
  37
  38 # for sending cancel emails in sub cancel
  39 use FS::Conf;
  40
  41 @ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
  42
  43 $DEBUG = 0;
  44
  45 $disable_agentcheck = 0;
  46
  47 sub _cache {
  48   my $self = shift;
  49   my ( $hashref, $cache ) = @_;
  50   #if ( $hashref->{'pkgpart'} ) {
  51   if ( $hashref->{'pkg'} ) {
  52     # #@{ $self->{'_pkgnum'} } = ();
  53     # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
  54     # $self->{'_pkgpart'} = $subcache;
  55     # #push @{ $self->{'_pkgnum'} },
  56     #   FS::part_pkg->new_or_cached($hashref, $subcache);
  57     $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
  58   }
  59   if ( exists $hashref->{'svcnum'} ) {
  60     #@{ $self->{'_pkgnum'} } = ();
  61     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
  62     $self->{'_svcnum'} = $subcache;
  63     #push @{ $self->{'_pkgnum'} },
  64     FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
  65   }
  66 }
  67
  68 =head1 NAME
  69
  70 FS::cust_pkg - Object methods for cust_pkg objects
  71
  72 =head1 SYNOPSIS
  73
  74   use FS::cust_pkg;
  75
  76   $record = new FS::cust_pkg \%hash;
  77   $record = new FS::cust_pkg { 'column' => 'value' };
  78
  79   $error = $record->insert;
  80
  81   $error = $new_record->replace($old_record);
  82
  83   $error = $record->delete;
  84
  85   $error = $record->check;
  86
  87   $error = $record->cancel;
  88
  89   $error = $record->suspend;
  90
  91   $error = $record->unsuspend;
  92
  93   $part_pkg = $record->part_pkg;
  94
  95   @labels = $record->labels;
  96
  97   $seconds = $record->seconds_since($timestamp);
  98
  99   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
 100   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
 101
 102 =head1 DESCRIPTION
 103
 104 An FS::cust_pkg object represents a customer billing item.  FS::cust_pkg
 105 inherits from FS::Record.  The following fields are currently supported:
 106
 107 =over 4
 108
 109 =item pkgnum
 110
 111 Primary key (assigned automatically for new billing items)
 112
 113 =item custnum
 114
 115 Customer (see L<FS::cust_main>)
 116
 117 =item pkgpart
 118
 119 Billing item definition (see L<FS::part_pkg>)
 120
 121 =item locationnum
 122
 123 Optional link to package location (see L<FS::location>)
 124
 125 =item setup
 126
 127 date
 128
 129 =item bill
 130
 131 date (next bill date)
 132
 133 =item last_bill
 134
 135 last bill date
 136
 137 =item adjourn
 138
 139 date
 140
 141 =item susp
 142
 143 date
 144
 145 =item expire
 146
 147 date
 148
 149 =item cancel
 150
 151 date
 152
 153 =item otaker
 154
 155 order taker (assigned automatically if null, see L<FS::UID>)
 156
 157 =item manual_flag
 158
 159 If this field is set to 1, disables the automatic
 160 unsuspension of this package when using the B<unsuspendauto> config option.
 161
 162 =item quantity
 163
 164 If not set, defaults to 1
 165
 166 =item change_date
 167
 168 Date of change from previous package
 169
 170 =item change_pkgnum
 171
 172 Previous pkgnum
 173
 174 =item change_pkgpart
 175
 176 Previous pkgpart
 177
 178 =item change_locationnum
 179
 180 Previous locationnum
 181
 182 =back
 183
 184 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
 185 are specified as UNIX timestamps; see L<perlfunc/"time">.  Also see
 186 L<Time::Local> and L<Date::Parse> for conversion functions.
 187
 188 =head1 METHODS
 189
 190 =over 4
 191
 192 =item new HASHREF
 193
 194 Create a new billing item.  To add the item to the database, see L<"insert">.
 195
 196 =cut
 197
 198 sub table { 'cust_pkg'; }
 199 sub cust_linked { $_[0]->cust_main_custnum; }
 200 sub cust_unlinked_msg {
 201   my $self = shift;
 202   "WARNING: can't find cust_main.custnum ". $self->custnum.
 203   ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
 204 }
 205
 206 =item insert [ OPTION => VALUE ... ]
 207
 208 Adds this billing item to the database ("Orders" the item).  If there is an
 209 error, returns the error, otherwise returns false.
 210
 211 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
 212 will be used to look up the package definition and agent restrictions will be
 213 ignored.
 214
 215 If the additional field I<refnum> is defined, an FS::pkg_referral record will
 216 be created and inserted.  Multiple FS::pkg_referral records can be created by
 217 setting I<refnum> to an array reference of refnums or a hash reference with
 218 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
 219 record will be created corresponding to cust_main.refnum.
 220
 221 The following options are available:
 222
 223 =over 4
 224
 225 =item change
 226
 227 If set true, supresses any referral credit to a referring customer.
 228
 229 =item options
 230
 231 cust_pkg_option records will be created
 232
 233 =item ticket_subject
 234
 235 a ticket will be added to this customer with this subject
 236
 237 =item ticket_queue
 238
 239 an optional queue name for ticket additions
 240
 241 =back
 242
 243 =cut
 244
 245 sub insert {
 246   my( $self, %options ) = @_;
 247
 248   local $SIG{HUP} = 'IGNORE';
 249   local $SIG{INT} = 'IGNORE';
 250   local $SIG{QUIT} = 'IGNORE';
 251   local $SIG{TERM} = 'IGNORE';
 252   local $SIG{TSTP} = 'IGNORE';
 253   local $SIG{PIPE} = 'IGNORE';
 254
 255   my $oldAutoCommit = $FS::UID::AutoCommit;
 256   local $FS::UID::AutoCommit = 0;
 257   my $dbh = dbh;
 258
 259   my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
 260   if ( $error ) {
 261     $dbh->rollback if $oldAutoCommit;
 262     return $error;
 263   }
 264
 265   $self->refnum($self->cust_main->refnum) unless $self->refnum;
 266   $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
 267   $self->process_m2m( 'link_table'   => 'pkg_referral',
 268                       'target_table' => 'part_referral',
 269                       'params'       => $self->refnum,
 270                     );
 271
 272   #if ( $self->reg_code ) {
 273   #  my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
 274   #  $error = $reg_code->delete;
 275   #  if ( $error ) {
 276   #    $dbh->rollback if $oldAutoCommit;
 277   #    return $error;
 278   #  }
 279   #}
 280
 281   my $conf = new FS::Conf;
 282
 283   if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
 284     eval '
 285       use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
 286       use RT;
 287     ';
 288     die $@ if $@;
 289
 290     RT::LoadConfig();
 291     RT::Init();
 292     my $q = new RT::Queue($RT::SystemUser);
 293     $q->Load($options{ticket_queue}) if $options{ticket_queue};
 294     my $t = new RT::Ticket($RT::SystemUser);
 295     my $mime = new MIME::Entity;
 296     $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
 297     $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
 298                 Subject => $options{ticket_subject},
 299                 MIMEObj => $mime,
 300               );
 301     $t->AddLink( Type   => 'MemberOf',
 302                  Target => 'freeside://freeside/cust_main/'. $self->custnum,
 303                );
 304   }
 305
 306   if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
 307     my $queue = new FS::queue {
 308       'job'     => 'FS::cust_main::queueable_print',
 309     };
 310     $error = $queue->insert(
 311       'custnum'  => $self->custnum,
 312       'template' => 'welcome_letter',
 313     );
 314
 315     if ($error) {
 316       warn "can't send welcome letter: $error";
 317     }
 318
 319   }
 320
 321   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 322   '';
 323
 324 }
 325
 326 =item delete
 327
 328 This method now works but you probably shouldn't use it.
 329
 330 You don't want to delete billing items, because there would then be no record
 331 the customer ever purchased the item.  Instead, see the cancel method.
 332
 333 =cut
 334
 335 #sub delete {
 336 #  return "Can't delete cust_pkg records!";
 337 #}
 338
 339 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
 340
 341 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 342 returns the error, otherwise returns false.
 343
 344 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
 345
 346 Changing pkgpart may have disasterous effects.  See the order subroutine.
 347
 348 setup and bill are normally updated by calling the bill method of a customer
 349 object (see L<FS::cust_main>).
 350
 351 suspend is normally updated by the suspend and unsuspend methods.
 352
 353 cancel is normally updated by the cancel method (and also the order subroutine
 354 in some cases).
 355
 356 Available options are:
 357
 358 =over 4
 359
 360 =item reason
 361
 362 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.
 363
 364 =item reason_otaker
 365
 366 the access_user (see L<FS::access_user>) providing the reason
 367
 368 =item options
 369
 370 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
 371
 372 =back
 373
 374 =cut
 375
 376 sub replace {
 377   my $new = shift;
 378
 379   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 380               ? shift
 381               : $new->replace_old;
 382
 383   my $options =
 384     ( ref($_[0]) eq 'HASH' )
 385       ? shift
 386       : { @_ };
 387
 388   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
 389   return "Can't change otaker!" if $old->otaker ne $new->otaker;
 390
 391   #allow this *sigh*
 392   #return "Can't change setup once it exists!"
 393   #  if $old->getfield('setup') &&
 394   #     $old->getfield('setup') != $new->getfield('setup');
 395
 396   #some logic for bill, susp, cancel?
 397
 398   local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
 399
 400   local $SIG{HUP} = 'IGNORE';
 401   local $SIG{INT} = 'IGNORE';
 402   local $SIG{QUIT} = 'IGNORE';
 403   local $SIG{TERM} = 'IGNORE';
 404   local $SIG{TSTP} = 'IGNORE';
 405   local $SIG{PIPE} = 'IGNORE';
 406
 407   my $oldAutoCommit = $FS::UID::AutoCommit;
 408   local $FS::UID::AutoCommit = 0;
 409   my $dbh = dbh;
 410
 411   foreach my $method ( qw(adjourn expire) ) {  # How many reasons?
 412     if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
 413       my $error = $new->insert_reason(
 414         'reason'        => $options->{'reason'},
 415         'date'          => $new->$method,
 416         'action'        => $method,
 417         'reason_otaker' => $options->{'reason_otaker'},
 418       );
 419       if ( $error ) {
 420         dbh->rollback if $oldAutoCommit;
 421         return "Error inserting cust_pkg_reason: $error";
 422       }
 423     }
 424   }
 425
 426   #save off and freeze RADIUS attributes for any associated svc_acct records
 427   my @svc_acct = ();
 428   if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
 429
 430                 #also check for specific exports?
 431                 # to avoid spurious modify export events
 432     @svc_acct = map  { $_->svc_x }
 433                 grep { $_->part_svc->svcdb eq 'svc_acct' }
 434                      $old->cust_svc;
 435
 436     $_->snapshot foreach @svc_acct;
 437
 438   }
 439
 440   my $error = $new->SUPER::replace($old,
 441                                    $options->{options} ? $options->{options} : ()
 442                                   );
 443   if ( $error ) {
 444     $dbh->rollback if $oldAutoCommit;
 445     return $error;
 446   }
 447
 448   #for prepaid packages,
 449   #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
 450   foreach my $old_svc_acct ( @svc_acct ) {
 451     my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
 452     my $s_error = $new_svc_acct->replace($old_svc_acct);
 453     if ( $s_error ) {
 454       $dbh->rollback if $oldAutoCommit;
 455       return $s_error;
 456     }
 457   }
 458
 459   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 460   '';
 461
 462 }
 463
 464 =item check
 465
 466 Checks all fields to make sure this is a valid billing item.  If there is an
 467 error, returns the error, otherwise returns false.  Called by the insert and
 468 replace methods.
 469
 470 =cut
 471
 472 sub check {
 473   my $self = shift;
 474
 475   $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
 476
 477   my $error =
 478     $self->ut_numbern('pkgnum')
 479     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
 480     || $self->ut_numbern('pkgpart')
 481     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 482     || $self->ut_numbern('setup')
 483     || $self->ut_numbern('bill')
 484     || $self->ut_numbern('susp')
 485     || $self->ut_numbern('cancel')
 486     || $self->ut_numbern('adjourn')
 487     || $self->ut_numbern('expire')
 488   ;
 489   return $error if $error;
 490
 491   if ( $self->reg_code ) {
 492
 493     unless ( grep { $self->pkgpart == $_->pkgpart }
 494              map  { $_->reg_code_pkg }
 495              qsearchs( 'reg_code', { 'code'     => $self->reg_code,
 496                                      'agentnum' => $self->cust_main->agentnum })
 497            ) {
 498       return "Unknown registration code";
 499     }
 500
 501   } elsif ( $self->promo_code ) {
 502
 503     my $promo_part_pkg =
 504       qsearchs('part_pkg', {
 505         'pkgpart'    => $self->pkgpart,
 506         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
 507       } );
 508     return 'Unknown promotional code' unless $promo_part_pkg;
 509
 510   } else {
 511
 512     unless ( $disable_agentcheck ) {
 513       my $agent =
 514         qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
 515       return "agent ". $agent->agentnum. ':'. $agent->agent.
 516              " can't purchase pkgpart ". $self->pkgpart
 517         unless $agent->pkgpart_hashref->{ $self->pkgpart }
 518             || $agent->agentnum == $self->part_pkg->agentnum;
 519     }
 520
 521     $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
 522     return $error if $error;
 523
 524   }
 525
 526   $self->otaker(getotaker) unless $self->otaker;
 527   $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
 528   $self->otaker($1);
 529
 530   if ( $self->dbdef_table->column('manual_flag') ) {
 531     $self->manual_flag('') if $self->manual_flag eq ' ';
 532     $self->manual_flag =~ /^([01]?)$/
 533       or return "Illegal manual_flag ". $self->manual_flag;
 534     $self->manual_flag($1);
 535   }
 536
 537   $self->SUPER::check;
 538 }
 539
 540 =item cancel [ OPTION => VALUE ... ]
 541
 542 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 543 in this package, then cancels the package itself (sets the cancel field to
 544 now).
 545
 546 Available options are:
 547
 548 =over 4
 549
 550 =item quiet - can be set true to supress email cancellation notices.
 551
 552 =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.
 553
 554 =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.
 555
 556 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
 557
 558 =back
 559
 560 If there is an error, returns the error, otherwise returns false.
 561
 562 =cut
 563
 564 sub cancel {
 565   my( $self, %options ) = @_;
 566   my $error;
 567
 568   warn "cust_pkg::cancel called with options".
 569        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 570     if $DEBUG;
 571
 572   local $SIG{HUP} = 'IGNORE';
 573   local $SIG{INT} = 'IGNORE';
 574   local $SIG{QUIT} = 'IGNORE';
 575   local $SIG{TERM} = 'IGNORE';
 576   local $SIG{TSTP} = 'IGNORE';
 577   local $SIG{PIPE} = 'IGNORE';
 578
 579   my $oldAutoCommit = $FS::UID::AutoCommit;
 580   local $FS::UID::AutoCommit = 0;
 581   my $dbh = dbh;
 582
 583   my $old = $self->select_for_update;
 584
 585   if ( $old->get('cancel') || $self->get('cancel') ) {
 586     dbh->rollback if $oldAutoCommit;
 587     return "";  # no error
 588   }
 589
 590   my $date = $options{date} if $options{date}; # expire/cancel later
 591   $date = '' if ($date && $date <= time);      # complain instead?
 592
 593   my $cancel_time = $options{'time'} || time;
 594
 595   if ( $options{'reason'} ) {
 596     $error = $self->insert_reason( 'reason' => $options{'reason'},
 597                                    'action' => $date ? 'expire' : 'cancel',
 598                                    'date'   => $date ? $date : $cancel_time,
 599                                    'reason_otaker' => $options{'reason_otaker'},
 600                                  );
 601     if ( $error ) {
 602       dbh->rollback if $oldAutoCommit;
 603       return "Error inserting cust_pkg_reason: $error";
 604     }
 605   }
 606
 607   my %svc;
 608   unless ( $date ) {
 609     foreach my $cust_svc (
 610       #schwartz
 611       map  { $_->[0] }
 612       sort { $a->[1] <=> $b->[1] }
 613       map  { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
 614       qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 615     ) {
 616
 617       my $error = $cust_svc->cancel;
 618
 619       if ( $error ) {
 620         $dbh->rollback if $oldAutoCommit;
 621         return "Error cancelling cust_svc: $error";
 622       }
 623     }
 624
 625     # Add a credit for remaining service
 626     my $remaining_value = $self->calc_remain(time=>$cancel_time);
 627     if ( $remaining_value > 0 && !$options{'no_credit'} ) {
 628       my $conf = new FS::Conf;
 629       my $error = $self->cust_main->credit(
 630         $remaining_value,
 631         'Credit for unused time on '. $self->part_pkg->pkg,
 632         'reason_type' => $conf->config('cancel_credit_type'),
 633       );
 634       if ($error) {
 635         $dbh->rollback if $oldAutoCommit;
 636         return "Error crediting customer \$$remaining_value for unused time on".
 637                $self->part_pkg->pkg. ": $error";
 638       }
 639     }
 640   }
 641
 642   my %hash = $self->hash;
 643   $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
 644   my $new = new FS::cust_pkg ( \%hash );
 645   $error = $new->replace( $self, options => { $self->options } );
 646   if ( $error ) {
 647     $dbh->rollback if $oldAutoCommit;
 648     return $error;
 649   }
 650
 651   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 652   return '' if $date; #no errors
 653
 654   my $conf = new FS::Conf;
 655   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
 656   if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
 657     my $conf = new FS::Conf;
 658     my $error = send_email(
 659       'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
 660       'to'      => \@invoicing_list,
 661       'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
 662       'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
 663     );
 664     #should this do something on errors?
 665   }
 666
 667   ''; #no errors
 668
 669 }
 670
 671 =item cancel_if_expired [ NOW_TIMESTAMP ]
 672
 673 Cancels this package if its expire date has been reached.
 674
 675 =cut
 676
 677 sub cancel_if_expired {
 678   my $self = shift;
 679   my $time = shift || time;
 680   return '' unless $self->expire && $self->expire <= $time;
 681   my $error = $self->cancel;
 682   if ( $error ) {
 683     return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
 684            $self->custnum. ": $error";
 685   }
 686   '';
 687 }
 688
 689 =item unexpire
 690
 691 Cancels any pending expiration (sets the expire field to null).
 692
 693 If there is an error, returns the error, otherwise returns false.
 694
 695 =cut
 696
 697 sub unexpire {
 698   my( $self, %options ) = @_;
 699   my $error;
 700
 701   local $SIG{HUP} = 'IGNORE';
 702   local $SIG{INT} = 'IGNORE';
 703   local $SIG{QUIT} = 'IGNORE';
 704   local $SIG{TERM} = 'IGNORE';
 705   local $SIG{TSTP} = 'IGNORE';
 706   local $SIG{PIPE} = 'IGNORE';
 707
 708   my $oldAutoCommit = $FS::UID::AutoCommit;
 709   local $FS::UID::AutoCommit = 0;
 710   my $dbh = dbh;
 711
 712   my $old = $self->select_for_update;
 713
 714   my $pkgnum = $old->pkgnum;
 715   if ( $old->get('cancel') || $self->get('cancel') ) {
 716     dbh->rollback if $oldAutoCommit;
 717     return "Can't unexpire cancelled package $pkgnum";
 718     # or at least it's pointless
 719   }
 720
 721   unless ( $old->get('expire') && $self->get('expire') ) {
 722     dbh->rollback if $oldAutoCommit;
 723     return "";  # no error
 724   }
 725
 726   my %hash = $self->hash;
 727   $hash{'expire'} = '';
 728   my $new = new FS::cust_pkg ( \%hash );
 729   $error = $new->replace( $self, options => { $self->options } );
 730   if ( $error ) {
 731     $dbh->rollback if $oldAutoCommit;
 732     return $error;
 733   }
 734
 735   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 736
 737   ''; #no errors
 738
 739 }
 740
 741 =item suspend [ OPTION => VALUE ... ]
 742
 743 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 744 package, then suspends the package itself (sets the susp field to now).
 745
 746 Available options are:
 747
 748 =over 4
 749
 750 =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.
 751
 752 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
 753
 754 =back
 755
 756 If there is an error, returns the error, otherwise returns false.
 757
 758 =cut
 759
 760 sub suspend {
 761   my( $self, %options ) = @_;
 762   my $error;
 763
 764   local $SIG{HUP} = 'IGNORE';
 765   local $SIG{INT} = 'IGNORE';
 766   local $SIG{QUIT} = 'IGNORE';
 767   local $SIG{TERM} = 'IGNORE';
 768   local $SIG{TSTP} = 'IGNORE';
 769   local $SIG{PIPE} = 'IGNORE';
 770
 771   my $oldAutoCommit = $FS::UID::AutoCommit;
 772   local $FS::UID::AutoCommit = 0;
 773   my $dbh = dbh;
 774
 775   my $old = $self->select_for_update;
 776
 777   my $pkgnum = $old->pkgnum;
 778   if ( $old->get('cancel') || $self->get('cancel') ) {
 779     dbh->rollback if $oldAutoCommit;
 780     return "Can't suspend cancelled package $pkgnum";
 781   }
 782
 783   if ( $old->get('susp') || $self->get('susp') ) {
 784     dbh->rollback if $oldAutoCommit;
 785     return "";  # no error                     # complain on adjourn?
 786   }
 787
 788   my $date = $options{date} if $options{date}; # adjourn/suspend later
 789   $date = '' if ($date && $date <= time);      # complain instead?
 790
 791   if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
 792     dbh->rollback if $oldAutoCommit;
 793     return "Package $pkgnum expires before it would be suspended.";
 794   }
 795
 796   my $suspend_time = $options{'time'} || time;
 797
 798   if ( $options{'reason'} ) {
 799     $error = $self->insert_reason( 'reason' => $options{'reason'},
 800                                    'action' => $date ? 'adjourn' : 'suspend',
 801                                    'date'   => $date ? $date : $suspend_time,
 802                                    'reason_otaker' => $options{'reason_otaker'},
 803                                  );
 804     if ( $error ) {
 805       dbh->rollback if $oldAutoCommit;
 806       return "Error inserting cust_pkg_reason: $error";
 807     }
 808   }
 809
 810   unless ( $date ) {
 811
 812     my @labels = ();
 813
 814     foreach my $cust_svc (
 815       qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 816     ) {
 817       my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 818
 819       $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 820         $dbh->rollback if $oldAutoCommit;
 821         return "Illegal svcdb value in part_svc!";
 822       };
 823       my $svcdb = $1;
 824       require "FS/$svcdb.pm";
 825
 826       my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 827       if ($svc) {
 828         $error = $svc->suspend;
 829         if ( $error ) {
 830           $dbh->rollback if $oldAutoCommit;
 831           return $error;
 832         }
 833         my( $label, $value ) = $cust_svc->label;
 834         push @labels, "$label: $value";
 835       }
 836     }
 837
 838     my $conf = new FS::Conf;
 839     if ( $conf->config('suspend_email_admin') ) {
 840
 841       my $error = send_email(
 842         'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
 843                                    #invoice_from ??? well as good as any
 844         'to'      => $conf->config('suspend_email_admin'),
 845         'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
 846         'body'    => [
 847           "This is an automatic message from your Freeside installation\n",
 848           "informing you that the following customer package has been suspended:\n",
 849           "\n",
 850           'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
 851           'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
 852           ( map { "Service : $_\n" } @labels ),
 853         ],
 854       );
 855
 856       if ( $error ) {
 857         warn "WARNING: can't send suspension admin email (suspending anyway): ".
 858              "$error\n";
 859       }
 860
 861     }
 862
 863   }
 864
 865   my %hash = $self->hash;
 866   if ( $date ) {
 867     $hash{'adjourn'} = $date;
 868   } else {
 869     $hash{'susp'} = $suspend_time;
 870   }
 871   my $new = new FS::cust_pkg ( \%hash );
 872   $error = $new->replace( $self, options => { $self->options } );
 873   if ( $error ) {
 874     $dbh->rollback if $oldAutoCommit;
 875     return $error;
 876   }
 877
 878   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 879
 880   ''; #no errors
 881 }
 882
 883 =item unsuspend [ OPTION => VALUE ... ]
 884
 885 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 886 package, then unsuspends the package itself (clears the susp field and the
 887 adjourn field if it is in the past).
 888
 889 Available options are:
 890
 891 =over 4
 892
 893 =item adjust_next_bill
 894
 895 Can be set true to adjust the next bill date forward by
 896 the amount of time the account was inactive.  This was set true by default
 897 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
 898 explicitly requested.  Price plans for which this makes sense (anniversary-date
 899 based than prorate or subscription) could have an option to enable this
 900 behaviour?
 901
 902 =back
 903
 904 If there is an error, returns the error, otherwise returns false.
 905
 906 =cut
 907
 908 sub unsuspend {
 909   my( $self, %opt ) = @_;
 910   my $error;
 911
 912   local $SIG{HUP} = 'IGNORE';
 913   local $SIG{INT} = 'IGNORE';
 914   local $SIG{QUIT} = 'IGNORE';
 915   local $SIG{TERM} = 'IGNORE';
 916   local $SIG{TSTP} = 'IGNORE';
 917   local $SIG{PIPE} = 'IGNORE';
 918
 919   my $oldAutoCommit = $FS::UID::AutoCommit;
 920   local $FS::UID::AutoCommit = 0;
 921   my $dbh = dbh;
 922
 923   my $old = $self->select_for_update;
 924
 925   my $pkgnum = $old->pkgnum;
 926   if ( $old->get('cancel') || $self->get('cancel') ) {
 927     dbh->rollback if $oldAutoCommit;
 928     return "Can't unsuspend cancelled package $pkgnum";
 929   }
 930
 931   unless ( $old->get('susp') && $self->get('susp') ) {
 932     dbh->rollback if $oldAutoCommit;
 933     return "";  # no error                     # complain instead?
 934   }
 935
 936   foreach my $cust_svc (
 937     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
 938   ) {
 939     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 940
 941     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 942       $dbh->rollback if $oldAutoCommit;
 943       return "Illegal svcdb value in part_svc!";
 944     };
 945     my $svcdb = $1;
 946     require "FS/$svcdb.pm";
 947
 948     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 949     if ($svc) {
 950       $error = $svc->unsuspend;
 951       if ( $error ) {
 952         $dbh->rollback if $oldAutoCommit;
 953         return $error;
 954       }
 955     }
 956
 957   }
 958
 959   my %hash = $self->hash;
 960   my $inactive = time - $hash{'susp'};
 961
 962   my $conf = new FS::Conf;
 963
 964   $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
 965     if ( $opt{'adjust_next_bill'}
 966          || $conf->exists('unsuspend-always_adjust_next_bill_date') )
 967     && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
 968
 969   $hash{'susp'} = '';
 970   $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
 971   my $new = new FS::cust_pkg ( \%hash );
 972   $error = $new->replace( $self, options => { $self->options } );
 973   if ( $error ) {
 974     $dbh->rollback if $oldAutoCommit;
 975     return $error;
 976   }
 977
 978   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 979
 980   ''; #no errors
 981 }
 982
 983 =item unadjourn
 984
 985 Cancels any pending suspension (sets the adjourn field to null).
 986
 987 If there is an error, returns the error, otherwise returns false.
 988
 989 =cut
 990
 991 sub unadjourn {
 992   my( $self, %options ) = @_;
 993   my $error;
 994
 995   local $SIG{HUP} = 'IGNORE';
 996   local $SIG{INT} = 'IGNORE';
 997   local $SIG{QUIT} = 'IGNORE';
 998   local $SIG{TERM} = 'IGNORE';
 999   local $SIG{TSTP} = 'IGNORE';
1000   local $SIG{PIPE} = 'IGNORE';
1001
1002   my $oldAutoCommit = $FS::UID::AutoCommit;
1003   local $FS::UID::AutoCommit = 0;
1004   my $dbh = dbh;
1005
1006   my $old = $self->select_for_update;
1007
1008   my $pkgnum = $old->pkgnum;
1009   if ( $old->get('cancel') || $self->get('cancel') ) {
1010     dbh->rollback if $oldAutoCommit;
1011     return "Can't unadjourn cancelled package $pkgnum";
1012     # or at least it's pointless
1013   }
1014
1015   if ( $old->get('susp') || $self->get('susp') ) {
1016     dbh->rollback if $oldAutoCommit;
1017     return "Can't unadjourn suspended package $pkgnum";
1018     # perhaps this is arbitrary
1019   }
1020
1021   unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1022     dbh->rollback if $oldAutoCommit;
1023     return "";  # no error
1024   }
1025
1026   my %hash = $self->hash;
1027   $hash{'adjourn'} = '';
1028   my $new = new FS::cust_pkg ( \%hash );
1029   $error = $new->replace( $self, options => { $self->options } );
1030   if ( $error ) {
1031     $dbh->rollback if $oldAutoCommit;
1032     return $error;
1033   }
1034
1035   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1036
1037   ''; #no errors
1038
1039 }
1040
1041
1042 =item change HASHREF | OPTION => VALUE ...
1043
1044 Changes this package: cancels it and creates a new one, with a different
1045 pkgpart or locationnum or both.  All services are transferred to the new
1046 package (no change will be made if this is not possible).
1047
1048 Options may be passed as a list of key/value pairs or as a hash reference.
1049 Options are:
1050
1051 =over 4
1052
1053 =item locaitonnum
1054
1055 New locationnum, to change the location for this package.
1056
1057 =item cust_location
1058
1059 New FS::cust_location object, to create a new location and assign it
1060 to this package.
1061
1062 =item pkgpart
1063
1064 New pkgpart (see L<FS::part_pkg>).
1065
1066 =item refnum
1067
1068 New refnum (see L<FS::part_referral>).
1069
1070 =back
1071
1072 At least one option must be specified (otherwise, what's the point?)
1073
1074 Returns either the new FS::cust_pkg object or a scalar error.
1075
1076 For example:
1077
1078   my $err_or_new_cust_pkg = $old_cust_pkg->change
1079
1080 =cut
1081
1082 #some false laziness w/order
1083 sub change {
1084   my $self = shift;
1085   my $opt = ref($_[0]) ? shift : { @_ };
1086
1087 #  my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1088 #
1089
1090   my $conf = new FS::Conf;
1091
1092   # Transactionize this whole mess
1093   local $SIG{HUP} = 'IGNORE';
1094   local $SIG{INT} = 'IGNORE';
1095   local $SIG{QUIT} = 'IGNORE';
1096   local $SIG{TERM} = 'IGNORE';
1097   local $SIG{TSTP} = 'IGNORE';
1098   local $SIG{PIPE} = 'IGNORE';
1099
1100   my $oldAutoCommit = $FS::UID::AutoCommit;
1101   local $FS::UID::AutoCommit = 0;
1102   my $dbh = dbh;
1103
1104   my $error;
1105
1106   my %hash = ();
1107
1108   my $time = time;
1109
1110   #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1111
1112   #$hash{$_} = $self->$_() foreach qw( setup );
1113
1114   $hash{'setup'} = $time if $self->setup;
1115
1116   $hash{'change_date'} = $time;
1117   $hash{"change_$_"}  = $self->$_()
1118     foreach qw( pkgnum pkgpart locationnum );
1119
1120   if ( $opt->{'cust_location'} &&
1121        ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1122     $error = $opt->{'cust_location'}->insert;
1123     if ( $error ) {
1124       $dbh->rollback if $oldAutoCommit;
1125       return "inserting cust_location (transaction rolled back): $error";
1126     }
1127     $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1128   }
1129
1130   # Create the new package.
1131   my $cust_pkg = new FS::cust_pkg {
1132     custnum      => $self->custnum,
1133     pkgpart      => ( $opt->{'pkgpart'}     || $self->pkgpart      ),
1134     refnum       => ( $opt->{'refnum'}      || $self->refnum       ),
1135     locationnum  => ( $opt->{'locationnum'} || $self->locationnum  ),
1136     %hash,
1137   };
1138
1139   $error = $cust_pkg->insert( 'change' => 1 );
1140   if ($error) {
1141     $dbh->rollback if $oldAutoCommit;
1142     return $error;
1143   }
1144
1145   # Transfer services and cancel old package.
1146
1147   $error = $self->transfer($cust_pkg);
1148   if ($error and $error == 0) {
1149     # $old_pkg->transfer failed.
1150     $dbh->rollback if $oldAutoCommit;
1151     return $error;
1152   }
1153
1154   if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1155     warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1156     $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1157     if ($error and $error == 0) {
1158       # $old_pkg->transfer failed.
1159       $dbh->rollback if $oldAutoCommit;
1160       return $error;
1161     }
1162   }
1163
1164   if ($error > 0) {
1165     # Transfers were successful, but we still had services left on the old
1166     # package.  We can't change the package under this circumstances, so abort.
1167     $dbh->rollback if $oldAutoCommit;
1168     return "Unable to transfer all services from package ". $self->pkgnum;
1169   }
1170
1171   #reset usage if changing pkgpart
1172   if ($self->pkgpart != $cust_pkg->pkgpart) {
1173     my $part_pkg = $cust_pkg->part_pkg;
1174     $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1175                                                  ? ()
1176                                                  : ( 'null' => 1 )
1177                                    )
1178       if $part_pkg->can('reset_usage');
1179
1180     if ($error) {
1181       $dbh->rollback if $oldAutoCommit;
1182       return "Error setting usage values: $error";
1183     }
1184   }
1185
1186   #Good to go, cancel old package.
1187   $error = $self->cancel( quiet=>1 );
1188   if ($error) {
1189     $dbh->rollback;
1190     return $error;
1191   }
1192
1193   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1194   $cust_pkg;
1195
1196 }
1197
1198 =item last_bill
1199
1200 Returns the last bill date, or if there is no last bill date, the setup date.
1201 Useful for billing metered services.
1202
1203 =cut
1204
1205 sub last_bill {
1206   my $self = shift;
1207   return $self->setfield('last_bill', $_[0]) if @_;
1208   return $self->getfield('last_bill') if $self->getfield('last_bill');
1209   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1210                                                   'edate'  => $self->bill,  } );
1211   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1212 }
1213
1214 =item last_cust_pkg_reason ACTION
1215
1216 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1217 Returns false if there is no reason or the package is not currenly ACTION'd
1218 ACTION is one of adjourn, susp, cancel, or expire.
1219
1220 =cut
1221
1222 sub last_cust_pkg_reason {
1223   my ( $self, $action ) = ( shift, shift );
1224   my $date = $self->get($action);
1225   qsearchs( {
1226               'table' => 'cust_pkg_reason',
1227               'hashref' => { 'pkgnum' => $self->pkgnum,
1228                              'action' => substr(uc($action), 0, 1),
1229                              'date'   => $date,
1230                            },
1231               'order_by' => 'ORDER BY num DESC LIMIT 1',
1232            } );
1233 }
1234
1235 =item last_reason ACTION
1236
1237 Returns the most recent ACTION FS::reason associated with the package.
1238 Returns false if there is no reason or the package is not currenly ACTION'd
1239 ACTION is one of adjourn, susp, cancel, or expire.
1240
1241 =cut
1242
1243 sub last_reason {
1244   my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1245   $cust_pkg_reason->reason
1246     if $cust_pkg_reason;
1247 }
1248
1249 =item part_pkg
1250
1251 Returns the definition for this billing item, as an FS::part_pkg object (see
1252 L<FS::part_pkg>).
1253
1254 =cut
1255
1256 sub part_pkg {
1257   my $self = shift;
1258   return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1259   cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1260   qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1261 }
1262
1263 =item old_cust_pkg
1264
1265 Returns the cancelled package this package was changed from, if any.
1266
1267 =cut
1268
1269 sub old_cust_pkg {
1270   my $self = shift;
1271   return '' unless $self->change_pkgnum;
1272   qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1273 }
1274
1275 =item calc_setup
1276
1277 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1278 item.
1279
1280 =cut
1281
1282 sub calc_setup {
1283   my $self = shift;
1284   $self->part_pkg->calc_setup($self, @_);
1285 }
1286
1287 =item calc_recur
1288
1289 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1290 item.
1291
1292 =cut
1293
1294 sub calc_recur {
1295   my $self = shift;
1296   $self->part_pkg->calc_recur($self, @_);
1297 }
1298
1299 =item calc_remain
1300
1301 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1302 billing item.
1303
1304 =cut
1305
1306 sub calc_remain {
1307   my $self = shift;
1308   $self->part_pkg->calc_remain($self, @_);
1309 }
1310
1311 =item calc_cancel
1312
1313 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1314 billing item.
1315
1316 =cut
1317
1318 sub calc_cancel {
1319   my $self = shift;
1320   $self->part_pkg->calc_cancel($self, @_);
1321 }
1322
1323 =item cust_bill_pkg
1324
1325 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1326
1327 =cut
1328
1329 sub cust_bill_pkg {
1330   my $self = shift;
1331   qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1332 }
1333
1334 =item cust_pkg_detail [ DETAILTYPE ]
1335
1336 Returns any customer package details for this package (see
1337 L<FS::cust_pkg_detail>).
1338
1339 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1340
1341 =cut
1342
1343 sub cust_pkg_detail {
1344   my $self = shift;
1345   my %hash = ( 'pkgnum' => $self->pkgnum );
1346   $hash{detailtype} = shift if @_;
1347   qsearch({
1348     'table'    => 'cust_pkg_detail',
1349     'hashref'  => \%hash,
1350     'order_by' => 'ORDER BY weight, pkgdetailnum',
1351   });
1352 }
1353
1354 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1355
1356 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1357
1358 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1359
1360 If there is an error, returns the error, otherwise returns false.
1361
1362 =cut
1363
1364 sub set_cust_pkg_detail {
1365   my( $self, $detailtype, @details ) = @_;
1366
1367   local $SIG{HUP} = 'IGNORE';
1368   local $SIG{INT} = 'IGNORE';
1369   local $SIG{QUIT} = 'IGNORE';
1370   local $SIG{TERM} = 'IGNORE';
1371   local $SIG{TSTP} = 'IGNORE';
1372   local $SIG{PIPE} = 'IGNORE';
1373
1374   my $oldAutoCommit = $FS::UID::AutoCommit;
1375   local $FS::UID::AutoCommit = 0;
1376   my $dbh = dbh;
1377
1378   foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1379     my $error = $current->delete;
1380     if ( $error ) {
1381       $dbh->rollback if $oldAutoCommit;
1382       return "error removing old detail: $error";
1383     }
1384   }
1385
1386   foreach my $detail ( @details ) {
1387     my $cust_pkg_detail = new FS::cust_pkg_detail {
1388       'pkgnum'     => $self->pkgnum,
1389       'detailtype' => $detailtype,
1390       'detail'     => $detail,
1391     };
1392     my $error = $cust_pkg_detail->insert;
1393     if ( $error ) {
1394       $dbh->rollback if $oldAutoCommit;
1395       return "error adding new detail: $error";
1396     }
1397
1398   }
1399
1400   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1401   '';
1402
1403 }
1404
1405 =item cust_event
1406
1407 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1408
1409 =cut
1410
1411 #false laziness w/cust_bill.pm
1412 sub cust_event {
1413   my $self = shift;
1414   qsearch({
1415     'table'     => 'cust_event',
1416     'addl_from' => 'JOIN part_event USING ( eventpart )',
1417     'hashref'   => { 'tablenum' => $self->pkgnum },
1418     'extra_sql' => " AND eventtable = 'cust_pkg' ",
1419   });
1420 }
1421
1422 =item num_cust_event
1423
1424 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1425
1426 =cut
1427
1428 #false laziness w/cust_bill.pm
1429 sub num_cust_event {
1430   my $self = shift;
1431   my $sql =
1432     "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1433     "  WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1434   my $sth = dbh->prepare($sql) or die  dbh->errstr. " preparing $sql";
1435   $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1436   $sth->fetchrow_arrayref->[0];
1437 }
1438
1439 =item cust_svc [ SVCPART ]
1440
1441 Returns the services for this package, as FS::cust_svc objects (see
1442 L<FS::cust_svc>).  If a svcpart is specified, return only the matching
1443 services.
1444
1445 =cut
1446
1447 sub cust_svc {
1448   my $self = shift;
1449
1450   return () unless $self->num_cust_svc(@_);
1451
1452   if ( @_ ) {
1453     return qsearch( 'cust_svc', { 'pkgnum'  => $self->pkgnum,
1454                                   'svcpart' => shift,          } );
1455   }
1456
1457   cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1458
1459   #if ( $self->{'_svcnum'} ) {
1460   #  values %{ $self->{'_svcnum'}->cache };
1461   #} else {
1462     $self->_sort_cust_svc(
1463       [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1464     );
1465   #}
1466
1467 }
1468
1469 =item overlimit [ SVCPART ]
1470
1471 Returns the services for this package which have exceeded their
1472 usage limit as FS::cust_svc objects (see L<FS::cust_svc>).  If a svcpart
1473 is specified, return only the matching services.
1474
1475 =cut
1476
1477 sub overlimit {
1478   my $self = shift;
1479   return () unless $self->num_cust_svc(@_);
1480   grep { $_->overlimit } $self->cust_svc(@_);
1481 }
1482
1483 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1484
1485 Returns historical services for this package created before END TIMESTAMP and
1486 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1487 (see L<FS::h_cust_svc>).
1488
1489 =cut
1490
1491 sub h_cust_svc {
1492   my $self = shift;
1493
1494   $self->_sort_cust_svc(
1495     [ qsearch( 'h_cust_svc',
1496                { 'pkgnum' => $self->pkgnum, },
1497                FS::h_cust_svc->sql_h_search(@_),
1498              )
1499     ]
1500   );
1501 }
1502
1503 sub _sort_cust_svc {
1504   my( $self, $arrayref ) = @_;
1505
1506   map  { $_->[0] }
1507   sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
1508   map {
1509         my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1510                                              'svcpart' => $_->svcpart     } );
1511         [ $_,
1512           $pkg_svc ? $pkg_svc->primary_svc : '',
1513           $pkg_svc ? $pkg_svc->quantity : 0,
1514         ];
1515       }
1516   @$arrayref;
1517
1518 }
1519
1520 =item num_cust_svc [ SVCPART ]
1521
1522 Returns the number of provisioned services for this package.  If a svcpart is
1523 specified, counts only the matching services.
1524
1525 =cut
1526
1527 sub num_cust_svc {
1528   my $self = shift;
1529
1530   return $self->{'_num_cust_svc'}
1531     if !scalar(@_)
1532        && exists($self->{'_num_cust_svc'})
1533        && $self->{'_num_cust_svc'} =~ /\d/;
1534
1535   cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1536     if $DEBUG > 2;
1537
1538   my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1539   $sql .= ' AND svcpart = ?' if @_;
1540
1541   my $sth = dbh->prepare($sql)     or die  dbh->errstr;
1542   $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1543   $sth->fetchrow_arrayref->[0];
1544 }
1545
1546 =item available_part_svc
1547
1548 Returns a list of FS::part_svc objects representing services included in this
1549 package but not yet provisioned.  Each FS::part_svc object also has an extra
1550 field, I<num_avail>, which specifies the number of available services.
1551
1552 =cut
1553
1554 sub available_part_svc {
1555   my $self = shift;
1556   grep { $_->num_avail > 0 }
1557     map {
1558           my $part_svc = $_->part_svc;
1559           $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1560             $_->quantity - $self->num_cust_svc($_->svcpart);
1561           $part_svc;
1562         }
1563       $self->part_pkg->pkg_svc;
1564 }
1565
1566 =item part_svc
1567
1568 Returns a list of FS::part_svc objects representing provisioned and available
1569 services included in this package.  Each FS::part_svc object also has the
1570 following extra fields:
1571
1572 =over 4
1573
1574 =item num_cust_svc  (count)
1575
1576 =item num_avail     (quantity - count)
1577
1578 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1579
1580 svcnum
1581 label -> ($cust_svc->label)[1]
1582
1583 =back
1584
1585 =cut
1586
1587 sub part_svc {
1588   my $self = shift;
1589
1590   #XXX some sort of sort order besides numeric by svcpart...
1591   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1592     my $pkg_svc = $_;
1593     my $part_svc = $pkg_svc->part_svc;
1594     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1595     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1596     $part_svc->{'Hash'}{'num_avail'}    =
1597       max( 0, $pkg_svc->quantity - $num_cust_svc );
1598     $part_svc->{'Hash'}{'cust_pkg_svc'} =
1599       $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1600     $part_svc;
1601   } $self->part_pkg->pkg_svc;
1602
1603   #extras
1604   push @part_svc, map {
1605     my $part_svc = $_;
1606     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1607     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1608     $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
1609     $part_svc->{'Hash'}{'cust_pkg_svc'} =
1610       $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1611     $part_svc;
1612   } $self->extra_part_svc;
1613
1614   @part_svc;
1615
1616 }
1617
1618 =item extra_part_svc
1619
1620 Returns a list of FS::part_svc objects corresponding to services in this
1621 package which are still provisioned but not (any longer) available in the
1622 package definition.
1623
1624 =cut
1625
1626 sub extra_part_svc {
1627   my $self = shift;
1628
1629   my $pkgnum  = $self->pkgnum;
1630   my $pkgpart = $self->pkgpart;
1631
1632 #  qsearch( {
1633 #    'table'     => 'part_svc',
1634 #    'hashref'   => {},
1635 #    'extra_sql' =>
1636 #      "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1637 #                     WHERE pkg_svc.svcpart = part_svc.svcpart
1638 #                       AND pkg_svc.pkgpart = ?
1639 #                       AND quantity > 0
1640 #                 )
1641 #        AND 0 < ( SELECT COUNT(*) FROM cust_svc
1642 #                       LEFT JOIN cust_pkg USING ( pkgnum )
1643 #                     WHERE cust_svc.svcpart = part_svc.svcpart
1644 #                       AND pkgnum = ?
1645 #                 )",
1646 #    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1647 #  } );
1648
1649 #seems to benchmark slightly faster...
1650   qsearch( {
1651     'select'      => 'DISTINCT ON (svcpart) part_svc.*',
1652     'table'       => 'part_svc',
1653     'addl_from'   =>
1654       'LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart
1655                                AND pkg_svc.pkgpart   = ?
1656                                AND quantity > 0
1657                              )
1658        LEFT JOIN cust_svc ON (     cust_svc.svcpart = part_svc.svcpart )
1659        LEFT JOIN cust_pkg USING ( pkgnum )
1660       ',
1661     'hashref'     => {},
1662     'extra_sql'   => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1663     'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1664   } );
1665 }
1666
1667 =item status
1668
1669 Returns a short status string for this package, currently:
1670
1671 =over 4
1672
1673 =item not yet billed
1674
1675 =item one-time charge
1676
1677 =item active
1678
1679 =item suspended
1680
1681 =item cancelled
1682
1683 =back
1684
1685 =cut
1686
1687 sub status {
1688   my $self = shift;
1689
1690   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1691
1692   return 'cancelled' if $self->get('cancel');
1693   return 'suspended' if $self->susp;
1694   return 'not yet billed' unless $self->setup;
1695   return 'one-time charge' if $freq =~ /^(0|$)/;
1696   return 'active';
1697 }
1698
1699 =item statuses
1700
1701 Class method that returns the list of possible status strings for packages
1702 (see L<the status method|/status>).  For example:
1703
1704   @statuses = FS::cust_pkg->statuses();
1705
1706 =cut
1707
1708 tie my %statuscolor, 'Tie::IxHash',
1709   'not yet billed'  => '000000',
1710   'one-time charge' => '000000',
1711   'active'          => '00CC00',
1712   'suspended'       => 'FF9900',
1713   'cancelled'       => 'FF0000',
1714 ;
1715
1716 sub statuses {
1717   my $self = shift; #could be class...
1718   #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1719   #                                    # mayble split btw one-time vs. recur
1720     keys %statuscolor;
1721 }
1722
1723 =item statuscolor
1724
1725 Returns a hex triplet color string for this package's status.
1726
1727 =cut
1728
1729 sub statuscolor {
1730   my $self = shift;
1731   $statuscolor{$self->status};
1732 }
1733
1734 =item labels
1735
1736 Returns a list of lists, calling the label method for all services
1737 (see L<FS::cust_svc>) of this billing item.
1738
1739 =cut
1740
1741 sub labels {
1742   my $self = shift;
1743   map { [ $_->label ] } $self->cust_svc;
1744 }
1745
1746 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1747
1748 Like the labels method, but returns historical information on services that
1749 were active as of END_TIMESTAMP and (optionally) not cancelled before
1750 START_TIMESTAMP.
1751
1752 Returns a list of lists, calling the label method for all (historical) services
1753 (see L<FS::h_cust_svc>) of this billing item.
1754
1755 =cut
1756
1757 sub h_labels {
1758   my $self = shift;
1759   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1760 }
1761
1762 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1763
1764 Like h_labels, except returns a simple flat list, and shortens long
1765 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1766 identical services to one line that lists the service label and the number of
1767 individual services rather than individual items.
1768
1769 =cut
1770
1771 sub h_labels_short {
1772   my $self = shift;
1773
1774   my $conf = new FS::Conf;
1775   my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1776
1777   my %labels;
1778   #tie %labels, 'Tie::IxHash';
1779   push @{ $labels{$_->[0]} }, $_->[1]
1780     foreach $self->h_labels(@_);
1781   my @labels;
1782   foreach my $label ( keys %labels ) {
1783     my %seen = ();
1784     my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1785     my $num = scalar(@values);
1786     if ( $num > $max_same_services ) {
1787       push @labels, "$label ($num)";
1788     } else {
1789       push @labels, map { "$label: $_" } @values;
1790     }
1791   }
1792
1793  @labels;
1794
1795 }
1796
1797 =item cust_main
1798
1799 Returns the parent customer object (see L<FS::cust_main>).
1800
1801 =cut
1802
1803 sub cust_main {
1804   my $self = shift;
1805   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1806 }
1807
1808 =item cust_location
1809
1810 Returns the location object, if any (see L<FS::cust_location>).
1811
1812 =cut
1813
1814 sub cust_location {
1815   my $self = shift;
1816   return '' unless $self->locationnum;
1817   qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1818 }
1819
1820 =item cust_location_or_main
1821
1822 If this package is associated with a location, returns the locaiton (see
1823 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1824
1825 =cut
1826
1827 sub cust_location_or_main {
1828   my $self = shift;
1829   $self->cust_location || $self->cust_main;
1830 }
1831
1832 =item seconds_since TIMESTAMP
1833
1834 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1835 package have been online since TIMESTAMP, according to the session monitor.
1836
1837 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
1838 L<Time::Local> and L<Date::Parse> for conversion functions.
1839
1840 =cut
1841
1842 sub seconds_since {
1843   my($self, $since) = @_;
1844   my $seconds = 0;
1845
1846   foreach my $cust_svc (
1847     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1848   ) {
1849     $seconds += $cust_svc->seconds_since($since);
1850   }
1851
1852   $seconds;
1853
1854 }
1855
1856 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1857
1858 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1859 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1860 (exclusive).
1861
1862 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1863 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
1864 functions.
1865
1866
1867 =cut
1868
1869 sub seconds_since_sqlradacct {
1870   my($self, $start, $end) = @_;
1871
1872   my $seconds = 0;
1873
1874   foreach my $cust_svc (
1875     grep {
1876       my $part_svc = $_->part_svc;
1877       $part_svc->svcdb eq 'svc_acct'
1878         && scalar($part_svc->part_export('sqlradius'));
1879     } $self->cust_svc
1880   ) {
1881     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1882   }
1883
1884   $seconds;
1885
1886 }
1887
1888 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1889
1890 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1891 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1892 TIMESTAMP_END
1893 (exclusive).
1894
1895 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1896 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
1897 functions.
1898
1899 =cut
1900
1901 sub attribute_since_sqlradacct {
1902   my($self, $start, $end, $attrib) = @_;
1903
1904   my $sum = 0;
1905
1906   foreach my $cust_svc (
1907     grep {
1908       my $part_svc = $_->part_svc;
1909       $part_svc->svcdb eq 'svc_acct'
1910         && scalar($part_svc->part_export('sqlradius'));
1911     } $self->cust_svc
1912   ) {
1913     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1914   }
1915
1916   $sum;
1917
1918 }
1919
1920 =item quantity
1921
1922 =cut
1923
1924 sub quantity {
1925   my( $self, $value ) = @_;
1926   if ( defined($value) ) {
1927     $self->setfield('quantity', $value);
1928   }
1929   $self->getfield('quantity') || 1;
1930 }
1931
1932 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1933
1934 Transfers as many services as possible from this package to another package.
1935
1936 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1937 object.  The destination package must already exist.
1938
1939 Services are moved only if the destination allows services with the correct
1940 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
1941 this option with caution!  No provision is made for export differences
1942 between the old and new service definitions.  Probably only should be used
1943 when your exports for all service definitions of a given svcdb are identical.
1944 (attempt a transfer without it first, to move all possible svcpart-matching
1945 services)
1946
1947 Any services that can't be moved remain in the original package.
1948
1949 Returns an error, if there is one; otherwise, returns the number of services
1950 that couldn't be moved.
1951
1952 =cut
1953
1954 sub transfer {
1955   my ($self, $dest_pkgnum, %opt) = @_;
1956
1957   my $remaining = 0;
1958   my $dest;
1959   my %target;
1960
1961   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1962     $dest = $dest_pkgnum;
1963     $dest_pkgnum = $dest->pkgnum;
1964   } else {
1965     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1966   }
1967
1968   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1969
1970   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1971     $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1972   }
1973
1974   foreach my $cust_svc ($dest->cust_svc) {
1975     $target{$cust_svc->svcpart}--;
1976   }
1977
1978   my %svcpart2svcparts = ();
1979   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1980     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1981     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1982       next if exists $svcpart2svcparts{$svcpart};
1983       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1984       $svcpart2svcparts{$svcpart} = [
1985         map  { $_->[0] }
1986         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
1987         map {
1988               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1989                                                    'svcpart' => $_          } );
1990               [ $_,
1991                 $pkg_svc ? $pkg_svc->primary_svc : '',
1992                 $pkg_svc ? $pkg_svc->quantity : 0,
1993               ];
1994             }
1995
1996         grep { $_ != $svcpart }
1997         map  { $_->svcpart }
1998         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1999       ];
2000       warn "alternates for svcpart $svcpart: ".
2001            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2002         if $DEBUG;
2003     }
2004   }
2005
2006   foreach my $cust_svc ($self->cust_svc) {
2007     if($target{$cust_svc->svcpart} > 0) {
2008       $target{$cust_svc->svcpart}--;
2009       my $new = new FS::cust_svc { $cust_svc->hash };
2010       $new->pkgnum($dest_pkgnum);
2011       my $error = $new->replace($cust_svc);
2012       return $error if $error;
2013     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2014       if ( $DEBUG ) {
2015         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2016         warn "alternates to consider: ".
2017              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2018       }
2019       my @alternate = grep {
2020                              warn "considering alternate svcpart $_: ".
2021                                   "$target{$_} available in new package\n"
2022                                if $DEBUG;
2023                              $target{$_} > 0;
2024                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
2025       if ( @alternate ) {
2026         warn "alternate(s) found\n" if $DEBUG;
2027         my $change_svcpart = $alternate[0];
2028         $target{$change_svcpart}--;
2029         my $new = new FS::cust_svc { $cust_svc->hash };
2030         $new->svcpart($change_svcpart);
2031         $new->pkgnum($dest_pkgnum);
2032         my $error = $new->replace($cust_svc);
2033         return $error if $error;
2034       } else {
2035         $remaining++;
2036       }
2037     } else {
2038       $remaining++
2039     }
2040   }
2041   return $remaining;
2042 }
2043
2044 =item reexport
2045
2046 This method is deprecated.  See the I<depend_jobnum> option to the insert and
2047 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2048
2049 =cut
2050
2051 sub reexport {
2052   my $self = shift;
2053
2054   local $SIG{HUP} = 'IGNORE';
2055   local $SIG{INT} = 'IGNORE';
2056   local $SIG{QUIT} = 'IGNORE';
2057   local $SIG{TERM} = 'IGNORE';
2058   local $SIG{TSTP} = 'IGNORE';
2059   local $SIG{PIPE} = 'IGNORE';
2060
2061   my $oldAutoCommit = $FS::UID::AutoCommit;
2062   local $FS::UID::AutoCommit = 0;
2063   my $dbh = dbh;
2064
2065   foreach my $cust_svc ( $self->cust_svc ) {
2066     #false laziness w/svc_Common::insert
2067     my $svc_x = $cust_svc->svc_x;
2068     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2069       my $error = $part_export->export_insert($svc_x);
2070       if ( $error ) {
2071         $dbh->rollback if $oldAutoCommit;
2072         return $error;
2073       }
2074     }
2075   }
2076
2077   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2078   '';
2079
2080 }
2081
2082 =back
2083
2084 =head1 CLASS METHODS
2085
2086 =over 4
2087
2088 =item recurring_sql
2089
2090 Returns an SQL expression identifying recurring packages.
2091
2092 =cut
2093
2094 sub recurring_sql { "
2095   '0' != ( select freq from part_pkg
2096              where cust_pkg.pkgpart = part_pkg.pkgpart )
2097 "; }
2098
2099 =item onetime_sql
2100
2101 Returns an SQL expression identifying one-time packages.
2102
2103 =cut
2104
2105 sub onetime_sql { "
2106   '0' = ( select freq from part_pkg
2107             where cust_pkg.pkgpart = part_pkg.pkgpart )
2108 "; }
2109
2110 =item active_sql
2111
2112 Returns an SQL expression identifying active packages.
2113
2114 =cut
2115
2116 sub active_sql { "
2117   ". $_[0]->recurring_sql(). "
2118   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2119   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2120 "; }
2121
2122 =item not_yet_billed_sql
2123
2124 Returns an SQL expression identifying packages which have not yet been billed.
2125
2126 =cut
2127
2128 sub not_yet_billed_sql { "
2129       ( cust_pkg.setup  IS NULL OR cust_pkg.setup  = 0 )
2130   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2131   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2132 "; }
2133
2134 =item inactive_sql
2135
2136 Returns an SQL expression identifying inactive packages (one-time packages
2137 that are otherwise unsuspended/uncancelled).
2138
2139 =cut
2140
2141 sub inactive_sql { "
2142   ". $_[0]->onetime_sql(). "
2143   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2144   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2145   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2146 "; }
2147
2148 =item susp_sql
2149 =item suspended_sql
2150
2151 Returns an SQL expression identifying suspended packages.
2152
2153 =cut
2154
2155 sub suspended_sql { susp_sql(@_); }
2156 sub susp_sql {
2157   #$_[0]->recurring_sql(). ' AND '.
2158   "
2159         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
2160     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
2161   ";
2162 }
2163
2164 =item cancel_sql
2165 =item cancelled_sql
2166
2167 Returns an SQL exprression identifying cancelled packages.
2168
2169 =cut
2170
2171 sub cancelled_sql { cancel_sql(@_); }
2172 sub cancel_sql {
2173   #$_[0]->recurring_sql(). ' AND '.
2174   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2175 }
2176
2177 =item search_sql HASHREF
2178
2179 (Class method)
2180
2181 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2182 Valid parameters are
2183
2184 =over 4
2185
2186 =item agentnum
2187
2188 =item magic
2189
2190 active, inactive, suspended, cancel (or cancelled)
2191
2192 =item status
2193
2194 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2195
2196 =item custom
2197
2198  boolean selects custom packages
2199
2200 =item classnum
2201
2202 =item pkgpart
2203
2204 list specified how?
2205
2206 =item setup
2207
2208 arrayref of beginning and ending epoch date
2209
2210 =item last_bill
2211
2212 arrayref of beginning and ending epoch date
2213
2214 =item bill
2215
2216 arrayref of beginning and ending epoch date
2217
2218 =item adjourn
2219
2220 arrayref of beginning and ending epoch date
2221
2222 =item susp
2223
2224 arrayref of beginning and ending epoch date
2225
2226 =item expire
2227
2228 arrayref of beginning and ending epoch date
2229
2230 =item cancel
2231
2232 arrayref of beginning and ending epoch date
2233
2234 =item query
2235
2236 pkgnum or APKG_pkgnum
2237
2238 =item cust_fields
2239
2240 a value suited to passing to FS::UI::Web::cust_header
2241
2242 =item CurrentUser
2243
2244 specifies the user for agent virtualization
2245
2246 =back
2247
2248 =cut
2249
2250 sub search_sql {
2251   my ($class, $params) = @_;
2252   my @where = ();
2253
2254   ##
2255   # parse agent
2256   ##
2257
2258   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2259     push @where,
2260       "cust_main.agentnum = $1";
2261   }
2262
2263   ##
2264   # parse status
2265   ##
2266
2267   if (    $params->{'magic'}  eq 'active'
2268        || $params->{'status'} eq 'active' ) {
2269
2270     push @where, FS::cust_pkg->active_sql();
2271
2272   } elsif (    $params->{'magic'}  eq 'not yet billed'
2273             || $params->{'status'} eq 'not yet billed' ) {
2274
2275     push @where, FS::cust_pkg->not_yet_billed_sql();
2276
2277   } elsif (    $params->{'magic'}  =~ /^(one-time charge|inactive)/
2278             || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2279
2280     push @where, FS::cust_pkg->inactive_sql();
2281
2282   } elsif (    $params->{'magic'}  eq 'suspended'
2283             || $params->{'status'} eq 'suspended'  ) {
2284
2285     push @where, FS::cust_pkg->suspended_sql();
2286
2287   } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
2288             || $params->{'status'} =~ /^cancell?ed$/ ) {
2289
2290     push @where, FS::cust_pkg->cancelled_sql();
2291
2292   }
2293
2294   ###
2295   # parse package class
2296   ###
2297
2298   #false lazinessish w/graph/cust_bill_pkg.cgi
2299   my $classnum = 0;
2300   my @pkg_class = ();
2301   if ( exists($params->{'classnum'})
2302        && $params->{'classnum'} =~ /^(\d*)$/
2303      )
2304   {
2305     $classnum = $1;
2306     if ( $classnum ) { #a specific class
2307       push @where, "classnum = $classnum";
2308
2309       #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2310       #die "classnum $classnum not found!" unless $pkg_class[0];
2311       #$title .= $pkg_class[0]->classname.' ';
2312
2313     } elsif ( $classnum eq '' ) { #the empty class
2314
2315       push @where, "classnum IS NULL";
2316       #$title .= 'Empty class ';
2317       #@pkg_class = ( '(empty class)' );
2318     } elsif ( $classnum eq '0' ) {
2319       #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2320       #push @pkg_class, '(empty class)';
2321     } else {
2322       die "illegal classnum";
2323     }
2324   }
2325   #eslaf
2326
2327   ###
2328   # parse custom
2329   ###
2330
2331   push @where,  "part_pkg.custom = 'Y'" if $params->{custom};
2332
2333   ###
2334   # parse part_pkg
2335   ###
2336
2337   my $pkgpart = join (' OR pkgpart=',
2338                       grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2339   push @where,  '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2340
2341   ###
2342   # parse dates
2343   ###
2344
2345   my $orderby = '';
2346
2347   #false laziness w/report_cust_pkg.html
2348   my %disable = (
2349     'all'             => {},
2350     'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2351     'active'          => { 'susp'=>1, 'cancel'=>1 },
2352     'suspended'       => { 'cancel' => 1 },
2353     'cancelled'       => {},
2354     ''                => {},
2355   );
2356
2357   foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2358
2359     next unless exists($params->{$field});
2360
2361     my($beginning, $ending) = @{$params->{$field}};
2362
2363     next if $beginning == 0 && $ending == 4294967295;
2364
2365     push @where,
2366       "cust_pkg.$field IS NOT NULL",
2367       "cust_pkg.$field >= $beginning",
2368       "cust_pkg.$field <= $ending";
2369
2370     $orderby ||= "ORDER BY cust_pkg.$field";
2371
2372   }
2373
2374   $orderby ||= 'ORDER BY bill';
2375
2376   ###
2377   # parse magic, legacy, etc.
2378   ###
2379
2380   if ( $params->{'magic'} &&
2381        $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2382   ) {
2383
2384     $orderby = 'ORDER BY pkgnum';
2385
2386     if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2387       push @where, "pkgpart = $1";
2388     }
2389
2390   } elsif ( $params->{'query'} eq 'pkgnum' ) {
2391
2392     $orderby = 'ORDER BY pkgnum';
2393
2394   } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2395
2396     $orderby = 'ORDER BY pkgnum';
2397
2398     push @where, '0 < (
2399       SELECT count(*) FROM pkg_svc
2400        WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
2401          AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2402                                    WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
2403                                      AND cust_svc.svcpart = pkg_svc.svcpart
2404                                 )
2405     )';
2406
2407   }
2408
2409   ##
2410   # setup queries, links, subs, etc. for the search
2411   ##
2412
2413   # here is the agent virtualization
2414   if ($params->{CurrentUser}) {
2415     my $access_user =
2416       qsearchs('access_user', { username => $params->{CurrentUser} });
2417
2418     if ($access_user) {
2419       push @where, $access_user->agentnums_sql('table'=>'cust_main');
2420     }else{
2421       push @where, "1=0";
2422     }
2423   }else{
2424     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2425   }
2426
2427   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2428
2429   my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
2430                   'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
2431                   'LEFT JOIN pkg_class USING ( classnum ) ';
2432
2433   my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2434
2435   my $sql_query = {
2436     'table'       => 'cust_pkg',
2437     'hashref'     => {},
2438     'select'      => join(', ',
2439                                 'cust_pkg.*',
2440                                 ( map "part_pkg.$_", qw( pkg freq ) ),
2441                                 'pkg_class.classname',
2442                                 'cust_main.custnum as cust_main_custnum',
2443                                 FS::UI::Web::cust_sql_fields(
2444                                   $params->{'cust_fields'}
2445                                 ),
2446                      ),
2447     'extra_sql'   => "$extra_sql $orderby",
2448     'addl_from'   => $addl_from,
2449     'count_query' => $count_query,
2450   };
2451
2452 }
2453
2454 =item location_sql
2455
2456 Returns a list: the first item is an SQL fragment identifying matching
2457 packages/customers via location (taking into account shipping and package
2458 address taxation, if enabled), and subsequent items are the parameters to
2459 substitute for the placeholders in that fragment.
2460
2461 =cut
2462
2463 sub location_sql {
2464   my($class, %opt) = @_;
2465   my $ornull = $opt{'ornull'};
2466
2467   my $conf = new FS::Conf;
2468
2469   # '?' placeholders in _location_sql_where
2470   my @bill_param;
2471   if ( $ornull ) {
2472     @bill_param = qw( county county state state state country );
2473   } else {
2474     @bill_param = qw( county state state country );
2475   }
2476   unshift @bill_param, 'county'; # unless $nec;
2477
2478   my $main_where;
2479   my @main_param;
2480   if ( $conf->exists('tax-ship_address') ) {
2481
2482     $main_where = "(
2483          (     ( ship_last IS NULL     OR  ship_last  = '' )
2484            AND ". _location_sql_where('cust_main', '', $ornull ). "
2485          )
2486       OR (       ship_last IS NOT NULL AND ship_last != ''
2487            AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2488          )
2489     )";
2490     #    AND payby != 'COMP'
2491
2492     @main_param = ( @bill_param, @bill_param );
2493
2494   } else {
2495
2496     $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2497     @main_param = @bill_param;
2498
2499   }
2500
2501   my $where;
2502   my @param;
2503   if ( $conf->exists('tax-pkg_address') ) {
2504
2505     my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2506
2507     $where = " (
2508                     ( cust_pkg.locationnum IS     NULL AND $main_where )
2509                  OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where  )
2510                )
2511              ";
2512     @param = ( @main_param, @bill_param );
2513
2514   } else {
2515
2516     $where = $main_where;
2517     @param = @main_param;
2518
2519   }
2520
2521   ( $where, @param );
2522
2523 }
2524
2525 #subroutine, helper for location_sql
2526 sub _location_sql_where {
2527   my $table  = shift;
2528   my $prefix = @_ ? shift : '';
2529   my $ornull = @_ ? shift : '';
2530
2531 #  $ornull             = $ornull          ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2532
2533   $ornull = $ornull ? ' OR ? IS NULL ' : '';
2534
2535   my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2536   my $or_empty_state =  " OR ( ? = '' AND $table.${prefix}state  IS NULL ) ";
2537
2538   "
2539         ( $table.${prefix}county  = ? $or_empty_county $ornull )
2540     AND ( $table.${prefix}state   = ? $or_empty_state  $ornull )
2541     AND   $table.${prefix}country = ?
2542   ";
2543 }
2544
2545 =head1 SUBROUTINES
2546
2547 =over 4
2548
2549 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2550
2551 CUSTNUM is a customer (see L<FS::cust_main>)
2552
2553 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2554 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
2555 permitted.
2556
2557 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2558 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
2559 new billing items.  An error is returned if this is not possible (see
2560 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
2561 parameter.
2562
2563 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2564 newly-created cust_pkg objects.
2565
2566 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2567 and inserted.  Multiple FS::pkg_referral records can be created by
2568 setting I<refnum> to an array reference of refnums or a hash reference with
2569 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
2570 record will be created corresponding to cust_main.refnum.
2571
2572 =cut
2573
2574 sub order {
2575   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2576
2577   my $conf = new FS::Conf;
2578
2579   # Transactionize this whole mess
2580   local $SIG{HUP} = 'IGNORE';
2581   local $SIG{INT} = 'IGNORE';
2582   local $SIG{QUIT} = 'IGNORE';
2583   local $SIG{TERM} = 'IGNORE';
2584   local $SIG{TSTP} = 'IGNORE';
2585   local $SIG{PIPE} = 'IGNORE';
2586
2587   my $oldAutoCommit = $FS::UID::AutoCommit;
2588   local $FS::UID::AutoCommit = 0;
2589   my $dbh = dbh;
2590
2591   my $error;
2592 #  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2593 #  return "Customer not found: $custnum" unless $cust_main;
2594
2595   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2596                          @$remove_pkgnum;
2597
2598   my $change = scalar(@old_cust_pkg) != 0;
2599
2600   my %hash = ();
2601   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2602
2603     my $err_or_cust_pkg =
2604       $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2605                                 'refnum'  => $refnum,
2606                               );
2607
2608     unless (ref($err_or_cust_pkg)) {
2609       $dbh->rollback if $oldAutoCommit;
2610       return $err_or_cust_pkg;
2611     }
2612
2613     push @$return_cust_pkg, $err_or_cust_pkg;
2614     return '';
2615
2616   }
2617
2618   # Create the new packages.
2619   foreach my $pkgpart (@$pkgparts) {
2620     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2621                                       pkgpart => $pkgpart,
2622                                       refnum  => $refnum,
2623                                       %hash,
2624                                     };
2625     $error = $cust_pkg->insert( 'change' => $change );
2626     if ($error) {
2627       $dbh->rollback if $oldAutoCommit;
2628       return $error;
2629     }
2630     push @$return_cust_pkg, $cust_pkg;
2631   }
2632   # $return_cust_pkg now contains refs to all of the newly
2633   # created packages.
2634
2635   # Transfer services and cancel old packages.
2636   foreach my $old_pkg (@old_cust_pkg) {
2637
2638     foreach my $new_pkg (@$return_cust_pkg) {
2639       $error = $old_pkg->transfer($new_pkg);
2640       if ($error and $error == 0) {
2641         # $old_pkg->transfer failed.
2642         $dbh->rollback if $oldAutoCommit;
2643         return $error;
2644       }
2645     }
2646
2647     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2648       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2649       foreach my $new_pkg (@$return_cust_pkg) {
2650         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2651         if ($error and $error == 0) {
2652           # $old_pkg->transfer failed.
2653         $dbh->rollback if $oldAutoCommit;
2654         return $error;
2655         }
2656       }
2657     }
2658
2659     if ($error > 0) {
2660       # Transfers were successful, but we went through all of the
2661       # new packages and still had services left on the old package.
2662       # We can't cancel the package under the circumstances, so abort.
2663       $dbh->rollback if $oldAutoCommit;
2664       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2665     }
2666     $error = $old_pkg->cancel( quiet=>1 );
2667     if ($error) {
2668       $dbh->rollback;
2669       return $error;
2670     }
2671   }
2672   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2673   '';
2674 }
2675
2676 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2677
2678 A bulk change method to change packages for multiple customers.
2679
2680 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2681 L<FS::part_pkg>) to order for each customer.  Duplicates are of course
2682 permitted.
2683
2684 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2685 replace.  The services (see L<FS::cust_svc>) are moved to the
2686 new billing items.  An error is returned if this is not possible (see
2687 L<FS::pkg_svc>).
2688
2689 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2690 newly-created cust_pkg objects.
2691
2692 =cut
2693
2694 sub bulk_change {
2695   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2696
2697   # Transactionize this whole mess
2698   local $SIG{HUP} = 'IGNORE';
2699   local $SIG{INT} = 'IGNORE';
2700   local $SIG{QUIT} = 'IGNORE';
2701   local $SIG{TERM} = 'IGNORE';
2702   local $SIG{TSTP} = 'IGNORE';
2703   local $SIG{PIPE} = 'IGNORE';
2704
2705   my $oldAutoCommit = $FS::UID::AutoCommit;
2706   local $FS::UID::AutoCommit = 0;
2707   my $dbh = dbh;
2708
2709   my @errors;
2710   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2711                          @$remove_pkgnum;
2712
2713   while(scalar(@old_cust_pkg)) {
2714     my @return = ();
2715     my $custnum = $old_cust_pkg[0]->custnum;
2716     my (@remove) = map { $_->pkgnum }
2717                    grep { $_->custnum == $custnum } @old_cust_pkg;
2718     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2719
2720     my $error = order $custnum, $pkgparts, \@remove, \@return;
2721
2722     push @errors, $error
2723       if $error;
2724     push @$return_cust_pkg, @return;
2725   }
2726
2727   if (scalar(@errors)) {
2728     $dbh->rollback if $oldAutoCommit;
2729     return join(' / ', @errors);
2730   }
2731
2732   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2733   '';
2734 }
2735
2736 =item insert_reason
2737
2738 Associates this package with a (suspension or cancellation) reason (see
2739 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2740 L<FS::reason>).
2741
2742 Available options are:
2743
2744 =over 4
2745
2746 =item reason
2747
2748 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.
2749
2750 =item reason_otaker
2751
2752 the access_user (see L<FS::access_user>) providing the reason
2753
2754 =item date
2755
2756 a unix timestamp
2757
2758 =item action
2759
2760 the action (cancel, susp, adjourn, expire) associated with the reason
2761
2762 =back
2763
2764 If there is an error, returns the error, otherwise returns false.
2765
2766 =cut
2767
2768 sub insert_reason {
2769   my ($self, %options) = @_;
2770
2771   my $otaker = $options{reason_otaker} ||
2772                $FS::CurrentUser::CurrentUser->username;
2773
2774   my $reasonnum;
2775   if ( $options{'reason'} =~ /^(\d+)$/ ) {
2776
2777     $reasonnum = $1;
2778
2779   } elsif ( ref($options{'reason'}) ) {
2780
2781     return 'Enter a new reason (or select an existing one)'
2782       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2783
2784     my $reason = new FS::reason({
2785       'reason_type' => $options{'reason'}->{'typenum'},
2786       'reason'      => $options{'reason'}->{'reason'},
2787     });
2788     my $error = $reason->insert;
2789     return $error if $error;
2790
2791     $reasonnum = $reason->reasonnum;
2792
2793   } else {
2794     return "Unparsable reason: ". $options{'reason'};
2795   }
2796
2797   my $cust_pkg_reason =
2798     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
2799                               'reasonnum' => $reasonnum,
2800                               'otaker'    => $otaker,
2801                               'action'    => substr(uc($options{'action'}),0,1),
2802                               'date'      => $options{'date'}
2803                                                ? $options{'date'}
2804                                                : time,
2805                             });
2806
2807   $cust_pkg_reason->insert;
2808 }
2809
2810 =item set_usage USAGE_VALUE_HASHREF
2811
2812 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2813 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2814 upbytes, downbytes, and totalbytes are appropriate keys.
2815
2816 All svc_accts which are part of this package have their values reset.
2817
2818 =cut
2819
2820 sub set_usage {
2821   my ($self, $valueref, %opt) = @_;
2822
2823   foreach my $cust_svc ($self->cust_svc){
2824     my $svc_x = $cust_svc->svc_x;
2825     $svc_x->set_usage($valueref, %opt)
2826       if $svc_x->can("set_usage");
2827   }
2828 }
2829
2830 =item recharge USAGE_VALUE_HASHREF
2831
2832 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2833 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2834 upbytes, downbytes, and totalbytes are appropriate keys.
2835
2836 All svc_accts which are part of this package have their values incremented.
2837
2838 =cut
2839
2840 sub recharge {
2841   my ($self, $valueref) = @_;
2842
2843   foreach my $cust_svc ($self->cust_svc){
2844     my $svc_x = $cust_svc->svc_x;
2845     $svc_x->recharge($valueref)
2846       if $svc_x->can("recharge");
2847   }
2848 }
2849
2850 =back
2851
2852 =head1 BUGS
2853
2854 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
2855
2856 In sub order, the @pkgparts array (passed by reference) is clobbered.
2857
2858 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
2859 method to pass dates to the recur_prog expression, it should do so.
2860
2861 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2862 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2863 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2864 configuration values.  Probably need a subroutine which decides what to do
2865 based on whether or not we've fetched the user yet, rather than a hash.  See
2866 FS::UID and the TODO.
2867
2868 Now that things are transactional should the check in the insert method be
2869 moved to check ?
2870
2871 =head1 SEE ALSO
2872
2873 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2874 L<FS::pkg_svc>, schema.html from the base documentation
2875
2876 =cut
2877
2878 1;
2879