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