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