FS/FS/cust_pkg.pm

   1 package FS::cust_pkg;
   2 use base qw( FS::cust_pkg::Search FS::cust_pkg::API
   3              FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
   4              FS::contact_Mixin FS::location_Mixin
   5              FS::m2m_Common FS::option_Common
   6            );
   7
   8 use strict;
   9 use Carp qw(cluck);
  10 use Scalar::Util qw( blessed );
  11 use List::Util qw(min max);
  12 use Tie::IxHash;
  13 use Time::Local qw( timelocal timelocal_nocheck );
  14 use MIME::Entity;
  15 use FS::UID qw( dbh driver_name );
  16 use FS::Record qw( qsearch qsearchs fields );
  17 use FS::CurrentUser;
  18 use FS::cust_svc;
  19 use FS::part_pkg;
  20 use FS::cust_main;
  21 use FS::contact;
  22 use FS::cust_location;
  23 use FS::pkg_svc;
  24 use FS::cust_bill_pkg;
  25 use FS::cust_pkg_detail;
  26 use FS::cust_pkg_usage;
  27 use FS::cdr_cust_pkg_usage;
  28 use FS::cust_event;
  29 use FS::h_cust_svc;
  30 use FS::reg_code;
  31 use FS::part_svc;
  32 use FS::cust_pkg_reason;
  33 use FS::reason;
  34 use FS::cust_pkg_usageprice;
  35 use FS::cust_pkg_discount;
  36 use FS::discount;
  37 use FS::sales;
  38 # for modify_charge
  39 use FS::cust_credit;
  40
  41 # temporary fix; remove this once (un)suspend admin notices are cleaned up
  42 use FS::Misc qw(send_email);
  43
  44 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
  45 # setup }
  46 # because they load configuration by setting FS::UID::callback (see TODO)
  47 use FS::svc_acct;
  48 use FS::svc_domain;
  49 use FS::svc_www;
  50 use FS::svc_forward;
  51
  52 # for sending cancel emails in sub cancel
  53 use FS::Conf;
  54
  55 our ($disable_agentcheck, $DEBUG, $me, $import) = (0, 0, '[FS::cust_pkg]', 0);
  56
  57 our $upgrade = 0; #go away after setup+start dates cleaned up for old customers
  58
  59 our $cache_enabled = 0;
  60
  61 sub _simplecache {
  62   my( $self, $hashref ) = @_;
  63   if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) {
  64     $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
  65   }
  66 }
  67
  68 sub _cache {
  69   my $self = shift;
  70   my ( $hashref, $cache ) = @_;
  71 #  #if ( $hashref->{'pkgpart'} ) {
  72 #  if ( $hashref->{'pkg'} ) {
  73 #    # #@{ $self->{'_pkgnum'} } = ();
  74 #    # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
  75 #    # $self->{'_pkgpart'} = $subcache;
  76 #    # #push @{ $self->{'_pkgnum'} },
  77 #    #   FS::part_pkg->new_or_cached($hashref, $subcache);
  78 #    $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
  79 #  }
  80   if ( exists $hashref->{'svcnum'} ) {
  81     #@{ $self->{'_pkgnum'} } = ();
  82     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
  83     $self->{'_svcnum'} = $subcache;
  84     #push @{ $self->{'_pkgnum'} },
  85     FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
  86   }
  87 }
  88
  89 =head1 NAME
  90
  91 FS::cust_pkg - Object methods for cust_pkg objects
  92
  93 =head1 SYNOPSIS
  94
  95   use FS::cust_pkg;
  96
  97   $record = new FS::cust_pkg \%hash;
  98   $record = new FS::cust_pkg { 'column' => 'value' };
  99
 100   $error = $record->insert;
 101
 102   $error = $new_record->replace($old_record);
 103
 104   $error = $record->delete;
 105
 106   $error = $record->check;
 107
 108   $error = $record->cancel;
 109
 110   $error = $record->suspend;
 111
 112   $error = $record->unsuspend;
 113
 114   $part_pkg = $record->part_pkg;
 115
 116   @labels = $record->labels;
 117
 118   $seconds = $record->seconds_since($timestamp);
 119
 120   #bulk cancel+order... perhaps slightly deprecated, only used by the bulk
 121   # cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
 122   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
 123   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
 124
 125 =head1 DESCRIPTION
 126
 127 An FS::cust_pkg object represents a customer billing item.  FS::cust_pkg
 128 inherits from FS::Record.  The following fields are currently supported:
 129
 130 =over 4
 131
 132 =item pkgnum
 133
 134 Primary key (assigned automatically for new billing items)
 135
 136 =item custnum
 137
 138 Customer (see L<FS::cust_main>)
 139
 140 =item pkgpart
 141
 142 Billing item definition (see L<FS::part_pkg>)
 143
 144 =item locationnum
 145
 146 Optional link to package location (see L<FS::location>)
 147
 148 =item order_date
 149
 150 date package was ordered (also remains same on changes)
 151
 152 =item start_date
 153
 154 date
 155
 156 =item setup
 157
 158 date
 159
 160 =item bill
 161
 162 date (next bill date)
 163
 164 =item last_bill
 165
 166 last bill date
 167
 168 =item adjourn
 169
 170 date
 171
 172 =item susp
 173
 174 date
 175
 176 =item expire
 177
 178 date
 179
 180 =item contract_end
 181
 182 date
 183
 184 =item cancel
 185
 186 date
 187
 188 =item usernum
 189
 190 order taker (see L<FS::access_user>)
 191
 192 =item quantity
 193
 194 If not set, defaults to 1
 195
 196 =item change_date
 197
 198 Date of change from previous package
 199
 200 =item change_pkgnum
 201
 202 Previous pkgnum
 203
 204 =item change_pkgpart
 205
 206 Previous pkgpart
 207
 208 =item change_locationnum
 209
 210 Previous locationnum
 211
 212 =item waive_setup
 213
 214 =item main_pkgnum
 215
 216 The pkgnum of the package that this package is supplemental to, if any.
 217
 218 =item pkglinknum
 219
 220 The package link (L<FS::part_pkg_link>) that defines this supplemental
 221 package, if it is one.
 222
 223 =item change_to_pkgnum
 224
 225 The pkgnum of the package this one will be "changed to" in the future
 226 (on its expiration date).
 227
 228 =back
 229
 230 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
 231 are specified as UNIX timestamps; see L<perlfunc/"time">.  Also see
 232 L<Time::Local> and L<Date::Parse> for conversion functions.
 233
 234 =head1 METHODS
 235
 236 =over 4
 237
 238 =item new HASHREF
 239
 240 Create a new billing item.  To add the item to the database, see L<"insert">.
 241
 242 =cut
 243
 244 sub table { 'cust_pkg'; }
 245 sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum }
 246 sub cust_unlinked_msg {
 247   my $self = shift;
 248   "WARNING: can't find cust_main.custnum ". $self->custnum.
 249   ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
 250 }
 251
 252 =item set_initial_timers
 253
 254 If required by the package definition, sets any automatic expire, adjourn,
 255 or contract_end timers to some number of months after the start date
 256 (or setup date, if the package has already been setup). If the package has
 257 a delayed setup fee after a period of "free days", will also set the
 258 start date to the end of that period.
 259
 260 If the package has an automatic transfer rule (C<change_to_pkgnum>), then
 261 this will also order the package and set its start date.
 262
 263 =cut
 264
 265 sub set_initial_timers {
 266   my $self = shift;
 267   my $part_pkg = $self->part_pkg;
 268   my $start = $self->start_date || $self->setup || time;
 269
 270   foreach my $action ( qw(expire adjourn contract_end) ) {
 271     my $months = $part_pkg->get("${action}_months");
 272     if($months and !$self->get($action)) {
 273       $self->set($action, $part_pkg->add_freq($start, $months) );
 274     }
 275   }
 276
 277   # if this package has an expire date and a change_to_pkgpart, set automatic
 278   # package transfer
 279   # (but don't call change_later, as that would call $self->replace, and we're
 280   # probably in the middle of $self->insert right now)
 281   if ( $part_pkg->expire_months and $part_pkg->change_to_pkgpart ) {
 282     if ( $self->change_to_pkgnum ) {
 283       # this can happen if a package is ordered on hold, scheduled for a
 284       # future change _while on hold_, and then released from hold, causing
 285       # the automatic transfer to schedule.
 286       #
 287       # what's correct behavior in that case? I think it's to disallow
 288       # future-changing an on-hold package that has an automatic transfer.
 289       # but if we DO get into this situation, let the manual package change
 290       # win.
 291       warn "pkgnum ".$self->pkgnum.": manual future package change blocks ".
 292            "automatic transfer.\n";
 293     } else {
 294       my $change_to = FS::cust_pkg->new( {
 295           start_date  => $self->get('expire'),
 296           pkgpart     => $part_pkg->change_to_pkgpart,
 297           map { $_ => $self->get($_) }
 298             qw( custnum locationnum quantity refnum salesnum contract_end )
 299       } );
 300       my $error = $change_to->insert;
 301
 302       return $error if $error;
 303       $self->set('change_to_pkgnum', $change_to->pkgnum);
 304     }
 305   }
 306
 307   # if this package has "free days" and delayed setup fee, then
 308   # set start date that many days in the future.
 309   # (this should have been set in the UI, but enforce it here)
 310   if ( $part_pkg->option('free_days',1)
 311        && $part_pkg->option('delay_setup',1)
 312      )
 313   {
 314     $self->start_date( $part_pkg->default_start_date );
 315   }
 316
 317   '';
 318 }
 319
 320 =item insert [ OPTION => VALUE ... ]
 321
 322 Adds this billing item to the database ("Orders" the item).  If there is an
 323 error, returns the error, otherwise returns false.
 324
 325 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
 326 will be used to look up the package definition and agent restrictions will be
 327 ignored.
 328
 329 If the additional field I<refnum> is defined, an FS::pkg_referral record will
 330 be created and inserted.  Multiple FS::pkg_referral records can be created by
 331 setting I<refnum> to an array reference of refnums or a hash reference with
 332 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
 333 record will be created corresponding to cust_main.refnum.
 334
 335 If the additional field I<cust_pkg_usageprice> is defined, it will be treated
 336 as an arrayref of FS::cust_pkg_usageprice objects, which will be inserted.
 337 (Note that this field cannot be set with a usual ->cust_pkg_usageprice method.
 338 It can be set as part of the hash when creating the object, or with the B<set>
 339 method.)
 340
 341 The following options are available:
 342
 343 =over 4
 344
 345 =item change
 346
 347 If set true, supresses actions that should only be taken for new package
 348 orders.  (Currently this includes: intro periods when delay_setup is on,
 349 auto-adding a 1st start date, auto-adding expiration/adjourn/contract_end dates)
 350
 351 =item options
 352
 353 cust_pkg_option records will be created
 354
 355 =item ticket_subject
 356
 357 a ticket will be added to this customer with this subject
 358
 359 =item ticket_queue
 360
 361 an optional queue name for ticket additions
 362
 363 =item allow_pkgpart
 364
 365 Don't check the legality of the package definition.  This should be used
 366 when performing a package change that doesn't change the pkgpart (i.e.
 367 a location change).
 368
 369 =back
 370
 371 =cut
 372
 373 sub insert {
 374   my( $self, %options ) = @_;
 375
 376   my $oldAutoCommit = $FS::UID::AutoCommit;
 377   local $FS::UID::AutoCommit = 0;
 378   my $dbh = dbh;
 379
 380   my $error;
 381   $error = $self->check_pkgpart unless $options{'allow_pkgpart'};
 382
 383   my $part_pkg = $self->part_pkg;
 384
 385   if ( ! $import && ! $options{'change'} ) {
 386
 387     # set order date to now
 388     $self->order_date(time) unless ($import && $self->order_date);
 389
 390     # if the package def says to start only on the first of the month:
 391     if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
 392       my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
 393       $mon += 1 unless $mday == 1;
 394       until ( $mon < 12 ) { $mon -= 12; $year++; }
 395       $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
 396     }
 397
 398     if ($self->susp eq 'now' or $part_pkg->start_on_hold) {
 399       # if the package was ordered on hold:
 400       # - suspend it
 401       # - don't set the start date (it will be started manually)
 402       $self->set('susp', $self->order_date);
 403       $self->set('start_date', '');
 404     } else {
 405       # set expire/adjourn/contract_end timers, and free days, if appropriate
 406       # and automatic package transfer, which can fail, so capture the result
 407       $error = $self->set_initial_timers;
 408     }
 409   } # else this is a package change, and shouldn't have "new package" behavior
 410
 411   $error ||= $self->SUPER::insert($options{options} ? %{$options{options}} : ());
 412   if ( $error ) {
 413     $dbh->rollback if $oldAutoCommit;
 414     return $error;
 415   }
 416
 417   $self->refnum($self->cust_main->refnum) unless $self->refnum;
 418   $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
 419   $self->process_m2m( 'link_table'   => 'pkg_referral',
 420                       'target_table' => 'part_referral',
 421                       'params'       => $self->refnum,
 422                     );
 423
 424   if ( $self->hashref->{cust_pkg_usageprice} ) {
 425     for my $cust_pkg_usageprice ( @{ $self->hashref->{cust_pkg_usageprice} } ) {
 426       $cust_pkg_usageprice->pkgnum( $self->pkgnum );
 427       my $error = $cust_pkg_usageprice->insert;
 428       if ( $error ) {
 429         $dbh->rollback if $oldAutoCommit;
 430         return $error;
 431       }
 432     }
 433   }
 434
 435   if ( $self->setup_discountnum || $self->recur_discountnum ) {
 436     my $error = $self->insert_discount();
 437     if ( $error ) {
 438       $dbh->rollback if $oldAutoCommit;
 439       return $error;
 440     }
 441   }
 442
 443   my $conf = new FS::Conf;
 444
 445   if ($self->locationnum) {
 446     my @part_export =
 447       map qsearch( 'part_export', {exportnum=>$_} ),
 448         $conf->config('cust_location-exports'); #, $agentnum
 449
 450     foreach my $part_export ( @part_export ) {
 451       my $error = $part_export->export_pkg_location($self); #, @$export_args);
 452       if ( $error ) {
 453         $dbh->rollback if $oldAutoCommit;
 454         return "exporting to ". $part_export->exporttype.
 455                " (transaction rolled back): $error";
 456       }
 457     }
 458   }
 459
 460   if ( ! $import && $conf->config('ticket_system') && $options{ticket_subject} ) {
 461
 462     #this init stuff is still inefficient, but at least its limited to
 463     # the small number (any?) folks using ticket emailing on pkg order
 464
 465     #eval '
 466     #  use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
 467     #  use RT;
 468     #';
 469     #die $@ if $@;
 470     #
 471     #RT::LoadConfig();
 472     #RT::Init();
 473     use FS::TicketSystem;
 474     FS::TicketSystem->init();
 475
 476     my $q = new RT::Queue($RT::SystemUser);
 477     $q->Load($options{ticket_queue}) if $options{ticket_queue};
 478     my $t = new RT::Ticket($RT::SystemUser);
 479     my $mime = new MIME::Entity;
 480     $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
 481     $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
 482                 Subject => $options{ticket_subject},
 483                 MIMEObj => $mime,
 484               );
 485     $t->AddLink( Type   => 'MemberOf',
 486                  Target => 'freeside://freeside/cust_main/'. $self->custnum,
 487                );
 488   }
 489
 490   if (! $import && $conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
 491     my $queue = new FS::queue {
 492       'job'     => 'FS::cust_main::queueable_print',
 493     };
 494     $error = $queue->insert(
 495       'custnum'  => $self->custnum,
 496       'template' => 'welcome_letter',
 497     );
 498
 499     if ($error) {
 500       warn "can't send welcome letter: $error";
 501     }
 502
 503   }
 504
 505   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 506   '';
 507
 508 }
 509
 510 =item delete
 511
 512 This method now works but you probably shouldn't use it.
 513
 514 You don't want to delete packages, because there would then be no record
 515 the customer ever purchased the package.  Instead, see the cancel method and
 516 hide cancelled packages.
 517
 518 =cut
 519
 520 # this is still used internally to abort future package changes, so it
 521 # does need to work
 522
 523 sub delete {
 524   my $self = shift;
 525
 526   # The following foreign keys to cust_pkg are not cleaned up here, and will
 527   # cause package deletion to fail:
 528   #
 529   # cust_credit.pkgnum and commission_pkgnum (and cust_credit_void)
 530   # cust_credit_bill.pkgnum
 531   # cust_pay_pending.pkgnum
 532   # cust_pay.pkgnum (and cust_pay_void)
 533   # cust_bill_pay.pkgnum (wtf, shouldn't reference pkgnum)
 534   # cust_pkg_usage.pkgnum
 535   # cust_pkg.uncancel_pkgnum, change_pkgnum, main_pkgnum, and change_to_pkgnum
 536
 537   # cust_svc is handled by canceling the package before deleting it
 538   # cust_pkg_option is handled via option_Common
 539
 540   my $oldAutoCommit = $FS::UID::AutoCommit;
 541   local $FS::UID::AutoCommit = 0;
 542   my $dbh = dbh;
 543
 544   foreach my $cust_pkg_discount ($self->cust_pkg_discount) {
 545     my $error = $cust_pkg_discount->delete;
 546     if ( $error ) {
 547       $dbh->rollback if $oldAutoCommit;
 548       return $error;
 549     }
 550   }
 551   #cust_bill_pkg_discount?
 552
 553   foreach my $cust_pkg_detail ($self->cust_pkg_detail) {
 554     my $error = $cust_pkg_detail->delete;
 555     if ( $error ) {
 556       $dbh->rollback if $oldAutoCommit;
 557       return $error;
 558     }
 559   }
 560
 561   foreach my $cust_pkg_reason (
 562     qsearchs( {
 563                 'table' => 'cust_pkg_reason',
 564                 'hashref' => { 'pkgnum' => $self->pkgnum },
 565               }
 566             )
 567   ) {
 568     my $error = $cust_pkg_reason->delete;
 569     if ( $error ) {
 570       $dbh->rollback if $oldAutoCommit;
 571       return $error;
 572     }
 573   }
 574
 575   foreach my $pkg_referral ( $self->pkg_referral ) {
 576     my $error = $pkg_referral->delete;
 577     if ( $error ) {
 578       $dbh->rollback if $oldAutoCommit;
 579       return $error;
 580     }
 581   }
 582
 583   my $error = $self->SUPER::delete(@_);
 584   if ( $error ) {
 585     $dbh->rollback if $oldAutoCommit;
 586     return $error;
 587   }
 588
 589   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 590
 591   '';
 592
 593 }
 594
 595 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
 596
 597 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 598 returns the error, otherwise returns false.
 599
 600 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
 601
 602 Changing pkgpart may have disasterous effects.  See the order subroutine.
 603
 604 setup and bill are normally updated by calling the bill method of a customer
 605 object (see L<FS::cust_main>).
 606
 607 suspend is normally updated by the suspend and unsuspend methods.
 608
 609 cancel is normally updated by the cancel method (and also the order subroutine
 610 in some cases).
 611
 612 Available options are:
 613
 614 =over 4
 615
 616 =item reason
 617
 618 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.
 619
 620 =item reason_otaker
 621
 622 the access_user (see L<FS::access_user>) providing the reason
 623
 624 =item options
 625
 626 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
 627
 628 =back
 629
 630 =cut
 631
 632 sub replace {
 633   my $new = shift;
 634
 635   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 636               ? shift
 637               : $new->replace_old;
 638
 639   my $options =
 640     ( ref($_[0]) eq 'HASH' )
 641       ? shift
 642       : { @_ };
 643
 644   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
 645   #return "Can't change otaker!" if $old->otaker ne $new->otaker;
 646
 647   #allow this *sigh*
 648   #return "Can't change setup once it exists!"
 649   #  if $old->getfield('setup') &&
 650   #     $old->getfield('setup') != $new->getfield('setup');
 651
 652   #some logic for bill, susp, cancel?
 653
 654   local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
 655
 656   my $oldAutoCommit = $FS::UID::AutoCommit;
 657   local $FS::UID::AutoCommit = 0;
 658   my $dbh = dbh;
 659
 660   foreach my $method ( qw(adjourn expire) ) {  # How many reasons?
 661     if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
 662       my $error = $new->insert_reason(
 663         'reason'        => $options->{'reason'},
 664         'date'          => $new->$method,
 665         'action'        => $method,
 666         'reason_otaker' => $options->{'reason_otaker'},
 667       );
 668       if ( $error ) {
 669         dbh->rollback if $oldAutoCommit;
 670         return "Error inserting cust_pkg_reason: $error";
 671       }
 672     }
 673   }
 674
 675   #save off and freeze RADIUS attributes for any associated svc_acct records
 676   my @svc_acct = ();
 677   if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
 678
 679                 #also check for specific exports?
 680                 # to avoid spurious modify export events
 681     @svc_acct = map  { $_->svc_x }
 682                 grep { $_->part_svc->svcdb eq 'svc_acct' }
 683                      $old->cust_svc;
 684
 685     $_->snapshot foreach @svc_acct;
 686
 687   }
 688
 689   my $error =  $new->export_pkg_change($old)
 690             || $new->SUPER::replace( $old,
 691                                      $options->{options}
 692                                        ? $options->{options}
 693                                        : ()
 694                                    );
 695   if ( $error ) {
 696     $dbh->rollback if $oldAutoCommit;
 697     return $error;
 698   }
 699
 700   #for prepaid packages,
 701   #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
 702   foreach my $old_svc_acct ( @svc_acct ) {
 703     my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
 704     my $s_error =
 705       $new_svc_acct->replace( $old_svc_acct,
 706                               'depend_jobnum' => $options->{depend_jobnum},
 707                             );
 708     if ( $s_error ) {
 709       $dbh->rollback if $oldAutoCommit;
 710       return $s_error;
 711     }
 712   }
 713
 714   # also run exports if removing locationnum?
 715   #   doesn't seem to happen, and we don't export blank locationnum on insert...
 716   if ($new->locationnum and ($new->locationnum != $old->locationnum)) {
 717     my $conf = new FS::Conf;
 718     my @part_export =
 719       map qsearch( 'part_export', {exportnum=>$_} ),
 720         $conf->config('cust_location-exports'); #, $agentnum
 721
 722     foreach my $part_export ( @part_export ) {
 723       my $error = $part_export->export_pkg_location($new); #, @$export_args);
 724       if ( $error ) {
 725         $dbh->rollback if $oldAutoCommit;
 726         return "exporting to ". $part_export->exporttype.
 727                " (transaction rolled back): $error";
 728       }
 729     }
 730   }
 731
 732   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 733   '';
 734
 735 }
 736
 737 =item check
 738
 739 Checks all fields to make sure this is a valid billing item.  If there is an
 740 error, returns the error, otherwise returns false.  Called by the insert and
 741 replace methods.
 742
 743 =cut
 744
 745 sub check {
 746   my $self = shift;
 747
 748   if ( !$self->locationnum or $self->locationnum == -1 ) {
 749     $self->set('locationnum', $self->cust_main->ship_locationnum);
 750   }
 751
 752   my $error =
 753     $self->ut_numbern('pkgnum')
 754     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
 755     || $self->ut_numbern('pkgpart')
 756     || $self->ut_foreign_keyn('contactnum',  'contact',       'contactnum' )
 757     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 758     || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
 759     || $self->ut_numbern('quantity')
 760     || $self->ut_numbern('start_date')
 761     || $self->ut_numbern('setup')
 762     || $self->ut_numbern('bill')
 763     || $self->ut_numbern('susp')
 764     || $self->ut_numbern('cancel')
 765     || $self->ut_numbern('adjourn')
 766     || $self->ut_numbern('resume')
 767     || $self->ut_numbern('expire')
 768     || $self->ut_numbern('dundate')
 769     || $self->ut_flag('no_auto', [ '', 'Y' ])
 770     || $self->ut_flag('waive_setup', [ '', 'Y' ])
 771     || $self->ut_flag('separate_bill')
 772     || $self->ut_textn('agent_pkgid')
 773     || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
 774     || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
 775     || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum')
 776     || $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum')
 777     || $self->ut_foreign_keyn('change_to_pkgnum', 'cust_pkg', 'pkgnum')
 778   ;
 779   return $error if $error;
 780
 781   return "A package with both start date (future start) and setup date (already started) will never bill"
 782     if $self->start_date && $self->setup && ! $upgrade;
 783
 784   return "A future unsuspend date can only be set for a package with a suspend date"
 785     if $self->resume and !$self->susp and !$self->adjourn;
 786
 787   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 788
 789   if ( $self->dbdef_table->column('manual_flag') ) {
 790     $self->manual_flag('') if $self->manual_flag eq ' ';
 791     $self->manual_flag =~ /^([01]?)$/
 792       or return "Illegal manual_flag ". $self->manual_flag;
 793     $self->manual_flag($1);
 794   }
 795
 796   $self->SUPER::check;
 797 }
 798
 799 =item check_pkgpart
 800
 801 Check the pkgpart to make sure it's allowed with the reg_code and/or
 802 promo_code of the package (if present) and with the customer's agent.
 803 Called from C<insert>, unless we are doing a package change that doesn't
 804 affect pkgpart.
 805
 806 =cut
 807
 808 sub check_pkgpart {
 809   my $self = shift;
 810
 811   # my $error = $self->ut_numbern('pkgpart'); # already done
 812
 813   my $error;
 814   if ( $self->reg_code ) {
 815
 816     unless ( grep { $self->pkgpart == $_->pkgpart }
 817              map  { $_->reg_code_pkg }
 818              qsearchs( 'reg_code', { 'code'     => $self->reg_code,
 819                                      'agentnum' => $self->cust_main->agentnum })
 820            ) {
 821       return "Unknown registration code";
 822     }
 823
 824   } elsif ( $self->promo_code ) {
 825
 826     my $promo_part_pkg =
 827       qsearchs('part_pkg', {
 828         'pkgpart'    => $self->pkgpart,
 829         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
 830       } );
 831     return 'Unknown promotional code' unless $promo_part_pkg;
 832
 833   } else {
 834
 835     unless ( $disable_agentcheck ) {
 836       my $agent =
 837         qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
 838       return "agent ". $agent->agentnum. ':'. $agent->agent.
 839              " can't purchase pkgpart ". $self->pkgpart
 840         unless $agent->pkgpart_hashref->{ $self->pkgpart }
 841             || $agent->agentnum == $self->part_pkg->agentnum;
 842     }
 843
 844     $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
 845     return $error if $error;
 846
 847   }
 848
 849   '';
 850
 851 }
 852
 853 =item cancel [ OPTION => VALUE ... ]
 854
 855 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 856 in this package, then cancels the package itself (sets the cancel field to
 857 now).
 858
 859 Available options are:
 860
 861 =over 4
 862
 863 =item quiet - can be set true to supress email cancellation notices.
 864
 865 =item time -  can be set to cancel the package based on a specific future or
 866 historical date.  Using time ensures that the remaining amount is calculated
 867 correctly.  Note however that this is an immediate cancel and just changes
 868 the date.  You are PROBABLY looking to expire the account instead of using
 869 this.
 870
 871 =item reason - can be set to a cancellation reason (see L<FS:reason>),
 872 either a reasonnum of an existing reason, or passing a hashref will create
 873 a new reason.  The hashref should have the following keys: typenum - Reason
 874 type (see L<FS::reason_type>, reason - Text of the new reason.
 875
 876 =item date - can be set to a unix style timestamp to specify when to
 877 cancel (expire)
 878
 879 =item nobill - can be set true to skip billing if it might otherwise be done.
 880
 881 =item unused_credit - can be set to 1 to credit the remaining time, or 0 to
 882 not credit it.  This must be set (by change()) when changing the package
 883 to a different pkgpart or location, and probably shouldn't be in any other
 884 case.  If it's not set, the 'unused_credit_cancel' part_pkg option will
 885 be used.
 886
 887 =item no_delay_cancel - prevents delay_cancel behavior
 888 no matter what other options say, for use when changing packages (or any
 889 other time you're really sure you want an immediate cancel)
 890
 891 =back
 892
 893 If there is an error, returns the error, otherwise returns false.
 894
 895 =cut
 896
 897 #NOT DOCUMENTING - this should only be used when calling recursively
 898 #=item delay_cancel - for internal use, to allow proper handling of
 899 #supplemental packages when the main package is flagged to suspend
 900 #before cancelling, probably shouldn't be used otherwise (set the
 901 #corresponding package option instead)
 902
 903 sub cancel {
 904   my( $self, %options ) = @_;
 905   my $error;
 906
 907   # supplemental packages can now be separately canceled, though the UI
 908   # shouldn't permit it
 909   #
 910   ## pass all suspend/cancel actions to the main package
 911   ## (unless the pkglinknum has been removed, then the link is defunct and
 912   ## this package can be canceled on its own)
 913   #if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
 914   #  return $self->main_pkg->cancel(%options);
 915   #}
 916
 917   my $conf = new FS::Conf;
 918
 919   warn "cust_pkg::cancel called with options".
 920        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 921     if $DEBUG;
 922
 923   my $oldAutoCommit = $FS::UID::AutoCommit;
 924   local $FS::UID::AutoCommit = 0;
 925   my $dbh = dbh;
 926
 927   my $old = $self->select_for_update;
 928
 929   if ( $old->get('cancel') || $self->get('cancel') ) {
 930     dbh->rollback if $oldAutoCommit;
 931     return "";  # no error
 932   }
 933
 934   # XXX possibly set cancel_time to the expire date?
 935   my $cancel_time = $options{'time'} || time;
 936   my $date = $options{'date'} if $options{'date'}; # expire/cancel later
 937   $date = '' if ($date && $date <= $cancel_time);      # complain instead?
 938
 939   my $delay_cancel = $options{'no_delay_cancel'} ? 0 : $options{'delay_cancel'};
 940   if ( !$date && $self->part_pkg->option('delay_cancel',1)
 941        && (($self->status eq 'active') || ($self->status eq 'suspended'))
 942        && !$options{'no_delay_cancel'}
 943   ) {
 944     my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
 945     my $expsecs = 60*60*24*$expdays;
 946     my $suspfor = $self->susp ? $cancel_time - $self->susp : 0;
 947     $expsecs = $expsecs - $suspfor if $suspfor;
 948     unless ($expsecs <= 0) { #if it's already been suspended long enough, don't re-suspend
 949       $delay_cancel = 1;
 950       $date = $cancel_time + $expsecs;
 951     }
 952   }
 953
 954   #race condition: usage could be ongoing until unprovisioned
 955   #resolved by performing a change package instead (which unprovisions) and
 956   #later cancelling
 957   if ( !$options{nobill} && !$date ) {
 958     # && $conf->exists('bill_usage_on_cancel') ) { #calc_cancel checks this
 959       my $copy = $self->new({$self->hash});
 960       my $error =
 961         $copy->cust_main->bill( 'pkg_list' => [ $copy ],
 962                                 'cancel'   => 1,
 963                                 'time'     => $cancel_time );
 964       warn "Error billing during cancel, custnum ".
 965         #$self->cust_main->custnum. ": $error"
 966         ": $error"
 967         if $error;
 968   }
 969
 970   if ( $options{'reason'} ) {
 971     $error = $self->insert_reason( 'reason' => $options{'reason'},
 972                                    'action' => $date ? 'expire' : 'cancel',
 973                                    'date'   => $date ? $date : $cancel_time,
 974                                    'reason_otaker' => $options{'reason_otaker'},
 975                                  );
 976     if ( $error ) {
 977       dbh->rollback if $oldAutoCommit;
 978       return "Error inserting cust_pkg_reason: $error";
 979     }
 980   }
 981
 982   my %svc_cancel_opt = ();
 983   $svc_cancel_opt{'date'} = $date if $date;
 984   foreach my $cust_svc (
 985     #schwartz
 986     map  { $_->[0] }
 987     sort { $a->[1] <=> $b->[1] }
 988     map  { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; }
 989     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 990   ) {
 991     my $part_svc = $cust_svc->part_svc;
 992     next if ( defined($part_svc) and $part_svc->preserve );
 993     my $error = $cust_svc->cancel( %svc_cancel_opt );
 994
 995     if ( $error ) {
 996       $dbh->rollback if $oldAutoCommit;
 997       return 'Error '. ($svc_cancel_opt{'date'} ? 'expiring' : 'canceling' ).
 998              " cust_svc: $error";
 999     }
1000   }
1001
1002   # if a reasonnum was passed, get the actual reason object so we can check
1003   # unused_credit
1004
1005   my $reason;
1006   if ($options{'reason'} =~ /^\d+$/) {
1007     $reason = FS::reason->by_key($options{'reason'});
1008   }
1009
1010   unless ($date) {
1011     # credit remaining time if any of these are true:
1012     # - unused_credit => 1 was passed (this happens when canceling a package
1013     #   for a package change when unused_credit_change is set)
1014     # - no unused_credit option, and there is a cancel reason, and the cancel
1015     #   reason says to credit the package
1016     # - no unused_credit option, and the package definition says to credit the
1017     #   package on cancellation
1018     my $do_credit;
1019     if ( exists($options{'unused_credit'}) ) {
1020       $do_credit = $options{'unused_credit'};
1021     } elsif ( defined($reason) && $reason->unused_credit ) {
1022       $do_credit = 1;
1023     } else {
1024       $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
1025     }
1026     if ( $do_credit ) {
1027       my $error = $self->credit_remaining('cancel', $cancel_time);
1028       if ($error) {
1029         $dbh->rollback if $oldAutoCommit;
1030         return $error;
1031       }
1032     }
1033   } #unless $date
1034
1035   my %hash = $self->hash;
1036   if ( $date ) {
1037     $hash{'expire'} = $date;
1038     if ($delay_cancel) {
1039       # just to be sure these are clear
1040       $hash{'adjourn'} = undef;
1041       $hash{'resume'} = undef;
1042     }
1043   } else {
1044     $hash{'cancel'} = $cancel_time;
1045   }
1046   $hash{'change_custnum'} = $options{'change_custnum'};
1047
1048   # if this is a supplemental package that's lost its part_pkg_link, and it's
1049   # being canceled for real, unlink it completely
1050   if ( !$date and ! $self->pkglinknum ) {
1051     $hash{main_pkgnum} = '';
1052   }
1053
1054   # if there is a future package change scheduled, unlink from it (like
1055   # abort_change) first, then delete it.
1056   $hash{'change_to_pkgnum'} = '';
1057
1058   # save the package state
1059   my $new = new FS::cust_pkg ( \%hash );
1060   $error = $new->replace( $self, options => { $self->options } );
1061
1062   if ( $self->change_to_pkgnum ) {
1063     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
1064     $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete;
1065   }
1066   if ( $error ) {
1067     $dbh->rollback if $oldAutoCommit;
1068     return $error;
1069   }
1070
1071   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1072     $error = $supp_pkg->cancel(%options,
1073       'from_main' => 1,
1074       'date' => $date, #in case it got changed by delay_cancel
1075       'delay_cancel' => $delay_cancel,
1076     );
1077     if ( $error ) {
1078       $dbh->rollback if $oldAutoCommit;
1079       return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
1080     }
1081   }
1082
1083   if ($delay_cancel && !$options{'from_main'}) {
1084     $error = $new->suspend(
1085       'from_cancel' => 1,
1086       'time'        => $cancel_time
1087     );
1088   }
1089
1090   unless ($date) {
1091     foreach my $usage ( $self->cust_pkg_usage ) {
1092       $error = $usage->delete;
1093       if ( $error ) {
1094         $dbh->rollback if $oldAutoCommit;
1095         return "deleting usage pools: $error";
1096       }
1097     }
1098   }
1099
1100   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1101   return '' if $date; #no errors
1102
1103   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
1104   if ( !$options{'quiet'} &&
1105         $conf->exists('emailcancel', $self->cust_main->agentnum) &&
1106         @invoicing_list ) {
1107     my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
1108     my $error = '';
1109     if ( $msgnum ) {
1110       my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
1111       $error = $msg_template->send( 'cust_main' => $self->cust_main,
1112                                     'object'    => $self );
1113     }
1114     #should this do something on errors?
1115   }
1116
1117   ''; #no errors
1118
1119 }
1120
1121 =item cancel_if_expired [ NOW_TIMESTAMP ]
1122
1123 Cancels this package if its expire date has been reached.
1124
1125 =cut
1126
1127 sub cancel_if_expired {
1128   my $self = shift;
1129   my $time = shift || time;
1130   return '' unless $self->expire && $self->expire <= $time;
1131   my $error = $self->cancel;
1132   if ( $error ) {
1133     return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
1134            $self->custnum. ": $error";
1135   }
1136   '';
1137 }
1138
1139 =item uncancel
1140
1141 "Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
1142 locationnum, (other fields?).  Attempts to re-provision cancelled services
1143 using history information (errors at this stage are not fatal).
1144
1145 cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object
1146
1147 svc_fatal: service provisioning errors are fatal
1148
1149 svc_errors: pass an array reference, will be filled in with any provisioning errors
1150
1151 main_pkgnum: link the package as a supplemental package of this one.  For
1152 internal use only.
1153
1154 =cut
1155
1156 sub uncancel {
1157   my( $self, %options ) = @_;
1158
1159   #in case you try do do $uncancel-date = $cust_pkg->uncacel
1160   return '' unless $self->get('cancel');
1161
1162   if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) {
1163     return $self->main_pkg->uncancel(%options);
1164   }
1165
1166   ##
1167   # Transaction-alize
1168   ##
1169
1170   my $oldAutoCommit = $FS::UID::AutoCommit;
1171   local $FS::UID::AutoCommit = 0;
1172   my $dbh = dbh;
1173
1174   ##
1175   # insert the new package
1176   ##
1177
1178   my $cust_pkg = new FS::cust_pkg {
1179     last_bill       => ( $options{'last_bill'} || $self->get('last_bill') ),
1180     bill            => ( $options{'bill'}      || $self->get('bill')      ),
1181     uncancel        => time,
1182     uncancel_pkgnum => $self->pkgnum,
1183     main_pkgnum     => ($options{'main_pkgnum'} || ''),
1184     map { $_ => $self->get($_) } qw(
1185       custnum pkgpart locationnum
1186       setup
1187       susp adjourn resume expire start_date contract_end dundate
1188       change_date change_pkgpart change_locationnum
1189       manual_flag no_auto separate_bill quantity agent_pkgid
1190       recur_show_zero setup_show_zero
1191     ),
1192   };
1193
1194   my $error = $cust_pkg->insert(
1195     'change' => 1, #supresses any referral credit to a referring customer
1196     'allow_pkgpart' => 1, # allow this even if the package def is disabled
1197   );
1198   if ($error) {
1199     $dbh->rollback if $oldAutoCommit;
1200     return $error;
1201   }
1202
1203   ##
1204   # insert services
1205   ##
1206
1207   #find historical services within this timeframe before the package cancel
1208   # (incompatible with "time" option to cust_pkg->cancel?)
1209   my $fuzz = 2 * 60; #2 minutes?  too much?   (might catch separate unprovision)
1210                      #            too little? (unprovisioing export delay?)
1211   my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
1212   my @h_cust_svc = $self->h_cust_svc( $end, $start );
1213
1214   my @svc_errors;
1215   foreach my $h_cust_svc (@h_cust_svc) {
1216     my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
1217     #next unless $h_svc_x; #should this happen?
1218     (my $table = $h_svc_x->table) =~ s/^h_//;
1219     require "FS/$table.pm";
1220     my $class = "FS::$table";
1221     my $svc_x = $class->new( {
1222       'pkgnum'  => $cust_pkg->pkgnum,
1223       'svcpart' => $h_cust_svc->svcpart,
1224       map { $_ => $h_svc_x->get($_) } fields($table)
1225     } );
1226
1227     # radius_usergroup
1228     if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
1229       $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
1230     }
1231
1232     my $svc_error = $svc_x->insert;
1233     if ( $svc_error ) {
1234       if ( $options{svc_fatal} ) {
1235         $dbh->rollback if $oldAutoCommit;
1236         return $svc_error;
1237       } else {
1238         # if we've failed to insert the svc_x object, svc_Common->insert
1239         # will have removed the cust_svc already.  if not, then both records
1240         # were inserted but we failed for some other reason (export, most
1241         # likely).  in that case, report the error and delete the records.
1242         push @svc_errors, $svc_error;
1243         my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
1244         if ( $cust_svc ) {
1245           # except if export_insert failed, export_delete probably won't be
1246           # much better
1247           local $FS::svc_Common::noexport_hack = 1;
1248           my $cleanup_error = $svc_x->delete; # also deletes cust_svc
1249           if ( $cleanup_error ) { # and if THAT fails, then run away
1250             $dbh->rollback if $oldAutoCommit;
1251             return $cleanup_error;
1252           }
1253         }
1254       } # svc_fatal
1255     } # svc_error
1256   } #foreach $h_cust_svc
1257
1258   #these are pretty rare, but should handle them
1259   # - dsl_device (mac addresses)
1260   # - phone_device (mac addresses)
1261   # - dsl_note (ikano notes)
1262   # - domain_record (i.e. restore DNS information w/domains)
1263   # - inventory_item(?) (inventory w/un-cancelling service?)
1264   # - nas (svc_broaband nas stuff)
1265   #this stuff is unused in the wild afaik
1266   # - mailinglistmember
1267   # - router.svcnum?
1268   # - svc_domain.parent_svcnum?
1269   # - acct_snarf (ancient mail fetching config)
1270   # - cgp_rule (communigate)
1271   # - cust_svc_option (used by our Tron stuff)
1272   # - acct_rt_transaction (used by our time worked stuff)
1273
1274   ##
1275   # also move over any services that didn't unprovision at cancellation
1276   ##
1277
1278   foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) {
1279     $cust_svc->pkgnum( $cust_pkg->pkgnum );
1280     my $error = $cust_svc->replace;
1281     if ( $error ) {
1282       $dbh->rollback if $oldAutoCommit;
1283       return $error;
1284     }
1285   }
1286
1287   ##
1288   # Uncancel any supplemental packages, and make them supplemental to the
1289   # new one.
1290   ##
1291
1292   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1293     my $new_pkg;
1294     $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum);
1295     if ( $error ) {
1296       $dbh->rollback if $oldAutoCommit;
1297       return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
1298     }
1299   }
1300
1301   ##
1302   # Finish
1303   ##
1304
1305   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1306
1307   ${ $options{cust_pkg} }   = $cust_pkg   if ref($options{cust_pkg});
1308   @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors});
1309
1310   '';
1311 }
1312
1313 =item unexpire
1314
1315 Cancels any pending expiration (sets the expire field to null).
1316
1317 If there is an error, returns the error, otherwise returns false.
1318
1319 =cut
1320
1321 sub unexpire {
1322   my( $self, %options ) = @_;
1323   my $error;
1324
1325   my $oldAutoCommit = $FS::UID::AutoCommit;
1326   local $FS::UID::AutoCommit = 0;
1327   my $dbh = dbh;
1328
1329   my $old = $self->select_for_update;
1330
1331   my $pkgnum = $old->pkgnum;
1332   if ( $old->get('cancel') || $self->get('cancel') ) {
1333     dbh->rollback if $oldAutoCommit;
1334     return "Can't unexpire cancelled package $pkgnum";
1335     # or at least it's pointless
1336   }
1337
1338   unless ( $old->get('expire') && $self->get('expire') ) {
1339     dbh->rollback if $oldAutoCommit;
1340     return "";  # no error
1341   }
1342
1343   my %hash = $self->hash;
1344   $hash{'expire'} = '';
1345   my $new = new FS::cust_pkg ( \%hash );
1346   $error = $new->replace( $self, options => { $self->options } );
1347   if ( $error ) {
1348     $dbh->rollback if $oldAutoCommit;
1349     return $error;
1350   }
1351
1352   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1353
1354   ''; #no errors
1355
1356 }
1357
1358 =item suspend [ OPTION => VALUE ... ]
1359
1360 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1361 package, then suspends the package itself (sets the susp field to now).
1362
1363 Available options are:
1364
1365 =over 4
1366
1367 =item reason - can be set to a cancellation reason (see L<FS:reason>),
1368 either a reasonnum of an existing reason, or passing a hashref will create
1369 a new reason.  The hashref should have the following keys:
1370 - typenum - Reason type (see L<FS::reason_type>
1371 - reason - Text of the new reason.
1372
1373 =item date - can be set to a unix style timestamp to specify when to
1374 suspend (adjourn)
1375
1376 =item time - can be set to override the current time, for calculation
1377 of final invoices or unused-time credits
1378
1379 =item resume_date - can be set to a time when the package should be
1380 unsuspended.  This may be more convenient than calling C<unsuspend()>
1381 separately.
1382
1383 =item from_main - allows a supplemental package to be suspended, rather
1384 than redirecting the method call to its main package.  For internal use.
1385
1386 =item from_cancel - used when suspending from the cancel method, forces
1387 this to skip everything besides basic suspension.  For internal use.
1388
1389 =back
1390
1391 If there is an error, returns the error, otherwise returns false.
1392
1393 =cut
1394
1395 sub suspend {
1396   my( $self, %options ) = @_;
1397   my $error;
1398
1399   # supplemental packages still can't be separately suspended, but silently
1400   # exit instead of failing or passing the action to the main package (so
1401   # that the "Suspend customer" action doesn't trip over the supplemental
1402   # packages and die)
1403
1404   if ( $self->main_pkgnum and !$options{'from_main'} ) {
1405     return;
1406   }
1407
1408   my $oldAutoCommit = $FS::UID::AutoCommit;
1409   local $FS::UID::AutoCommit = 0;
1410   my $dbh = dbh;
1411
1412   my $old = $self->select_for_update;
1413
1414   my $pkgnum = $old->pkgnum;
1415   if ( $old->get('cancel') || $self->get('cancel') ) {
1416     dbh->rollback if $oldAutoCommit;
1417     return "Can't suspend cancelled package $pkgnum";
1418   }
1419
1420   if ( $old->get('susp') || $self->get('susp') ) {
1421     dbh->rollback if $oldAutoCommit;
1422     return "";  # no error                     # complain on adjourn?
1423   }
1424
1425   my $suspend_time = $options{'time'} || time;
1426   my $date = $options{date} if $options{date}; # adjourn/suspend later
1427   $date = '' if ($date && $date <= $suspend_time); # complain instead?
1428
1429   if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
1430     dbh->rollback if $oldAutoCommit;
1431     return "Package $pkgnum expires before it would be suspended.";
1432   }
1433
1434   # some false laziness with sub cancel
1435   if ( !$options{nobill} && !$date && !$options{'from_cancel'} &&
1436        $self->part_pkg->option('bill_suspend_as_cancel',1) ) {
1437     # kind of a kludge--'bill_suspend_as_cancel' to avoid having to
1438     # make the entire cust_main->bill path recognize 'suspend' and
1439     # 'cancel' separately.
1440     warn "Billing $pkgnum on suspension (at $suspend_time)\n" if $DEBUG;
1441     my $copy = $self->new({$self->hash});
1442     my $error =
1443       $copy->cust_main->bill( 'pkg_list' => [ $copy ],
1444                               'cancel'   => 1,
1445                               'time'     => $suspend_time );
1446     warn "Error billing during suspend, custnum ".
1447       #$self->cust_main->custnum. ": $error"
1448       ": $error"
1449       if $error;
1450   }
1451
1452   my $cust_pkg_reason;
1453   if ( $options{'reason'} ) {
1454     $error = $self->insert_reason( 'reason' => $options{'reason'},
1455                                    'action' => $date ? 'adjourn' : 'suspend',
1456                                    'date'   => $date ? $date : $suspend_time,
1457                                    'reason_otaker' => $options{'reason_otaker'},
1458                                  );
1459     if ( $error ) {
1460       dbh->rollback if $oldAutoCommit;
1461       return "Error inserting cust_pkg_reason: $error";
1462     }
1463     $cust_pkg_reason = qsearchs('cust_pkg_reason', {
1464         'date'    => $date ? $date : $suspend_time,
1465         'action'  => $date ? 'A' : 'S',
1466         'pkgnum'  => $self->pkgnum,
1467     });
1468   }
1469
1470   # if a reasonnum was passed, get the actual reason object so we can check
1471   # unused_credit
1472   # (passing a reason hashref is still allowed, but it can't be used with
1473   # the fancy behavioral options.)
1474
1475   my $reason;
1476   if ($options{'reason'} =~ /^\d+$/) {
1477     $reason = FS::reason->by_key($options{'reason'});
1478   }
1479
1480   my %hash = $self->hash;
1481   if ( $date ) {
1482     $hash{'adjourn'} = $date;
1483   } else {
1484     $hash{'susp'} = $suspend_time;
1485   }
1486
1487   my $resume_date = $options{'resume_date'} || 0;
1488   if ( $resume_date > ($date || $suspend_time) ) {
1489     $hash{'resume'} = $resume_date;
1490   }
1491
1492   $options{options} ||= {};
1493
1494   my $new = new FS::cust_pkg ( \%hash );
1495   $error = $new->replace( $self, options => { $self->options,
1496                                               %{ $options{options} },
1497                                             }
1498                         );
1499   if ( $error ) {
1500     $dbh->rollback if $oldAutoCommit;
1501     return $error;
1502   }
1503
1504   unless ( $date ) { # then we are suspending now
1505
1506     unless ($options{'from_cancel'}) {
1507       # credit remaining time if appropriate
1508       # (if required by the package def, or the suspend reason)
1509       my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1)
1510                           || ( defined($reason) && $reason->unused_credit );
1511
1512       if ( $unused_credit ) {
1513         warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG;
1514         my $error = $self->credit_remaining('suspend', $suspend_time);
1515         if ($error) {
1516           $dbh->rollback if $oldAutoCommit;
1517           return $error;
1518         }
1519       }
1520     }
1521
1522     my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
1523
1524     #attempt ordering ala cust_svc_suspend_cascade (without infinite-looping
1525     # on the circular dep case)
1526     #  (this is too simple for multi-level deps, we need to use something
1527     #   to resolve the DAG properly when possible)
1528     my %svcpart = ();
1529     $svcpart{$_->svcpart} = 0 foreach @cust_svc;
1530     foreach my $svcpart ( keys %svcpart ) {
1531       foreach my $part_svc_link (
1532         FS::part_svc_link->by_agentnum($self->cust_main->agentnum,
1533                                          src_svcpart => $svcpart,
1534                                          link_type => 'cust_svc_suspend_cascade'
1535                                       )
1536       ) {
1537         $svcpart{$part_svc_link->dst_svcpart} = max(
1538           $svcpart{$part_svc_link->dst_svcpart},
1539           $svcpart{$part_svc_link->src_svcpart} + 1
1540         );
1541       }
1542     }
1543     @cust_svc = sort { $svcpart{ $a->svcpart } <=> $svcpart{ $b->svcpart } }
1544                   @cust_svc;
1545
1546     my @labels = ();
1547     foreach my $cust_svc ( @cust_svc ) {
1548       $cust_svc->suspend( 'labels_arrayref' => \@labels );
1549     }
1550
1551     # suspension fees: if there is a feepart, and it's not an unsuspend fee,
1552     # and this is not a suspend-before-cancel
1553     if ( $cust_pkg_reason ) {
1554       my $reason_obj = $cust_pkg_reason->reason;
1555       if ( $reason_obj->feepart and
1556            ! $reason_obj->fee_on_unsuspend and
1557            ! $options{'from_cancel'} ) {
1558
1559         # register the need to charge a fee, cust_main->bill will do the rest
1560         warn "registering suspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
1561           if $DEBUG;
1562         my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
1563             'pkgreasonnum'  => $cust_pkg_reason->num,
1564             'pkgnum'        => $self->pkgnum,
1565             'feepart'       => $reason->feepart,
1566             'nextbill'      => $reason->fee_hold,
1567         });
1568         $error ||= $cust_pkg_reason_fee->insert;
1569       }
1570     }
1571
1572     my $conf = new FS::Conf;
1573     if ( $conf->config('suspend_email_admin') && !$options{'from_cancel'} ) {
1574
1575       my $error = send_email(
1576         'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
1577                                    #invoice_from ??? well as good as any
1578         'to'      => $conf->config('suspend_email_admin'),
1579         'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
1580         'body'    => [
1581           "This is an automatic message from your Freeside installation\n",
1582           "informing you that the following customer package has been suspended:\n",
1583           "\n",
1584           'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1585           'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1586           ( map { "Service : $_\n" } @labels ),
1587         ],
1588         'custnum' => $self->custnum,
1589         'msgtype' => 'admin'
1590       );
1591
1592       if ( $error ) {
1593         warn "WARNING: can't send suspension admin email (suspending anyway): ".
1594              "$error\n";
1595       }
1596
1597     }
1598
1599   }
1600
1601   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1602     $error = $supp_pkg->suspend(%options, 'from_main' => 1);
1603     if ( $error ) {
1604       $dbh->rollback if $oldAutoCommit;
1605       return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
1606     }
1607   }
1608
1609   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1610
1611   ''; #no errors
1612 }
1613
1614 =item credit_remaining MODE TIME
1615
1616 Generate a credit for this package for the time remaining in the current
1617 billing period.  MODE is either "suspend" or "cancel" (determines the
1618 credit type).  TIME is the time of suspension/cancellation.  Both arguments
1619 are mandatory.
1620
1621 =cut
1622
1623 # Implementation note:
1624 #
1625 # If you pkgpart-change a package that has been billed, and it's set to give
1626 # credit on package change, then this method gets called and then the new
1627 # package will have no last_bill date. Therefore the customer will be credited
1628 # only once (per billing period) even if there are multiple package changes.
1629 #
1630 # If you location-change a package that has been billed, this method will NOT
1631 # be called and the new package WILL have the last bill date of the old
1632 # package.
1633 #
1634 # If the new package is then canceled within the same billing cycle,
1635 # credit_remaining needs to run calc_remain on the OLD package to determine
1636 # the amount of unused time to credit.
1637
1638 sub credit_remaining {
1639   # Add a credit for remaining service
1640   my ($self, $mode, $time) = @_;
1641   die 'credit_remaining requires suspend or cancel'
1642     unless $mode eq 'suspend' or $mode eq 'cancel';
1643   die 'no suspend/cancel time' unless $time > 0;
1644
1645   my $conf = FS::Conf->new;
1646   my $reason_type = $conf->config($mode.'_credit_type');
1647
1648   my $last_bill = $self->getfield('last_bill') || 0;
1649   my $next_bill = $self->getfield('bill') || 0;
1650   if ( $last_bill > 0         # the package has been billed
1651       and $next_bill > 0      # the package has a next bill date
1652       and $next_bill >= $time # which is in the future
1653   ) {
1654     my @cust_credit_source_bill_pkg = ();
1655     my $remaining_value = 0;
1656
1657     my $remain_pkg = $self;
1658     $remaining_value = $remain_pkg->calc_remain(
1659       'time' => $time,
1660       'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
1661     );
1662
1663     # we may have to walk back past some package changes to get to the
1664     # one that actually has unused time
1665     while ( $remaining_value == 0 ) {
1666       if ( $remain_pkg->change_pkgnum ) {
1667         $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum);
1668       } else {
1669         # the package has really never been billed
1670         return;
1671       }
1672       $remaining_value = $remain_pkg->calc_remain(
1673         'time' => $time,
1674         'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
1675       );
1676     }
1677
1678     if ( $remaining_value > 0 ) {
1679       warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
1680         if $DEBUG;
1681       my $error = $self->cust_main->credit(
1682         $remaining_value,
1683         'Credit for unused time on '. $self->part_pkg->pkg,
1684         'reason_type' => $reason_type,
1685         'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
1686       );
1687       return "Error crediting customer \$$remaining_value for unused time".
1688         " on ". $self->part_pkg->pkg. ": $error"
1689         if $error;
1690     } #if $remaining_value
1691   } #if $last_bill, etc.
1692   '';
1693 }
1694
1695 =item unsuspend [ OPTION => VALUE ... ]
1696
1697 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1698 package, then unsuspends the package itself (clears the susp field and the
1699 adjourn field if it is in the past).  If the suspend reason includes an
1700 unsuspension package, that package will be ordered.
1701
1702 Available options are:
1703
1704 =over 4
1705
1706 =item date
1707
1708 Can be set to a date to unsuspend the package in the future (the 'resume'
1709 field).
1710
1711 =item adjust_next_bill
1712
1713 Can be set true to adjust the next bill date forward by
1714 the amount of time the account was inactive.  This was set true by default
1715 in the past (from 1.4.2 and 1.5.0pre6 through 1.7.0), but now needs to be
1716 explicitly requested with this option or in the price plan.
1717
1718 =back
1719
1720 If there is an error, returns the error, otherwise returns false.
1721
1722 =cut
1723
1724 sub unsuspend {
1725   my( $self, %opt ) = @_;
1726   my $error;
1727
1728   # pass all suspend/cancel actions to the main package
1729   if ( $self->main_pkgnum and !$opt{'from_main'} ) {
1730     return $self->main_pkg->unsuspend(%opt);
1731   }
1732
1733   my $oldAutoCommit = $FS::UID::AutoCommit;
1734   local $FS::UID::AutoCommit = 0;
1735   my $dbh = dbh;
1736
1737   my $old = $self->select_for_update;
1738
1739   my $pkgnum = $old->pkgnum;
1740   if ( $old->get('cancel') || $self->get('cancel') ) {
1741     $dbh->rollback if $oldAutoCommit;
1742     return "Can't unsuspend cancelled package $pkgnum";
1743   }
1744
1745   unless ( $old->get('susp') && $self->get('susp') ) {
1746     $dbh->rollback if $oldAutoCommit;
1747     return "";  # no error                     # complain instead?
1748   }
1749
1750   # handle the case of setting a future unsuspend (resume) date
1751   # and do not continue to actually unsuspend the package
1752   my $date = $opt{'date'};
1753   if ( $date and $date > time ) { # return an error if $date <= time?
1754
1755     if ( $old->get('expire') && $old->get('expire') < $date ) {
1756       $dbh->rollback if $oldAutoCommit;
1757       return "Package $pkgnum expires before it would be unsuspended.";
1758     }
1759
1760     my $new = new FS::cust_pkg { $self->hash };
1761     $new->set('resume', $date);
1762     $error = $new->replace($self, options => $self->options);
1763
1764     if ( $error ) {
1765       $dbh->rollback if $oldAutoCommit;
1766       return $error;
1767     }
1768     else {
1769       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1770       return '';
1771     }
1772
1773   } #if $date
1774
1775   if (!$self->setup) {
1776     # then this package is being released from on-hold status
1777     $error = $self->set_initial_timers;
1778     if ( $error ) {
1779       $dbh->rollback if $oldAutoCommit;
1780       return $error;
1781     }
1782   }
1783
1784   my @labels = ();
1785
1786   foreach my $cust_svc (
1787     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1788   ) {
1789     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1790
1791     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1792       $dbh->rollback if $oldAutoCommit;
1793       return "Illegal svcdb value in part_svc!";
1794     };
1795     my $svcdb = $1;
1796     require "FS/$svcdb.pm";
1797
1798     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1799     if ($svc) {
1800       $error = $svc->unsuspend;
1801       if ( $error ) {
1802         $dbh->rollback if $oldAutoCommit;
1803         return $error;
1804       }
1805       my( $label, $value ) = $cust_svc->label;
1806       push @labels, "$label: $value";
1807     }
1808
1809   }
1810
1811   my $cust_pkg_reason = $self->last_cust_pkg_reason('susp');
1812   my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : '';
1813
1814   my %hash = $self->hash;
1815   my $inactive = time - $hash{'susp'};
1816
1817   my $conf = new FS::Conf;
1818
1819   #adjust the next bill date forward
1820   # increment next bill date if certain conditions are met:
1821   # - it was due to be billed at some point
1822   # - either the global or local config says to do this
1823   my $adjust_bill = 0;
1824   if (
1825        $inactive > 0
1826     && ( $hash{'bill'} || $hash{'setup'} )
1827     && (    $opt{'adjust_next_bill'}
1828          || $conf->exists('unsuspend-always_adjust_next_bill_date')
1829          || $self->part_pkg->option('unsuspend_adjust_bill', 1)
1830        )
1831   ) {
1832     $adjust_bill = 1;
1833   }
1834
1835   # but not if:
1836   # - the package billed during suspension
1837   # - or it was ordered on hold
1838   # - or the customer was credited for the unused time
1839
1840   if ( $self->option('suspend_bill',1)
1841       or ( $self->part_pkg->option('suspend_bill',1)
1842            and ! $self->option('no_suspend_bill',1)
1843          )
1844       or $hash{'order_date'} == $hash{'susp'}
1845   ) {
1846     $adjust_bill = 0;
1847   }
1848
1849   if ( $adjust_bill ) {
1850     if (    $self->part_pkg->option('unused_credit_suspend')
1851          or ( ref($reason) and $reason->unused_credit ) ) {
1852       # then the customer was credited for the unused time before suspending,
1853       # so their next bill should be immediate
1854       $hash{'bill'} = time;
1855     } else {
1856       # add the length of time suspended to the bill date
1857       $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1858     }
1859   }
1860
1861   $hash{'susp'} = '';
1862   $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
1863   $hash{'resume'} = '' if !$hash{'adjourn'};
1864   my $new = new FS::cust_pkg ( \%hash );
1865   $error = $new->replace( $self, options => { $self->options } );
1866   if ( $error ) {
1867     $dbh->rollback if $oldAutoCommit;
1868     return $error;
1869   }
1870
1871   my $unsusp_pkg;
1872
1873   if ( $reason ) {
1874     if ( $reason->unsuspend_pkgpart ) {
1875       warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n";
1876       my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
1877         or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
1878                     " not found.";
1879       my $start_date = $self->cust_main->next_bill_date
1880         if $reason->unsuspend_hold;
1881
1882       if ( $part_pkg ) {
1883         $unsusp_pkg = FS::cust_pkg->new({
1884             'custnum'     => $self->custnum,
1885             'pkgpart'     => $reason->unsuspend_pkgpart,
1886             'start_date'  => $start_date,
1887             'locationnum' => $self->locationnum,
1888             # discount? probably not...
1889         });
1890
1891         $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
1892       }
1893     }
1894     # new way, using fees
1895     if ( $reason->feepart and $reason->fee_on_unsuspend ) {
1896       # register the need to charge a fee, cust_main->bill will do the rest
1897       warn "registering unsuspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
1898         if $DEBUG;
1899       my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
1900           'pkgreasonnum'  => $cust_pkg_reason->num,
1901           'pkgnum'        => $self->pkgnum,
1902           'feepart'       => $reason->feepart,
1903           'nextbill'      => $reason->fee_hold,
1904       });
1905       $error ||= $cust_pkg_reason_fee->insert;
1906     }
1907
1908     if ( $error ) {
1909       $dbh->rollback if $oldAutoCommit;
1910       return $error;
1911     }
1912   }
1913
1914   if ( $conf->config('unsuspend_email_admin') ) {
1915
1916     my $error = send_email(
1917       'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
1918                                  #invoice_from ??? well as good as any
1919       'to'      => $conf->config('unsuspend_email_admin'),
1920       'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended',       'body'    => [
1921         "This is an automatic message from your Freeside installation\n",
1922         "informing you that the following customer package has been unsuspended:\n",
1923         "\n",
1924         'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1925         'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1926         ( map { "Service : $_\n" } @labels ),
1927         ($unsusp_pkg ?
1928           "An unsuspension fee was charged: ".
1929             $unsusp_pkg->part_pkg->pkg_comment."\n"
1930           : ''
1931         ),
1932       ],
1933       'custnum' => $self->custnum,
1934       'msgtype' => 'admin',
1935     );
1936
1937     if ( $error ) {
1938       warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ".
1939            "$error\n";
1940     }
1941
1942   }
1943
1944   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1945     $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1);
1946     if ( $error ) {
1947       $dbh->rollback if $oldAutoCommit;
1948       return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
1949     }
1950   }
1951
1952   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1953
1954   ''; #no errors
1955 }
1956
1957 =item unadjourn
1958
1959 Cancels any pending suspension (sets the adjourn field to null).
1960
1961 If there is an error, returns the error, otherwise returns false.
1962
1963 =cut
1964
1965 sub unadjourn {
1966   my( $self, %options ) = @_;
1967   my $error;
1968
1969   my $oldAutoCommit = $FS::UID::AutoCommit;
1970   local $FS::UID::AutoCommit = 0;
1971   my $dbh = dbh;
1972
1973   my $old = $self->select_for_update;
1974
1975   my $pkgnum = $old->pkgnum;
1976   if ( $old->get('cancel') || $self->get('cancel') ) {
1977     dbh->rollback if $oldAutoCommit;
1978     return "Can't unadjourn cancelled package $pkgnum";
1979     # or at least it's pointless
1980   }
1981
1982   if ( $old->get('susp') || $self->get('susp') ) {
1983     dbh->rollback if $oldAutoCommit;
1984     return "Can't unadjourn suspended package $pkgnum";
1985     # perhaps this is arbitrary
1986   }
1987
1988   unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1989     dbh->rollback if $oldAutoCommit;
1990     return "";  # no error
1991   }
1992
1993   my %hash = $self->hash;
1994   $hash{'adjourn'} = '';
1995   $hash{'resume'}  = '';
1996   my $new = new FS::cust_pkg ( \%hash );
1997   $error = $new->replace( $self, options => { $self->options } );
1998   if ( $error ) {
1999     $dbh->rollback if $oldAutoCommit;
2000     return $error;
2001   }
2002
2003   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2004
2005   ''; #no errors
2006
2007 }
2008
2009
2010 =item change HASHREF | OPTION => VALUE ...
2011
2012 Changes this package: cancels it and creates a new one, with a different
2013 pkgpart or locationnum or both.  All services are transferred to the new
2014 package (no change will be made if this is not possible).
2015
2016 Options may be passed as a list of key/value pairs or as a hash reference.
2017 Options are:
2018
2019 =over 4
2020
2021 =item locationnum
2022
2023 New locationnum, to change the location for this package.
2024
2025 =item cust_location
2026
2027 New FS::cust_location object, to create a new location and assign it
2028 to this package.
2029
2030 =item cust_main
2031
2032 New FS::cust_main object, to create a new customer and assign the new package
2033 to it.
2034
2035 =item pkgpart
2036
2037 New pkgpart (see L<FS::part_pkg>).
2038
2039 =item refnum
2040
2041 New refnum (see L<FS::part_referral>).
2042
2043 =item quantity
2044
2045 New quantity; if unspecified, the new package will have the same quantity
2046 as the old.
2047
2048 =item cust_pkg
2049
2050 "New" (existing) FS::cust_pkg object.  The package's services and other
2051 attributes will be transferred to this package.
2052
2053 =item keep_dates
2054
2055 Set to true to transfer billing dates (start_date, setup, last_bill, bill,
2056 susp, adjourn, cancel, expire, and contract_end) to the new package.
2057
2058 =item unprotect_svcs
2059
2060 Normally, change() will rollback and return an error if some services
2061 can't be transferred (also see the I<cust_pkg-change_svcpart> config option).
2062 If unprotect_svcs is true, this method will transfer as many services as
2063 it can and then unconditionally cancel the old package.
2064
2065 =item contract_end
2066
2067 If specified, sets this value for the contract_end date on the new package
2068 (without regard for keep_dates or the usual date-preservation behavior.)
2069 Will throw an error if defined but false;  the UI doesn't allow editing
2070 this unless it already exists, making removal impossible to undo.
2071
2072 =back
2073
2074 At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or
2075 cust_pkg must be specified (otherwise, what's the point?)
2076
2077 Returns either the new FS::cust_pkg object or a scalar error.
2078
2079 For example:
2080
2081   my $err_or_new_cust_pkg = $old_cust_pkg->change
2082
2083 =cut
2084
2085 #used by change and change_later
2086 #didn't put with documented check methods because it depends on change-specific opts
2087 #and it also possibly edits the value of opts
2088 sub _check_change {
2089   my $self = shift;
2090   my $opt = shift;
2091   if ( defined($opt->{'contract_end'}) ) {
2092     my $current_contract_end = $self->get('contract_end');
2093     unless ($opt->{'contract_end'}) {
2094       if ($current_contract_end) {
2095         return "Cannot remove contract end date when changing packages";
2096       } else {
2097         #shouldn't even pass this option if there's not a current value
2098         #but can be handled gracefully if the option is empty
2099         warn "Contract end date passed unexpectedly";
2100         delete $opt->{'contract_end'};
2101         return '';
2102       }
2103     }
2104     unless ($current_contract_end) {
2105       #option shouldn't be passed, throw error if it's non-empty
2106       return "Cannot add contract end date when changing packages " . $self->pkgnum;
2107     }
2108   }
2109   return '';
2110 }
2111
2112 #some false laziness w/order
2113 sub change {
2114   my $self = shift;
2115   my $opt = ref($_[0]) ? shift : { @_ };
2116
2117   my $conf = new FS::Conf;
2118
2119   # handle contract_end on cust_pkg same as passed option
2120   if ( $opt->{'cust_pkg'} ) {
2121     $opt->{'contract_end'} = $opt->{'cust_pkg'}->contract_end;
2122     delete $opt->{'contract_end'} unless $opt->{'contract_end'};
2123   }
2124
2125   # check contract_end, prevent adding/removing
2126   my $error = $self->_check_change($opt);
2127   return $error if $error;
2128
2129   # Transactionize this whole mess
2130   my $oldAutoCommit = $FS::UID::AutoCommit;
2131   local $FS::UID::AutoCommit = 0;
2132   my $dbh = dbh;
2133
2134   if ( $opt->{'cust_location'} ) {
2135     $error = $opt->{'cust_location'}->find_or_insert;
2136     if ( $error ) {
2137       $dbh->rollback if $oldAutoCommit;
2138       return "creating location record: $error";
2139     }
2140     $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
2141   }
2142
2143   # Before going any further here: if the package is still in the pre-setup
2144   # state, it's safe to modify it in place. No need to charge/credit for
2145   # partial period, transfer services, transfer usage pools, copy invoice
2146   # details, or change any dates.
2147   if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
2148     foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) {
2149       if ( length($opt->{$_}) ) {
2150         $self->set($_, $opt->{$_});
2151       }
2152     }
2153     # almost. if the new pkgpart specifies start/adjourn/expire timers,
2154     # apply those.
2155     if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
2156       $error ||= $self->set_initial_timers;
2157     }
2158     # but if contract_end was explicitly specified, that overrides all else
2159     $self->set('contract_end', $opt->{'contract_end'})
2160       if $opt->{'contract_end'};
2161     $error ||= $self->replace;
2162     if ( $error ) {
2163       $dbh->rollback if $oldAutoCommit;
2164       return "modifying package: $error";
2165     } else {
2166       $dbh->commit if $oldAutoCommit;
2167       return $self;
2168     }
2169   }
2170
2171   my %hash = ();
2172
2173   my $time = time;
2174
2175   $hash{'setup'} = $time if $self->get('setup');
2176
2177   $hash{'change_date'} = $time;
2178   $hash{"change_$_"}  = $self->$_()
2179     foreach qw( pkgnum pkgpart locationnum );
2180
2181   if ( $opt->{'cust_pkg'} ) {
2182     # treat changing to a package with a different pkgpart as a
2183     # pkgpart change (because it is)
2184     $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart;
2185   }
2186
2187   # whether to override pkgpart checking on the new package
2188   my $same_pkgpart = 1;
2189   if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) {
2190     $same_pkgpart = 0;
2191   }
2192
2193   my $unused_credit = 0;
2194   my $keep_dates = $opt->{'keep_dates'};
2195
2196   # Special case.  If the pkgpart is changing, and the customer is going to be
2197   # credited for remaining time, don't keep setup, bill, or last_bill dates,
2198   # and DO pass the flag to cancel() to credit the customer.  If the old
2199   # package had a setup date, set the new package's setup to the package
2200   # change date so that it has the same status as before.
2201   if ( $opt->{'pkgpart'}
2202        and $opt->{'pkgpart'} != $self->pkgpart
2203        and $self->part_pkg->option('unused_credit_change', 1) ) {
2204     $unused_credit = 1;
2205     $keep_dates = 0;
2206     $hash{'last_bill'} = '';
2207     $hash{'bill'} = '';
2208   }
2209
2210   if ( $keep_dates ) {
2211     foreach my $date ( qw(setup bill last_bill) ) {
2212       $hash{$date} = $self->getfield($date);
2213     }
2214   }
2215   # always keep the following dates
2216   foreach my $date (qw(order_date susp adjourn cancel expire resume
2217                     start_date contract_end)) {
2218     $hash{$date} = $self->getfield($date);
2219   }
2220   # but if contract_end was explicitly specified, that overrides all else
2221   $hash{'contract_end'} = $opt->{'contract_end'}
2222     if $opt->{'contract_end'};
2223
2224   # allow $opt->{'locationnum'} = '' to specifically set it to null
2225   # (i.e. customer default location)
2226   $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2227
2228   # usually this doesn't matter.  the two cases where it does are:
2229   # 1. unused_credit_change + pkgpart change + setup fee on the new package
2230   # and
2231   # 2. (more importantly) changing a package before it's billed
2232   $hash{'waive_setup'} = $self->waive_setup;
2233
2234   # if this package is scheduled for a future package change, preserve that
2235   $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
2236
2237   my $custnum = $self->custnum;
2238   if ( $opt->{cust_main} ) {
2239     my $cust_main = $opt->{cust_main};
2240     unless ( $cust_main->custnum ) {
2241       my $error = $cust_main->insert( @{ $opt->{cust_main_insert_args}||[] } );
2242       if ( $error ) {
2243         $dbh->rollback if $oldAutoCommit;
2244         return "inserting customer record: $error";
2245       }
2246     }
2247     $custnum = $cust_main->custnum;
2248   }
2249
2250   $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
2251
2252   my $cust_pkg;
2253   if ( $opt->{'cust_pkg'} ) {
2254     # The target package already exists; update it to show that it was
2255     # changed from this package.
2256     $cust_pkg = $opt->{'cust_pkg'};
2257
2258     # follow all the above rules for date changes, etc.
2259     foreach (keys %hash) {
2260       $cust_pkg->set($_, $hash{$_});
2261     }
2262     # except those that implement the future package change behavior
2263     foreach (qw(change_to_pkgnum start_date expire)) {
2264       $cust_pkg->set($_, '');
2265     }
2266
2267     $error = $cust_pkg->replace;
2268
2269   } else {
2270     # Create the new package.
2271     $cust_pkg = new FS::cust_pkg {
2272       custnum     => $custnum,
2273       locationnum => $opt->{'locationnum'},
2274       ( map {  $_ => ( $opt->{$_} || $self->$_() )  }
2275           qw( pkgpart quantity refnum salesnum )
2276       ),
2277       %hash,
2278     };
2279     $error = $cust_pkg->insert( 'change' => 1,
2280                                 'allow_pkgpart' => $same_pkgpart );
2281   }
2282   if ($error) {
2283     $dbh->rollback if $oldAutoCommit;
2284     return "inserting new package: $error";
2285   }
2286
2287   # Transfer services and cancel old package.
2288   # Enforce service limits only if this is a pkgpart change.
2289   local $FS::cust_svc::ignore_quantity;
2290   $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
2291   $error = $self->transfer($cust_pkg);
2292   if ($error and $error == 0) {
2293     # $old_pkg->transfer failed.
2294     $dbh->rollback if $oldAutoCommit;
2295     return "transferring $error";
2296   }
2297
2298   if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2299     warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2300     $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
2301     if ($error and $error == 0) {
2302       # $old_pkg->transfer failed.
2303       $dbh->rollback if $oldAutoCommit;
2304       return "converting $error";
2305     }
2306   }
2307
2308   # We set unprotect_svcs when executing a "future package change".  It's
2309   # not a user-interactive operation, so returning an error means the
2310   # package change will just fail.  Rather than have that happen, we'll
2311   # let leftover services be deleted.
2312   if ($error > 0 and !$opt->{'unprotect_svcs'}) {
2313     # Transfers were successful, but we still had services left on the old
2314     # package.  We can't change the package under this circumstances, so abort.
2315     $dbh->rollback if $oldAutoCommit;
2316     return "unable to transfer all services";
2317   }
2318
2319   #reset usage if changing pkgpart
2320   # AND usage rollover is off (otherwise adds twice, now and at package bill)
2321   if ($self->pkgpart != $cust_pkg->pkgpart) {
2322     my $part_pkg = $cust_pkg->part_pkg;
2323     $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
2324                                                  ? ()
2325                                                  : ( 'null' => 1 )
2326                                    )
2327       if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
2328
2329     if ($error) {
2330       $dbh->rollback if $oldAutoCommit;
2331       return "setting usage values: $error";
2332     }
2333   } else {
2334     # if NOT changing pkgpart, transfer any usage pools over
2335     foreach my $usage ($self->cust_pkg_usage) {
2336       $usage->set('pkgnum', $cust_pkg->pkgnum);
2337       $error = $usage->replace;
2338       if ( $error ) {
2339         $dbh->rollback if $oldAutoCommit;
2340         return "transferring usage pools: $error";
2341       }
2342     }
2343   }
2344
2345   # transfer usage pricing add-ons, if we're not changing pkgpart or if they were specified
2346   if ( $same_pkgpart || $opt->{'cust_pkg_usageprice'}) {
2347     my @old_cust_pkg_usageprice;
2348     if ($opt->{'cust_pkg_usageprice'}) {
2349       @old_cust_pkg_usageprice = @{ $opt->{'cust_pkg_usageprice'} };
2350     } else {
2351       @old_cust_pkg_usageprice = $self->cust_pkg_usageprice;
2352     }
2353     foreach my $old_cust_pkg_usageprice (@old_cust_pkg_usageprice) {
2354       my $new_cust_pkg_usageprice = new FS::cust_pkg_usageprice {
2355         'pkgnum'         => $cust_pkg->pkgnum,
2356         'usagepricepart' => $old_cust_pkg_usageprice->usagepricepart,
2357         'quantity'       => $old_cust_pkg_usageprice->quantity,
2358       };
2359       $error = $new_cust_pkg_usageprice->insert;
2360       if ( $error ) {
2361         $dbh->rollback if $oldAutoCommit;
2362         return "Error transferring usage pricing add-on: $error";
2363       }
2364     }
2365   }
2366
2367   # transfer discounts, if we're not changing pkgpart
2368   if ( $same_pkgpart ) {
2369     foreach my $old_discount ($self->cust_pkg_discount_active) {
2370       # don't remove the old discount, we may still need to bill that package.
2371       my $new_discount = new FS::cust_pkg_discount {
2372         'pkgnum'      => $cust_pkg->pkgnum,
2373         'discountnum' => $old_discount->discountnum,
2374         'months_used' => $old_discount->months_used,
2375       };
2376       $error = $new_discount->insert;
2377       if ( $error ) {
2378         $dbh->rollback if $oldAutoCommit;
2379         return "transferring discounts: $error";
2380       }
2381     }
2382   }
2383
2384   # transfer (copy) invoice details
2385   foreach my $detail ($self->cust_pkg_detail) {
2386     my $new_detail = FS::cust_pkg_detail->new({ $detail->hash });
2387     $new_detail->set('pkgdetailnum', '');
2388     $new_detail->set('pkgnum', $cust_pkg->pkgnum);
2389     $error = $new_detail->insert;
2390     if ( $error ) {
2391       $dbh->rollback if $oldAutoCommit;
2392       return "transferring package notes: $error";
2393     }
2394   }
2395
2396   my @new_supp_pkgs;
2397
2398   if ( !$opt->{'cust_pkg'} ) {
2399     # Order any supplemental packages.
2400     my $part_pkg = $cust_pkg->part_pkg;
2401     my @old_supp_pkgs = $self->supplemental_pkgs;
2402     foreach my $link ($part_pkg->supp_part_pkg_link) {
2403       my $old;
2404       foreach (@old_supp_pkgs) {
2405         if ($_->pkgpart == $link->dst_pkgpart) {
2406           $old = $_;
2407           $_->pkgpart(0); # so that it can't match more than once
2408         }
2409         last if $old;
2410       }
2411       # false laziness with FS::cust_main::Packages::order_pkg
2412       my $new = FS::cust_pkg->new({
2413           pkgpart       => $link->dst_pkgpart,
2414           pkglinknum    => $link->pkglinknum,
2415           custnum       => $custnum,
2416           main_pkgnum   => $cust_pkg->pkgnum,
2417           locationnum   => $cust_pkg->locationnum,
2418           start_date    => $cust_pkg->start_date,
2419           order_date    => $cust_pkg->order_date,
2420           expire        => $cust_pkg->expire,
2421           adjourn       => $cust_pkg->adjourn,
2422           contract_end  => $cust_pkg->contract_end,
2423           refnum        => $cust_pkg->refnum,
2424           discountnum   => $cust_pkg->discountnum,
2425           waive_setup   => $cust_pkg->waive_setup,
2426       });
2427       if ( $old and $opt->{'keep_dates'} ) {
2428         foreach (qw(setup bill last_bill)) {
2429           $new->set($_, $old->get($_));
2430         }
2431       }
2432       $error = $new->insert( allow_pkgpart => $same_pkgpart );
2433       # transfer services
2434       if ( $old ) {
2435         $error ||= $old->transfer($new);
2436       }
2437       if ( $error and $error > 0 ) {
2438         # no reason why this should ever fail, but still...
2439         $error = "Unable to transfer all services from supplemental package ".
2440           $old->pkgnum;
2441       }
2442       if ( $error ) {
2443         $dbh->rollback if $oldAutoCommit;
2444         return $error;
2445       }
2446       push @new_supp_pkgs, $new;
2447     }
2448   } # if !$opt->{'cust_pkg'}
2449     # because if there is one, then supplemental packages would already
2450     # have been created for it.
2451
2452   #Good to go, cancel old package.  Notify 'cancel' of whether to credit
2453   #remaining time.
2454   #Don't allow billing the package (preceding period packages and/or
2455   #outstanding usage) if we are keeping dates (i.e. location changing),
2456   #because the new package will be billed for the same date range.
2457   #Supplemental packages are also canceled here.
2458
2459   # during scheduled changes, avoid canceling the package we just
2460   # changed to (duh)
2461   $self->set('change_to_pkgnum' => '');
2462
2463   $error = $self->cancel(
2464     quiet          => 1,
2465     unused_credit  => $unused_credit,
2466     nobill         => $keep_dates,
2467     change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
2468     no_delay_cancel => 1,
2469   );
2470   if ($error) {
2471     $dbh->rollback if $oldAutoCommit;
2472     return "canceling old package: $error";
2473   }
2474
2475   if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
2476     #$self->cust_main
2477     my $error = $cust_pkg->cust_main->bill(
2478       'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
2479     );
2480     if ( $error ) {
2481       $dbh->rollback if $oldAutoCommit;
2482       return "billing new package: $error";
2483     }
2484   }
2485
2486   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2487
2488   $cust_pkg;
2489
2490 }
2491
2492 =item change_later OPTION => VALUE...
2493
2494 Schedule a package change for a later date.  This actually orders the new
2495 package immediately, but sets its start date for a future date, and sets
2496 the current package to expire on the same date.
2497
2498 If the package is already scheduled for a change, this can be called with
2499 'start_date' to change the scheduled date, or with pkgpart and/or
2500 locationnum to modify the package change.  To cancel the scheduled change
2501 entirely, see C<abort_change>.
2502
2503 Options include:
2504
2505 =over 4
2506
2507 =item start_date
2508
2509 The date for the package change.  Required, and must be in the future.
2510
2511 =item pkgpart
2512
2513 =item locationnum
2514
2515 =item quantity
2516
2517 =item contract_end
2518
2519 The pkgpart, locationnum, quantity and optional contract_end of the new
2520 package, with the same meaning as in C<change>.
2521
2522 =back
2523
2524 =cut
2525
2526 sub change_later {
2527   my $self = shift;
2528   my $opt = ref($_[0]) ? shift : { @_ };
2529
2530   # check contract_end, prevent adding/removing
2531   my $error = $self->_check_change($opt);
2532   return $error if $error;
2533
2534   my $oldAutoCommit = $FS::UID::AutoCommit;
2535   local $FS::UID::AutoCommit = 0;
2536   my $dbh = dbh;
2537
2538   my $cust_main = $self->cust_main;
2539
2540   my $date = delete $opt->{'start_date'} or return 'start_date required';
2541
2542   if ( $date <= time ) {
2543     $dbh->rollback if $oldAutoCommit;
2544     return "start_date $date is in the past";
2545   }
2546
2547   if ( $self->change_to_pkgnum ) {
2548     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
2549     my $new_pkgpart = $opt->{'pkgpart'}
2550         if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $change_to->pkgpart;
2551     my $new_locationnum = $opt->{'locationnum'}
2552         if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum;
2553     my $new_quantity = $opt->{'quantity'}
2554         if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity;
2555     my $new_contract_end = $opt->{'contract_end'}
2556         if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end;
2557     if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) {
2558       # it hasn't been billed yet, so in principle we could just edit
2559       # it in place (w/o a package change), but that's bad form.
2560       # So change the package according to the new options...
2561       my $err_or_pkg = $change_to->change(%$opt);
2562       if ( ref $err_or_pkg ) {
2563         # Then set that package up for a future start.
2564         $self->set('change_to_pkgnum', $err_or_pkg->pkgnum);
2565         $self->set('expire', $date); # in case it's different
2566         $err_or_pkg->set('start_date', $date);
2567         $err_or_pkg->set('change_date', '');
2568         $err_or_pkg->set('change_pkgnum', '');
2569
2570         $error = $self->replace       ||
2571                  $err_or_pkg->replace ||
2572                  #because change() might've edited existing scheduled change in place
2573                  (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
2574                   $change_to->cancel('no_delay_cancel' => 1) ||
2575                   $change_to->delete);
2576       } else {
2577         $error = $err_or_pkg;
2578       }
2579     } else { # change the start date only.
2580       $self->set('expire', $date);
2581       $change_to->set('start_date', $date);
2582       $error = $self->replace || $change_to->replace;
2583     }
2584     if ( $error ) {
2585       $dbh->rollback if $oldAutoCommit;
2586       return $error;
2587     } else {
2588       $dbh->commit if $oldAutoCommit;
2589       return '';
2590     }
2591   } # if $self->change_to_pkgnum
2592
2593   my $new_pkgpart = $opt->{'pkgpart'}
2594       if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart;
2595   my $new_locationnum = $opt->{'locationnum'}
2596       if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
2597   my $new_quantity = $opt->{'quantity'}
2598       if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
2599   my $new_contract_end = $opt->{'contract_end'}
2600       if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end;
2601
2602   return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything
2603
2604   # allow $opt->{'locationnum'} = '' to specifically set it to null
2605   # (i.e. customer default location)
2606   $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2607
2608   my $new = FS::cust_pkg->new( {
2609     custnum     => $self->custnum,
2610     locationnum => $opt->{'locationnum'},
2611     start_date  => $date,
2612     map   {  $_ => ( $opt->{$_} || $self->$_() )  }
2613       qw( pkgpart quantity refnum salesnum contract_end )
2614   } );
2615   $error = $new->insert('change' => 1,
2616                         'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
2617   if ( !$error ) {
2618     $self->set('change_to_pkgnum', $new->pkgnum);
2619     $self->set('expire', $date);
2620     $error = $self->replace;
2621   }
2622   if ( $error ) {
2623     $dbh->rollback if $oldAutoCommit;
2624   } else {
2625     $dbh->commit if $oldAutoCommit;
2626   }
2627
2628   $error;
2629 }
2630
2631 =item abort_change
2632
2633 Cancels a future package change scheduled by C<change_later>.
2634
2635 =cut
2636
2637 sub abort_change {
2638   my $self = shift;
2639   my $oldAutoCommit = $FS::UID::AutoCommit;
2640   local $FS::UID::AutoCommit = 0;
2641
2642   my $pkgnum = $self->change_to_pkgnum;
2643   my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
2644   my $error;
2645   $self->set('change_to_pkgnum', '');
2646   $self->set('expire', '');
2647   $error = $self->replace;
2648   if ( $change_to ) {
2649     $error ||= $change_to->cancel || $change_to->delete;
2650   }
2651
2652   if ( $oldAutoCommit ) {
2653     if ( $error ) {
2654       dbh->rollback;
2655     } else {
2656       dbh->commit;
2657     }
2658   }
2659
2660   return $error;
2661 }
2662
2663 =item set_quantity QUANTITY
2664
2665 Change the package's quantity field.  This is one of the few package properties
2666 that can safely be changed without canceling and reordering the package
2667 (because it doesn't affect tax eligibility).  Returns an error or an
2668 empty string.
2669
2670 =cut
2671
2672 sub set_quantity {
2673   my $self = shift;
2674   $self = $self->replace_old; # just to make sure
2675   $self->quantity(shift);
2676   $self->replace;
2677 }
2678
2679 =item set_salesnum SALESNUM
2680
2681 Change the package's salesnum (sales person) field.  This is one of the few
2682 package properties that can safely be changed without canceling and reordering
2683 the package (because it doesn't affect tax eligibility).  Returns an error or
2684 an empty string.
2685
2686 =cut
2687
2688 sub set_salesnum {
2689   my $self = shift;
2690   $self = $self->replace_old; # just to make sure
2691   $self->salesnum(shift);
2692   $self->replace;
2693   # XXX this should probably reassign any credit that's already been given
2694 }
2695
2696 =item modify_charge OPTIONS
2697
2698 Change the properties of a one-time charge.  The following properties can
2699 be changed this way:
2700 - pkg: the package description
2701 - classnum: the package class
2702 - additional: arrayref of additional invoice details to add to this package
2703
2704 and, I<if the charge has not yet been billed>:
2705 - start_date: the date when it will be billed
2706 - amount: the setup fee to be charged
2707 - quantity: the multiplier for the setup fee
2708 - separate_bill: whether to put the charge on a separate invoice
2709
2710 If you pass 'adjust_commission' => 1, and the classnum changes, and there are
2711 commission credits linked to this charge, they will be recalculated.
2712
2713 =cut
2714
2715 sub modify_charge {
2716   my $self = shift;
2717   my %opt = @_;
2718   my $part_pkg = $self->part_pkg;
2719   my $pkgnum = $self->pkgnum;
2720
2721   my $dbh = dbh;
2722   my $oldAutoCommit = $FS::UID::AutoCommit;
2723   local $FS::UID::AutoCommit = 0;
2724
2725   return "Can't use modify_charge except on one-time charges"
2726     unless $part_pkg->freq eq '0';
2727
2728   if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) {
2729     $part_pkg->set('pkg', $opt{'pkg'});
2730   }
2731
2732   my %pkg_opt = $part_pkg->options;
2733   my $pkg_opt_modified = 0;
2734
2735   $opt{'additional'} ||= [];
2736   my $i;
2737   my @old_additional;
2738   foreach (grep /^additional/, keys %pkg_opt) {
2739     ($i) = ($_ =~ /^additional_info(\d+)$/);
2740     $old_additional[$i] = $pkg_opt{$_} if $i;
2741     delete $pkg_opt{$_};
2742   }
2743
2744   for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
2745     $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
2746     if (!exists($old_additional[$i])
2747         or $old_additional[$i] ne $opt{'additional'}->[$i])
2748     {
2749       $pkg_opt_modified = 1;
2750     }
2751   }
2752   $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
2753   $pkg_opt{'additional_count'} = $i if $i > 0;
2754
2755   my $old_classnum;
2756   if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} )
2757   {
2758     # remember it
2759     $old_classnum = $part_pkg->classnum;
2760     $part_pkg->set('classnum', $opt{'classnum'});
2761   }
2762
2763   if ( !$self->get('setup') ) {
2764     # not yet billed, so allow amount, setup_cost, quantity, start_date,
2765     # and separate_bill
2766
2767     if ( exists($opt{'amount'})
2768           and $part_pkg->option('setup_fee') != $opt{'amount'}
2769           and $opt{'amount'} > 0 ) {
2770
2771       $pkg_opt{'setup_fee'} = $opt{'amount'};
2772       $pkg_opt_modified = 1;
2773     }
2774
2775     if ( exists($opt{'setup_cost'})
2776           and $part_pkg->setup_cost != $opt{'setup_cost'}
2777           and $opt{'setup_cost'} > 0 ) {
2778
2779       $part_pkg->set('setup_cost', $opt{'setup_cost'});
2780     }
2781
2782     if ( exists($opt{'quantity'})
2783           and $opt{'quantity'} != $self->quantity
2784           and $opt{'quantity'} > 0 ) {
2785
2786       $self->set('quantity', $opt{'quantity'});
2787     }
2788
2789     if ( exists($opt{'start_date'})
2790           and $opt{'start_date'} != $self->start_date ) {
2791
2792       $self->set('start_date', $opt{'start_date'});
2793     }
2794
2795     if ( exists($opt{'separate_bill'})
2796           and $opt{'separate_bill'} ne $self->separate_bill ) {
2797
2798       $self->set('separate_bill', $opt{'separate_bill'});
2799     }
2800
2801
2802   } # else simply ignore them; the UI shouldn't allow editing the fields
2803
2804
2805   if ( exists($opt{'taxclass'})
2806           and $part_pkg->taxclass ne $opt{'taxclass'}) {
2807
2808       $part_pkg->set('taxclass', $opt{'taxclass'});
2809   }
2810
2811   my $error;
2812   if ( $part_pkg->modified or $pkg_opt_modified ) {
2813     # can we safely modify the package def?
2814     # Yes, if it's not available for purchase, and this is the only instance
2815     # of it.
2816     if ( $part_pkg->disabled
2817          and FS::cust_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 1
2818          and FS::quotation_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 0
2819        ) {
2820       $error = $part_pkg->replace( options => \%pkg_opt );
2821     } else {
2822       # clone it
2823       $part_pkg = $part_pkg->clone;
2824       $part_pkg->set('disabled' => 'Y');
2825       $error = $part_pkg->insert( options => \%pkg_opt );
2826       # and associate this as yet-unbilled package to the new package def
2827       $self->set('pkgpart' => $part_pkg->pkgpart);
2828     }
2829     if ( $error ) {
2830       $dbh->rollback if $oldAutoCommit;
2831       return $error;
2832     }
2833   }
2834
2835   if ($self->modified) { # for quantity or start_date change, or if we had
2836                          # to clone the existing package def
2837     my $error = $self->replace;
2838     return $error if $error;
2839   }
2840   if (defined $old_classnum) {
2841     # fix invoice grouping records
2842     my $old_catname = $old_classnum
2843                       ? FS::pkg_class->by_key($old_classnum)->categoryname
2844                       : '';
2845     my $new_catname = $opt{'classnum'}
2846                       ? $part_pkg->pkg_class->categoryname
2847                       : '';
2848     if ( $old_catname ne $new_catname ) {
2849       foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
2850         # (there should only be one...)
2851         my @display = qsearch( 'cust_bill_pkg_display', {
2852             'billpkgnum'  => $cust_bill_pkg->billpkgnum,
2853             'section'     => $old_catname,
2854         });
2855         foreach (@display) {
2856           $_->set('section', $new_catname);
2857           $error = $_->replace;
2858           if ( $error ) {
2859             $dbh->rollback if $oldAutoCommit;
2860             return $error;
2861           }
2862         }
2863       } # foreach $cust_bill_pkg
2864     }
2865
2866     if ( $opt{'adjust_commission'} ) {
2867       # fix commission credits...tricky.
2868       foreach my $cust_event ($self->cust_event) {
2869         my $part_event = $cust_event->part_event;
2870         foreach my $table (qw(sales agent)) {
2871           my $class =
2872             "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
2873           my $credit = qsearchs('cust_credit', {
2874               'eventnum' => $cust_event->eventnum,
2875           });
2876           if ( $part_event->isa($class) ) {
2877             # Yes, this results in current commission rates being applied
2878             # retroactively to a one-time charge.  For accounting purposes
2879             # there ought to be some kind of time limit on doing this.
2880             my $amount = $part_event->_calc_credit($self);
2881             if ( $credit and $credit->amount ne $amount ) {
2882               # Void the old credit.
2883               $error = $credit->void('Package class changed');
2884               if ( $error ) {
2885                 $dbh->rollback if $oldAutoCommit;
2886                 return "$error (adjusting commission credit)";
2887               }
2888             }
2889             # redo the event action to recreate the credit.
2890             local $@ = '';
2891             eval { $part_event->do_action( $self, $cust_event ) };
2892             if ( $@ ) {
2893               $dbh->rollback if $oldAutoCommit;
2894               return $@;
2895             }
2896           } # if $part_event->isa($class)
2897         } # foreach $table
2898       } # foreach $cust_event
2899     } # if $opt{'adjust_commission'}
2900   } # if defined $old_classnum
2901
2902   $dbh->commit if $oldAutoCommit;
2903   '';
2904 }
2905
2906
2907
2908 use Data::Dumper;
2909 sub process_bulk_cust_pkg {
2910   my $job = shift;
2911   my $param = shift;
2912   warn Dumper($param) if $DEBUG;
2913
2914   my $old_part_pkg = qsearchs('part_pkg',
2915                               { pkgpart => $param->{'old_pkgpart'} });
2916   my $new_part_pkg = qsearchs('part_pkg',
2917                               { pkgpart => $param->{'new_pkgpart'} });
2918   die "Must select a new package type\n" unless $new_part_pkg;
2919   #my $keep_dates = $param->{'keep_dates'} || 0;
2920   my $keep_dates = 1; # there is no good reason to turn this off
2921
2922   my $oldAutoCommit = $FS::UID::AutoCommit;
2923   local $FS::UID::AutoCommit = 0;
2924   my $dbh = dbh;
2925
2926   my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
2927
2928   my $i = 0;
2929   foreach my $old_cust_pkg ( @cust_pkgs ) {
2930     $i++;
2931     $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
2932     if ( $old_cust_pkg->getfield('cancel') ) {
2933       warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
2934         $old_cust_pkg->pkgnum."\n"
2935         if $DEBUG;
2936       next;
2937     }
2938     warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
2939       if $DEBUG;
2940     my $error = $old_cust_pkg->change(
2941       'pkgpart'     => $param->{'new_pkgpart'},
2942       'keep_dates'  => $keep_dates
2943     );
2944     if ( !ref($error) ) { # change returns the cust_pkg on success
2945       $dbh->rollback;
2946       die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
2947     }
2948   }
2949   $dbh->commit if $oldAutoCommit;
2950   return;
2951 }
2952
2953 =item last_bill
2954
2955 Returns the last bill date, or if there is no last bill date, the setup date.
2956 Useful for billing metered services.
2957
2958 =cut
2959
2960 sub last_bill {
2961   my $self = shift;
2962   return $self->setfield('last_bill', $_[0]) if @_;
2963   return $self->getfield('last_bill') if $self->getfield('last_bill');
2964   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
2965                                                   'edate'  => $self->bill,  } );
2966   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
2967 }
2968
2969 =item last_cust_pkg_reason ACTION
2970
2971 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
2972 Returns false if there is no reason or the package is not currenly ACTION'd
2973 ACTION is one of adjourn, susp, cancel, or expire.
2974
2975 =cut
2976
2977 sub last_cust_pkg_reason {
2978   my ( $self, $action ) = ( shift, shift );
2979   my $date = $self->get($action);
2980   qsearchs( {
2981               'table' => 'cust_pkg_reason',
2982               'hashref' => { 'pkgnum' => $self->pkgnum,
2983                              'action' => substr(uc($action), 0, 1),
2984                              'date'   => $date,
2985                            },
2986               'order_by' => 'ORDER BY num DESC LIMIT 1',
2987            } );
2988 }
2989
2990 =item last_reason ACTION
2991
2992 Returns the most recent ACTION FS::reason associated with the package.
2993 Returns false if there is no reason or the package is not currenly ACTION'd
2994 ACTION is one of adjourn, susp, cancel, or expire.
2995
2996 =cut
2997
2998 sub last_reason {
2999   my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
3000   $cust_pkg_reason->reason
3001     if $cust_pkg_reason;
3002 }
3003
3004 =item part_pkg
3005
3006 Returns the definition for this billing item, as an FS::part_pkg object (see
3007 L<FS::part_pkg>).
3008
3009 =cut
3010
3011 sub part_pkg {
3012   my $self = shift;
3013   return $self->{'_pkgpart'} if $self->{'_pkgpart'};
3014   cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
3015   qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
3016 }
3017
3018 =item old_cust_pkg
3019
3020 Returns the cancelled package this package was changed from, if any.
3021
3022 =cut
3023
3024 sub old_cust_pkg {
3025   my $self = shift;
3026   return '' unless $self->change_pkgnum;
3027   qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
3028 }
3029
3030 =item change_cust_main
3031
3032 Returns the customter this package was detached to, if any.
3033
3034 =cut
3035
3036 sub change_cust_main {
3037   my $self = shift;
3038   return '' unless $self->change_custnum;
3039   qsearchs('cust_main', { 'custnum' => $self->change_custnum } );
3040 }
3041
3042 =item calc_setup
3043
3044 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
3045 item.
3046
3047 =cut
3048
3049 sub calc_setup {
3050   my $self = shift;
3051   $self->part_pkg->calc_setup($self, @_);
3052 }
3053
3054 =item calc_recur
3055
3056 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
3057 item.
3058
3059 =cut
3060
3061 sub calc_recur {
3062   my $self = shift;
3063   $self->part_pkg->calc_recur($self, @_);
3064 }
3065
3066 =item base_setup
3067
3068 Calls the I<base_setup> of the FS::part_pkg object associated with this billing
3069 item.
3070
3071 =cut
3072
3073 sub base_setup {
3074   my $self = shift;
3075   $self->part_pkg->base_setup($self, @_);
3076 }
3077
3078 =item base_recur
3079
3080 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
3081 item.
3082
3083 =cut
3084
3085 sub base_recur {
3086   my $self = shift;
3087   $self->part_pkg->base_recur($self, @_);
3088 }
3089
3090 =item calc_remain
3091
3092 Calls the I<calc_remain> of the FS::part_pkg object associated with this
3093 billing item.
3094
3095 =cut
3096
3097 sub calc_remain {
3098   my $self = shift;
3099   $self->part_pkg->calc_remain($self, @_);
3100 }
3101
3102 =item calc_cancel
3103
3104 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
3105 billing item.
3106
3107 =cut
3108
3109 sub calc_cancel {
3110   my $self = shift;
3111   $self->part_pkg->calc_cancel($self, @_);
3112 }
3113
3114 =item cust_bill_pkg
3115
3116 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
3117
3118 =cut
3119
3120 sub cust_bill_pkg {
3121   my $self = shift;
3122   qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
3123 }
3124
3125 =item cust_pkg_detail [ DETAILTYPE ]
3126
3127 Returns any customer package details for this package (see
3128 L<FS::cust_pkg_detail>).
3129
3130 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3131
3132 =cut
3133
3134 sub cust_pkg_detail {
3135   my $self = shift;
3136   my %hash = ( 'pkgnum' => $self->pkgnum );
3137   $hash{detailtype} = shift if @_;
3138   qsearch({
3139     'table'    => 'cust_pkg_detail',
3140     'hashref'  => \%hash,
3141     'order_by' => 'ORDER BY weight, pkgdetailnum',
3142   });
3143 }
3144
3145 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
3146
3147 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
3148
3149 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3150
3151 If there is an error, returns the error, otherwise returns false.
3152
3153 =cut
3154
3155 sub set_cust_pkg_detail {
3156   my( $self, $detailtype, @details ) = @_;
3157
3158   my $oldAutoCommit = $FS::UID::AutoCommit;
3159   local $FS::UID::AutoCommit = 0;
3160   my $dbh = dbh;
3161
3162   foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
3163     my $error = $current->delete;
3164     if ( $error ) {
3165       $dbh->rollback if $oldAutoCommit;
3166       return "error removing old detail: $error";
3167     }
3168   }
3169
3170   foreach my $detail ( @details ) {
3171     my $cust_pkg_detail = new FS::cust_pkg_detail {
3172       'pkgnum'     => $self->pkgnum,
3173       'detailtype' => $detailtype,
3174       'detail'     => $detail,
3175     };
3176     my $error = $cust_pkg_detail->insert;
3177     if ( $error ) {
3178       $dbh->rollback if $oldAutoCommit;
3179       return "error adding new detail: $error";
3180     }
3181
3182   }
3183
3184   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3185   '';
3186
3187 }
3188
3189 =item cust_event
3190
3191 Returns the customer billing events (see L<FS::cust_event>) for this invoice.
3192
3193 =cut
3194
3195 #false laziness w/cust_bill.pm
3196 sub cust_event {
3197   my $self = shift;
3198   qsearch({
3199     'table'     => 'cust_event',
3200     'addl_from' => 'JOIN part_event USING ( eventpart )',
3201     'hashref'   => { 'tablenum' => $self->pkgnum },
3202     'extra_sql' => " AND eventtable = 'cust_pkg' ",
3203   });
3204 }
3205
3206 =item num_cust_event
3207
3208 Returns the number of customer billing events (see L<FS::cust_event>) for this package.
3209
3210 =cut
3211
3212 #false laziness w/cust_bill.pm
3213 sub num_cust_event {
3214   my $self = shift;
3215   my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
3216   $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
3217 }
3218
3219 =item exists_cust_event
3220
3221 Returns true if there are customer billing events (see L<FS::cust_event>) for this package.  More efficient than using num_cust_event.
3222
3223 =cut
3224
3225 sub exists_cust_event {
3226   my $self = shift;
3227   my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
3228   my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
3229   $row ? $row->[0] : '';
3230 }
3231
3232 sub _from_cust_event_where {
3233   #my $self = shift;
3234   " FROM cust_event JOIN part_event USING ( eventpart ) ".
3235   "  WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
3236 }
3237
3238 sub _prep_ex {
3239   my( $self, $sql, @args ) = @_;
3240   my $sth = dbh->prepare($sql) or die  dbh->errstr. " preparing $sql";
3241   $sth->execute(@args)         or die $sth->errstr. " executing $sql";
3242   $sth;
3243 }
3244
3245 =item part_pkg_currency_option OPTIONNAME
3246
3247 Returns a two item list consisting of the currency of this customer, if any,
3248 and a value for the provided option.  If the customer has a currency, the value
3249 is the option value the given name and the currency (see
3250 L<FS::part_pkg_currency>).  Otherwise, if the customer has no currency, is the
3251 regular option value for the given name (see L<FS::part_pkg_option>).
3252
3253 =cut
3254
3255 sub part_pkg_currency_option {
3256   my( $self, $optionname ) = @_;
3257   my $part_pkg = $self->part_pkg;
3258   if ( my $currency = $self->cust_main->currency ) {
3259     ($currency, $part_pkg->part_pkg_currency_option($currency, $optionname) );
3260   } else {
3261     ('', $part_pkg->option($optionname) );
3262   }
3263 }
3264
3265 =item cust_svc [ SVCPART ] (old, deprecated usage)
3266
3267 =item cust_svc [ OPTION => VALUE ... ] (current usage)
3268
3269 =item cust_svc_unsorted [ OPTION => VALUE ... ]
3270
3271 Returns the services for this package, as FS::cust_svc objects (see
3272 L<FS::cust_svc>).  Available options are svcpart and svcdb.  If either is
3273 spcififed, returns only the matching services.
3274
3275 As an optimization, use the cust_svc_unsorted version if you are not displaying
3276 the results.
3277
3278 =cut
3279
3280 sub cust_svc {
3281   my $self = shift;
3282   cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
3283   $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
3284 }
3285
3286 sub cust_svc_unsorted {
3287   my $self = shift;
3288   @{ $self->cust_svc_unsorted_arrayref(@_) };
3289 }
3290
3291 sub cust_svc_unsorted_arrayref {
3292   my $self = shift;
3293
3294   return [] unless $self->num_cust_svc(@_);
3295
3296   my %opt = ();
3297   if ( @_ && $_[0] =~ /^\d+/ ) {
3298     $opt{svcpart} = shift;
3299   } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3300     %opt = %{ $_[0] };
3301   } elsif ( @_ ) {
3302     %opt = @_;
3303   }
3304
3305   my %search = (
3306     'select'    => 'cust_svc.*, part_svc.*',
3307     'table'     => 'cust_svc',
3308     'hashref'   => { 'pkgnum' => $self->pkgnum },
3309     'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
3310   );
3311   $search{hashref}->{svcpart} = $opt{svcpart}
3312     if $opt{svcpart};
3313   $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{svcdb} )
3314     if $opt{svcdb};
3315
3316   [ qsearch(\%search) ];
3317
3318 }
3319
3320 =item overlimit [ SVCPART ]
3321
3322 Returns the services for this package which have exceeded their
3323 usage limit as FS::cust_svc objects (see L<FS::cust_svc>).  If a svcpart
3324 is specified, return only the matching services.
3325
3326 =cut
3327
3328 sub overlimit {
3329   my $self = shift;
3330   return () unless $self->num_cust_svc(@_);
3331   grep { $_->overlimit } $self->cust_svc(@_);
3332 }
3333
3334 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3335
3336 Returns historical services for this package created before END TIMESTAMP and
3337 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
3338 (see L<FS::h_cust_svc>).  If MODE is 'I' (for 'invoice'), services with the
3339 I<pkg_svc.hidden> flag will be omitted.
3340
3341 =cut
3342
3343 sub h_cust_svc {
3344   my $self = shift;
3345   warn "$me _h_cust_svc called on $self\n"
3346     if $DEBUG;
3347
3348   my ($end, $start, $mode) = @_;
3349
3350   local($FS::Record::qsearch_qualify_columns) = 0;
3351
3352   my @cust_svc = $self->_sort_cust_svc(
3353     [ qsearch( 'h_cust_svc',
3354       { 'pkgnum' => $self->pkgnum, },
3355       FS::h_cust_svc->sql_h_search(@_),
3356     ) ]
3357   );
3358
3359   if ( defined($mode) && $mode eq 'I' ) {
3360     my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
3361     return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
3362   } else {
3363     return @cust_svc;
3364   }
3365 }
3366
3367 sub _sort_cust_svc {
3368   my( $self, $arrayref ) = @_;
3369
3370   my $sort =
3371     sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] };
3372
3373   my %pkg_svc = map { $_->svcpart => $_ }
3374                 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
3375
3376   map  { $_->[0] }
3377   sort $sort
3378   map {
3379         my $pkg_svc = $pkg_svc{ $_->svcpart } || '';
3380         [ $_,
3381           $pkg_svc ? $pkg_svc->primary_svc : '',
3382           $pkg_svc ? $pkg_svc->quantity : 0,
3383         ];
3384       }
3385   @$arrayref;
3386
3387 }
3388
3389 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
3390
3391 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
3392
3393 Returns the number of services for this package.  Available options are svcpart
3394 and svcdb.  If either is spcififed, returns only the matching services.
3395
3396 =cut
3397
3398 sub num_cust_svc {
3399   my $self = shift;
3400
3401   return $self->{'_num_cust_svc'}
3402     if !scalar(@_)
3403        && exists($self->{'_num_cust_svc'})
3404        && $self->{'_num_cust_svc'} =~ /\d/;
3405
3406   cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
3407     if $DEBUG > 2;
3408
3409   my %opt = ();
3410   if ( @_ && $_[0] =~ /^\d+/ ) {
3411     $opt{svcpart} = shift;
3412   } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3413     %opt = %{ $_[0] };
3414   } elsif ( @_ ) {
3415     %opt = @_;
3416   }
3417
3418   my $select = 'SELECT COUNT(*) FROM cust_svc ';
3419   my $where = ' WHERE pkgnum = ? ';
3420   my @param = ($self->pkgnum);
3421
3422   if ( $opt{'svcpart'} ) {
3423     $where .= ' AND svcpart = ? ';
3424     push @param, $opt{'svcpart'};
3425   }
3426   if ( $opt{'svcdb'} ) {
3427     $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
3428     $where .= ' AND svcdb = ? ';
3429     push @param, $opt{'svcdb'};
3430   }
3431
3432   my $sth = dbh->prepare("$select $where") or die  dbh->errstr;
3433   $sth->execute(@param) or die $sth->errstr;
3434   $sth->fetchrow_arrayref->[0];
3435 }
3436
3437 =item available_part_svc
3438
3439 Returns a list of FS::part_svc objects representing services included in this
3440 package but not yet provisioned.  Each FS::part_svc object also has an extra
3441 field, I<num_avail>, which specifies the number of available services.
3442
3443 Accepts option I<provision_hold>;  if true, only returns part_svc for which the
3444 associated pkg_svc has the provision_hold flag set.
3445
3446 =cut
3447
3448 sub available_part_svc {
3449   my $self = shift;
3450   my %opt  = @_;
3451
3452   my $pkg_quantity = $self->quantity || 1;
3453
3454   grep { $_->num_avail > 0 }
3455   map {
3456     my $part_svc = $_->part_svc;
3457     $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
3458     $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
3459
3460     # more evil encapsulation breakage
3461     if ($part_svc->{'Hash'}{'num_avail'} > 0) {
3462       my @exports = $part_svc->part_export_did;
3463       $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
3464         }
3465
3466     $part_svc;
3467   }
3468   grep { $opt{'provision_hold'} ? $_->provision_hold : 1 }
3469   $self->part_pkg->pkg_svc;
3470 }
3471
3472 =item part_svc [ OPTION => VALUE ... ]
3473
3474 Returns a list of FS::part_svc objects representing provisioned and available
3475 services included in this package.  Each FS::part_svc object also has the
3476 following extra fields:
3477
3478 =over 4
3479
3480 =item num_cust_svc
3481
3482 (count)
3483
3484 =item num_avail
3485
3486 (quantity - count)
3487
3488 =item cust_pkg_svc
3489
3490 (services) - array reference containing the provisioned services, as cust_svc objects
3491
3492 =back
3493
3494 Accepts two options:
3495
3496 =over 4
3497
3498 =item summarize_size
3499
3500 If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc
3501 is this size or greater.
3502
3503 =item hide_discontinued
3504
3505 If true, will omit looking for services that are no longer avaialble in the
3506 package definition.
3507
3508 =back
3509
3510 =cut
3511
3512 #svcnum
3513 #label -> ($cust_svc->label)[1]
3514
3515 sub part_svc {
3516   my $self = shift;
3517   my %opt = @_;
3518
3519   my $pkg_quantity = $self->quantity || 1;
3520
3521   #XXX some sort of sort order besides numeric by svcpart...
3522   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
3523     my $pkg_svc = $_;
3524     my $part_svc = $pkg_svc->part_svc;
3525     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3526     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
3527     $part_svc->{'Hash'}{'num_avail'}    =
3528       max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc );
3529     $part_svc->{'Hash'}{'cust_pkg_svc'} =
3530         $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
3531       unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
3532           && $num_cust_svc >= $opt{summarize_size};
3533     $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
3534     $part_svc;
3535   } $self->part_pkg->pkg_svc;
3536
3537   unless ( $opt{hide_discontinued} ) {
3538     #extras
3539     push @part_svc, map {
3540       my $part_svc = $_;
3541       my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3542       $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
3543       $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
3544       $part_svc->{'Hash'}{'cust_pkg_svc'} =
3545         $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
3546       $part_svc;
3547     } $self->extra_part_svc;
3548   }
3549
3550   @part_svc;
3551
3552 }
3553
3554 =item extra_part_svc
3555
3556 Returns a list of FS::part_svc objects corresponding to services in this
3557 package which are still provisioned but not (any longer) available in the
3558 package definition.
3559
3560 =cut
3561
3562 sub extra_part_svc {
3563   my $self = shift;
3564
3565   my $pkgnum  = $self->pkgnum;
3566   #my $pkgpart = $self->pkgpart;
3567
3568 #  qsearch( {
3569 #    'table'     => 'part_svc',
3570 #    'hashref'   => {},
3571 #    'extra_sql' =>
3572 #      "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
3573 #                     WHERE pkg_svc.svcpart = part_svc.svcpart
3574 #                       AND pkg_svc.pkgpart = ?
3575 #                       AND quantity > 0
3576 #                 )
3577 #        AND 0 < ( SELECT COUNT(*) FROM cust_svc
3578 #                       LEFT JOIN cust_pkg USING ( pkgnum )
3579 #                     WHERE cust_svc.svcpart = part_svc.svcpart
3580 #                       AND pkgnum = ?
3581 #                 )",
3582 #    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
3583 #  } );
3584
3585 #seems to benchmark slightly faster... (or did?)
3586
3587   my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
3588   my $pkgparts = join(',', @pkgparts);
3589
3590   qsearch( {
3591     #'select'      => 'DISTINCT ON (svcpart) part_svc.*',
3592     #MySQL doesn't grok DISINCT ON
3593     'select'      => 'DISTINCT part_svc.*',
3594     'table'       => 'part_svc',
3595     'addl_from'   =>
3596       "LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart
3597                                AND pkg_svc.pkgpart IN ($pkgparts)
3598                                AND quantity > 0
3599                              )
3600        LEFT JOIN cust_svc ON (     cust_svc.svcpart = part_svc.svcpart )
3601        LEFT JOIN cust_pkg USING ( pkgnum )
3602       ",
3603     'hashref'     => {},
3604     'extra_sql'   => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
3605     'extra_param' => [ [$self->pkgnum=>'int'] ],
3606   } );
3607 }
3608
3609 =item status
3610
3611 Returns a short status string for this package, currently:
3612
3613 =over 4
3614
3615 =item on hold
3616
3617 =item not yet billed
3618
3619 =item one-time charge
3620
3621 =item active
3622
3623 =item suspended
3624
3625 =item cancelled
3626
3627 =back
3628
3629 =cut
3630
3631 sub status {
3632   my $self = shift;
3633
3634   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
3635
3636   return 'cancelled' if $self->get('cancel');
3637   return 'on hold' if $self->susp && ! $self->setup;
3638   return 'suspended' if $self->susp;
3639   return 'not yet billed' unless $self->setup;
3640   return 'one-time charge' if $freq =~ /^(0|$)/;
3641   return 'active';
3642 }
3643
3644 =item ucfirst_status
3645
3646 Returns the status with the first character capitalized.
3647
3648 =cut
3649
3650 sub ucfirst_status {
3651   ucfirst(shift->status);
3652 }
3653
3654 =item statuses
3655
3656 Class method that returns the list of possible status strings for packages
3657 (see L<the status method|/status>).  For example:
3658
3659   @statuses = FS::cust_pkg->statuses();
3660
3661 =cut
3662
3663 tie my %statuscolor, 'Tie::IxHash',
3664   'on hold'         => 'FF00F5', #brighter purple!
3665   'not yet billed'  => '009999', #teal? cyan?
3666   'one-time charge' => '0000CC', #blue  #'000000',
3667   'active'          => '00CC00',
3668   'suspended'       => 'FF9900',
3669   'cancelled'       => 'FF0000',
3670 ;
3671
3672 sub statuses {
3673   my $self = shift; #could be class...
3674   #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
3675   #                                    # mayble split btw one-time vs. recur
3676     keys %statuscolor;
3677 }
3678
3679 sub statuscolors {
3680   #my $self = shift;
3681   \%statuscolor;
3682 }
3683
3684 =item statuscolor
3685
3686 Returns a hex triplet color string for this package's status.
3687
3688 =cut
3689
3690 sub statuscolor {
3691   my $self = shift;
3692   $statuscolor{$self->status};
3693 }
3694
3695 =item is_status_delay_cancel
3696
3697 Returns true if part_pkg has option delay_cancel,
3698 cust_pkg status is 'suspended' and expire is set
3699 to cancel package within the next day (or however
3700 many days are set in global config part_pkg-delay_cancel-days.
3701
3702 Accepts option I<part_pkg-delay_cancel-days> which should be
3703 the value of the config setting, to avoid looking it up again.
3704
3705 This is not a real status, this only meant for hacking display
3706 values, because otherwise treating the package as suspended is
3707 really the whole point of the delay_cancel option.
3708
3709 =cut
3710
3711 sub is_status_delay_cancel {
3712   my ($self,%opt) = @_;
3713   if ( $self->main_pkgnum and $self->pkglinknum ) {
3714     return $self->main_pkg->is_status_delay_cancel;
3715   }
3716   return 0 unless $self->part_pkg->option('delay_cancel',1);
3717   return 0 unless $self->status eq 'suspended';
3718   return 0 unless $self->expire;
3719   my $expdays = $opt{'part_pkg-delay_cancel-days'};
3720   unless ($expdays) {
3721     my $conf = new FS::Conf;
3722     $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
3723   }
3724   my $expsecs = 60*60*24*$expdays;
3725   return 0 unless $self->expire < time + $expsecs;
3726   return 1;
3727 }
3728
3729 =item pkg_label
3730
3731 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
3732 "pkg - comment" depending on user preference).
3733
3734 =cut
3735
3736 sub pkg_label {
3737   my $self = shift;
3738   my $label = $self->part_pkg->pkg_comment( cust_pkg=>$self, nopkgpart=>1 );
3739   $label = $self->pkgnum. ": $label"
3740     if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
3741   $label;
3742 }
3743
3744 =item pkg_label_long
3745
3746 Returns a long label for this package, adding the primary service's label to
3747 pkg_label.
3748
3749 =cut
3750
3751 sub pkg_label_long {
3752   my $self = shift;
3753   my $label = $self->pkg_label;
3754   my $cust_svc = $self->primary_cust_svc;
3755   $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
3756   $label;
3757 }
3758
3759 =item pkg_locale
3760
3761 Returns a customer-localized label for this package.
3762
3763 =cut
3764
3765 sub pkg_locale {
3766   my $self = shift;
3767   $self->part_pkg->pkg_locale( $self->cust_main->locale );
3768 }
3769
3770 =item primary_cust_svc
3771
3772 Returns a primary service (as FS::cust_svc object) if one can be identified.
3773
3774 =cut
3775
3776 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
3777
3778 sub primary_cust_svc {
3779   my $self = shift;
3780
3781   my @cust_svc = $self->cust_svc;
3782
3783   return '' unless @cust_svc; #no serivces - irrelevant then
3784
3785   return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
3786
3787   # primary service as specified in the package definition
3788   # or exactly one service definition with quantity one
3789   my $svcpart = $self->part_pkg->svcpart;
3790   @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
3791   return $cust_svc[0] if scalar(@cust_svc) == 1;
3792
3793   #couldn't identify one thing..
3794   return '';
3795 }
3796
3797 =item labels
3798
3799 Returns a list of lists, calling the label method for all services
3800 (see L<FS::cust_svc>) of this billing item.
3801
3802 =cut
3803
3804 sub labels {
3805   my $self = shift;
3806   map { [ $_->label ] } $self->cust_svc;
3807 }
3808
3809 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3810
3811 Like the labels method, but returns historical information on services that
3812 were active as of END_TIMESTAMP and (optionally) not cancelled before
3813 START_TIMESTAMP.  If MODE is 'I' (for 'invoice'), services with the
3814 I<pkg_svc.hidden> flag will be omitted.
3815
3816 Returns a list of lists, calling the label method for all (historical) services
3817 (see L<FS::h_cust_svc>) of this billing item.
3818
3819 =cut
3820
3821 sub h_labels {
3822   my $self = shift;
3823   warn "$me _h_labels called on $self\n"
3824     if $DEBUG;
3825   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
3826 }
3827
3828 =item labels_short
3829
3830 Like labels, except returns a simple flat list, and shortens long
3831 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3832 identical services to one line that lists the service label and the number of
3833 individual services rather than individual items.
3834
3835 =cut
3836
3837 sub labels_short {
3838   shift->_labels_short( 'labels', @_ );
3839 }
3840
3841 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
3842
3843 Like h_labels, except returns a simple flat list, and shortens long
3844 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3845 identical services to one line that lists the service label and the number of
3846 individual services rather than individual items.
3847
3848 =cut
3849
3850 sub h_labels_short {
3851   shift->_labels_short( 'h_labels', @_ );
3852 }
3853
3854 sub _labels_short {
3855   my( $self, $method ) = ( shift, shift );
3856
3857   warn "$me _labels_short called on $self with $method method\n"
3858     if $DEBUG;
3859
3860   my $conf = new FS::Conf;
3861   my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
3862
3863   warn "$me _labels_short populating \%labels\n"
3864     if $DEBUG;
3865
3866   my %labels;
3867   #tie %labels, 'Tie::IxHash';
3868   push @{ $labels{$_->[0]} }, $_->[1]
3869     foreach $self->$method(@_);
3870
3871   warn "$me _labels_short populating \@labels\n"
3872     if $DEBUG;
3873
3874   my @labels;
3875   foreach my $label ( keys %labels ) {
3876     my %seen = ();
3877     my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
3878     my $num = scalar(@values);
3879     warn "$me _labels_short $num items for $label\n"
3880       if $DEBUG;
3881
3882     if ( $num > $max_same_services ) {
3883       warn "$me _labels_short   more than $max_same_services, so summarizing\n"
3884         if $DEBUG;
3885       push @labels, "$label ($num)";
3886     } else {
3887       if ( $conf->exists('cust_bill-consolidate_services') ) {
3888         warn "$me _labels_short   consolidating services\n"
3889           if $DEBUG;
3890         # push @labels, "$label: ". join(', ', @values);
3891         while ( @values ) {
3892           my $detail = "$label: ";
3893           $detail .= shift(@values). ', '
3894             while @values
3895                && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
3896           $detail =~ s/, $//;
3897           push @labels, $detail;
3898         }
3899         warn "$me _labels_short   done consolidating services\n"
3900           if $DEBUG;
3901       } else {
3902         warn "$me _labels_short   adding service data\n"
3903           if $DEBUG;
3904         push @labels, map { "$label: $_" } @values;
3905       }
3906     }
3907   }
3908
3909  @labels;
3910
3911 }
3912
3913 =item cust_main
3914
3915 Returns the parent customer object (see L<FS::cust_main>).
3916
3917 =item balance
3918
3919 Returns the balance for this specific package, when using
3920 experimental package balance.
3921
3922 =cut
3923
3924 sub balance {
3925   my $self = shift;
3926   $self->cust_main->balance_pkgnum( $self->pkgnum );
3927 }
3928
3929 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
3930
3931 =item cust_location
3932
3933 Returns the location object, if any (see L<FS::cust_location>).
3934
3935 =item cust_location_or_main
3936
3937 If this package is associated with a location, returns the locaiton (see
3938 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
3939
3940 =item location_label [ OPTION => VALUE ... ]
3941
3942 Returns the label of the location object (see L<FS::cust_location>).
3943
3944 =cut
3945
3946 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
3947
3948 =item tax_locationnum
3949
3950 Returns the foreign key to a L<FS::cust_location> object for calculating
3951 tax on this package, as determined by the C<tax-pkg_address> and
3952 C<tax-ship_address> configuration flags.
3953
3954 =cut
3955
3956 sub tax_locationnum {
3957   my $self = shift;
3958   my $conf = FS::Conf->new;
3959   if ( $conf->exists('tax-pkg_address') ) {
3960     return $self->locationnum;
3961   }
3962   elsif ( $conf->exists('tax-ship_address') ) {
3963     return $self->cust_main->ship_locationnum;
3964   }
3965   else {
3966     return $self->cust_main->bill_locationnum;
3967   }
3968 }
3969
3970 =item tax_location
3971
3972 Returns the L<FS::cust_location> object for tax_locationnum.
3973
3974 =cut
3975
3976 sub tax_location {
3977   my $self = shift;
3978   my $conf = FS::Conf->new;
3979   if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
3980     return FS::cust_location->by_key($self->locationnum);
3981   }
3982   elsif ( $conf->exists('tax-ship_address') ) {
3983     return $self->cust_main->ship_location;
3984   }
3985   else {
3986     return $self->cust_main->bill_location;
3987   }
3988 }
3989
3990 =item seconds_since TIMESTAMP
3991
3992 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
3993 package have been online since TIMESTAMP, according to the session monitor.
3994
3995 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
3996 L<Time::Local> and L<Date::Parse> for conversion functions.
3997
3998 =cut
3999
4000 sub seconds_since {
4001   my($self, $since) = @_;
4002   my $seconds = 0;
4003
4004   foreach my $cust_svc (
4005     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
4006   ) {
4007     $seconds += $cust_svc->seconds_since($since);
4008   }
4009
4010   $seconds;
4011
4012 }
4013
4014 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
4015
4016 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
4017 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
4018 (exclusive).
4019
4020 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
4021 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
4022 functions.
4023
4024
4025 =cut
4026
4027 sub seconds_since_sqlradacct {
4028   my($self, $start, $end) = @_;
4029
4030   my $seconds = 0;
4031
4032   foreach my $cust_svc (
4033     grep {
4034       my $part_svc = $_->part_svc;
4035       $part_svc->svcdb eq 'svc_acct'
4036         && scalar($part_svc->part_export_usage);
4037     } $self->cust_svc
4038   ) {
4039     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
4040   }
4041
4042   $seconds;
4043
4044 }
4045
4046 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
4047
4048 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
4049 in this package for sessions ending between TIMESTAMP_START (inclusive) and
4050 TIMESTAMP_END
4051 (exclusive).
4052
4053 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
4054 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
4055 functions.
4056
4057 =cut
4058
4059 sub attribute_since_sqlradacct {
4060   my($self, $start, $end, $attrib) = @_;
4061
4062   my $sum = 0;
4063
4064   foreach my $cust_svc (
4065     grep {
4066       my $part_svc = $_->part_svc;
4067       scalar($part_svc->part_export_usage);
4068     } $self->cust_svc
4069   ) {
4070     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
4071   }
4072
4073   $sum;
4074
4075 }
4076
4077 =item quantity
4078
4079 =cut
4080
4081 sub quantity {
4082   my( $self, $value ) = @_;
4083   if ( defined($value) ) {
4084     $self->setfield('quantity', $value);
4085   }
4086   $self->getfield('quantity') || 1;
4087 }
4088
4089 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
4090
4091 Transfers as many services as possible from this package to another package.
4092
4093 The destination package can be specified by pkgnum by passing an FS::cust_pkg
4094 object.  The destination package must already exist.
4095
4096 Services are moved only if the destination allows services with the correct
4097 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
4098 this option with caution!  No provision is made for export differences
4099 between the old and new service definitions.  Probably only should be used
4100 when your exports for all service definitions of a given svcdb are identical.
4101 (attempt a transfer without it first, to move all possible svcpart-matching
4102 services)
4103
4104 Any services that can't be moved remain in the original package.
4105
4106 Returns an error, if there is one; otherwise, returns the number of services
4107 that couldn't be moved.
4108
4109 =cut
4110
4111 sub transfer {
4112   my ($self, $dest_pkgnum, %opt) = @_;
4113
4114   my $remaining = 0;
4115   my $dest;
4116   my %target;
4117
4118   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
4119     $dest = $dest_pkgnum;
4120     $dest_pkgnum = $dest->pkgnum;
4121   } else {
4122     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
4123   }
4124
4125   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
4126
4127   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
4128     $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
4129   }
4130
4131   foreach my $cust_svc ($dest->cust_svc) {
4132     $target{$cust_svc->svcpart}--;
4133   }
4134
4135   my %svcpart2svcparts = ();
4136   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4137     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
4138     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
4139       next if exists $svcpart2svcparts{$svcpart};
4140       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
4141       $svcpart2svcparts{$svcpart} = [
4142         map  { $_->[0] }
4143         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
4144         map {
4145               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
4146                                                    'svcpart' => $_          } );
4147               [ $_,
4148                 $pkg_svc ? $pkg_svc->primary_svc : '',
4149                 $pkg_svc ? $pkg_svc->quantity : 0,
4150               ];
4151             }
4152
4153         grep { $_ != $svcpart }
4154         map  { $_->svcpart }
4155         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
4156       ];
4157       warn "alternates for svcpart $svcpart: ".
4158            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
4159         if $DEBUG;
4160     }
4161   }
4162
4163   my $error;
4164   foreach my $cust_svc ($self->cust_svc) {
4165     my $svcnum = $cust_svc->svcnum;
4166     if($target{$cust_svc->svcpart} > 0
4167        or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
4168       $target{$cust_svc->svcpart}--;
4169       my $new = new FS::cust_svc { $cust_svc->hash };
4170       $new->pkgnum($dest_pkgnum);
4171       $error = $new->replace($cust_svc);
4172     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4173       if ( $DEBUG ) {
4174         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
4175         warn "alternates to consider: ".
4176              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
4177       }
4178       my @alternate = grep {
4179                              warn "considering alternate svcpart $_: ".
4180                                   "$target{$_} available in new package\n"
4181                                if $DEBUG;
4182                              $target{$_} > 0;
4183                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
4184       if ( @alternate ) {
4185         warn "alternate(s) found\n" if $DEBUG;
4186         my $change_svcpart = $alternate[0];
4187         $target{$change_svcpart}--;
4188         my $new = new FS::cust_svc { $cust_svc->hash };
4189         $new->svcpart($change_svcpart);
4190         $new->pkgnum($dest_pkgnum);
4191         $error = $new->replace($cust_svc);
4192       } else {
4193         $remaining++;
4194       }
4195     } else {
4196       $remaining++
4197     }
4198     if ( $error ) {
4199       my @label = $cust_svc->label;
4200       return "$label[0] $label[1]: $error";
4201     }
4202   }
4203   return $remaining;
4204 }
4205
4206 =item grab_svcnums SVCNUM, SVCNUM ...
4207
4208 Change the pkgnum for the provided services to this packages.  If there is an
4209 error, returns the error, otherwise returns false.
4210
4211 =cut
4212
4213 sub grab_svcnums {
4214   my $self = shift;
4215   my @svcnum = @_;
4216
4217   my $oldAutoCommit = $FS::UID::AutoCommit;
4218   local $FS::UID::AutoCommit = 0;
4219   my $dbh = dbh;
4220
4221   foreach my $svcnum (@svcnum) {
4222     my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do {
4223       $dbh->rollback if $oldAutoCommit;
4224       return "unknown svcnum $svcnum";
4225     };
4226     $cust_svc->pkgnum( $self->pkgnum );
4227     my $error = $cust_svc->replace;
4228     if ( $error ) {
4229       $dbh->rollback if $oldAutoCommit;
4230       return $error;
4231     }
4232   }
4233
4234   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4235   '';
4236
4237 }
4238
4239 =item reexport
4240
4241 This method is deprecated.  See the I<depend_jobnum> option to the insert and
4242 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
4243
4244 =cut
4245
4246 #looks like this is still used by the order_pkg and change_pkg methods in
4247 # ClientAPI/MyAccount, need to look into those before removing
4248 sub reexport {
4249   my $self = shift;
4250
4251   my $oldAutoCommit = $FS::UID::AutoCommit;
4252   local $FS::UID::AutoCommit = 0;
4253   my $dbh = dbh;
4254
4255   foreach my $cust_svc ( $self->cust_svc ) {
4256     #false laziness w/svc_Common::insert
4257     my $svc_x = $cust_svc->svc_x;
4258     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
4259       my $error = $part_export->export_insert($svc_x);
4260       if ( $error ) {
4261         $dbh->rollback if $oldAutoCommit;
4262         return $error;
4263       }
4264     }
4265   }
4266
4267   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4268   '';
4269
4270 }
4271
4272 =item export_pkg_change OLD_CUST_PKG
4273
4274 Calls the "pkg_change" export action for all services attached to this package.
4275
4276 =cut
4277
4278 sub export_pkg_change {
4279   my( $self, $old )  = ( shift, shift );
4280
4281   my $oldAutoCommit = $FS::UID::AutoCommit;
4282   local $FS::UID::AutoCommit = 0;
4283   my $dbh = dbh;
4284
4285   foreach my $svc_x ( map $_->svc_x, $self->cust_svc ) {
4286     my $error = $svc_x->export('pkg_change', $self, $old);
4287     if ( $error ) {
4288       $dbh->rollback if $oldAutoCommit;
4289       return $error;
4290     }
4291   }
4292
4293   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4294   '';
4295
4296 }
4297
4298 =item insert_reason
4299
4300 Associates this package with a (suspension or cancellation) reason (see
4301 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
4302 L<FS::reason>).
4303
4304 Available options are:
4305
4306 =over 4
4307
4308 =item reason
4309
4310 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.
4311
4312 =item reason_otaker
4313
4314 the access_user (see L<FS::access_user>) providing the reason
4315
4316 =item date
4317
4318 a unix timestamp
4319
4320 =item action
4321
4322 the action (cancel, susp, adjourn, expire) associated with the reason
4323
4324 =back
4325
4326 If there is an error, returns the error, otherwise returns false.
4327
4328 =cut
4329
4330 sub insert_reason {
4331   my ($self, %options) = @_;
4332
4333   my $otaker = $options{reason_otaker} ||
4334                $FS::CurrentUser::CurrentUser->username;
4335
4336   my $reasonnum;
4337   if ( $options{'reason'} =~ /^(\d+)$/ ) {
4338
4339     $reasonnum = $1;
4340
4341   } elsif ( ref($options{'reason'}) ) {
4342
4343     return 'Enter a new reason (or select an existing one)'
4344       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
4345
4346     my $reason = new FS::reason({
4347       'reason_type' => $options{'reason'}->{'typenum'},
4348       'reason'      => $options{'reason'}->{'reason'},
4349     });
4350     my $error = $reason->insert;
4351     return $error if $error;
4352
4353     $reasonnum = $reason->reasonnum;
4354
4355   } else {
4356     return "Unparseable reason: ". $options{'reason'};
4357   }
4358
4359   my $cust_pkg_reason =
4360     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
4361                               'reasonnum' => $reasonnum,
4362                               'otaker'    => $otaker,
4363                               'action'    => substr(uc($options{'action'}),0,1),
4364                               'date'      => $options{'date'}
4365                                                ? $options{'date'}
4366                                                : time,
4367                             });
4368
4369   $cust_pkg_reason->insert;
4370 }
4371
4372 =item insert_discount
4373
4374 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
4375 inserting a new discount on the fly (see L<FS::discount>).
4376
4377 This will look at the cust_pkg for a pseudo-field named "setup_discountnum",
4378 and if present, will create a setup discount. If the discountnum is -1,
4379 a new discount definition will be inserted using the value in
4380 "setup_discountnum_amount" or "setup_discountnum_percent". Likewise for recur.
4381
4382 If there is an error, returns the error, otherwise returns false.
4383
4384 =cut
4385
4386 sub insert_discount {
4387   #my ($self, %options) = @_;
4388   my $self = shift;
4389
4390   foreach my $x (qw(setup recur)) {
4391     if ( my $discountnum = $self->get("${x}_discountnum") ) {
4392       my $cust_pkg_discount = FS::cust_pkg_discount->new( {
4393         'pkgnum'      => $self->pkgnum,
4394         'discountnum' => $discountnum,
4395         'setuprecur'  => $x,
4396         'months_used' => 0,
4397         'end_date'    => '', #XXX
4398         #for the create a new discount case
4399         'amount'      => $self->get("${x}_discountnum_amount"),
4400         'percent'     => $self->get("${x}_discountnum_percent"),
4401         'months'      => $self->get("${x}_discountnum_months"),
4402       } );
4403       if ( $x eq 'setup' ) {
4404         $cust_pkg_discount->setup('Y');
4405         $cust_pkg_discount->months('');
4406       }
4407       my $error = $cust_pkg_discount->insert;
4408       return $error if $error;
4409     }
4410   }
4411
4412   '';
4413 }
4414
4415 =item set_usage USAGE_VALUE_HASHREF
4416
4417 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
4418 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
4419 upbytes, downbytes, and totalbytes are appropriate keys.
4420
4421 All svc_accts which are part of this package have their values reset.
4422
4423 =cut
4424
4425 sub set_usage {
4426   my ($self, $valueref, %opt) = @_;
4427
4428   #only svc_acct can set_usage for now
4429   foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
4430     my $svc_x = $cust_svc->svc_x;
4431     $svc_x->set_usage($valueref, %opt)
4432       if $svc_x->can("set_usage");
4433   }
4434 }
4435
4436 =item recharge USAGE_VALUE_HASHREF
4437
4438 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
4439 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
4440 upbytes, downbytes, and totalbytes are appropriate keys.
4441
4442 All svc_accts which are part of this package have their values incremented.
4443
4444 =cut
4445
4446 sub recharge {
4447   my ($self, $valueref) = @_;
4448
4449   #only svc_acct can set_usage for now
4450   foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
4451     my $svc_x = $cust_svc->svc_x;
4452     $svc_x->recharge($valueref)
4453       if $svc_x->can("recharge");
4454   }
4455 }
4456
4457 =item apply_usageprice
4458
4459 =cut
4460
4461 sub apply_usageprice {
4462   my $self = shift;
4463
4464   my $oldAutoCommit = $FS::UID::AutoCommit;
4465   local $FS::UID::AutoCommit = 0;
4466   my $dbh = dbh;
4467
4468   my $error = '';
4469
4470   foreach my $cust_pkg_usageprice ( $self->cust_pkg_usageprice ) {
4471     $error ||= $cust_pkg_usageprice->apply;
4472   }
4473
4474   if ( $error ) {
4475     $dbh->rollback if $oldAutoCommit;
4476     die "error applying part_pkg_usageprice add-ons, pkgnum ". $self->pkgnum.
4477         ": $error\n";
4478   } else {
4479     $dbh->commit if $oldAutoCommit;
4480   }
4481
4482
4483 }
4484
4485 =item cust_pkg_discount
4486
4487 =item cust_pkg_discount_active
4488
4489 =cut
4490
4491 sub cust_pkg_discount_active {
4492   my $self = shift;
4493   grep { $_->status eq 'active' } $self->cust_pkg_discount;
4494 }
4495
4496 =item cust_pkg_usage
4497
4498 Returns a list of all voice usage counters attached to this package.
4499
4500 =item apply_usage OPTIONS
4501
4502 Takes the following options:
4503 - cdr: a call detail record (L<FS::cdr>)
4504 - rate_detail: the rate determined for this call (L<FS::rate_detail>)
4505 - minutes: the maximum number of minutes to be charged
4506
4507 Finds available usage minutes for a call of this class, and subtracts
4508 up to that many minutes from the usage pool.  If the usage pool is empty,
4509 and the C<cdr-minutes_priority> global config option is set, minutes may
4510 be taken from other calls as well.  Either way, an allocation record will
4511 be created (L<FS::cdr_cust_pkg_usage>) and this method will return the
4512 number of minutes of usage applied to the call.
4513
4514 =cut
4515
4516 sub apply_usage {
4517   my ($self, %opt) = @_;
4518   my $cdr = $opt{cdr};
4519   my $rate_detail = $opt{rate_detail};
4520   my $minutes = $opt{minutes};
4521   my $classnum = $rate_detail->classnum;
4522   my $pkgnum = $self->pkgnum;
4523   my $custnum = $self->custnum;
4524
4525   my $oldAutoCommit = $FS::UID::AutoCommit;
4526   local $FS::UID::AutoCommit = 0;
4527   my $dbh = dbh;
4528
4529   my $order = FS::Conf->new->config('cdr-minutes_priority');
4530
4531   my $is_classnum;
4532   if ( $classnum ) {
4533     $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum;
4534   } else {
4535     $is_classnum = ' part_pkg_usage_class.classnum IS NULL';
4536   }
4537   my @usage_recs = qsearch({
4538       'table'     => 'cust_pkg_usage',
4539       'addl_from' => ' JOIN part_pkg_usage       USING (pkgusagepart)'.
4540                      ' JOIN cust_pkg             USING (pkgnum)'.
4541                      ' JOIN part_pkg_usage_class USING (pkgusagepart)',
4542       'select'    => 'cust_pkg_usage.*',
4543       'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ".
4544                      " ( cust_pkg.custnum = $custnum AND ".
4545                      " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4546                      $is_classnum . ' AND '.
4547                      " cust_pkg_usage.minutes > 0",
4548       'order_by'  => " ORDER BY priority ASC",
4549   });
4550
4551   my $orig_minutes = $minutes;
4552   my $error;
4553   while (!$error and $minutes > 0 and @usage_recs) {
4554     my $cust_pkg_usage = shift @usage_recs;
4555     $cust_pkg_usage->select_for_update;
4556     my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({
4557         pkgusagenum => $cust_pkg_usage->pkgusagenum,
4558         acctid      => $cdr->acctid,
4559         minutes     => min($cust_pkg_usage->minutes, $minutes),
4560     });
4561     $cust_pkg_usage->set('minutes',
4562       $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes
4563     );
4564     $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert;
4565     $minutes -= $cdr_cust_pkg_usage->minutes;
4566   }
4567   if ( $order and $minutes > 0 and !$error ) {
4568     # then try to steal minutes from another call
4569     my %search = (
4570         'table'     => 'cdr_cust_pkg_usage',
4571         'addl_from' => ' JOIN cust_pkg_usage        USING (pkgusagenum)'.
4572                        ' JOIN part_pkg_usage        USING (pkgusagepart)'.
4573                        ' JOIN cust_pkg              USING (pkgnum)'.
4574                        ' JOIN part_pkg_usage_class  USING (pkgusagepart)'.
4575                        ' JOIN cdr                   USING (acctid)',
4576         'select'    => 'cdr_cust_pkg_usage.*',
4577         'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ".
4578                        " ( cust_pkg.pkgnum = $pkgnum OR ".
4579                        " ( cust_pkg.custnum = $custnum AND ".
4580                        " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4581                        " part_pkg_usage_class.classnum = $classnum",
4582         'order_by'  => ' ORDER BY part_pkg_usage.priority ASC',
4583     );
4584     if ( $order eq 'time' ) {
4585       # find CDRs that are using minutes, but have a later startdate
4586       # than this call
4587       my $startdate = $cdr->startdate;
4588       if ($startdate !~ /^\d+$/) {
4589         die "bad cdr startdate '$startdate'";
4590       }
4591       $search{'extra_sql'} .= " AND cdr.startdate > $startdate";
4592       # minimize needless reshuffling
4593       $search{'order_by'} .= ', cdr.startdate DESC';
4594     } else {
4595       # XXX may not work correctly with rate_time schedules.  Could
4596       # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I
4597       # think...
4598       $search{'addl_from'} .=
4599         ' JOIN rate_detail'.
4600         ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)';
4601       if ( $order eq 'rate_high' ) {
4602         $search{'extra_sql'} .= ' AND rate_detail.min_charge < '.
4603                                 $rate_detail->min_charge;
4604         $search{'order_by'} .= ', rate_detail.min_charge ASC';
4605       } elsif ( $order eq 'rate_low' ) {
4606         $search{'extra_sql'} .= ' AND rate_detail.min_charge > '.
4607                                 $rate_detail->min_charge;
4608         $search{'order_by'} .= ', rate_detail.min_charge DESC';
4609       } else {
4610         #  this should really never happen
4611         die "invalid cdr-minutes_priority value '$order'\n";
4612       }
4613     }
4614     my @cdr_usage_recs = qsearch(\%search);
4615     my %reproc_cdrs;
4616     while (!$error and @cdr_usage_recs and $minutes > 0) {
4617       my $cdr_cust_pkg_usage = shift @cdr_usage_recs;
4618       my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage;
4619       my $old_cdr = $cdr_cust_pkg_usage->cdr;
4620       $reproc_cdrs{$old_cdr->acctid} = $old_cdr;
4621       $cdr_cust_pkg_usage->select_for_update;
4622       $old_cdr->select_for_update;
4623       $cust_pkg_usage->select_for_update;
4624       # in case someone else stole the usage from this CDR
4625       # while waiting for the lock...
4626       next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid;
4627       # steal the usage allocation and flag the old CDR for reprocessing
4628       $cdr_cust_pkg_usage->set('acctid', $cdr->acctid);
4629       # if the allocation is more minutes than we need, adjust it...
4630       my $delta = $cdr_cust_pkg_usage->minutes - $minutes;
4631       if ( $delta > 0 ) {
4632         $cdr_cust_pkg_usage->set('minutes', $minutes);
4633         $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta);
4634         $error = $cust_pkg_usage->replace;
4635       }
4636       #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n";
4637       $error ||= $cdr_cust_pkg_usage->replace;
4638       # deduct the stolen minutes
4639       $minutes -= $cdr_cust_pkg_usage->minutes;
4640     }
4641     # after all minute-stealing is done, reset the affected CDRs
4642     foreach (values %reproc_cdrs) {
4643       $error ||= $_->set_status('');
4644       # XXX or should we just call $cdr->rate right here?
4645       # it's not like we can create a loop this way, since the min_charge
4646       # or call time has to go monotonically in one direction.
4647       # we COULD get some very deep recursions going, though...
4648     }
4649   } # if $order and $minutes
4650   if ( $error ) {
4651     $dbh->rollback;
4652     die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n"
4653   } else {
4654     $dbh->commit if $oldAutoCommit;
4655     return $orig_minutes - $minutes;
4656   }
4657 }
4658
4659 =item supplemental_pkgs
4660
4661 Returns a list of all packages supplemental to this one.
4662
4663 =cut
4664
4665 sub supplemental_pkgs {
4666   my $self = shift;
4667   qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
4668 }
4669
4670 =item main_pkg
4671
4672 Returns the package that this one is supplemental to, if any.
4673
4674 =cut
4675
4676 sub main_pkg {
4677   my $self = shift;
4678   if ( $self->main_pkgnum ) {
4679     return FS::cust_pkg->by_key($self->main_pkgnum);
4680   }
4681   return;
4682 }
4683
4684 =back
4685
4686 =head1 CLASS METHODS
4687
4688 =over 4
4689
4690 =item recurring_sql
4691
4692 Returns an SQL expression identifying recurring packages.
4693
4694 =cut
4695
4696 sub recurring_sql { "
4697   '0' != ( select freq from part_pkg
4698              where cust_pkg.pkgpart = part_pkg.pkgpart )
4699 "; }
4700
4701 =item onetime_sql
4702
4703 Returns an SQL expression identifying one-time packages.
4704
4705 =cut
4706
4707 sub onetime_sql { "
4708   '0' = ( select freq from part_pkg
4709             where cust_pkg.pkgpart = part_pkg.pkgpart )
4710 "; }
4711
4712 =item ordered_sql
4713
4714 Returns an SQL expression identifying ordered packages (recurring packages not
4715 yet billed).
4716
4717 =cut
4718
4719 sub ordered_sql {
4720    $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
4721 }
4722
4723 =item active_sql
4724
4725 Returns an SQL expression identifying active packages.
4726
4727 =cut
4728
4729 sub active_sql {
4730   $_[0]->recurring_sql. "
4731   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4732   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4733   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
4734 "; }
4735
4736 =item not_yet_billed_sql
4737
4738 Returns an SQL expression identifying packages which have not yet been billed.
4739
4740 =cut
4741
4742 sub not_yet_billed_sql { "
4743       ( cust_pkg.setup  IS NULL OR cust_pkg.setup  = 0 )
4744   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4745   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
4746 "; }
4747
4748 =item inactive_sql
4749
4750 Returns an SQL expression identifying inactive packages (one-time packages
4751 that are otherwise unsuspended/uncancelled).
4752
4753 =cut
4754
4755 sub inactive_sql { "
4756   ". $_[0]->onetime_sql(). "
4757   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4758   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4759   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
4760 "; }
4761
4762 =item on_hold_sql
4763
4764 Returns an SQL expression identifying on-hold packages.
4765
4766 =cut
4767
4768 sub on_hold_sql {
4769   #$_[0]->recurring_sql(). ' AND '.
4770   "
4771         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel  = 0 )
4772     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp   != 0
4773     AND ( cust_pkg.setup  IS     NULL  OR cust_pkg.setup   = 0 )
4774   ";
4775 }
4776
4777 =item susp_sql
4778 =item suspended_sql
4779
4780 Returns an SQL expression identifying suspended packages.
4781
4782 =cut
4783
4784 sub suspended_sql { susp_sql(@_); }
4785 sub susp_sql {
4786   #$_[0]->recurring_sql(). ' AND '.
4787   "
4788         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
4789     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
4790     AND   cust_pkg.setup  IS NOT NULL AND cust_pkg.setup != 0
4791   ";
4792 }
4793
4794 =item cancel_sql
4795 =item cancelled_sql
4796
4797 Returns an SQL exprression identifying cancelled packages.
4798
4799 =cut
4800
4801 sub cancelled_sql { cancel_sql(@_); }
4802 sub cancel_sql {
4803   #$_[0]->recurring_sql(). ' AND '.
4804   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
4805 }
4806
4807 =item status_sql
4808
4809 Returns an SQL expression to give the package status as a string.
4810
4811 =cut
4812
4813 sub status_sql {
4814 "CASE
4815   WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
4816   WHEN ( cust_pkg.susp IS NOT NULL AND cust_pkg.setup IS NULL ) THEN 'on hold'
4817   WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
4818   WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
4819   WHEN ".onetime_sql()." THEN 'one-time charge'
4820   ELSE 'active'
4821 END"
4822 }
4823
4824 =item fcc_477_count
4825
4826 Returns a list of two package counts.  The first is a count of packages
4827 based on the supplied criteria and the second is the count of residential
4828 packages with those same criteria.  Criteria are specified as in the search
4829 method.
4830
4831 =cut
4832
4833 sub fcc_477_count {
4834   my ($class, $params) = @_;
4835
4836   my $sql_query = $class->search( $params );
4837
4838   my $count_sql = delete($sql_query->{'count_query'});
4839   $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
4840     or die "couldn't parse count_sql";
4841
4842   my $count_sth = dbh->prepare($count_sql)
4843     or die "Error preparing $count_sql: ". dbh->errstr;
4844   $count_sth->execute
4845     or die "Error executing $count_sql: ". $count_sth->errstr;
4846   my $count_arrayref = $count_sth->fetchrow_arrayref;
4847
4848   return ( @$count_arrayref );
4849
4850 }
4851
4852 =item tax_locationnum_sql
4853
4854 Returns an SQL expression for the tax location for a package, based
4855 on the settings of 'tax-pkg_address' and 'tax-ship_address'.
4856
4857 =cut
4858
4859 sub tax_locationnum_sql {
4860   my $conf = FS::Conf->new;
4861   if ( $conf->exists('tax-pkg_address') ) {
4862     'cust_pkg.locationnum';
4863   }
4864   elsif ( $conf->exists('tax-ship_address') ) {
4865     'cust_main.ship_locationnum';
4866   }
4867   else {
4868     'cust_main.bill_locationnum';
4869   }
4870 }
4871
4872 =item location_sql
4873
4874 Returns a list: the first item is an SQL fragment identifying matching
4875 packages/customers via location (taking into account shipping and package
4876 address taxation, if enabled), and subsequent items are the parameters to
4877 substitute for the placeholders in that fragment.
4878
4879 =cut
4880
4881 sub location_sql {
4882   my($class, %opt) = @_;
4883   my $ornull = $opt{'ornull'};
4884
4885   my $conf = new FS::Conf;
4886
4887   # '?' placeholders in _location_sql_where
4888   my $x = $ornull ? 3 : 2;
4889   my @bill_param = (
4890     ('district')x3,
4891     ('city')x3,
4892     ('county')x$x,
4893     ('state')x$x,
4894     'country'
4895   );
4896
4897   my $main_where;
4898   my @main_param;
4899   if ( $conf->exists('tax-ship_address') ) {
4900
4901     $main_where = "(
4902          (     ( ship_last IS NULL     OR  ship_last  = '' )
4903            AND ". _location_sql_where('cust_main', '', $ornull ). "
4904          )
4905       OR (       ship_last IS NOT NULL AND ship_last != ''
4906            AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
4907          )
4908     )";
4909     #    AND payby != 'COMP'
4910
4911     @main_param = ( @bill_param, @bill_param );
4912
4913   } else {
4914
4915     $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
4916     @main_param = @bill_param;
4917
4918   }
4919
4920   my $where;
4921   my @param;
4922   if ( $conf->exists('tax-pkg_address') ) {
4923
4924     my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
4925
4926     $where = " (
4927                     ( cust_pkg.locationnum IS     NULL AND $main_where )
4928                  OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where  )
4929                )
4930              ";
4931     @param = ( @main_param, @bill_param );
4932
4933   } else {
4934
4935     $where = $main_where;
4936     @param = @main_param;
4937
4938   }
4939
4940   ( $where, @param );
4941
4942 }
4943
4944 #subroutine, helper for location_sql
4945 sub _location_sql_where {
4946   my $table  = shift;
4947   my $prefix = @_ ? shift : '';
4948   my $ornull = @_ ? shift : '';
4949
4950 #  $ornull             = $ornull          ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
4951
4952   $ornull = $ornull ? ' OR ? IS NULL ' : '';
4953
4954   my $or_empty_city     = " OR ( ? = '' AND $table.${prefix}city     IS NULL )";
4955   my $or_empty_county   = " OR ( ? = '' AND $table.${prefix}county   IS NULL )";
4956   my $or_empty_state    = " OR ( ? = '' AND $table.${prefix}state    IS NULL )";
4957
4958   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
4959
4960 #        ( $table.${prefix}city    = ? $or_empty_city   $ornull )
4961   "
4962         ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL )
4963     AND ( $table.${prefix}city     = ? OR ? = '' OR CAST(? AS $text) IS NULL )
4964     AND ( $table.${prefix}county   = ? $or_empty_county $ornull )
4965     AND ( $table.${prefix}state    = ? $or_empty_state  $ornull )
4966     AND   $table.${prefix}country  = ?
4967   ";
4968 }
4969
4970 sub _X_show_zero {
4971   my( $self, $what ) = @_;
4972
4973   my $what_show_zero = $what. '_show_zero';
4974   length($self->$what_show_zero())
4975     ? ($self->$what_show_zero() eq 'Y')
4976     : $self->part_pkg->$what_show_zero();
4977 }
4978
4979 =head1 SUBROUTINES
4980
4981 =over 4
4982
4983 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
4984
4985 Bulk cancel + order subroutine.  Perhaps slightly deprecated, only used by the
4986 bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
4987
4988 CUSTNUM is a customer (see L<FS::cust_main>)
4989
4990 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
4991 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
4992 permitted.
4993
4994 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
4995 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
4996 new billing items.  An error is returned if this is not possible (see
4997 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
4998 parameter.
4999
5000 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
5001 newly-created cust_pkg objects.
5002
5003 REFNUM, if specified, will specify the FS::pkg_referral record to be created
5004 and inserted.  Multiple FS::pkg_referral records can be created by
5005 setting I<refnum> to an array reference of refnums or a hash reference with
5006 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
5007 record will be created corresponding to cust_main.refnum.
5008
5009 =cut
5010
5011 sub order {
5012   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
5013
5014   my $conf = new FS::Conf;
5015
5016   # Transactionize this whole mess
5017   my $oldAutoCommit = $FS::UID::AutoCommit;
5018   local $FS::UID::AutoCommit = 0;
5019   my $dbh = dbh;
5020
5021   my $error;
5022 #  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
5023 #  return "Customer not found: $custnum" unless $cust_main;
5024
5025   warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
5026     if $DEBUG;
5027
5028   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
5029                          @$remove_pkgnum;
5030
5031   my $change = scalar(@old_cust_pkg) != 0;
5032
5033   my %hash = ();
5034   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
5035
5036     warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
5037          " to pkgpart ". $pkgparts->[0]. "\n"
5038       if $DEBUG;
5039
5040     my $err_or_cust_pkg =
5041       $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
5042                                 'refnum'  => $refnum,
5043                               );
5044
5045     unless (ref($err_or_cust_pkg)) {
5046       $dbh->rollback if $oldAutoCommit;
5047       return $err_or_cust_pkg;
5048     }
5049
5050     push @$return_cust_pkg, $err_or_cust_pkg;
5051     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5052     return '';
5053
5054   }
5055
5056   # Create the new packages.
5057   foreach my $pkgpart (@$pkgparts) {
5058
5059     warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
5060
5061     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
5062                                       pkgpart => $pkgpart,
5063                                       refnum  => $refnum,
5064                                       %hash,
5065                                     };
5066     $error = $cust_pkg->insert( 'change' => $change );
5067     push @$return_cust_pkg, $cust_pkg;
5068
5069     foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) {
5070       my $supp_pkg = FS::cust_pkg->new({
5071           custnum => $custnum,
5072           pkgpart => $link->dst_pkgpart,
5073           refnum  => $refnum,
5074           main_pkgnum => $cust_pkg->pkgnum,
5075           %hash,
5076       });
5077       $error ||= $supp_pkg->insert( 'change' => $change );
5078       push @$return_cust_pkg, $supp_pkg;
5079     }
5080
5081     if ($error) {
5082       $dbh->rollback if $oldAutoCommit;
5083       return $error;
5084     }
5085
5086   }
5087   # $return_cust_pkg now contains refs to all of the newly
5088   # created packages.
5089
5090   # Transfer services and cancel old packages.
5091   foreach my $old_pkg (@old_cust_pkg) {
5092
5093     warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
5094       if $DEBUG;
5095
5096     foreach my $new_pkg (@$return_cust_pkg) {
5097       $error = $old_pkg->transfer($new_pkg);
5098       if ($error and $error == 0) {
5099         # $old_pkg->transfer failed.
5100         $dbh->rollback if $oldAutoCommit;
5101         return $error;
5102       }
5103     }
5104
5105     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
5106       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
5107       foreach my $new_pkg (@$return_cust_pkg) {
5108         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
5109         if ($error and $error == 0) {
5110           # $old_pkg->transfer failed.
5111         $dbh->rollback if $oldAutoCommit;
5112         return $error;
5113         }
5114       }
5115     }
5116
5117     if ($error > 0) {
5118       # Transfers were successful, but we went through all of the
5119       # new packages and still had services left on the old package.
5120       # We can't cancel the package under the circumstances, so abort.
5121       $dbh->rollback if $oldAutoCommit;
5122       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
5123     }
5124     $error = $old_pkg->cancel( quiet=>1, 'no_delay_cancel'=>1 );
5125     if ($error) {
5126       $dbh->rollback;
5127       return $error;
5128     }
5129   }
5130   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5131   '';
5132 }
5133
5134 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
5135
5136 A bulk change method to change packages for multiple customers.
5137
5138 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
5139 L<FS::part_pkg>) to order for each customer.  Duplicates are of course
5140 permitted.
5141
5142 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
5143 replace.  The services (see L<FS::cust_svc>) are moved to the
5144 new billing items.  An error is returned if this is not possible (see
5145 L<FS::pkg_svc>).
5146
5147 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
5148 newly-created cust_pkg objects.
5149
5150 =cut
5151
5152 sub bulk_change {
5153   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
5154
5155   # Transactionize this whole mess
5156   my $oldAutoCommit = $FS::UID::AutoCommit;
5157   local $FS::UID::AutoCommit = 0;
5158   my $dbh = dbh;
5159
5160   my @errors;
5161   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
5162                          @$remove_pkgnum;
5163
5164   while(scalar(@old_cust_pkg)) {
5165     my @return = ();
5166     my $custnum = $old_cust_pkg[0]->custnum;
5167     my (@remove) = map { $_->pkgnum }
5168                    grep { $_->custnum == $custnum } @old_cust_pkg;
5169     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
5170
5171     my $error = order $custnum, $pkgparts, \@remove, \@return;
5172
5173     push @errors, $error
5174       if $error;
5175     push @$return_cust_pkg, @return;
5176   }
5177
5178   if (scalar(@errors)) {
5179     $dbh->rollback if $oldAutoCommit;
5180     return join(' / ', @errors);
5181   }
5182
5183   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5184   '';
5185 }
5186
5187 =item forward_emails
5188
5189 Returns a hash of svcnums and corresponding email addresses
5190 for svc_acct services that can be used as source or dest
5191 for svc_forward services provisioned in this package.
5192
5193 Accepts options I<svc_forward> OR I<svcnum> for a svc_forward
5194 service;  if included, will ensure the current values of the
5195 specified service are included in the list, even if for some
5196 other reason they wouldn't be.  If called as a class method
5197 with a specified service, returns only these current values.
5198
5199 Caution: does not actually check if svc_forward services are
5200 available to be provisioned on this package.
5201
5202 =cut
5203
5204 sub forward_emails {
5205   my $self = shift;
5206   my %opt = @_;
5207
5208   #load optional service, thoroughly validated
5209   die "Use svcnum or svc_forward, not both"
5210     if $opt{'svcnum'} && $opt{'svc_forward'};
5211   my $svc_forward = $opt{'svc_forward'};
5212   $svc_forward ||= qsearchs('svc_forward',{ 'svcnum' => $opt{'svcnum'} })
5213     if $opt{'svcnum'};
5214   die "Specified service is not a forward service"
5215     if $svc_forward && (ref($svc_forward) ne 'FS::svc_forward');
5216   die "Specified service not found"
5217     if ($opt{'svcnum'} || $opt{'svc_forward'}) && !$svc_forward;
5218
5219   my %email;
5220
5221   ## everything below was basically copied from httemplate/edit/svc_forward.cgi
5222   ## with minimal refactoring, not sure why we can't just load all svc_accts for this custnum
5223
5224   #add current values from specified service, if there was one
5225   if ($svc_forward) {
5226     foreach my $method (qw( srcsvc_acct dstsvc_acct )) {
5227       my $svc_acct = $svc_forward->$method();
5228       $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct;
5229     }
5230   }
5231
5232   if (ref($self) eq 'FS::cust_pkg') {
5233
5234     #and including the rest for this customer
5235     my($u_part_svc,@u_acct_svcparts);
5236     foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
5237       push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
5238     }
5239
5240     my $custnum = $self->getfield('custnum');
5241     foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
5242       my $cust_pkgnum = $i_cust_pkg->getfield('pkgnum');
5243       #now find the corresponding record(s) in cust_svc (for this pkgnum!)
5244       foreach my $acct_svcpart (@u_acct_svcparts) {
5245         foreach my $i_cust_svc (
5246           qsearch( 'cust_svc', { 'pkgnum'  => $cust_pkgnum,
5247                                  'svcpart' => $acct_svcpart } )
5248         ) {
5249           my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } );
5250           $email{$svc_acct->svcnum} = $svc_acct->email;
5251         }
5252       }
5253     }
5254   }
5255
5256   return %email;
5257 }
5258
5259 # Used by FS::Upgrade to migrate to a new database.
5260 sub _upgrade_data {  # class method
5261   my ($class, %opts) = @_;
5262   $class->_upgrade_otaker(%opts);
5263   my @statements = (
5264     # RT#10139, bug resulting in contract_end being set when it shouldn't
5265   'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
5266     # RT#10830, bad calculation of prorate date near end of year
5267     # the date range for bill is December 2009, and we move it forward
5268     # one year if it's before the previous bill date (which it should
5269     # never be)
5270   'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
5271   AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
5272   WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
5273     # RT6628, add order_date to cust_pkg
5274     'update cust_pkg set order_date = (select history_date from h_cust_pkg
5275         where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
5276         history_action = \'insert\') where order_date is null',
5277   );
5278   foreach my $sql (@statements) {
5279     my $sth = dbh->prepare($sql);
5280     $sth->execute or die $sth->errstr;
5281   }
5282
5283   # RT31194: supplemental package links that are deleted don't clean up
5284   # linked records
5285   my @pkglinknums = qsearch({
5286       'select'    => 'DISTINCT cust_pkg.pkglinknum',
5287       'table'     => 'cust_pkg',
5288       'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ',
5289       'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL
5290                         AND part_pkg_link.pkglinknum IS NULL',
5291   });
5292   foreach (@pkglinknums) {
5293     my $pkglinknum = $_->pkglinknum;
5294     warn "cleaning part_pkg_link #$pkglinknum\n";
5295     my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum});
5296     my $error = $part_pkg_link->remove_linked;
5297     die $error if $error;
5298   }
5299 }
5300
5301 =back
5302
5303 =head1 BUGS
5304
5305 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
5306
5307 In sub order, the @pkgparts array (passed by reference) is clobbered.
5308
5309 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
5310 method to pass dates to the recur_prog expression, it should do so.
5311
5312 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
5313 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
5314 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
5315 configuration values.  Probably need a subroutine which decides what to do
5316 based on whether or not we've fetched the user yet, rather than a hash.  See
5317 FS::UID and the TODO.
5318
5319 Now that things are transactional should the check in the insert method be
5320 moved to check ?
5321
5322 =head1 SEE ALSO
5323
5324 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
5325 L<FS::pkg_svc>, schema.html from the base documentation
5326
5327 =cut
5328
5329 1;
5330