FS/FS/cust_pkg.pm

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