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->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
2164   # going to be credited for remaining time, don't keep setup, bill,
2165   # or last_bill dates, and DO pass the flag to cancel() to credit
2166   # the customer.
2167   if ( $opt->{'pkgpart'}
2168        and $opt->{'pkgpart'} != $self->pkgpart
2169        and $self->part_pkg->option('unused_credit_change', 1) ) {
2170     $unused_credit = 1;
2171     $keep_dates = 0;
2172     $hash{$_} = '' foreach qw(setup bill last_bill);
2173   }
2174
2175   if ( $keep_dates ) {
2176     foreach my $date ( qw(setup bill last_bill) ) {
2177       $hash{$date} = $self->getfield($date);
2178     }
2179   }
2180   # always keep the following dates
2181   foreach my $date (qw(order_date susp adjourn cancel expire resume
2182                     start_date contract_end)) {
2183     $hash{$date} = $self->getfield($date);
2184   }
2185   # but if contract_end was explicitly specified, that overrides all else
2186   $hash{'contract_end'} = $opt->{'contract_end'}
2187     if $opt->{'contract_end'};
2188
2189   # allow $opt->{'locationnum'} = '' to specifically set it to null
2190   # (i.e. customer default location)
2191   $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2192
2193   # usually this doesn't matter.  the two cases where it does are:
2194   # 1. unused_credit_change + pkgpart change + setup fee on the new package
2195   # and
2196   # 2. (more importantly) changing a package before it's billed
2197   $hash{'waive_setup'} = $self->waive_setup;
2198
2199   # if this package is scheduled for a future package change, preserve that
2200   $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
2201
2202   my $custnum = $self->custnum;
2203   if ( $opt->{cust_main} ) {
2204     my $cust_main = $opt->{cust_main};
2205     unless ( $cust_main->custnum ) {
2206       my $error = $cust_main->insert( @{ $opt->{cust_main_insert_args}||[] } );
2207       if ( $error ) {
2208         $dbh->rollback if $oldAutoCommit;
2209         return "inserting customer record: $error";
2210       }
2211     }
2212     $custnum = $cust_main->custnum;
2213   }
2214
2215   $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
2216
2217   my $cust_pkg;
2218   if ( $opt->{'cust_pkg'} ) {
2219     # The target package already exists; update it to show that it was
2220     # changed from this package.
2221     $cust_pkg = $opt->{'cust_pkg'};
2222
2223     # follow all the above rules for date changes, etc.
2224     foreach (keys %hash) {
2225       $cust_pkg->set($_, $hash{$_});
2226     }
2227     # except those that implement the future package change behavior
2228     foreach (qw(change_to_pkgnum start_date expire)) {
2229       $cust_pkg->set($_, '');
2230     }
2231
2232     $error = $cust_pkg->replace;
2233
2234   } else {
2235     # Create the new package.
2236     $cust_pkg = new FS::cust_pkg {
2237       custnum     => $custnum,
2238       locationnum => $opt->{'locationnum'},
2239       ( map {  $_ => ( $opt->{$_} || $self->$_() )  }
2240           qw( pkgpart quantity refnum salesnum )
2241       ),
2242       %hash,
2243     };
2244     $error = $cust_pkg->insert( 'change' => 1,
2245                                 'allow_pkgpart' => $same_pkgpart );
2246   }
2247   if ($error) {
2248     $dbh->rollback if $oldAutoCommit;
2249     return "inserting new package: $error";
2250   }
2251
2252   # Transfer services and cancel old package.
2253   # Enforce service limits only if this is a pkgpart change.
2254   local $FS::cust_svc::ignore_quantity;
2255   $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
2256   $error = $self->transfer($cust_pkg);
2257   if ($error and $error == 0) {
2258     # $old_pkg->transfer failed.
2259     $dbh->rollback if $oldAutoCommit;
2260     return "transferring $error";
2261   }
2262
2263   if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2264     warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2265     $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
2266     if ($error and $error == 0) {
2267       # $old_pkg->transfer failed.
2268       $dbh->rollback if $oldAutoCommit;
2269       return "converting $error";
2270     }
2271   }
2272
2273   # We set unprotect_svcs when executing a "future package change".  It's
2274   # not a user-interactive operation, so returning an error means the
2275   # package change will just fail.  Rather than have that happen, we'll
2276   # let leftover services be deleted.
2277   if ($error > 0 and !$opt->{'unprotect_svcs'}) {
2278     # Transfers were successful, but we still had services left on the old
2279     # package.  We can't change the package under this circumstances, so abort.
2280     $dbh->rollback if $oldAutoCommit;
2281     return "unable to transfer all services";
2282   }
2283
2284   #reset usage if changing pkgpart
2285   # AND usage rollover is off (otherwise adds twice, now and at package bill)
2286   if ($self->pkgpart != $cust_pkg->pkgpart) {
2287     my $part_pkg = $cust_pkg->part_pkg;
2288     $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
2289                                                  ? ()
2290                                                  : ( 'null' => 1 )
2291                                    )
2292       if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
2293
2294     if ($error) {
2295       $dbh->rollback if $oldAutoCommit;
2296       return "setting usage values: $error";
2297     }
2298   } else {
2299     # if NOT changing pkgpart, transfer any usage pools over
2300     foreach my $usage ($self->cust_pkg_usage) {
2301       $usage->set('pkgnum', $cust_pkg->pkgnum);
2302       $error = $usage->replace;
2303       if ( $error ) {
2304         $dbh->rollback if $oldAutoCommit;
2305         return "transferring usage pools: $error";
2306       }
2307     }
2308   }
2309
2310   # transfer usage pricing add-ons, if we're not changing pkgpart or if they were specified
2311   if ( $same_pkgpart || $opt->{'cust_pkg_usageprice'}) {
2312     my @old_cust_pkg_usageprice;
2313     if ($opt->{'cust_pkg_usageprice'}) {
2314       @old_cust_pkg_usageprice = @{ $opt->{'cust_pkg_usageprice'} };
2315     } else {
2316       @old_cust_pkg_usageprice = $self->cust_pkg_usageprice;
2317     }
2318     foreach my $old_cust_pkg_usageprice (@old_cust_pkg_usageprice) {
2319       my $new_cust_pkg_usageprice = new FS::cust_pkg_usageprice {
2320         'pkgnum'         => $cust_pkg->pkgnum,
2321         'usagepricepart' => $old_cust_pkg_usageprice->usagepricepart,
2322         'quantity'       => $old_cust_pkg_usageprice->quantity,
2323       };
2324       $error = $new_cust_pkg_usageprice->insert;
2325       if ( $error ) {
2326         $dbh->rollback if $oldAutoCommit;
2327         return "Error transferring usage pricing add-on: $error";
2328       }
2329     }
2330   }
2331
2332   # transfer discounts, if we're not changing pkgpart
2333   if ( $same_pkgpart ) {
2334     foreach my $old_discount ($self->cust_pkg_discount_active) {
2335       # don't remove the old discount, we may still need to bill that package.
2336       my $new_discount = new FS::cust_pkg_discount {
2337         'pkgnum'      => $cust_pkg->pkgnum,
2338         'discountnum' => $old_discount->discountnum,
2339         'months_used' => $old_discount->months_used,
2340       };
2341       $error = $new_discount->insert;
2342       if ( $error ) {
2343         $dbh->rollback if $oldAutoCommit;
2344         return "transferring discounts: $error";
2345       }
2346     }
2347   }
2348
2349   # transfer (copy) invoice details
2350   foreach my $detail ($self->cust_pkg_detail) {
2351     my $new_detail = FS::cust_pkg_detail->new({ $detail->hash });
2352     $new_detail->set('pkgdetailnum', '');
2353     $new_detail->set('pkgnum', $cust_pkg->pkgnum);
2354     $error = $new_detail->insert;
2355     if ( $error ) {
2356       $dbh->rollback if $oldAutoCommit;
2357       return "transferring package notes: $error";
2358     }
2359   }
2360
2361   my @new_supp_pkgs;
2362
2363   if ( !$opt->{'cust_pkg'} ) {
2364     # Order any supplemental packages.
2365     my $part_pkg = $cust_pkg->part_pkg;
2366     my @old_supp_pkgs = $self->supplemental_pkgs;
2367     foreach my $link ($part_pkg->supp_part_pkg_link) {
2368       my $old;
2369       foreach (@old_supp_pkgs) {
2370         if ($_->pkgpart == $link->dst_pkgpart) {
2371           $old = $_;
2372           $_->pkgpart(0); # so that it can't match more than once
2373         }
2374         last if $old;
2375       }
2376       # false laziness with FS::cust_main::Packages::order_pkg
2377       my $new = FS::cust_pkg->new({
2378           pkgpart       => $link->dst_pkgpart,
2379           pkglinknum    => $link->pkglinknum,
2380           custnum       => $custnum,
2381           main_pkgnum   => $cust_pkg->pkgnum,
2382           locationnum   => $cust_pkg->locationnum,
2383           start_date    => $cust_pkg->start_date,
2384           order_date    => $cust_pkg->order_date,
2385           expire        => $cust_pkg->expire,
2386           adjourn       => $cust_pkg->adjourn,
2387           contract_end  => $cust_pkg->contract_end,
2388           refnum        => $cust_pkg->refnum,
2389           discountnum   => $cust_pkg->discountnum,
2390           waive_setup   => $cust_pkg->waive_setup,
2391       });
2392       if ( $old and $opt->{'keep_dates'} ) {
2393         foreach (qw(setup bill last_bill)) {
2394           $new->set($_, $old->get($_));
2395         }
2396       }
2397       $error = $new->insert( allow_pkgpart => $same_pkgpart );
2398       # transfer services
2399       if ( $old ) {
2400         $error ||= $old->transfer($new);
2401       }
2402       if ( $error and $error > 0 ) {
2403         # no reason why this should ever fail, but still...
2404         $error = "Unable to transfer all services from supplemental package ".
2405           $old->pkgnum;
2406       }
2407       if ( $error ) {
2408         $dbh->rollback if $oldAutoCommit;
2409         return $error;
2410       }
2411       push @new_supp_pkgs, $new;
2412     }
2413   } # if !$opt->{'cust_pkg'}
2414     # because if there is one, then supplemental packages would already
2415     # have been created for it.
2416
2417   #Good to go, cancel old package.  Notify 'cancel' of whether to credit
2418   #remaining time.
2419   #Don't allow billing the package (preceding period packages and/or
2420   #outstanding usage) if we are keeping dates (i.e. location changing),
2421   #because the new package will be billed for the same date range.
2422   #Supplemental packages are also canceled here.
2423
2424   # during scheduled changes, avoid canceling the package we just
2425   # changed to (duh)
2426   $self->set('change_to_pkgnum' => '');
2427
2428   $error = $self->cancel(
2429     quiet          => 1,
2430     unused_credit  => $unused_credit,
2431     nobill         => $keep_dates,
2432     change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
2433     no_delay_cancel => 1,
2434   );
2435   if ($error) {
2436     $dbh->rollback if $oldAutoCommit;
2437     return "canceling old package: $error";
2438   }
2439
2440   if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
2441     #$self->cust_main
2442     my $error = $cust_pkg->cust_main->bill(
2443       'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
2444     );
2445     if ( $error ) {
2446       $dbh->rollback if $oldAutoCommit;
2447       return "billing new package: $error";
2448     }
2449   }
2450
2451   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2452
2453   $cust_pkg;
2454
2455 }
2456
2457 =item change_later OPTION => VALUE...
2458
2459 Schedule a package change for a later date.  This actually orders the new
2460 package immediately, but sets its start date for a future date, and sets
2461 the current package to expire on the same date.
2462
2463 If the package is already scheduled for a change, this can be called with
2464 'start_date' to change the scheduled date, or with pkgpart and/or
2465 locationnum to modify the package change.  To cancel the scheduled change
2466 entirely, see C<abort_change>.
2467
2468 Options include:
2469
2470 =over 4
2471
2472 =item start_date
2473
2474 The date for the package change.  Required, and must be in the future.
2475
2476 =item pkgpart
2477
2478 =item locationnum
2479
2480 =item quantity
2481
2482 =item contract_end
2483
2484 The pkgpart, locationnum, quantity and optional contract_end of the new
2485 package, with the same meaning as in C<change>.
2486
2487 =back
2488
2489 =cut
2490
2491 sub change_later {
2492   my $self = shift;
2493   my $opt = ref($_[0]) ? shift : { @_ };
2494
2495   # check contract_end, prevent adding/removing
2496   my $error = $self->_check_change($opt);
2497   return $error if $error;
2498
2499   my $oldAutoCommit = $FS::UID::AutoCommit;
2500   local $FS::UID::AutoCommit = 0;
2501   my $dbh = dbh;
2502
2503   my $cust_main = $self->cust_main;
2504
2505   my $date = delete $opt->{'start_date'} or return 'start_date required';
2506
2507   if ( $date <= time ) {
2508     $dbh->rollback if $oldAutoCommit;
2509     return "start_date $date is in the past";
2510   }
2511
2512   if ( $self->change_to_pkgnum ) {
2513     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
2514     my $new_pkgpart = $opt->{'pkgpart'}
2515         if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $change_to->pkgpart;
2516     my $new_locationnum = $opt->{'locationnum'}
2517         if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum;
2518     my $new_quantity = $opt->{'quantity'}
2519         if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity;
2520     my $new_contract_end = $opt->{'contract_end'}
2521         if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end;
2522     if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) {
2523       # it hasn't been billed yet, so in principle we could just edit
2524       # it in place (w/o a package change), but that's bad form.
2525       # So change the package according to the new options...
2526       my $err_or_pkg = $change_to->change(%$opt);
2527       if ( ref $err_or_pkg ) {
2528         # Then set that package up for a future start.
2529         $self->set('change_to_pkgnum', $err_or_pkg->pkgnum);
2530         $self->set('expire', $date); # in case it's different
2531         $err_or_pkg->set('start_date', $date);
2532         $err_or_pkg->set('change_date', '');
2533         $err_or_pkg->set('change_pkgnum', '');
2534
2535         $error = $self->replace       ||
2536                  $err_or_pkg->replace ||
2537                  #because change() might've edited existing scheduled change in place
2538                  (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
2539                   $change_to->cancel('no_delay_cancel' => 1) ||
2540                   $change_to->delete);
2541       } else {
2542         $error = $err_or_pkg;
2543       }
2544     } else { # change the start date only.
2545       $self->set('expire', $date);
2546       $change_to->set('start_date', $date);
2547       $error = $self->replace || $change_to->replace;
2548     }
2549     if ( $error ) {
2550       $dbh->rollback if $oldAutoCommit;
2551       return $error;
2552     } else {
2553       $dbh->commit if $oldAutoCommit;
2554       return '';
2555     }
2556   } # if $self->change_to_pkgnum
2557
2558   my $new_pkgpart = $opt->{'pkgpart'}
2559       if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart;
2560   my $new_locationnum = $opt->{'locationnum'}
2561       if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
2562   my $new_quantity = $opt->{'quantity'}
2563       if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
2564   my $new_contract_end = $opt->{'contract_end'}
2565       if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end;
2566
2567   return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything
2568
2569   # allow $opt->{'locationnum'} = '' to specifically set it to null
2570   # (i.e. customer default location)
2571   $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2572
2573   my $new = FS::cust_pkg->new( {
2574     custnum     => $self->custnum,
2575     locationnum => $opt->{'locationnum'},
2576     start_date  => $date,
2577     map   {  $_ => ( $opt->{$_} || $self->$_() )  }
2578       qw( pkgpart quantity refnum salesnum contract_end )
2579   } );
2580   $error = $new->insert('change' => 1,
2581                         'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
2582   if ( !$error ) {
2583     $self->set('change_to_pkgnum', $new->pkgnum);
2584     $self->set('expire', $date);
2585     $error = $self->replace;
2586   }
2587   if ( $error ) {
2588     $dbh->rollback if $oldAutoCommit;
2589   } else {
2590     $dbh->commit if $oldAutoCommit;
2591   }
2592
2593   $error;
2594 }
2595
2596 =item abort_change
2597
2598 Cancels a future package change scheduled by C<change_later>.
2599
2600 =cut
2601
2602 sub abort_change {
2603   my $self = shift;
2604   my $oldAutoCommit = $FS::UID::AutoCommit;
2605   local $FS::UID::AutoCommit = 0;
2606
2607   my $pkgnum = $self->change_to_pkgnum;
2608   my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
2609   my $error;
2610   $self->set('change_to_pkgnum', '');
2611   $self->set('expire', '');
2612   $error = $self->replace;
2613   if ( $change_to ) {
2614     $error ||= $change_to->cancel || $change_to->delete;
2615   }
2616
2617   if ( $oldAutoCommit ) {
2618     if ( $error ) {
2619       dbh->rollback;
2620     } else {
2621       dbh->commit;
2622     }
2623   }
2624
2625   return $error;
2626 }
2627
2628 =item set_quantity QUANTITY
2629
2630 Change the package's quantity field.  This is one of the few package properties
2631 that can safely be changed without canceling and reordering the package
2632 (because it doesn't affect tax eligibility).  Returns an error or an
2633 empty string.
2634
2635 =cut
2636
2637 sub set_quantity {
2638   my $self = shift;
2639   $self = $self->replace_old; # just to make sure
2640   $self->quantity(shift);
2641   $self->replace;
2642 }
2643
2644 =item set_salesnum SALESNUM
2645
2646 Change the package's salesnum (sales person) field.  This is one of the few
2647 package properties that can safely be changed without canceling and reordering
2648 the package (because it doesn't affect tax eligibility).  Returns an error or
2649 an empty string.
2650
2651 =cut
2652
2653 sub set_salesnum {
2654   my $self = shift;
2655   $self = $self->replace_old; # just to make sure
2656   $self->salesnum(shift);
2657   $self->replace;
2658   # XXX this should probably reassign any credit that's already been given
2659 }
2660
2661 =item modify_charge OPTIONS
2662
2663 Change the properties of a one-time charge.  The following properties can
2664 be changed this way:
2665 - pkg: the package description
2666 - classnum: the package class
2667 - additional: arrayref of additional invoice details to add to this package
2668
2669 and, I<if the charge has not yet been billed>:
2670 - start_date: the date when it will be billed
2671 - amount: the setup fee to be charged
2672 - quantity: the multiplier for the setup fee
2673 - separate_bill: whether to put the charge on a separate invoice
2674
2675 If you pass 'adjust_commission' => 1, and the classnum changes, and there are
2676 commission credits linked to this charge, they will be recalculated.
2677
2678 =cut
2679
2680 sub modify_charge {
2681   my $self = shift;
2682   my %opt = @_;
2683   my $part_pkg = $self->part_pkg;
2684   my $pkgnum = $self->pkgnum;
2685
2686   my $dbh = dbh;
2687   my $oldAutoCommit = $FS::UID::AutoCommit;
2688   local $FS::UID::AutoCommit = 0;
2689
2690   return "Can't use modify_charge except on one-time charges"
2691     unless $part_pkg->freq eq '0';
2692
2693   if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) {
2694     $part_pkg->set('pkg', $opt{'pkg'});
2695   }
2696
2697   my %pkg_opt = $part_pkg->options;
2698   my $pkg_opt_modified = 0;
2699
2700   $opt{'additional'} ||= [];
2701   my $i;
2702   my @old_additional;
2703   foreach (grep /^additional/, keys %pkg_opt) {
2704     ($i) = ($_ =~ /^additional_info(\d+)$/);
2705     $old_additional[$i] = $pkg_opt{$_} if $i;
2706     delete $pkg_opt{$_};
2707   }
2708
2709   for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
2710     $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
2711     if (!exists($old_additional[$i])
2712         or $old_additional[$i] ne $opt{'additional'}->[$i])
2713     {
2714       $pkg_opt_modified = 1;
2715     }
2716   }
2717   $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
2718   $pkg_opt{'additional_count'} = $i if $i > 0;
2719
2720   my $old_classnum;
2721   if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} )
2722   {
2723     # remember it
2724     $old_classnum = $part_pkg->classnum;
2725     $part_pkg->set('classnum', $opt{'classnum'});
2726   }
2727
2728   if ( !$self->get('setup') ) {
2729     # not yet billed, so allow amount, setup_cost, quantity, start_date,
2730     # and separate_bill
2731
2732     if ( exists($opt{'amount'})
2733           and $part_pkg->option('setup_fee') != $opt{'amount'}
2734           and $opt{'amount'} > 0 ) {
2735
2736       $pkg_opt{'setup_fee'} = $opt{'amount'};
2737       $pkg_opt_modified = 1;
2738     }
2739
2740     if ( exists($opt{'setup_cost'})
2741           and $part_pkg->setup_cost != $opt{'setup_cost'}
2742           and $opt{'setup_cost'} > 0 ) {
2743
2744       $part_pkg->set('setup_cost', $opt{'setup_cost'});
2745     }
2746
2747     if ( exists($opt{'quantity'})
2748           and $opt{'quantity'} != $self->quantity
2749           and $opt{'quantity'} > 0 ) {
2750
2751       $self->set('quantity', $opt{'quantity'});
2752     }
2753
2754     if ( exists($opt{'start_date'})
2755           and $opt{'start_date'} != $self->start_date ) {
2756
2757       $self->set('start_date', $opt{'start_date'});
2758     }
2759
2760     if ( exists($opt{'separate_bill'})
2761           and $opt{'separate_bill'} ne $self->separate_bill ) {
2762
2763       $self->set('separate_bill', $opt{'separate_bill'});
2764     }
2765
2766
2767   } # else simply ignore them; the UI shouldn't allow editing the fields
2768
2769
2770   if ( exists($opt{'taxclass'})
2771           and $part_pkg->taxclass ne $opt{'taxclass'}) {
2772
2773       $part_pkg->set('taxclass', $opt{'taxclass'});
2774   }
2775
2776   my $error;
2777   if ( $part_pkg->modified or $pkg_opt_modified ) {
2778     # can we safely modify the package def?
2779     # Yes, if it's not available for purchase, and this is the only instance
2780     # of it.
2781     if ( $part_pkg->disabled
2782          and FS::cust_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 1
2783          and FS::quotation_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 0
2784        ) {
2785       $error = $part_pkg->replace( options => \%pkg_opt );
2786     } else {
2787       # clone it
2788       $part_pkg = $part_pkg->clone;
2789       $part_pkg->set('disabled' => 'Y');
2790       $error = $part_pkg->insert( options => \%pkg_opt );
2791       # and associate this as yet-unbilled package to the new package def
2792       $self->set('pkgpart' => $part_pkg->pkgpart);
2793     }
2794     if ( $error ) {
2795       $dbh->rollback if $oldAutoCommit;
2796       return $error;
2797     }
2798   }
2799
2800   if ($self->modified) { # for quantity or start_date change, or if we had
2801                          # to clone the existing package def
2802     my $error = $self->replace;
2803     return $error if $error;
2804   }
2805   if (defined $old_classnum) {
2806     # fix invoice grouping records
2807     my $old_catname = $old_classnum
2808                       ? FS::pkg_class->by_key($old_classnum)->categoryname
2809                       : '';
2810     my $new_catname = $opt{'classnum'}
2811                       ? $part_pkg->pkg_class->categoryname
2812                       : '';
2813     if ( $old_catname ne $new_catname ) {
2814       foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
2815         # (there should only be one...)
2816         my @display = qsearch( 'cust_bill_pkg_display', {
2817             'billpkgnum'  => $cust_bill_pkg->billpkgnum,
2818             'section'     => $old_catname,
2819         });
2820         foreach (@display) {
2821           $_->set('section', $new_catname);
2822           $error = $_->replace;
2823           if ( $error ) {
2824             $dbh->rollback if $oldAutoCommit;
2825             return $error;
2826           }
2827         }
2828       } # foreach $cust_bill_pkg
2829     }
2830
2831     if ( $opt{'adjust_commission'} ) {
2832       # fix commission credits...tricky.
2833       foreach my $cust_event ($self->cust_event) {
2834         my $part_event = $cust_event->part_event;
2835         foreach my $table (qw(sales agent)) {
2836           my $class =
2837             "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
2838           my $credit = qsearchs('cust_credit', {
2839               'eventnum' => $cust_event->eventnum,
2840           });
2841           if ( $part_event->isa($class) ) {
2842             # Yes, this results in current commission rates being applied
2843             # retroactively to a one-time charge.  For accounting purposes
2844             # there ought to be some kind of time limit on doing this.
2845             my $amount = $part_event->_calc_credit($self);
2846             if ( $credit and $credit->amount ne $amount ) {
2847               # Void the old credit.
2848               $error = $credit->void('Package class changed');
2849               if ( $error ) {
2850                 $dbh->rollback if $oldAutoCommit;
2851                 return "$error (adjusting commission credit)";
2852               }
2853             }
2854             # redo the event action to recreate the credit.
2855             local $@ = '';
2856             eval { $part_event->do_action( $self, $cust_event ) };
2857             if ( $@ ) {
2858               $dbh->rollback if $oldAutoCommit;
2859               return $@;
2860             }
2861           } # if $part_event->isa($class)
2862         } # foreach $table
2863       } # foreach $cust_event
2864     } # if $opt{'adjust_commission'}
2865   } # if defined $old_classnum
2866
2867   $dbh->commit if $oldAutoCommit;
2868   '';
2869 }
2870
2871
2872
2873 use Data::Dumper;
2874 sub process_bulk_cust_pkg {
2875   my $job = shift;
2876   my $param = shift;
2877   warn Dumper($param) if $DEBUG;
2878
2879   my $old_part_pkg = qsearchs('part_pkg',
2880                               { pkgpart => $param->{'old_pkgpart'} });
2881   my $new_part_pkg = qsearchs('part_pkg',
2882                               { pkgpart => $param->{'new_pkgpart'} });
2883   die "Must select a new package type\n" unless $new_part_pkg;
2884   #my $keep_dates = $param->{'keep_dates'} || 0;
2885   my $keep_dates = 1; # there is no good reason to turn this off
2886
2887   my $oldAutoCommit = $FS::UID::AutoCommit;
2888   local $FS::UID::AutoCommit = 0;
2889   my $dbh = dbh;
2890
2891   my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
2892
2893   my $i = 0;
2894   foreach my $old_cust_pkg ( @cust_pkgs ) {
2895     $i++;
2896     $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
2897     if ( $old_cust_pkg->getfield('cancel') ) {
2898       warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
2899         $old_cust_pkg->pkgnum."\n"
2900         if $DEBUG;
2901       next;
2902     }
2903     warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
2904       if $DEBUG;
2905     my $error = $old_cust_pkg->change(
2906       'pkgpart'     => $param->{'new_pkgpart'},
2907       'keep_dates'  => $keep_dates
2908     );
2909     if ( !ref($error) ) { # change returns the cust_pkg on success
2910       $dbh->rollback;
2911       die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
2912     }
2913   }
2914   $dbh->commit if $oldAutoCommit;
2915   return;
2916 }
2917
2918 =item last_bill
2919
2920 Returns the last bill date, or if there is no last bill date, the setup date.
2921 Useful for billing metered services.
2922
2923 =cut
2924
2925 sub last_bill {
2926   my $self = shift;
2927   return $self->setfield('last_bill', $_[0]) if @_;
2928   return $self->getfield('last_bill') if $self->getfield('last_bill');
2929   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
2930                                                   'edate'  => $self->bill,  } );
2931   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
2932 }
2933
2934 =item last_cust_pkg_reason ACTION
2935
2936 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
2937 Returns false if there is no reason or the package is not currenly ACTION'd
2938 ACTION is one of adjourn, susp, cancel, or expire.
2939
2940 =cut
2941
2942 sub last_cust_pkg_reason {
2943   my ( $self, $action ) = ( shift, shift );
2944   my $date = $self->get($action);
2945   qsearchs( {
2946               'table' => 'cust_pkg_reason',
2947               'hashref' => { 'pkgnum' => $self->pkgnum,
2948                              'action' => substr(uc($action), 0, 1),
2949                              'date'   => $date,
2950                            },
2951               'order_by' => 'ORDER BY num DESC LIMIT 1',
2952            } );
2953 }
2954
2955 =item last_reason ACTION
2956
2957 Returns the most recent ACTION FS::reason associated with the package.
2958 Returns false if there is no reason or the package is not currenly ACTION'd
2959 ACTION is one of adjourn, susp, cancel, or expire.
2960
2961 =cut
2962
2963 sub last_reason {
2964   my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
2965   $cust_pkg_reason->reason
2966     if $cust_pkg_reason;
2967 }
2968
2969 =item part_pkg
2970
2971 Returns the definition for this billing item, as an FS::part_pkg object (see
2972 L<FS::part_pkg>).
2973
2974 =cut
2975
2976 sub part_pkg {
2977   my $self = shift;
2978   return $self->{'_pkgpart'} if $self->{'_pkgpart'};
2979   cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
2980   qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
2981 }
2982
2983 =item old_cust_pkg
2984
2985 Returns the cancelled package this package was changed from, if any.
2986
2987 =cut
2988
2989 sub old_cust_pkg {
2990   my $self = shift;
2991   return '' unless $self->change_pkgnum;
2992   qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
2993 }
2994
2995 =item change_cust_main
2996
2997 Returns the customter this package was detached to, if any.
2998
2999 =cut
3000
3001 sub change_cust_main {
3002   my $self = shift;
3003   return '' unless $self->change_custnum;
3004   qsearchs('cust_main', { 'custnum' => $self->change_custnum } );
3005 }
3006
3007 =item calc_setup
3008
3009 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
3010 item.
3011
3012 =cut
3013
3014 sub calc_setup {
3015   my $self = shift;
3016   $self->part_pkg->calc_setup($self, @_);
3017 }
3018
3019 =item calc_recur
3020
3021 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
3022 item.
3023
3024 =cut
3025
3026 sub calc_recur {
3027   my $self = shift;
3028   $self->part_pkg->calc_recur($self, @_);
3029 }
3030
3031 =item base_setup
3032
3033 Calls the I<base_setup> of the FS::part_pkg object associated with this billing
3034 item.
3035
3036 =cut
3037
3038 sub base_setup {
3039   my $self = shift;
3040   $self->part_pkg->base_setup($self, @_);
3041 }
3042
3043 =item base_recur
3044
3045 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
3046 item.
3047
3048 =cut
3049
3050 sub base_recur {
3051   my $self = shift;
3052   $self->part_pkg->base_recur($self, @_);
3053 }
3054
3055 =item calc_remain
3056
3057 Calls the I<calc_remain> of the FS::part_pkg object associated with this
3058 billing item.
3059
3060 =cut
3061
3062 sub calc_remain {
3063   my $self = shift;
3064   $self->part_pkg->calc_remain($self, @_);
3065 }
3066
3067 =item calc_cancel
3068
3069 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
3070 billing item.
3071
3072 =cut
3073
3074 sub calc_cancel {
3075   my $self = shift;
3076   $self->part_pkg->calc_cancel($self, @_);
3077 }
3078
3079 =item cust_bill_pkg
3080
3081 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
3082
3083 =cut
3084
3085 sub cust_bill_pkg {
3086   my $self = shift;
3087   qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
3088 }
3089
3090 =item cust_pkg_detail [ DETAILTYPE ]
3091
3092 Returns any customer package details for this package (see
3093 L<FS::cust_pkg_detail>).
3094
3095 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3096
3097 =cut
3098
3099 sub cust_pkg_detail {
3100   my $self = shift;
3101   my %hash = ( 'pkgnum' => $self->pkgnum );
3102   $hash{detailtype} = shift if @_;
3103   qsearch({
3104     'table'    => 'cust_pkg_detail',
3105     'hashref'  => \%hash,
3106     'order_by' => 'ORDER BY weight, pkgdetailnum',
3107   });
3108 }
3109
3110 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
3111
3112 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
3113
3114 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3115
3116 If there is an error, returns the error, otherwise returns false.
3117
3118 =cut
3119
3120 sub set_cust_pkg_detail {
3121   my( $self, $detailtype, @details ) = @_;
3122
3123   my $oldAutoCommit = $FS::UID::AutoCommit;
3124   local $FS::UID::AutoCommit = 0;
3125   my $dbh = dbh;
3126
3127   foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
3128     my $error = $current->delete;
3129     if ( $error ) {
3130       $dbh->rollback if $oldAutoCommit;
3131       return "error removing old detail: $error";
3132     }
3133   }
3134
3135   foreach my $detail ( @details ) {
3136     my $cust_pkg_detail = new FS::cust_pkg_detail {
3137       'pkgnum'     => $self->pkgnum,
3138       'detailtype' => $detailtype,
3139       'detail'     => $detail,
3140     };
3141     my $error = $cust_pkg_detail->insert;
3142     if ( $error ) {
3143       $dbh->rollback if $oldAutoCommit;
3144       return "error adding new detail: $error";
3145     }
3146
3147   }
3148
3149   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3150   '';
3151
3152 }
3153
3154 =item cust_event
3155
3156 Returns the customer billing events (see L<FS::cust_event>) for this invoice.
3157
3158 =cut
3159
3160 #false laziness w/cust_bill.pm
3161 sub cust_event {
3162   my $self = shift;
3163   qsearch({
3164     'table'     => 'cust_event',
3165     'addl_from' => 'JOIN part_event USING ( eventpart )',
3166     'hashref'   => { 'tablenum' => $self->pkgnum },
3167     'extra_sql' => " AND eventtable = 'cust_pkg' ",
3168   });
3169 }
3170
3171 =item num_cust_event
3172
3173 Returns the number of customer billing events (see L<FS::cust_event>) for this package.
3174
3175 =cut
3176
3177 #false laziness w/cust_bill.pm
3178 sub num_cust_event {
3179   my $self = shift;
3180   my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
3181   $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
3182 }
3183
3184 =item exists_cust_event
3185
3186 Returns true if there are customer billing events (see L<FS::cust_event>) for this package.  More efficient than using num_cust_event.
3187
3188 =cut
3189
3190 sub exists_cust_event {
3191   my $self = shift;
3192   my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
3193   my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
3194   $row ? $row->[0] : '';
3195 }
3196
3197 sub _from_cust_event_where {
3198   #my $self = shift;
3199   " FROM cust_event JOIN part_event USING ( eventpart ) ".
3200   "  WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
3201 }
3202
3203 sub _prep_ex {
3204   my( $self, $sql, @args ) = @_;
3205   my $sth = dbh->prepare($sql) or die  dbh->errstr. " preparing $sql";
3206   $sth->execute(@args)         or die $sth->errstr. " executing $sql";
3207   $sth;
3208 }
3209
3210 =item part_pkg_currency_option OPTIONNAME
3211
3212 Returns a two item list consisting of the currency of this customer, if any,
3213 and a value for the provided option.  If the customer has a currency, the value
3214 is the option value the given name and the currency (see
3215 L<FS::part_pkg_currency>).  Otherwise, if the customer has no currency, is the
3216 regular option value for the given name (see L<FS::part_pkg_option>).
3217
3218 =cut
3219
3220 sub part_pkg_currency_option {
3221   my( $self, $optionname ) = @_;
3222   my $part_pkg = $self->part_pkg;
3223   if ( my $currency = $self->cust_main->currency ) {
3224     ($currency, $part_pkg->part_pkg_currency_option($currency, $optionname) );
3225   } else {
3226     ('', $part_pkg->option($optionname) );
3227   }
3228 }
3229
3230 =item cust_svc [ SVCPART ] (old, deprecated usage)
3231
3232 =item cust_svc [ OPTION => VALUE ... ] (current usage)
3233
3234 =item cust_svc_unsorted [ OPTION => VALUE ... ]
3235
3236 Returns the services for this package, as FS::cust_svc objects (see
3237 L<FS::cust_svc>).  Available options are svcpart and svcdb.  If either is
3238 spcififed, returns only the matching services.
3239
3240 As an optimization, use the cust_svc_unsorted version if you are not displaying
3241 the results.
3242
3243 =cut
3244
3245 sub cust_svc {
3246   my $self = shift;
3247   cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
3248   $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
3249 }
3250
3251 sub cust_svc_unsorted {
3252   my $self = shift;
3253   @{ $self->cust_svc_unsorted_arrayref(@_) };
3254 }
3255
3256 sub cust_svc_unsorted_arrayref {
3257   my $self = shift;
3258
3259   return [] unless $self->num_cust_svc(@_);
3260
3261   my %opt = ();
3262   if ( @_ && $_[0] =~ /^\d+/ ) {
3263     $opt{svcpart} = shift;
3264   } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3265     %opt = %{ $_[0] };
3266   } elsif ( @_ ) {
3267     %opt = @_;
3268   }
3269
3270   my %search = (
3271     'table'   => 'cust_svc',
3272     'hashref' => { 'pkgnum' => $self->pkgnum },
3273   );
3274   if ( $opt{svcpart} ) {
3275     $search{hashref}->{svcpart} = $opt{'svcpart'};
3276   }
3277   if ( $opt{'svcdb'} ) {
3278     $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
3279     $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
3280   }
3281
3282   [ qsearch(\%search) ];
3283
3284 }
3285
3286 =item overlimit [ SVCPART ]
3287
3288 Returns the services for this package which have exceeded their
3289 usage limit as FS::cust_svc objects (see L<FS::cust_svc>).  If a svcpart
3290 is specified, return only the matching services.
3291
3292 =cut
3293
3294 sub overlimit {
3295   my $self = shift;
3296   return () unless $self->num_cust_svc(@_);
3297   grep { $_->overlimit } $self->cust_svc(@_);
3298 }
3299
3300 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3301
3302 Returns historical services for this package created before END TIMESTAMP and
3303 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
3304 (see L<FS::h_cust_svc>).  If MODE is 'I' (for 'invoice'), services with the
3305 I<pkg_svc.hidden> flag will be omitted.
3306
3307 =cut
3308
3309 sub h_cust_svc {
3310   my $self = shift;
3311   warn "$me _h_cust_svc called on $self\n"
3312     if $DEBUG;
3313
3314   my ($end, $start, $mode) = @_;
3315
3316   local($FS::Record::qsearch_qualify_columns) = 0;
3317
3318   my @cust_svc = $self->_sort_cust_svc(
3319     [ qsearch( 'h_cust_svc',
3320       { 'pkgnum' => $self->pkgnum, },
3321       FS::h_cust_svc->sql_h_search(@_),
3322     ) ]
3323   );
3324
3325   if ( defined($mode) && $mode eq 'I' ) {
3326     my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
3327     return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
3328   } else {
3329     return @cust_svc;
3330   }
3331 }
3332
3333 sub _sort_cust_svc {
3334   my( $self, $arrayref ) = @_;
3335
3336   my $sort =
3337     sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] };
3338
3339   my %pkg_svc = map { $_->svcpart => $_ }
3340                 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
3341
3342   map  { $_->[0] }
3343   sort $sort
3344   map {
3345         my $pkg_svc = $pkg_svc{ $_->svcpart } || '';
3346         [ $_,
3347           $pkg_svc ? $pkg_svc->primary_svc : '',
3348           $pkg_svc ? $pkg_svc->quantity : 0,
3349         ];
3350       }
3351   @$arrayref;
3352
3353 }
3354
3355 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
3356
3357 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
3358
3359 Returns the number of services for this package.  Available options are svcpart
3360 and svcdb.  If either is spcififed, returns only the matching services.
3361
3362 =cut
3363
3364 sub num_cust_svc {
3365   my $self = shift;
3366
3367   return $self->{'_num_cust_svc'}
3368     if !scalar(@_)
3369        && exists($self->{'_num_cust_svc'})
3370        && $self->{'_num_cust_svc'} =~ /\d/;
3371
3372   cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
3373     if $DEBUG > 2;
3374
3375   my %opt = ();
3376   if ( @_ && $_[0] =~ /^\d+/ ) {
3377     $opt{svcpart} = shift;
3378   } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3379     %opt = %{ $_[0] };
3380   } elsif ( @_ ) {
3381     %opt = @_;
3382   }
3383
3384   my $select = 'SELECT COUNT(*) FROM cust_svc ';
3385   my $where = ' WHERE pkgnum = ? ';
3386   my @param = ($self->pkgnum);
3387
3388   if ( $opt{'svcpart'} ) {
3389     $where .= ' AND svcpart = ? ';
3390     push @param, $opt{'svcpart'};
3391   }
3392   if ( $opt{'svcdb'} ) {
3393     $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
3394     $where .= ' AND svcdb = ? ';
3395     push @param, $opt{'svcdb'};
3396   }
3397
3398   my $sth = dbh->prepare("$select $where") or die  dbh->errstr;
3399   $sth->execute(@param) or die $sth->errstr;
3400   $sth->fetchrow_arrayref->[0];
3401 }
3402
3403 =item available_part_svc
3404
3405 Returns a list of FS::part_svc objects representing services included in this
3406 package but not yet provisioned.  Each FS::part_svc object also has an extra
3407 field, I<num_avail>, which specifies the number of available services.
3408
3409 Accepts option I<provision_hold>;  if true, only returns part_svc for which the
3410 associated pkg_svc has the provision_hold flag set.
3411
3412 =cut
3413
3414 sub available_part_svc {
3415   my $self = shift;
3416   my %opt  = @_;
3417
3418   my $pkg_quantity = $self->quantity || 1;
3419
3420   grep { $_->num_avail > 0 }
3421   map {
3422     my $part_svc = $_->part_svc;
3423     $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
3424     $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
3425
3426     # more evil encapsulation breakage
3427     if ($part_svc->{'Hash'}{'num_avail'} > 0) {
3428       my @exports = $part_svc->part_export_did;
3429       $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
3430         }
3431
3432     $part_svc;
3433   }
3434   grep { $opt{'provision_hold'} ? $_->provision_hold : 1 }
3435   $self->part_pkg->pkg_svc;
3436 }
3437
3438 =item part_svc [ OPTION => VALUE ... ]
3439
3440 Returns a list of FS::part_svc objects representing provisioned and available
3441 services included in this package.  Each FS::part_svc object also has the
3442 following extra fields:
3443
3444 =over 4
3445
3446 =item num_cust_svc
3447
3448 (count)
3449
3450 =item num_avail
3451
3452 (quantity - count)
3453
3454 =item cust_pkg_svc
3455
3456 (services) - array reference containing the provisioned services, as cust_svc objects
3457
3458 =back
3459
3460 Accepts two options:
3461
3462 =over 4
3463
3464 =item summarize_size
3465
3466 If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc
3467 is this size or greater.
3468
3469 =item hide_discontinued
3470
3471 If true, will omit looking for services that are no longer avaialble in the
3472 package definition.
3473
3474 =back
3475
3476 =cut
3477
3478 #svcnum
3479 #label -> ($cust_svc->label)[1]
3480
3481 sub part_svc {
3482   my $self = shift;
3483   my %opt = @_;
3484
3485   my $pkg_quantity = $self->quantity || 1;
3486
3487   #XXX some sort of sort order besides numeric by svcpart...
3488   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
3489     my $pkg_svc = $_;
3490     my $part_svc = $pkg_svc->part_svc;
3491     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3492     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
3493     $part_svc->{'Hash'}{'num_avail'}    =
3494       max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc );
3495     $part_svc->{'Hash'}{'cust_pkg_svc'} =
3496         $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
3497       unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
3498           && $num_cust_svc >= $opt{summarize_size};
3499     $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
3500     $part_svc;
3501   } $self->part_pkg->pkg_svc;
3502
3503   unless ( $opt{hide_discontinued} ) {
3504     #extras
3505     push @part_svc, map {
3506       my $part_svc = $_;
3507       my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3508       $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
3509       $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
3510       $part_svc->{'Hash'}{'cust_pkg_svc'} =
3511         $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
3512       $part_svc;
3513     } $self->extra_part_svc;
3514   }
3515
3516   @part_svc;
3517
3518 }
3519
3520 =item extra_part_svc
3521
3522 Returns a list of FS::part_svc objects corresponding to services in this
3523 package which are still provisioned but not (any longer) available in the
3524 package definition.
3525
3526 =cut
3527
3528 sub extra_part_svc {
3529   my $self = shift;
3530
3531   my $pkgnum  = $self->pkgnum;
3532   #my $pkgpart = $self->pkgpart;
3533
3534 #  qsearch( {
3535 #    'table'     => 'part_svc',
3536 #    'hashref'   => {},
3537 #    'extra_sql' =>
3538 #      "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
3539 #                     WHERE pkg_svc.svcpart = part_svc.svcpart
3540 #                       AND pkg_svc.pkgpart = ?
3541 #                       AND quantity > 0
3542 #                 )
3543 #        AND 0 < ( SELECT COUNT(*) FROM cust_svc
3544 #                       LEFT JOIN cust_pkg USING ( pkgnum )
3545 #                     WHERE cust_svc.svcpart = part_svc.svcpart
3546 #                       AND pkgnum = ?
3547 #                 )",
3548 #    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
3549 #  } );
3550
3551 #seems to benchmark slightly faster... (or did?)
3552
3553   my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
3554   my $pkgparts = join(',', @pkgparts);
3555
3556   qsearch( {
3557     #'select'      => 'DISTINCT ON (svcpart) part_svc.*',
3558     #MySQL doesn't grok DISINCT ON
3559     'select'      => 'DISTINCT part_svc.*',
3560     'table'       => 'part_svc',
3561     'addl_from'   =>
3562       "LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart
3563                                AND pkg_svc.pkgpart IN ($pkgparts)
3564                                AND quantity > 0
3565                              )
3566        LEFT JOIN cust_svc ON (     cust_svc.svcpart = part_svc.svcpart )
3567        LEFT JOIN cust_pkg USING ( pkgnum )
3568       ",
3569     'hashref'     => {},
3570     'extra_sql'   => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
3571     'extra_param' => [ [$self->pkgnum=>'int'] ],
3572   } );
3573 }
3574
3575 =item status
3576
3577 Returns a short status string for this package, currently:
3578
3579 =over 4
3580
3581 =item on hold
3582
3583 =item not yet billed
3584
3585 =item one-time charge
3586
3587 =item active
3588
3589 =item suspended
3590
3591 =item cancelled
3592
3593 =back
3594
3595 =cut
3596
3597 sub status {
3598   my $self = shift;
3599
3600   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
3601
3602   return 'cancelled' if $self->get('cancel');
3603   return 'on hold' if $self->susp && ! $self->setup;
3604   return 'suspended' if $self->susp;
3605   return 'not yet billed' unless $self->setup;
3606   return 'one-time charge' if $freq =~ /^(0|$)/;
3607   return 'active';
3608 }
3609
3610 =item ucfirst_status
3611
3612 Returns the status with the first character capitalized.
3613
3614 =cut
3615
3616 sub ucfirst_status {
3617   ucfirst(shift->status);
3618 }
3619
3620 =item statuses
3621
3622 Class method that returns the list of possible status strings for packages
3623 (see L<the status method|/status>).  For example:
3624
3625   @statuses = FS::cust_pkg->statuses();
3626
3627 =cut
3628
3629 tie my %statuscolor, 'Tie::IxHash',
3630   'on hold'         => 'FF00F5', #brighter purple!
3631   'not yet billed'  => '009999', #teal? cyan?
3632   'one-time charge' => '0000CC', #blue  #'000000',
3633   'active'          => '00CC00',
3634   'suspended'       => 'FF9900',
3635   'cancelled'       => 'FF0000',
3636 ;
3637
3638 sub statuses {
3639   my $self = shift; #could be class...
3640   #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
3641   #                                    # mayble split btw one-time vs. recur
3642     keys %statuscolor;
3643 }
3644
3645 sub statuscolors {
3646   #my $self = shift;
3647   \%statuscolor;
3648 }
3649
3650 =item statuscolor
3651
3652 Returns a hex triplet color string for this package's status.
3653
3654 =cut
3655
3656 sub statuscolor {
3657   my $self = shift;
3658   $statuscolor{$self->status};
3659 }
3660
3661 =item is_status_delay_cancel
3662
3663 Returns true if part_pkg has option delay_cancel,
3664 cust_pkg status is 'suspended' and expire is set
3665 to cancel package within the next day (or however
3666 many days are set in global config part_pkg-delay_cancel-days.
3667
3668 Accepts option I<part_pkg-delay_cancel-days> which should be
3669 the value of the config setting, to avoid looking it up again.
3670
3671 This is not a real status, this only meant for hacking display
3672 values, because otherwise treating the package as suspended is
3673 really the whole point of the delay_cancel option.
3674
3675 =cut
3676
3677 sub is_status_delay_cancel {
3678   my ($self,%opt) = @_;
3679   if ( $self->main_pkgnum and $self->pkglinknum ) {
3680     return $self->main_pkg->is_status_delay_cancel;
3681   }
3682   return 0 unless $self->part_pkg->option('delay_cancel',1);
3683   return 0 unless $self->status eq 'suspended';
3684   return 0 unless $self->expire;
3685   my $expdays = $opt{'part_pkg-delay_cancel-days'};
3686   unless ($expdays) {
3687     my $conf = new FS::Conf;
3688     $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
3689   }
3690   my $expsecs = 60*60*24*$expdays;
3691   return 0 unless $self->expire < time + $expsecs;
3692   return 1;
3693 }
3694
3695 =item pkg_label
3696
3697 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
3698 "pkg - comment" depending on user preference).
3699
3700 =cut
3701
3702 sub pkg_label {
3703   my $self = shift;
3704   my $label = $self->part_pkg->pkg_comment( cust_pkg=>$self, nopkgpart=>1 );
3705   $label = $self->pkgnum. ": $label"
3706     if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
3707   $label;
3708 }
3709
3710 =item pkg_label_long
3711
3712 Returns a long label for this package, adding the primary service's label to
3713 pkg_label.
3714
3715 =cut
3716
3717 sub pkg_label_long {
3718   my $self = shift;
3719   my $label = $self->pkg_label;
3720   my $cust_svc = $self->primary_cust_svc;
3721   $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
3722   $label;
3723 }
3724
3725 =item pkg_locale
3726
3727 Returns a customer-localized label for this package.
3728
3729 =cut
3730
3731 sub pkg_locale {
3732   my $self = shift;
3733   $self->part_pkg->pkg_locale( $self->cust_main->locale );
3734 }
3735
3736 =item primary_cust_svc
3737
3738 Returns a primary service (as FS::cust_svc object) if one can be identified.
3739
3740 =cut
3741
3742 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
3743
3744 sub primary_cust_svc {
3745   my $self = shift;
3746
3747   my @cust_svc = $self->cust_svc;
3748
3749   return '' unless @cust_svc; #no serivces - irrelevant then
3750
3751   return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
3752
3753   # primary service as specified in the package definition
3754   # or exactly one service definition with quantity one
3755   my $svcpart = $self->part_pkg->svcpart;
3756   @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
3757   return $cust_svc[0] if scalar(@cust_svc) == 1;
3758
3759   #couldn't identify one thing..
3760   return '';
3761 }
3762
3763 =item labels
3764
3765 Returns a list of lists, calling the label method for all services
3766 (see L<FS::cust_svc>) of this billing item.
3767
3768 =cut
3769
3770 sub labels {
3771   my $self = shift;
3772   map { [ $_->label ] } $self->cust_svc;
3773 }
3774
3775 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3776
3777 Like the labels method, but returns historical information on services that
3778 were active as of END_TIMESTAMP and (optionally) not cancelled before
3779 START_TIMESTAMP.  If MODE is 'I' (for 'invoice'), services with the
3780 I<pkg_svc.hidden> flag will be omitted.
3781
3782 Returns a list of lists, calling the label method for all (historical) services
3783 (see L<FS::h_cust_svc>) of this billing item.
3784
3785 =cut
3786
3787 sub h_labels {
3788   my $self = shift;
3789   warn "$me _h_labels called on $self\n"
3790     if $DEBUG;
3791   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
3792 }
3793
3794 =item labels_short
3795
3796 Like labels, except returns a simple flat list, and shortens long
3797 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3798 identical services to one line that lists the service label and the number of
3799 individual services rather than individual items.
3800
3801 =cut
3802
3803 sub labels_short {
3804   shift->_labels_short( 'labels', @_ );
3805 }
3806
3807 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
3808
3809 Like h_labels, except returns a simple flat list, and shortens long
3810 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3811 identical services to one line that lists the service label and the number of
3812 individual services rather than individual items.
3813
3814 =cut
3815
3816 sub h_labels_short {
3817   shift->_labels_short( 'h_labels', @_ );
3818 }
3819
3820 sub _labels_short {
3821   my( $self, $method ) = ( shift, shift );
3822
3823   warn "$me _labels_short called on $self with $method method\n"
3824     if $DEBUG;
3825
3826   my $conf = new FS::Conf;
3827   my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
3828
3829   warn "$me _labels_short populating \%labels\n"
3830     if $DEBUG;
3831
3832   my %labels;
3833   #tie %labels, 'Tie::IxHash';
3834   push @{ $labels{$_->[0]} }, $_->[1]
3835     foreach $self->$method(@_);
3836
3837   warn "$me _labels_short populating \@labels\n"
3838     if $DEBUG;
3839
3840   my @labels;
3841   foreach my $label ( keys %labels ) {
3842     my %seen = ();
3843     my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
3844     my $num = scalar(@values);
3845     warn "$me _labels_short $num items for $label\n"
3846       if $DEBUG;
3847
3848     if ( $num > $max_same_services ) {
3849       warn "$me _labels_short   more than $max_same_services, so summarizing\n"
3850         if $DEBUG;
3851       push @labels, "$label ($num)";
3852     } else {
3853       if ( $conf->exists('cust_bill-consolidate_services') ) {
3854         warn "$me _labels_short   consolidating services\n"
3855           if $DEBUG;
3856         # push @labels, "$label: ". join(', ', @values);
3857         while ( @values ) {
3858           my $detail = "$label: ";
3859           $detail .= shift(@values). ', '
3860             while @values
3861                && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
3862           $detail =~ s/, $//;
3863           push @labels, $detail;
3864         }
3865         warn "$me _labels_short   done consolidating services\n"
3866           if $DEBUG;
3867       } else {
3868         warn "$me _labels_short   adding service data\n"
3869           if $DEBUG;
3870         push @labels, map { "$label: $_" } @values;
3871       }
3872     }
3873   }
3874
3875  @labels;
3876
3877 }
3878
3879 =item cust_main
3880
3881 Returns the parent customer object (see L<FS::cust_main>).
3882
3883 =item balance
3884
3885 Returns the balance for this specific package, when using
3886 experimental package balance.
3887
3888 =cut
3889
3890 sub balance {
3891   my $self = shift;
3892   $self->cust_main->balance_pkgnum( $self->pkgnum );
3893 }
3894
3895 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
3896
3897 =item cust_location
3898
3899 Returns the location object, if any (see L<FS::cust_location>).
3900
3901 =item cust_location_or_main
3902
3903 If this package is associated with a location, returns the locaiton (see
3904 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
3905
3906 =item location_label [ OPTION => VALUE ... ]
3907
3908 Returns the label of the location object (see L<FS::cust_location>).
3909
3910 =cut
3911
3912 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
3913
3914 =item tax_locationnum
3915
3916 Returns the foreign key to a L<FS::cust_location> object for calculating
3917 tax on this package, as determined by the C<tax-pkg_address> and
3918 C<tax-ship_address> configuration flags.
3919
3920 =cut
3921
3922 sub tax_locationnum {
3923   my $self = shift;
3924   my $conf = FS::Conf->new;
3925   if ( $conf->exists('tax-pkg_address') ) {
3926     return $self->locationnum;
3927   }
3928   elsif ( $conf->exists('tax-ship_address') ) {
3929     return $self->cust_main->ship_locationnum;
3930   }
3931   else {
3932     return $self->cust_main->bill_locationnum;
3933   }
3934 }
3935
3936 =item tax_location
3937
3938 Returns the L<FS::cust_location> object for tax_locationnum.
3939
3940 =cut
3941
3942 sub tax_location {
3943   my $self = shift;
3944   my $conf = FS::Conf->new;
3945   if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
3946     return FS::cust_location->by_key($self->locationnum);
3947   }
3948   elsif ( $conf->exists('tax-ship_address') ) {
3949     return $self->cust_main->ship_location;
3950   }
3951   else {
3952     return $self->cust_main->bill_location;
3953   }
3954 }
3955
3956 =item seconds_since TIMESTAMP
3957
3958 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
3959 package have been online since TIMESTAMP, according to the session monitor.
3960
3961 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
3962 L<Time::Local> and L<Date::Parse> for conversion functions.
3963
3964 =cut
3965
3966 sub seconds_since {
3967   my($self, $since) = @_;
3968   my $seconds = 0;
3969
3970   foreach my $cust_svc (
3971     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
3972   ) {
3973     $seconds += $cust_svc->seconds_since($since);
3974   }
3975
3976   $seconds;
3977
3978 }
3979
3980 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
3981
3982 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
3983 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
3984 (exclusive).
3985
3986 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
3987 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
3988 functions.
3989
3990
3991 =cut
3992
3993 sub seconds_since_sqlradacct {
3994   my($self, $start, $end) = @_;
3995
3996   my $seconds = 0;
3997
3998   foreach my $cust_svc (
3999     grep {
4000       my $part_svc = $_->part_svc;
4001       $part_svc->svcdb eq 'svc_acct'
4002         && scalar($part_svc->part_export_usage);
4003     } $self->cust_svc
4004   ) {
4005     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
4006   }
4007
4008   $seconds;
4009
4010 }
4011
4012 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
4013
4014 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
4015 in this package for sessions ending between TIMESTAMP_START (inclusive) and
4016 TIMESTAMP_END
4017 (exclusive).
4018
4019 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
4020 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
4021 functions.
4022
4023 =cut
4024
4025 sub attribute_since_sqlradacct {
4026   my($self, $start, $end, $attrib) = @_;
4027
4028   my $sum = 0;
4029
4030   foreach my $cust_svc (
4031     grep {
4032       my $part_svc = $_->part_svc;
4033       scalar($part_svc->part_export_usage);
4034     } $self->cust_svc
4035   ) {
4036     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
4037   }
4038
4039   $sum;
4040
4041 }
4042
4043 =item quantity
4044
4045 =cut
4046
4047 sub quantity {
4048   my( $self, $value ) = @_;
4049   if ( defined($value) ) {
4050     $self->setfield('quantity', $value);
4051   }
4052   $self->getfield('quantity') || 1;
4053 }
4054
4055 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
4056
4057 Transfers as many services as possible from this package to another package.
4058
4059 The destination package can be specified by pkgnum by passing an FS::cust_pkg
4060 object.  The destination package must already exist.
4061
4062 Services are moved only if the destination allows services with the correct
4063 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
4064 this option with caution!  No provision is made for export differences
4065 between the old and new service definitions.  Probably only should be used
4066 when your exports for all service definitions of a given svcdb are identical.
4067 (attempt a transfer without it first, to move all possible svcpart-matching
4068 services)
4069
4070 Any services that can't be moved remain in the original package.
4071
4072 Returns an error, if there is one; otherwise, returns the number of services
4073 that couldn't be moved.
4074
4075 =cut
4076
4077 sub transfer {
4078   my ($self, $dest_pkgnum, %opt) = @_;
4079
4080   my $remaining = 0;
4081   my $dest;
4082   my %target;
4083
4084   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
4085     $dest = $dest_pkgnum;
4086     $dest_pkgnum = $dest->pkgnum;
4087   } else {
4088     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
4089   }
4090
4091   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
4092
4093   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
4094     $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
4095   }
4096
4097   foreach my $cust_svc ($dest->cust_svc) {
4098     $target{$cust_svc->svcpart}--;
4099   }
4100
4101   my %svcpart2svcparts = ();
4102   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4103     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
4104     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
4105       next if exists $svcpart2svcparts{$svcpart};
4106       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
4107       $svcpart2svcparts{$svcpart} = [
4108         map  { $_->[0] }
4109         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
4110         map {
4111               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
4112                                                    'svcpart' => $_          } );
4113               [ $_,
4114                 $pkg_svc ? $pkg_svc->primary_svc : '',
4115                 $pkg_svc ? $pkg_svc->quantity : 0,
4116               ];
4117             }
4118
4119         grep { $_ != $svcpart }
4120         map  { $_->svcpart }
4121         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
4122       ];
4123       warn "alternates for svcpart $svcpart: ".
4124            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
4125         if $DEBUG;
4126     }
4127   }
4128
4129   my $error;
4130   foreach my $cust_svc ($self->cust_svc) {
4131     my $svcnum = $cust_svc->svcnum;
4132     if($target{$cust_svc->svcpart} > 0
4133        or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
4134       $target{$cust_svc->svcpart}--;
4135       my $new = new FS::cust_svc { $cust_svc->hash };
4136       $new->pkgnum($dest_pkgnum);
4137       $error = $new->replace($cust_svc);
4138     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4139       if ( $DEBUG ) {
4140         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
4141         warn "alternates to consider: ".
4142              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
4143       }
4144       my @alternate = grep {
4145                              warn "considering alternate svcpart $_: ".
4146                                   "$target{$_} available in new package\n"
4147                                if $DEBUG;
4148                              $target{$_} > 0;
4149                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
4150       if ( @alternate ) {
4151         warn "alternate(s) found\n" if $DEBUG;
4152         my $change_svcpart = $alternate[0];
4153         $target{$change_svcpart}--;
4154         my $new = new FS::cust_svc { $cust_svc->hash };
4155         $new->svcpart($change_svcpart);
4156         $new->pkgnum($dest_pkgnum);
4157         $error = $new->replace($cust_svc);
4158       } else {
4159         $remaining++;
4160       }
4161     } else {
4162       $remaining++
4163     }
4164     if ( $error ) {
4165       my @label = $cust_svc->label;
4166       return "$label[0] $label[1]: $error";
4167     }
4168   }
4169   return $remaining;
4170 }
4171
4172 =item grab_svcnums SVCNUM, SVCNUM ...
4173
4174 Change the pkgnum for the provided services to this packages.  If there is an
4175 error, returns the error, otherwise returns false.
4176
4177 =cut
4178
4179 sub grab_svcnums {
4180   my $self = shift;
4181   my @svcnum = @_;
4182
4183   my $oldAutoCommit = $FS::UID::AutoCommit;
4184   local $FS::UID::AutoCommit = 0;
4185   my $dbh = dbh;
4186
4187   foreach my $svcnum (@svcnum) {
4188     my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do {
4189       $dbh->rollback if $oldAutoCommit;
4190       return "unknown svcnum $svcnum";
4191     };
4192     $cust_svc->pkgnum( $self->pkgnum );
4193     my $error = $cust_svc->replace;
4194     if ( $error ) {
4195       $dbh->rollback if $oldAutoCommit;
4196       return $error;
4197     }
4198   }
4199
4200   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4201   '';
4202
4203 }
4204
4205 =item reexport
4206
4207 This method is deprecated.  See the I<depend_jobnum> option to the insert and
4208 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
4209
4210 =cut
4211
4212 #looks like this is still used by the order_pkg and change_pkg methods in
4213 # ClientAPI/MyAccount, need to look into those before removing
4214 sub reexport {
4215   my $self = shift;
4216
4217   my $oldAutoCommit = $FS::UID::AutoCommit;
4218   local $FS::UID::AutoCommit = 0;
4219   my $dbh = dbh;
4220
4221   foreach my $cust_svc ( $self->cust_svc ) {
4222     #false laziness w/svc_Common::insert
4223     my $svc_x = $cust_svc->svc_x;
4224     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
4225       my $error = $part_export->export_insert($svc_x);
4226       if ( $error ) {
4227         $dbh->rollback if $oldAutoCommit;
4228         return $error;
4229       }
4230     }
4231   }
4232
4233   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4234   '';
4235
4236 }
4237
4238 =item export_pkg_change OLD_CUST_PKG
4239
4240 Calls the "pkg_change" export action for all services attached to this package.
4241
4242 =cut
4243
4244 sub export_pkg_change {
4245   my( $self, $old )  = ( shift, shift );
4246
4247   my $oldAutoCommit = $FS::UID::AutoCommit;
4248   local $FS::UID::AutoCommit = 0;
4249   my $dbh = dbh;
4250
4251   foreach my $svc_x ( map $_->svc_x, $self->cust_svc ) {
4252     my $error = $svc_x->export('pkg_change', $self, $old);
4253     if ( $error ) {
4254       $dbh->rollback if $oldAutoCommit;
4255       return $error;
4256     }
4257   }
4258
4259   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4260   '';
4261
4262 }
4263
4264 =item insert_reason
4265
4266 Associates this package with a (suspension or cancellation) reason (see
4267 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
4268 L<FS::reason>).
4269
4270 Available options are:
4271
4272 =over 4
4273
4274 =item reason
4275
4276 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.
4277
4278 =item reason_otaker
4279
4280 the access_user (see L<FS::access_user>) providing the reason
4281
4282 =item date
4283
4284 a unix timestamp
4285
4286 =item action
4287
4288 the action (cancel, susp, adjourn, expire) associated with the reason
4289
4290 =back
4291
4292 If there is an error, returns the error, otherwise returns false.
4293
4294 =cut
4295
4296 sub insert_reason {
4297   my ($self, %options) = @_;
4298
4299   my $otaker = $options{reason_otaker} ||
4300                $FS::CurrentUser::CurrentUser->username;
4301
4302   my $reasonnum;
4303   if ( $options{'reason'} =~ /^(\d+)$/ ) {
4304
4305     $reasonnum = $1;
4306
4307   } elsif ( ref($options{'reason'}) ) {
4308
4309     return 'Enter a new reason (or select an existing one)'
4310       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
4311
4312     my $reason = new FS::reason({
4313       'reason_type' => $options{'reason'}->{'typenum'},
4314       'reason'      => $options{'reason'}->{'reason'},
4315     });
4316     my $error = $reason->insert;
4317     return $error if $error;
4318
4319     $reasonnum = $reason->reasonnum;
4320
4321   } else {
4322     return "Unparseable reason: ". $options{'reason'};
4323   }
4324
4325   my $cust_pkg_reason =
4326     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
4327                               'reasonnum' => $reasonnum,
4328                               'otaker'    => $otaker,
4329                               'action'    => substr(uc($options{'action'}),0,1),
4330                               'date'      => $options{'date'}
4331                                                ? $options{'date'}
4332                                                : time,
4333                             });
4334
4335   $cust_pkg_reason->insert;
4336 }
4337
4338 =item insert_discount
4339
4340 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
4341 inserting a new discount on the fly (see L<FS::discount>).
4342
4343 This will look at the cust_pkg for a pseudo-field named "setup_discountnum",
4344 and if present, will create a setup discount. If the discountnum is -1,
4345 a new discount definition will be inserted using the value in
4346 "setup_discountnum_amount" or "setup_discountnum_percent". Likewise for recur.
4347
4348 If there is an error, returns the error, otherwise returns false.
4349
4350 =cut
4351
4352 sub insert_discount {
4353   #my ($self, %options) = @_;
4354   my $self = shift;
4355
4356   foreach my $x (qw(setup recur)) {
4357     if ( my $discountnum = $self->get("${x}_discountnum") ) {
4358       my $cust_pkg_discount = FS::cust_pkg_discount->new( {
4359         'pkgnum'      => $self->pkgnum,
4360         'discountnum' => $discountnum,
4361         'setuprecur'  => $x,
4362         'months_used' => 0,
4363         'end_date'    => '', #XXX
4364         #for the create a new discount case
4365         'amount'      => $self->get("${x}_discountnum_amount"),
4366         'percent'     => $self->get("${x}_discountnum_percent"),
4367         'months'      => $self->get("${x}_discountnum_months"),
4368       } );
4369       if ( $x eq 'setup' ) {
4370         $cust_pkg_discount->setup('Y');
4371         $cust_pkg_discount->months('');
4372       }
4373       my $error = $cust_pkg_discount->insert;
4374       return $error if $error;
4375     }
4376   }
4377
4378   '';
4379 }
4380
4381 =item set_usage USAGE_VALUE_HASHREF
4382
4383 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
4384 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
4385 upbytes, downbytes, and totalbytes are appropriate keys.
4386
4387 All svc_accts which are part of this package have their values reset.
4388
4389 =cut
4390
4391 sub set_usage {
4392   my ($self, $valueref, %opt) = @_;
4393
4394   #only svc_acct can set_usage for now
4395   foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
4396     my $svc_x = $cust_svc->svc_x;
4397     $svc_x->set_usage($valueref, %opt)
4398       if $svc_x->can("set_usage");
4399   }
4400 }
4401
4402 =item recharge USAGE_VALUE_HASHREF
4403
4404 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
4405 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
4406 upbytes, downbytes, and totalbytes are appropriate keys.
4407
4408 All svc_accts which are part of this package have their values incremented.
4409
4410 =cut
4411
4412 sub recharge {
4413   my ($self, $valueref) = @_;
4414
4415   #only svc_acct can set_usage for now
4416   foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
4417     my $svc_x = $cust_svc->svc_x;
4418     $svc_x->recharge($valueref)
4419       if $svc_x->can("recharge");
4420   }
4421 }
4422
4423 =item apply_usageprice
4424
4425 =cut
4426
4427 sub apply_usageprice {
4428   my $self = shift;
4429
4430   my $oldAutoCommit = $FS::UID::AutoCommit;
4431   local $FS::UID::AutoCommit = 0;
4432   my $dbh = dbh;
4433
4434   my $error = '';
4435
4436   foreach my $cust_pkg_usageprice ( $self->cust_pkg_usageprice ) {
4437     $error ||= $cust_pkg_usageprice->apply;
4438   }
4439
4440   if ( $error ) {
4441     $dbh->rollback if $oldAutoCommit;
4442     die "error applying part_pkg_usageprice add-ons, pkgnum ". $self->pkgnum.
4443         ": $error\n";
4444   } else {
4445     $dbh->commit if $oldAutoCommit;
4446   }
4447
4448
4449 }
4450
4451 =item cust_pkg_discount
4452
4453 =item cust_pkg_discount_active
4454
4455 =cut
4456
4457 sub cust_pkg_discount_active {
4458   my $self = shift;
4459   grep { $_->status eq 'active' } $self->cust_pkg_discount;
4460 }
4461
4462 =item cust_pkg_usage
4463
4464 Returns a list of all voice usage counters attached to this package.
4465
4466 =item apply_usage OPTIONS
4467
4468 Takes the following options:
4469 - cdr: a call detail record (L<FS::cdr>)
4470 - rate_detail: the rate determined for this call (L<FS::rate_detail>)
4471 - minutes: the maximum number of minutes to be charged
4472
4473 Finds available usage minutes for a call of this class, and subtracts
4474 up to that many minutes from the usage pool.  If the usage pool is empty,
4475 and the C<cdr-minutes_priority> global config option is set, minutes may
4476 be taken from other calls as well.  Either way, an allocation record will
4477 be created (L<FS::cdr_cust_pkg_usage>) and this method will return the
4478 number of minutes of usage applied to the call.
4479
4480 =cut
4481
4482 sub apply_usage {
4483   my ($self, %opt) = @_;
4484   my $cdr = $opt{cdr};
4485   my $rate_detail = $opt{rate_detail};
4486   my $minutes = $opt{minutes};
4487   my $classnum = $rate_detail->classnum;
4488   my $pkgnum = $self->pkgnum;
4489   my $custnum = $self->custnum;
4490
4491   my $oldAutoCommit = $FS::UID::AutoCommit;
4492   local $FS::UID::AutoCommit = 0;
4493   my $dbh = dbh;
4494
4495   my $order = FS::Conf->new->config('cdr-minutes_priority');
4496
4497   my $is_classnum;
4498   if ( $classnum ) {
4499     $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum;
4500   } else {
4501     $is_classnum = ' part_pkg_usage_class.classnum IS NULL';
4502   }
4503   my @usage_recs = qsearch({
4504       'table'     => 'cust_pkg_usage',
4505       'addl_from' => ' JOIN part_pkg_usage       USING (pkgusagepart)'.
4506                      ' JOIN cust_pkg             USING (pkgnum)'.
4507                      ' JOIN part_pkg_usage_class USING (pkgusagepart)',
4508       'select'    => 'cust_pkg_usage.*',
4509       'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ".
4510                      " ( cust_pkg.custnum = $custnum AND ".
4511                      " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4512                      $is_classnum . ' AND '.
4513                      " cust_pkg_usage.minutes > 0",
4514       'order_by'  => " ORDER BY priority ASC",
4515   });
4516
4517   my $orig_minutes = $minutes;
4518   my $error;
4519   while (!$error and $minutes > 0 and @usage_recs) {
4520     my $cust_pkg_usage = shift @usage_recs;
4521     $cust_pkg_usage->select_for_update;
4522     my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({
4523         pkgusagenum => $cust_pkg_usage->pkgusagenum,
4524         acctid      => $cdr->acctid,
4525         minutes     => min($cust_pkg_usage->minutes, $minutes),
4526     });
4527     $cust_pkg_usage->set('minutes',
4528       $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes
4529     );
4530     $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert;
4531     $minutes -= $cdr_cust_pkg_usage->minutes;
4532   }
4533   if ( $order and $minutes > 0 and !$error ) {
4534     # then try to steal minutes from another call
4535     my %search = (
4536         'table'     => 'cdr_cust_pkg_usage',
4537         'addl_from' => ' JOIN cust_pkg_usage        USING (pkgusagenum)'.
4538                        ' JOIN part_pkg_usage        USING (pkgusagepart)'.
4539                        ' JOIN cust_pkg              USING (pkgnum)'.
4540                        ' JOIN part_pkg_usage_class  USING (pkgusagepart)'.
4541                        ' JOIN cdr                   USING (acctid)',
4542         'select'    => 'cdr_cust_pkg_usage.*',
4543         'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ".
4544                        " ( cust_pkg.pkgnum = $pkgnum OR ".
4545                        " ( cust_pkg.custnum = $custnum AND ".
4546                        " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4547                        " part_pkg_usage_class.classnum = $classnum",
4548         'order_by'  => ' ORDER BY part_pkg_usage.priority ASC',
4549     );
4550     if ( $order eq 'time' ) {
4551       # find CDRs that are using minutes, but have a later startdate
4552       # than this call
4553       my $startdate = $cdr->startdate;
4554       if ($startdate !~ /^\d+$/) {
4555         die "bad cdr startdate '$startdate'";
4556       }
4557       $search{'extra_sql'} .= " AND cdr.startdate > $startdate";
4558       # minimize needless reshuffling
4559       $search{'order_by'} .= ', cdr.startdate DESC';
4560     } else {
4561       # XXX may not work correctly with rate_time schedules.  Could
4562       # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I
4563       # think...
4564       $search{'addl_from'} .=
4565         ' JOIN rate_detail'.
4566         ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)';
4567       if ( $order eq 'rate_high' ) {
4568         $search{'extra_sql'} .= ' AND rate_detail.min_charge < '.
4569                                 $rate_detail->min_charge;
4570         $search{'order_by'} .= ', rate_detail.min_charge ASC';
4571       } elsif ( $order eq 'rate_low' ) {
4572         $search{'extra_sql'} .= ' AND rate_detail.min_charge > '.
4573                                 $rate_detail->min_charge;
4574         $search{'order_by'} .= ', rate_detail.min_charge DESC';
4575       } else {
4576         #  this should really never happen
4577         die "invalid cdr-minutes_priority value '$order'\n";
4578       }
4579     }
4580     my @cdr_usage_recs = qsearch(\%search);
4581     my %reproc_cdrs;
4582     while (!$error and @cdr_usage_recs and $minutes > 0) {
4583       my $cdr_cust_pkg_usage = shift @cdr_usage_recs;
4584       my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage;
4585       my $old_cdr = $cdr_cust_pkg_usage->cdr;
4586       $reproc_cdrs{$old_cdr->acctid} = $old_cdr;
4587       $cdr_cust_pkg_usage->select_for_update;
4588       $old_cdr->select_for_update;
4589       $cust_pkg_usage->select_for_update;
4590       # in case someone else stole the usage from this CDR
4591       # while waiting for the lock...
4592       next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid;
4593       # steal the usage allocation and flag the old CDR for reprocessing
4594       $cdr_cust_pkg_usage->set('acctid', $cdr->acctid);
4595       # if the allocation is more minutes than we need, adjust it...
4596       my $delta = $cdr_cust_pkg_usage->minutes - $minutes;
4597       if ( $delta > 0 ) {
4598         $cdr_cust_pkg_usage->set('minutes', $minutes);
4599         $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta);
4600         $error = $cust_pkg_usage->replace;
4601       }
4602       #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n";
4603       $error ||= $cdr_cust_pkg_usage->replace;
4604       # deduct the stolen minutes
4605       $minutes -= $cdr_cust_pkg_usage->minutes;
4606     }
4607     # after all minute-stealing is done, reset the affected CDRs
4608     foreach (values %reproc_cdrs) {
4609       $error ||= $_->set_status('');
4610       # XXX or should we just call $cdr->rate right here?
4611       # it's not like we can create a loop this way, since the min_charge
4612       # or call time has to go monotonically in one direction.
4613       # we COULD get some very deep recursions going, though...
4614     }
4615   } # if $order and $minutes
4616   if ( $error ) {
4617     $dbh->rollback;
4618     die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n"
4619   } else {
4620     $dbh->commit if $oldAutoCommit;
4621     return $orig_minutes - $minutes;
4622   }
4623 }
4624
4625 =item supplemental_pkgs
4626
4627 Returns a list of all packages supplemental to this one.
4628
4629 =cut
4630
4631 sub supplemental_pkgs {
4632   my $self = shift;
4633   qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
4634 }
4635
4636 =item main_pkg
4637
4638 Returns the package that this one is supplemental to, if any.
4639
4640 =cut
4641
4642 sub main_pkg {
4643   my $self = shift;
4644   if ( $self->main_pkgnum ) {
4645     return FS::cust_pkg->by_key($self->main_pkgnum);
4646   }
4647   return;
4648 }
4649
4650 =back
4651
4652 =head1 CLASS METHODS
4653
4654 =over 4
4655
4656 =item recurring_sql
4657
4658 Returns an SQL expression identifying recurring packages.
4659
4660 =cut
4661
4662 sub recurring_sql { "
4663   '0' != ( select freq from part_pkg
4664              where cust_pkg.pkgpart = part_pkg.pkgpart )
4665 "; }
4666
4667 =item onetime_sql
4668
4669 Returns an SQL expression identifying one-time packages.
4670
4671 =cut
4672
4673 sub onetime_sql { "
4674   '0' = ( select freq from part_pkg
4675             where cust_pkg.pkgpart = part_pkg.pkgpart )
4676 "; }
4677
4678 =item ordered_sql
4679
4680 Returns an SQL expression identifying ordered packages (recurring packages not
4681 yet billed).
4682
4683 =cut
4684
4685 sub ordered_sql {
4686    $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
4687 }
4688
4689 =item active_sql
4690
4691 Returns an SQL expression identifying active packages.
4692
4693 =cut
4694
4695 sub active_sql {
4696   $_[0]->recurring_sql. "
4697   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4698   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4699   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
4700 "; }
4701
4702 =item not_yet_billed_sql
4703
4704 Returns an SQL expression identifying packages which have not yet been billed.
4705
4706 =cut
4707
4708 sub not_yet_billed_sql { "
4709       ( cust_pkg.setup  IS NULL OR cust_pkg.setup  = 0 )
4710   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4711   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
4712 "; }
4713
4714 =item inactive_sql
4715
4716 Returns an SQL expression identifying inactive packages (one-time packages
4717 that are otherwise unsuspended/uncancelled).
4718
4719 =cut
4720
4721 sub inactive_sql { "
4722   ". $_[0]->onetime_sql(). "
4723   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4724   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4725   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
4726 "; }
4727
4728 =item on_hold_sql
4729
4730 Returns an SQL expression identifying on-hold packages.
4731
4732 =cut
4733
4734 sub on_hold_sql {
4735   #$_[0]->recurring_sql(). ' AND '.
4736   "
4737         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel  = 0 )
4738     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp   != 0
4739     AND ( cust_pkg.setup  IS     NULL  OR cust_pkg.setup   = 0 )
4740   ";
4741 }
4742
4743 =item susp_sql
4744 =item suspended_sql
4745
4746 Returns an SQL expression identifying suspended packages.
4747
4748 =cut
4749
4750 sub suspended_sql { susp_sql(@_); }
4751 sub susp_sql {
4752   #$_[0]->recurring_sql(). ' AND '.
4753   "
4754         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
4755     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
4756     AND   cust_pkg.setup  IS NOT NULL AND cust_pkg.setup != 0
4757   ";
4758 }
4759
4760 =item cancel_sql
4761 =item cancelled_sql
4762
4763 Returns an SQL exprression identifying cancelled packages.
4764
4765 =cut
4766
4767 sub cancelled_sql { cancel_sql(@_); }
4768 sub cancel_sql {
4769   #$_[0]->recurring_sql(). ' AND '.
4770   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
4771 }
4772
4773 =item status_sql
4774
4775 Returns an SQL expression to give the package status as a string.
4776
4777 =cut
4778
4779 sub status_sql {
4780 "CASE
4781   WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
4782   WHEN ( cust_pkg.susp IS NOT NULL AND cust_pkg.setup IS NULL ) THEN 'on hold'
4783   WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
4784   WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
4785   WHEN ".onetime_sql()." THEN 'one-time charge'
4786   ELSE 'active'
4787 END"
4788 }
4789
4790 =item fcc_477_count
4791
4792 Returns a list of two package counts.  The first is a count of packages
4793 based on the supplied criteria and the second is the count of residential
4794 packages with those same criteria.  Criteria are specified as in the search
4795 method.
4796
4797 =cut
4798
4799 sub fcc_477_count {
4800   my ($class, $params) = @_;
4801
4802   my $sql_query = $class->search( $params );
4803
4804   my $count_sql = delete($sql_query->{'count_query'});
4805   $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
4806     or die "couldn't parse count_sql";
4807
4808   my $count_sth = dbh->prepare($count_sql)
4809     or die "Error preparing $count_sql: ". dbh->errstr;
4810   $count_sth->execute
4811     or die "Error executing $count_sql: ". $count_sth->errstr;
4812   my $count_arrayref = $count_sth->fetchrow_arrayref;
4813
4814   return ( @$count_arrayref );
4815
4816 }
4817
4818 =item tax_locationnum_sql
4819
4820 Returns an SQL expression for the tax location for a package, based
4821 on the settings of 'tax-pkg_address' and 'tax-ship_address'.
4822
4823 =cut
4824
4825 sub tax_locationnum_sql {
4826   my $conf = FS::Conf->new;
4827   if ( $conf->exists('tax-pkg_address') ) {
4828     'cust_pkg.locationnum';
4829   }
4830   elsif ( $conf->exists('tax-ship_address') ) {
4831     'cust_main.ship_locationnum';
4832   }
4833   else {
4834     'cust_main.bill_locationnum';
4835   }
4836 }
4837
4838 =item location_sql
4839
4840 Returns a list: the first item is an SQL fragment identifying matching
4841 packages/customers via location (taking into account shipping and package
4842 address taxation, if enabled), and subsequent items are the parameters to
4843 substitute for the placeholders in that fragment.
4844
4845 =cut
4846
4847 sub location_sql {
4848   my($class, %opt) = @_;
4849   my $ornull = $opt{'ornull'};
4850
4851   my $conf = new FS::Conf;
4852
4853   # '?' placeholders in _location_sql_where
4854   my $x = $ornull ? 3 : 2;
4855   my @bill_param = (
4856     ('district')x3,
4857     ('city')x3,
4858     ('county')x$x,
4859     ('state')x$x,
4860     'country'
4861   );
4862
4863   my $main_where;
4864   my @main_param;
4865   if ( $conf->exists('tax-ship_address') ) {
4866
4867     $main_where = "(
4868          (     ( ship_last IS NULL     OR  ship_last  = '' )
4869            AND ". _location_sql_where('cust_main', '', $ornull ). "
4870          )
4871       OR (       ship_last IS NOT NULL AND ship_last != ''
4872            AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
4873          )
4874     )";
4875     #    AND payby != 'COMP'
4876
4877     @main_param = ( @bill_param, @bill_param );
4878
4879   } else {
4880
4881     $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
4882     @main_param = @bill_param;
4883
4884   }
4885
4886   my $where;
4887   my @param;
4888   if ( $conf->exists('tax-pkg_address') ) {
4889
4890     my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
4891
4892     $where = " (
4893                     ( cust_pkg.locationnum IS     NULL AND $main_where )
4894                  OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where  )
4895                )
4896              ";
4897     @param = ( @main_param, @bill_param );
4898
4899   } else {
4900
4901     $where = $main_where;
4902     @param = @main_param;
4903
4904   }
4905
4906   ( $where, @param );
4907
4908 }
4909
4910 #subroutine, helper for location_sql
4911 sub _location_sql_where {
4912   my $table  = shift;
4913   my $prefix = @_ ? shift : '';
4914   my $ornull = @_ ? shift : '';
4915
4916 #  $ornull             = $ornull          ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
4917
4918   $ornull = $ornull ? ' OR ? IS NULL ' : '';
4919
4920   my $or_empty_city     = " OR ( ? = '' AND $table.${prefix}city     IS NULL )";
4921   my $or_empty_county   = " OR ( ? = '' AND $table.${prefix}county   IS NULL )";
4922   my $or_empty_state    = " OR ( ? = '' AND $table.${prefix}state    IS NULL )";
4923
4924   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
4925
4926 #        ( $table.${prefix}city    = ? $or_empty_city   $ornull )
4927   "
4928         ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL )
4929     AND ( $table.${prefix}city     = ? OR ? = '' OR CAST(? AS $text) IS NULL )
4930     AND ( $table.${prefix}county   = ? $or_empty_county $ornull )
4931     AND ( $table.${prefix}state    = ? $or_empty_state  $ornull )
4932     AND   $table.${prefix}country  = ?
4933   ";
4934 }
4935
4936 sub _X_show_zero {
4937   my( $self, $what ) = @_;
4938
4939   my $what_show_zero = $what. '_show_zero';
4940   length($self->$what_show_zero())
4941     ? ($self->$what_show_zero() eq 'Y')
4942     : $self->part_pkg->$what_show_zero();
4943 }
4944
4945 =head1 SUBROUTINES
4946
4947 =over 4
4948
4949 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
4950
4951 Bulk cancel + order subroutine.  Perhaps slightly deprecated, only used by the
4952 bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
4953
4954 CUSTNUM is a customer (see L<FS::cust_main>)
4955
4956 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
4957 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
4958 permitted.
4959
4960 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
4961 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
4962 new billing items.  An error is returned if this is not possible (see
4963 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
4964 parameter.
4965
4966 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
4967 newly-created cust_pkg objects.
4968
4969 REFNUM, if specified, will specify the FS::pkg_referral record to be created
4970 and inserted.  Multiple FS::pkg_referral records can be created by
4971 setting I<refnum> to an array reference of refnums or a hash reference with
4972 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
4973 record will be created corresponding to cust_main.refnum.
4974
4975 =cut
4976
4977 sub order {
4978   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
4979
4980   my $conf = new FS::Conf;
4981
4982   # Transactionize this whole mess
4983   my $oldAutoCommit = $FS::UID::AutoCommit;
4984   local $FS::UID::AutoCommit = 0;
4985   my $dbh = dbh;
4986
4987   my $error;
4988 #  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
4989 #  return "Customer not found: $custnum" unless $cust_main;
4990
4991   warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
4992     if $DEBUG;
4993
4994   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
4995                          @$remove_pkgnum;
4996
4997   my $change = scalar(@old_cust_pkg) != 0;
4998
4999   my %hash = ();
5000   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
5001
5002     warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
5003          " to pkgpart ". $pkgparts->[0]. "\n"
5004       if $DEBUG;
5005
5006     my $err_or_cust_pkg =
5007       $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
5008                                 'refnum'  => $refnum,
5009                               );
5010
5011     unless (ref($err_or_cust_pkg)) {
5012       $dbh->rollback if $oldAutoCommit;
5013       return $err_or_cust_pkg;
5014     }
5015
5016     push @$return_cust_pkg, $err_or_cust_pkg;
5017     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5018     return '';
5019
5020   }
5021
5022   # Create the new packages.
5023   foreach my $pkgpart (@$pkgparts) {
5024
5025     warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
5026
5027     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
5028                                       pkgpart => $pkgpart,
5029                                       refnum  => $refnum,
5030                                       %hash,
5031                                     };
5032     $error = $cust_pkg->insert( 'change' => $change );
5033     push @$return_cust_pkg, $cust_pkg;
5034
5035     foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) {
5036       my $supp_pkg = FS::cust_pkg->new({
5037           custnum => $custnum,
5038           pkgpart => $link->dst_pkgpart,
5039           refnum  => $refnum,
5040           main_pkgnum => $cust_pkg->pkgnum,
5041           %hash,
5042       });
5043       $error ||= $supp_pkg->insert( 'change' => $change );
5044       push @$return_cust_pkg, $supp_pkg;
5045     }
5046
5047     if ($error) {
5048       $dbh->rollback if $oldAutoCommit;
5049       return $error;
5050     }
5051
5052   }
5053   # $return_cust_pkg now contains refs to all of the newly
5054   # created packages.
5055
5056   # Transfer services and cancel old packages.
5057   foreach my $old_pkg (@old_cust_pkg) {
5058
5059     warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
5060       if $DEBUG;
5061
5062     foreach my $new_pkg (@$return_cust_pkg) {
5063       $error = $old_pkg->transfer($new_pkg);
5064       if ($error and $error == 0) {
5065         # $old_pkg->transfer failed.
5066         $dbh->rollback if $oldAutoCommit;
5067         return $error;
5068       }
5069     }
5070
5071     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
5072       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
5073       foreach my $new_pkg (@$return_cust_pkg) {
5074         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
5075         if ($error and $error == 0) {
5076           # $old_pkg->transfer failed.
5077         $dbh->rollback if $oldAutoCommit;
5078         return $error;
5079         }
5080       }
5081     }
5082
5083     if ($error > 0) {
5084       # Transfers were successful, but we went through all of the
5085       # new packages and still had services left on the old package.
5086       # We can't cancel the package under the circumstances, so abort.
5087       $dbh->rollback if $oldAutoCommit;
5088       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
5089     }
5090     $error = $old_pkg->cancel( quiet=>1, 'no_delay_cancel'=>1 );
5091     if ($error) {
5092       $dbh->rollback;
5093       return $error;
5094     }
5095   }
5096   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5097   '';
5098 }
5099
5100 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
5101
5102 A bulk change method to change packages for multiple customers.
5103
5104 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
5105 L<FS::part_pkg>) to order for each customer.  Duplicates are of course
5106 permitted.
5107
5108 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
5109 replace.  The services (see L<FS::cust_svc>) are moved to the
5110 new billing items.  An error is returned if this is not possible (see
5111 L<FS::pkg_svc>).
5112
5113 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
5114 newly-created cust_pkg objects.
5115
5116 =cut
5117
5118 sub bulk_change {
5119   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
5120
5121   # Transactionize this whole mess
5122   my $oldAutoCommit = $FS::UID::AutoCommit;
5123   local $FS::UID::AutoCommit = 0;
5124   my $dbh = dbh;
5125
5126   my @errors;
5127   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
5128                          @$remove_pkgnum;
5129
5130   while(scalar(@old_cust_pkg)) {
5131     my @return = ();
5132     my $custnum = $old_cust_pkg[0]->custnum;
5133     my (@remove) = map { $_->pkgnum }
5134                    grep { $_->custnum == $custnum } @old_cust_pkg;
5135     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
5136
5137     my $error = order $custnum, $pkgparts, \@remove, \@return;
5138
5139     push @errors, $error
5140       if $error;
5141     push @$return_cust_pkg, @return;
5142   }
5143
5144   if (scalar(@errors)) {
5145     $dbh->rollback if $oldAutoCommit;
5146     return join(' / ', @errors);
5147   }
5148
5149   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5150   '';
5151 }
5152
5153 =item forward_emails
5154
5155 Returns a hash of svcnums and corresponding email addresses
5156 for svc_acct services that can be used as source or dest
5157 for svc_forward services provisioned in this package.
5158
5159 Accepts options I<svc_forward> OR I<svcnum> for a svc_forward
5160 service;  if included, will ensure the current values of the
5161 specified service are included in the list, even if for some
5162 other reason they wouldn't be.  If called as a class method
5163 with a specified service, returns only these current values.
5164
5165 Caution: does not actually check if svc_forward services are
5166 available to be provisioned on this package.
5167
5168 =cut
5169
5170 sub forward_emails {
5171   my $self = shift;
5172   my %opt = @_;
5173
5174   #load optional service, thoroughly validated
5175   die "Use svcnum or svc_forward, not both"
5176     if $opt{'svcnum'} && $opt{'svc_forward'};
5177   my $svc_forward = $opt{'svc_forward'};
5178   $svc_forward ||= qsearchs('svc_forward',{ 'svcnum' => $opt{'svcnum'} })
5179     if $opt{'svcnum'};
5180   die "Specified service is not a forward service"
5181     if $svc_forward && (ref($svc_forward) ne 'FS::svc_forward');
5182   die "Specified service not found"
5183     if ($opt{'svcnum'} || $opt{'svc_forward'}) && !$svc_forward;
5184
5185   my %email;
5186
5187   ## everything below was basically copied from httemplate/edit/svc_forward.cgi
5188   ## with minimal refactoring, not sure why we can't just load all svc_accts for this custnum
5189
5190   #add current values from specified service, if there was one
5191   if ($svc_forward) {
5192     foreach my $method (qw( srcsvc_acct dstsvc_acct )) {
5193       my $svc_acct = $svc_forward->$method();
5194       $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct;
5195     }
5196   }
5197
5198   if (ref($self) eq 'FS::cust_pkg') {
5199
5200     #and including the rest for this customer
5201     my($u_part_svc,@u_acct_svcparts);
5202     foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
5203       push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
5204     }
5205
5206     my $custnum = $self->getfield('custnum');
5207     foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
5208       my $cust_pkgnum = $i_cust_pkg->getfield('pkgnum');
5209       #now find the corresponding record(s) in cust_svc (for this pkgnum!)
5210       foreach my $acct_svcpart (@u_acct_svcparts) {
5211         foreach my $i_cust_svc (
5212           qsearch( 'cust_svc', { 'pkgnum'  => $cust_pkgnum,
5213                                  'svcpart' => $acct_svcpart } )
5214         ) {
5215           my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } );
5216           $email{$svc_acct->svcnum} = $svc_acct->email;
5217         }
5218       }
5219     }
5220   }
5221
5222   return %email;
5223 }
5224
5225 # Used by FS::Upgrade to migrate to a new database.
5226 sub _upgrade_data {  # class method
5227   my ($class, %opts) = @_;
5228   $class->_upgrade_otaker(%opts);
5229   my @statements = (
5230     # RT#10139, bug resulting in contract_end being set when it shouldn't
5231   'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
5232     # RT#10830, bad calculation of prorate date near end of year
5233     # the date range for bill is December 2009, and we move it forward
5234     # one year if it's before the previous bill date (which it should
5235     # never be)
5236   'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
5237   AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
5238   WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
5239     # RT6628, add order_date to cust_pkg
5240     'update cust_pkg set order_date = (select history_date from h_cust_pkg
5241         where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
5242         history_action = \'insert\') where order_date is null',
5243   );
5244   foreach my $sql (@statements) {
5245     my $sth = dbh->prepare($sql);
5246     $sth->execute or die $sth->errstr;
5247   }
5248
5249   # RT31194: supplemental package links that are deleted don't clean up
5250   # linked records
5251   my @pkglinknums = qsearch({
5252       'select'    => 'DISTINCT cust_pkg.pkglinknum',
5253       'table'     => 'cust_pkg',
5254       'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ',
5255       'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL
5256                         AND part_pkg_link.pkglinknum IS NULL',
5257   });
5258   foreach (@pkglinknums) {
5259     my $pkglinknum = $_->pkglinknum;
5260     warn "cleaning part_pkg_link #$pkglinknum\n";
5261     my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum});
5262     my $error = $part_pkg_link->remove_linked;
5263     die $error if $error;
5264   }
5265 }
5266
5267 =back
5268
5269 =head1 BUGS
5270
5271 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
5272
5273 In sub order, the @pkgparts array (passed by reference) is clobbered.
5274
5275 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
5276 method to pass dates to the recur_prog expression, it should do so.
5277
5278 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
5279 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
5280 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
5281 configuration values.  Probably need a subroutine which decides what to do
5282 based on whether or not we've fetched the user yet, rather than a hash.  See
5283 FS::UID and the TODO.
5284
5285 Now that things are transactional should the check in the insert method be
5286 moved to check ?
5287
5288 =head1 SEE ALSO
5289
5290 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
5291 L<FS::pkg_svc>, schema.html from the base documentation
5292
5293 =cut
5294
5295 1;
5296