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