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