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