FS/FS/cust_pkg.pm

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