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 Data::Dumper;
2462 sub process_bulk_cust_pkg {
2463   my $job = shift;
2464   my $param = shift;
2465   warn Dumper($param) if $DEBUG;
2466
2467   my $old_part_pkg = qsearchs('part_pkg',
2468                               { pkgpart => $param->{'old_pkgpart'} });
2469   my $new_part_pkg = qsearchs('part_pkg',
2470                               { pkgpart => $param->{'new_pkgpart'} });
2471   die "Must select a new package type\n" unless $new_part_pkg;
2472   #my $keep_dates = $param->{'keep_dates'} || 0;
2473   my $keep_dates = 1; # there is no good reason to turn this off
2474
2475   my $oldAutoCommit = $FS::UID::AutoCommit;
2476   local $FS::UID::AutoCommit = 0;
2477   my $dbh = dbh;
2478
2479   my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
2480
2481   my $i = 0;
2482   foreach my $old_cust_pkg ( @cust_pkgs ) {
2483     $i++;
2484     $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
2485     if ( $old_cust_pkg->getfield('cancel') ) {
2486       warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
2487         $old_cust_pkg->pkgnum."\n"
2488         if $DEBUG;
2489       next;
2490     }
2491     warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
2492       if $DEBUG;
2493     my $error = $old_cust_pkg->change(
2494       'pkgpart'     => $param->{'new_pkgpart'},
2495       'keep_dates'  => $keep_dates
2496     );
2497     if ( !ref($error) ) { # change returns the cust_pkg on success
2498       $dbh->rollback;
2499       die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
2500     }
2501   }
2502   $dbh->commit if $oldAutoCommit;
2503   return;
2504 }
2505
2506 =item last_bill
2507
2508 Returns the last bill date, or if there is no last bill date, the setup date.
2509 Useful for billing metered services.
2510
2511 =cut
2512
2513 sub last_bill {
2514   my $self = shift;
2515   return $self->setfield('last_bill', $_[0]) if @_;
2516   return $self->getfield('last_bill') if $self->getfield('last_bill');
2517   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
2518                                                   'edate'  => $self->bill,  } );
2519   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
2520 }
2521
2522 =item last_cust_pkg_reason ACTION
2523
2524 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
2525 Returns false if there is no reason or the package is not currenly ACTION'd
2526 ACTION is one of adjourn, susp, cancel, or expire.
2527
2528 =cut
2529
2530 sub last_cust_pkg_reason {
2531   my ( $self, $action ) = ( shift, shift );
2532   my $date = $self->get($action);
2533   qsearchs( {
2534               'table' => 'cust_pkg_reason',
2535               'hashref' => { 'pkgnum' => $self->pkgnum,
2536                              'action' => substr(uc($action), 0, 1),
2537                              'date'   => $date,
2538                            },
2539               'order_by' => 'ORDER BY num DESC LIMIT 1',
2540            } );
2541 }
2542
2543 =item last_reason ACTION
2544
2545 Returns the most recent ACTION FS::reason associated with the package.
2546 Returns false if there is no reason or the package is not currenly ACTION'd
2547 ACTION is one of adjourn, susp, cancel, or expire.
2548
2549 =cut
2550
2551 sub last_reason {
2552   my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
2553   $cust_pkg_reason->reason
2554     if $cust_pkg_reason;
2555 }
2556
2557 =item part_pkg
2558
2559 Returns the definition for this billing item, as an FS::part_pkg object (see
2560 L<FS::part_pkg>).
2561
2562 =cut
2563
2564 sub part_pkg {
2565   my $self = shift;
2566   return $self->{'_pkgpart'} if $self->{'_pkgpart'};
2567   cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
2568   qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
2569 }
2570
2571 =item old_cust_pkg
2572
2573 Returns the cancelled package this package was changed from, if any.
2574
2575 =cut
2576
2577 sub old_cust_pkg {
2578   my $self = shift;
2579   return '' unless $self->change_pkgnum;
2580   qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
2581 }
2582
2583 =item change_cust_main
2584
2585 Returns the customter this package was detached to, if any.
2586
2587 =cut
2588
2589 sub change_cust_main {
2590   my $self = shift;
2591   return '' unless $self->change_custnum;
2592   qsearchs('cust_main', { 'custnum' => $self->change_custnum } );
2593 }
2594
2595 =item calc_setup
2596
2597 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
2598 item.
2599
2600 =cut
2601
2602 sub calc_setup {
2603   my $self = shift;
2604   $self->part_pkg->calc_setup($self, @_);
2605 }
2606
2607 =item calc_recur
2608
2609 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
2610 item.
2611
2612 =cut
2613
2614 sub calc_recur {
2615   my $self = shift;
2616   $self->part_pkg->calc_recur($self, @_);
2617 }
2618
2619 =item base_setup
2620
2621 Calls the I<base_setup> of the FS::part_pkg object associated with this billing
2622 item.
2623
2624 =cut
2625
2626 sub base_setup {
2627   my $self = shift;
2628   $self->part_pkg->base_setup($self, @_);
2629 }
2630
2631 =item base_recur
2632
2633 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
2634 item.
2635
2636 =cut
2637
2638 sub base_recur {
2639   my $self = shift;
2640   $self->part_pkg->base_recur($self, @_);
2641 }
2642
2643 =item calc_remain
2644
2645 Calls the I<calc_remain> of the FS::part_pkg object associated with this
2646 billing item.
2647
2648 =cut
2649
2650 sub calc_remain {
2651   my $self = shift;
2652   $self->part_pkg->calc_remain($self, @_);
2653 }
2654
2655 =item calc_cancel
2656
2657 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
2658 billing item.
2659
2660 =cut
2661
2662 sub calc_cancel {
2663   my $self = shift;
2664   $self->part_pkg->calc_cancel($self, @_);
2665 }
2666
2667 =item cust_bill_pkg
2668
2669 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
2670
2671 =cut
2672
2673 sub cust_bill_pkg {
2674   my $self = shift;
2675   qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
2676 }
2677
2678 =item cust_pkg_detail [ DETAILTYPE ]
2679
2680 Returns any customer package details for this package (see
2681 L<FS::cust_pkg_detail>).
2682
2683 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
2684
2685 =cut
2686
2687 sub cust_pkg_detail {
2688   my $self = shift;
2689   my %hash = ( 'pkgnum' => $self->pkgnum );
2690   $hash{detailtype} = shift if @_;
2691   qsearch({
2692     'table'    => 'cust_pkg_detail',
2693     'hashref'  => \%hash,
2694     'order_by' => 'ORDER BY weight, pkgdetailnum',
2695   });
2696 }
2697
2698 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
2699
2700 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
2701
2702 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
2703
2704 If there is an error, returns the error, otherwise returns false.
2705
2706 =cut
2707
2708 sub set_cust_pkg_detail {
2709   my( $self, $detailtype, @details ) = @_;
2710
2711   my $oldAutoCommit = $FS::UID::AutoCommit;
2712   local $FS::UID::AutoCommit = 0;
2713   my $dbh = dbh;
2714
2715   foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
2716     my $error = $current->delete;
2717     if ( $error ) {
2718       $dbh->rollback if $oldAutoCommit;
2719       return "error removing old detail: $error";
2720     }
2721   }
2722
2723   foreach my $detail ( @details ) {
2724     my $cust_pkg_detail = new FS::cust_pkg_detail {
2725       'pkgnum'     => $self->pkgnum,
2726       'detailtype' => $detailtype,
2727       'detail'     => $detail,
2728     };
2729     my $error = $cust_pkg_detail->insert;
2730     if ( $error ) {
2731       $dbh->rollback if $oldAutoCommit;
2732       return "error adding new detail: $error";
2733     }
2734
2735   }
2736
2737   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2738   '';
2739
2740 }
2741
2742 =item cust_event
2743
2744 Returns the customer billing events (see L<FS::cust_event>) for this invoice.
2745
2746 =cut
2747
2748 #false laziness w/cust_bill.pm
2749 sub cust_event {
2750   my $self = shift;
2751   qsearch({
2752     'table'     => 'cust_event',
2753     'addl_from' => 'JOIN part_event USING ( eventpart )',
2754     'hashref'   => { 'tablenum' => $self->pkgnum },
2755     'extra_sql' => " AND eventtable = 'cust_pkg' ",
2756   });
2757 }
2758
2759 =item num_cust_event
2760
2761 Returns the number of customer billing events (see L<FS::cust_event>) for this package.
2762
2763 =cut
2764
2765 #false laziness w/cust_bill.pm
2766 sub num_cust_event {
2767   my $self = shift;
2768   my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
2769   $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
2770 }
2771
2772 =item exists_cust_event
2773
2774 Returns true if there are customer billing events (see L<FS::cust_event>) for this package.  More efficient than using num_cust_event.
2775
2776 =cut
2777
2778 sub exists_cust_event {
2779   my $self = shift;
2780   my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
2781   my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
2782   $row ? $row->[0] : '';
2783 }
2784
2785 sub _from_cust_event_where {
2786   #my $self = shift;
2787   " FROM cust_event JOIN part_event USING ( eventpart ) ".
2788   "  WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
2789 }
2790
2791 sub _prep_ex {
2792   my( $self, $sql, @args ) = @_;
2793   my $sth = dbh->prepare($sql) or die  dbh->errstr. " preparing $sql";
2794   $sth->execute(@args)         or die $sth->errstr. " executing $sql";
2795   $sth;
2796 }
2797
2798 =item part_pkg_currency_option OPTIONNAME
2799
2800 Returns a two item list consisting of the currency of this customer, if any,
2801 and a value for the provided option.  If the customer has a currency, the value
2802 is the option value the given name and the currency (see
2803 L<FS::part_pkg_currency>).  Otherwise, if the customer has no currency, is the
2804 regular option value for the given name (see L<FS::part_pkg_option>).
2805
2806 =cut
2807
2808 sub part_pkg_currency_option {
2809   my( $self, $optionname ) = @_;
2810   my $part_pkg = $self->part_pkg;
2811   if ( my $currency = $self->cust_main->currency ) {
2812     ($currency, $part_pkg->part_pkg_currency_option($currency, $optionname) );
2813   } else {
2814     ('', $part_pkg->option($optionname) );
2815   }
2816 }
2817
2818 =item cust_svc [ SVCPART ] (old, deprecated usage)
2819
2820 =item cust_svc [ OPTION => VALUE ... ] (current usage)
2821
2822 =item cust_svc_unsorted [ OPTION => VALUE ... ]
2823
2824 Returns the services for this package, as FS::cust_svc objects (see
2825 L<FS::cust_svc>).  Available options are svcpart and svcdb.  If either is
2826 spcififed, returns only the matching services.
2827
2828 As an optimization, use the cust_svc_unsorted version if you are not displaying
2829 the results.
2830
2831 =cut
2832
2833 sub cust_svc {
2834   my $self = shift;
2835   cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
2836   $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
2837 }
2838
2839 sub cust_svc_unsorted {
2840   my $self = shift;
2841   @{ $self->cust_svc_unsorted_arrayref(@_) };
2842 }
2843
2844 sub cust_svc_unsorted_arrayref {
2845   my $self = shift;
2846
2847   return [] unless $self->num_cust_svc(@_);
2848
2849   my %opt = ();
2850   if ( @_ && $_[0] =~ /^\d+/ ) {
2851     $opt{svcpart} = shift;
2852   } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
2853     %opt = %{ $_[0] };
2854   } elsif ( @_ ) {
2855     %opt = @_;
2856   }
2857
2858   my %search = (
2859     'table'   => 'cust_svc',
2860     'hashref' => { 'pkgnum' => $self->pkgnum },
2861   );
2862   if ( $opt{svcpart} ) {
2863     $search{hashref}->{svcpart} = $opt{'svcpart'};
2864   }
2865   if ( $opt{'svcdb'} ) {
2866     $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
2867     $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
2868   }
2869
2870   [ qsearch(\%search) ];
2871
2872 }
2873
2874 =item overlimit [ SVCPART ]
2875
2876 Returns the services for this package which have exceeded their
2877 usage limit as FS::cust_svc objects (see L<FS::cust_svc>).  If a svcpart
2878 is specified, return only the matching services.
2879
2880 =cut
2881
2882 sub overlimit {
2883   my $self = shift;
2884   return () unless $self->num_cust_svc(@_);
2885   grep { $_->overlimit } $self->cust_svc(@_);
2886 }
2887
2888 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2889
2890 Returns historical services for this package created before END TIMESTAMP and
2891 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
2892 (see L<FS::h_cust_svc>).  If MODE is 'I' (for 'invoice'), services with the
2893 I<pkg_svc.hidden> flag will be omitted.
2894
2895 =cut
2896
2897 sub h_cust_svc {
2898   my $self = shift;
2899   warn "$me _h_cust_svc called on $self\n"
2900     if $DEBUG;
2901
2902   my ($end, $start, $mode) = @_;
2903   my @cust_svc = $self->_sort_cust_svc(
2904     [ qsearch( 'h_cust_svc',
2905       { 'pkgnum' => $self->pkgnum, },
2906       FS::h_cust_svc->sql_h_search(@_),
2907     ) ]
2908   );
2909   if ( defined($mode) && $mode eq 'I' ) {
2910     my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
2911     return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
2912   } else {
2913     return @cust_svc;
2914   }
2915 }
2916
2917 sub _sort_cust_svc {
2918   my( $self, $arrayref ) = @_;
2919
2920   my $sort =
2921     sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] };
2922
2923   my %pkg_svc = map { $_->svcpart => $_ }
2924                 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
2925
2926   map  { $_->[0] }
2927   sort $sort
2928   map {
2929         my $pkg_svc = $pkg_svc{ $_->svcpart } || '';
2930         [ $_,
2931           $pkg_svc ? $pkg_svc->primary_svc : '',
2932           $pkg_svc ? $pkg_svc->quantity : 0,
2933         ];
2934       }
2935   @$arrayref;
2936
2937 }
2938
2939 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
2940
2941 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
2942
2943 Returns the number of services for this package.  Available options are svcpart
2944 and svcdb.  If either is spcififed, returns only the matching services.
2945
2946 =cut
2947
2948 sub num_cust_svc {
2949   my $self = shift;
2950
2951   return $self->{'_num_cust_svc'}
2952     if !scalar(@_)
2953        && exists($self->{'_num_cust_svc'})
2954        && $self->{'_num_cust_svc'} =~ /\d/;
2955
2956   cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
2957     if $DEBUG > 2;
2958
2959   my %opt = ();
2960   if ( @_ && $_[0] =~ /^\d+/ ) {
2961     $opt{svcpart} = shift;
2962   } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
2963     %opt = %{ $_[0] };
2964   } elsif ( @_ ) {
2965     %opt = @_;
2966   }
2967
2968   my $select = 'SELECT COUNT(*) FROM cust_svc ';
2969   my $where = ' WHERE pkgnum = ? ';
2970   my @param = ($self->pkgnum);
2971
2972   if ( $opt{'svcpart'} ) {
2973     $where .= ' AND svcpart = ? ';
2974     push @param, $opt{'svcpart'};
2975   }
2976   if ( $opt{'svcdb'} ) {
2977     $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
2978     $where .= ' AND svcdb = ? ';
2979     push @param, $opt{'svcdb'};
2980   }
2981
2982   my $sth = dbh->prepare("$select $where") or die  dbh->errstr;
2983   $sth->execute(@param) or die $sth->errstr;
2984   $sth->fetchrow_arrayref->[0];
2985 }
2986
2987 =item available_part_svc
2988
2989 Returns a list of FS::part_svc objects representing services included in this
2990 package but not yet provisioned.  Each FS::part_svc object also has an extra
2991 field, I<num_avail>, which specifies the number of available services.
2992
2993 =cut
2994
2995 sub available_part_svc {
2996   my $self = shift;
2997
2998   my $pkg_quantity = $self->quantity || 1;
2999
3000   grep { $_->num_avail > 0 }
3001     map {
3002           my $part_svc = $_->part_svc;
3003           $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
3004             $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
3005
3006           # more evil encapsulation breakage
3007           if($part_svc->{'Hash'}{'num_avail'} > 0) {
3008             my @exports = $part_svc->part_export_did;
3009             $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
3010           }
3011
3012           $part_svc;
3013         }
3014       $self->part_pkg->pkg_svc;
3015 }
3016
3017 =item part_svc [ OPTION => VALUE ... ]
3018
3019 Returns a list of FS::part_svc objects representing provisioned and available
3020 services included in this package.  Each FS::part_svc object also has the
3021 following extra fields:
3022
3023 =over 4
3024
3025 =item num_cust_svc
3026
3027 (count)
3028
3029 =item num_avail
3030
3031 (quantity - count)
3032
3033 =item cust_pkg_svc
3034
3035 (services) - array reference containing the provisioned services, as cust_svc objects
3036
3037 =back
3038
3039 Accepts two options:
3040
3041 =over 4
3042
3043 =item summarize_size
3044
3045 If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc
3046 is this size or greater.
3047
3048 =item hide_discontinued
3049
3050 If true, will omit looking for services that are no longer avaialble in the
3051 package definition.
3052
3053 =back
3054
3055 =cut
3056
3057 #svcnum
3058 #label -> ($cust_svc->label)[1]
3059
3060 sub part_svc {
3061   my $self = shift;
3062   my %opt = @_;
3063
3064   my $pkg_quantity = $self->quantity || 1;
3065
3066   #XXX some sort of sort order besides numeric by svcpart...
3067   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
3068     my $pkg_svc = $_;
3069     my $part_svc = $pkg_svc->part_svc;
3070     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3071     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
3072     $part_svc->{'Hash'}{'num_avail'}    =
3073       max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc );
3074     $part_svc->{'Hash'}{'cust_pkg_svc'} =
3075         $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
3076       unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
3077           && $num_cust_svc >= $opt{summarize_size};
3078     $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
3079     $part_svc;
3080   } $self->part_pkg->pkg_svc;
3081
3082   unless ( $opt{hide_discontinued} ) {
3083     #extras
3084     push @part_svc, map {
3085       my $part_svc = $_;
3086       my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3087       $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
3088       $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
3089       $part_svc->{'Hash'}{'cust_pkg_svc'} =
3090         $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
3091       $part_svc;
3092     } $self->extra_part_svc;
3093   }
3094
3095   @part_svc;
3096
3097 }
3098
3099 =item extra_part_svc
3100
3101 Returns a list of FS::part_svc objects corresponding to services in this
3102 package which are still provisioned but not (any longer) available in the
3103 package definition.
3104
3105 =cut
3106
3107 sub extra_part_svc {
3108   my $self = shift;
3109
3110   my $pkgnum  = $self->pkgnum;
3111   #my $pkgpart = $self->pkgpart;
3112
3113 #  qsearch( {
3114 #    'table'     => 'part_svc',
3115 #    'hashref'   => {},
3116 #    'extra_sql' =>
3117 #      "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
3118 #                     WHERE pkg_svc.svcpart = part_svc.svcpart
3119 #                       AND pkg_svc.pkgpart = ?
3120 #                       AND quantity > 0
3121 #                 )
3122 #        AND 0 < ( SELECT COUNT(*) FROM cust_svc
3123 #                       LEFT JOIN cust_pkg USING ( pkgnum )
3124 #                     WHERE cust_svc.svcpart = part_svc.svcpart
3125 #                       AND pkgnum = ?
3126 #                 )",
3127 #    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
3128 #  } );
3129
3130 #seems to benchmark slightly faster... (or did?)
3131
3132   my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
3133   my $pkgparts = join(',', @pkgparts);
3134
3135   qsearch( {
3136     #'select'      => 'DISTINCT ON (svcpart) part_svc.*',
3137     #MySQL doesn't grok DISINCT ON
3138     'select'      => 'DISTINCT part_svc.*',
3139     'table'       => 'part_svc',
3140     'addl_from'   =>
3141       "LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart
3142                                AND pkg_svc.pkgpart IN ($pkgparts)
3143                                AND quantity > 0
3144                              )
3145        LEFT JOIN cust_svc ON (     cust_svc.svcpart = part_svc.svcpart )
3146        LEFT JOIN cust_pkg USING ( pkgnum )
3147       ",
3148     'hashref'     => {},
3149     'extra_sql'   => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
3150     'extra_param' => [ [$self->pkgnum=>'int'] ],
3151   } );
3152 }
3153
3154 =item status
3155
3156 Returns a short status string for this package, currently:
3157
3158 =over 4
3159
3160 =item on hold
3161
3162 =item not yet billed
3163
3164 =item one-time charge
3165
3166 =item active
3167
3168 =item suspended
3169
3170 =item cancelled
3171
3172 =back
3173
3174 =cut
3175
3176 sub status {
3177   my $self = shift;
3178
3179   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
3180
3181   return 'cancelled' if $self->get('cancel');
3182   return 'on hold' if $self->susp && ! $self->setup;
3183   return 'suspended' if $self->susp;
3184   return 'not yet billed' unless $self->setup;
3185   return 'one-time charge' if $freq =~ /^(0|$)/;
3186   return 'active';
3187 }
3188
3189 =item ucfirst_status
3190
3191 Returns the status with the first character capitalized.
3192
3193 =cut
3194
3195 sub ucfirst_status {
3196   ucfirst(shift->status);
3197 }
3198
3199 =item statuses
3200
3201 Class method that returns the list of possible status strings for packages
3202 (see L<the status method|/status>).  For example:
3203
3204   @statuses = FS::cust_pkg->statuses();
3205
3206 =cut
3207
3208 tie my %statuscolor, 'Tie::IxHash',
3209   'on hold'         => '7E0079', #purple!
3210   'not yet billed'  => '009999', #teal? cyan?
3211   'one-time charge' => '0000CC', #blue  #'000000',
3212   'active'          => '00CC00',
3213   'suspended'       => 'FF9900',
3214   'cancelled'       => 'FF0000',
3215 ;
3216
3217 sub statuses {
3218   my $self = shift; #could be class...
3219   #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
3220   #                                    # mayble split btw one-time vs. recur
3221     keys %statuscolor;
3222 }
3223
3224 sub statuscolors {
3225   #my $self = shift;
3226   \%statuscolor;
3227 }
3228
3229 =item statuscolor
3230
3231 Returns a hex triplet color string for this package's status.
3232
3233 =cut
3234
3235 sub statuscolor {
3236   my $self = shift;
3237   $statuscolor{$self->status};
3238 }
3239
3240 =item pkg_label
3241
3242 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
3243 "pkg - comment" depending on user preference).
3244
3245 =cut
3246
3247 sub pkg_label {
3248   my $self = shift;
3249   my $label = $self->part_pkg->pkg_comment( cust_pkg=>$self, nopkgpart=>1 );
3250   $label = $self->pkgnum. ": $label"
3251     if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
3252   $label;
3253 }
3254
3255 =item pkg_label_long
3256
3257 Returns a long label for this package, adding the primary service's label to
3258 pkg_label.
3259
3260 =cut
3261
3262 sub pkg_label_long {
3263   my $self = shift;
3264   my $label = $self->pkg_label;
3265   my $cust_svc = $self->primary_cust_svc;
3266   $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
3267   $label;
3268 }
3269
3270 =item pkg_locale
3271
3272 Returns a customer-localized label for this package.
3273
3274 =cut
3275
3276 sub pkg_locale {
3277   my $self = shift;
3278   $self->part_pkg->pkg_locale( $self->cust_main->locale );
3279 }
3280
3281 =item primary_cust_svc
3282
3283 Returns a primary service (as FS::cust_svc object) if one can be identified.
3284
3285 =cut
3286
3287 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
3288
3289 sub primary_cust_svc {
3290   my $self = shift;
3291
3292   my @cust_svc = $self->cust_svc;
3293
3294   return '' unless @cust_svc; #no serivces - irrelevant then
3295
3296   return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
3297
3298   # primary service as specified in the package definition
3299   # or exactly one service definition with quantity one
3300   my $svcpart = $self->part_pkg->svcpart;
3301   @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
3302   return $cust_svc[0] if scalar(@cust_svc) == 1;
3303
3304   #couldn't identify one thing..
3305   return '';
3306 }
3307
3308 =item labels
3309
3310 Returns a list of lists, calling the label method for all services
3311 (see L<FS::cust_svc>) of this billing item.
3312
3313 =cut
3314
3315 sub labels {
3316   my $self = shift;
3317   map { [ $_->label ] } $self->cust_svc;
3318 }
3319
3320 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3321
3322 Like the labels method, but returns historical information on services that
3323 were active as of END_TIMESTAMP and (optionally) not cancelled before
3324 START_TIMESTAMP.  If MODE is 'I' (for 'invoice'), services with the
3325 I<pkg_svc.hidden> flag will be omitted.
3326
3327 Returns a list of lists, calling the label method for all (historical) services
3328 (see L<FS::h_cust_svc>) of this billing item.
3329
3330 =cut
3331
3332 sub h_labels {
3333   my $self = shift;
3334   warn "$me _h_labels called on $self\n"
3335     if $DEBUG;
3336   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
3337 }
3338
3339 =item labels_short
3340
3341 Like labels, except returns a simple flat list, and shortens long
3342 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3343 identical services to one line that lists the service label and the number of
3344 individual services rather than individual items.
3345
3346 =cut
3347
3348 sub labels_short {
3349   shift->_labels_short( 'labels', @_ );
3350 }
3351
3352 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
3353
3354 Like h_labels, except returns a simple flat list, and shortens long
3355 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3356 identical services to one line that lists the service label and the number of
3357 individual services rather than individual items.
3358
3359 =cut
3360
3361 sub h_labels_short {
3362   shift->_labels_short( 'h_labels', @_ );
3363 }
3364
3365 sub _labels_short {
3366   my( $self, $method ) = ( shift, shift );
3367
3368   warn "$me _labels_short called on $self with $method method\n"
3369     if $DEBUG;
3370
3371   my $conf = new FS::Conf;
3372   my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
3373
3374   warn "$me _labels_short populating \%labels\n"
3375     if $DEBUG;
3376
3377   my %labels;
3378   #tie %labels, 'Tie::IxHash';
3379   push @{ $labels{$_->[0]} }, $_->[1]
3380     foreach $self->$method(@_);
3381
3382   warn "$me _labels_short populating \@labels\n"
3383     if $DEBUG;
3384
3385   my @labels;
3386   foreach my $label ( keys %labels ) {
3387     my %seen = ();
3388     my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
3389     my $num = scalar(@values);
3390     warn "$me _labels_short $num items for $label\n"
3391       if $DEBUG;
3392
3393     if ( $num > $max_same_services ) {
3394       warn "$me _labels_short   more than $max_same_services, so summarizing\n"
3395         if $DEBUG;
3396       push @labels, "$label ($num)";
3397     } else {
3398       if ( $conf->exists('cust_bill-consolidate_services') ) {
3399         warn "$me _labels_short   consolidating services\n"
3400           if $DEBUG;
3401         # push @labels, "$label: ". join(', ', @values);
3402         while ( @values ) {
3403           my $detail = "$label: ";
3404           $detail .= shift(@values). ', '
3405             while @values
3406                && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
3407           $detail =~ s/, $//;
3408           push @labels, $detail;
3409         }
3410         warn "$me _labels_short   done consolidating services\n"
3411           if $DEBUG;
3412       } else {
3413         warn "$me _labels_short   adding service data\n"
3414           if $DEBUG;
3415         push @labels, map { "$label: $_" } @values;
3416       }
3417     }
3418   }
3419
3420  @labels;
3421
3422 }
3423
3424 =item cust_main
3425
3426 Returns the parent customer object (see L<FS::cust_main>).
3427
3428 =item balance
3429
3430 Returns the balance for this specific package, when using
3431 experimental package balance.
3432
3433 =cut
3434
3435 sub balance {
3436   my $self = shift;
3437   $self->cust_main->balance_pkgnum( $self->pkgnum );
3438 }
3439
3440 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
3441
3442 =item cust_location
3443
3444 Returns the location object, if any (see L<FS::cust_location>).
3445
3446 =item cust_location_or_main
3447
3448 If this package is associated with a location, returns the locaiton (see
3449 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
3450
3451 =item location_label [ OPTION => VALUE ... ]
3452
3453 Returns the label of the location object (see L<FS::cust_location>).
3454
3455 =cut
3456
3457 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
3458
3459 =item tax_locationnum
3460
3461 Returns the foreign key to a L<FS::cust_location> object for calculating
3462 tax on this package, as determined by the C<tax-pkg_address> and
3463 C<tax-ship_address> configuration flags.
3464
3465 =cut
3466
3467 sub tax_locationnum {
3468   my $self = shift;
3469   my $conf = FS::Conf->new;
3470   if ( $conf->exists('tax-pkg_address') ) {
3471     return $self->locationnum;
3472   }
3473   elsif ( $conf->exists('tax-ship_address') ) {
3474     return $self->cust_main->ship_locationnum;
3475   }
3476   else {
3477     return $self->cust_main->bill_locationnum;
3478   }
3479 }
3480
3481 =item tax_location
3482
3483 Returns the L<FS::cust_location> object for tax_locationnum.
3484
3485 =cut
3486
3487 sub tax_location {
3488   my $self = shift;
3489   my $conf = FS::Conf->new;
3490   if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
3491     return FS::cust_location->by_key($self->locationnum);
3492   }
3493   elsif ( $conf->exists('tax-ship_address') ) {
3494     return $self->cust_main->ship_location;
3495   }
3496   else {
3497     return $self->cust_main->bill_location;
3498   }
3499 }
3500
3501 =item seconds_since TIMESTAMP
3502
3503 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
3504 package have been online since TIMESTAMP, according to the session monitor.
3505
3506 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
3507 L<Time::Local> and L<Date::Parse> for conversion functions.
3508
3509 =cut
3510
3511 sub seconds_since {
3512   my($self, $since) = @_;
3513   my $seconds = 0;
3514
3515   foreach my $cust_svc (
3516     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
3517   ) {
3518     $seconds += $cust_svc->seconds_since($since);
3519   }
3520
3521   $seconds;
3522
3523 }
3524
3525 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
3526
3527 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
3528 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
3529 (exclusive).
3530
3531 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
3532 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
3533 functions.
3534
3535
3536 =cut
3537
3538 sub seconds_since_sqlradacct {
3539   my($self, $start, $end) = @_;
3540
3541   my $seconds = 0;
3542
3543   foreach my $cust_svc (
3544     grep {
3545       my $part_svc = $_->part_svc;
3546       $part_svc->svcdb eq 'svc_acct'
3547         && scalar($part_svc->part_export_usage);
3548     } $self->cust_svc
3549   ) {
3550     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
3551   }
3552
3553   $seconds;
3554
3555 }
3556
3557 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
3558
3559 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
3560 in this package for sessions ending between TIMESTAMP_START (inclusive) and
3561 TIMESTAMP_END
3562 (exclusive).
3563
3564 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
3565 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
3566 functions.
3567
3568 =cut
3569
3570 sub attribute_since_sqlradacct {
3571   my($self, $start, $end, $attrib) = @_;
3572
3573   my $sum = 0;
3574
3575   foreach my $cust_svc (
3576     grep {
3577       my $part_svc = $_->part_svc;
3578       scalar($part_svc->part_export_usage);
3579     } $self->cust_svc
3580   ) {
3581     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
3582   }
3583
3584   $sum;
3585
3586 }
3587
3588 =item quantity
3589
3590 =cut
3591
3592 sub quantity {
3593   my( $self, $value ) = @_;
3594   if ( defined($value) ) {
3595     $self->setfield('quantity', $value);
3596   }
3597   $self->getfield('quantity') || 1;
3598 }
3599
3600 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
3601
3602 Transfers as many services as possible from this package to another package.
3603
3604 The destination package can be specified by pkgnum by passing an FS::cust_pkg
3605 object.  The destination package must already exist.
3606
3607 Services are moved only if the destination allows services with the correct
3608 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
3609 this option with caution!  No provision is made for export differences
3610 between the old and new service definitions.  Probably only should be used
3611 when your exports for all service definitions of a given svcdb are identical.
3612 (attempt a transfer without it first, to move all possible svcpart-matching
3613 services)
3614
3615 Any services that can't be moved remain in the original package.
3616
3617 Returns an error, if there is one; otherwise, returns the number of services
3618 that couldn't be moved.
3619
3620 =cut
3621
3622 sub transfer {
3623   my ($self, $dest_pkgnum, %opt) = @_;
3624
3625   my $remaining = 0;
3626   my $dest;
3627   my %target;
3628
3629   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
3630     $dest = $dest_pkgnum;
3631     $dest_pkgnum = $dest->pkgnum;
3632   } else {
3633     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
3634   }
3635
3636   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
3637
3638   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
3639     $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
3640   }
3641
3642   foreach my $cust_svc ($dest->cust_svc) {
3643     $target{$cust_svc->svcpart}--;
3644   }
3645
3646   my %svcpart2svcparts = ();
3647   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
3648     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
3649     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
3650       next if exists $svcpart2svcparts{$svcpart};
3651       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
3652       $svcpart2svcparts{$svcpart} = [
3653         map  { $_->[0] }
3654         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
3655         map {
3656               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
3657                                                    'svcpart' => $_          } );
3658               [ $_,
3659                 $pkg_svc ? $pkg_svc->primary_svc : '',
3660                 $pkg_svc ? $pkg_svc->quantity : 0,
3661               ];
3662             }
3663
3664         grep { $_ != $svcpart }
3665         map  { $_->svcpart }
3666         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
3667       ];
3668       warn "alternates for svcpart $svcpart: ".
3669            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
3670         if $DEBUG;
3671     }
3672   }
3673
3674   my $error;
3675   foreach my $cust_svc ($self->cust_svc) {
3676     my $svcnum = $cust_svc->svcnum;
3677     if($target{$cust_svc->svcpart} > 0
3678        or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
3679       $target{$cust_svc->svcpart}--;
3680       my $new = new FS::cust_svc { $cust_svc->hash };
3681       $new->pkgnum($dest_pkgnum);
3682       $error = $new->replace($cust_svc);
3683     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
3684       if ( $DEBUG ) {
3685         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
3686         warn "alternates to consider: ".
3687              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
3688       }
3689       my @alternate = grep {
3690                              warn "considering alternate svcpart $_: ".
3691                                   "$target{$_} available in new package\n"
3692                                if $DEBUG;
3693                              $target{$_} > 0;
3694                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
3695       if ( @alternate ) {
3696         warn "alternate(s) found\n" if $DEBUG;
3697         my $change_svcpart = $alternate[0];
3698         $target{$change_svcpart}--;
3699         my $new = new FS::cust_svc { $cust_svc->hash };
3700         $new->svcpart($change_svcpart);
3701         $new->pkgnum($dest_pkgnum);
3702         $error = $new->replace($cust_svc);
3703       } else {
3704         $remaining++;
3705       }
3706     } else {
3707       $remaining++
3708     }
3709     if ( $error ) {
3710       my @label = $cust_svc->label;
3711       return "$label[0] $label[1]: $error";
3712     }
3713   }
3714   return $remaining;
3715 }
3716
3717 =item grab_svcnums SVCNUM, SVCNUM ...
3718
3719 Change the pkgnum for the provided services to this packages.  If there is an
3720 error, returns the error, otherwise returns false.
3721
3722 =cut
3723
3724 sub grab_svcnums {
3725   my $self = shift;
3726   my @svcnum = @_;
3727
3728   my $oldAutoCommit = $FS::UID::AutoCommit;
3729   local $FS::UID::AutoCommit = 0;
3730   my $dbh = dbh;
3731
3732   foreach my $svcnum (@svcnum) {
3733     my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do {
3734       $dbh->rollback if $oldAutoCommit;
3735       return "unknown svcnum $svcnum";
3736     };
3737     $cust_svc->pkgnum( $self->pkgnum );
3738     my $error = $cust_svc->replace;
3739     if ( $error ) {
3740       $dbh->rollback if $oldAutoCommit;
3741       return $error;
3742     }
3743   }
3744
3745   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3746   '';
3747
3748 }
3749
3750 =item reexport
3751
3752 This method is deprecated.  See the I<depend_jobnum> option to the insert and
3753 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
3754
3755 =cut
3756
3757 #looks like this is still used by the order_pkg and change_pkg methods in
3758 # ClientAPI/MyAccount, need to look into those before removing
3759 sub reexport {
3760   my $self = shift;
3761
3762   my $oldAutoCommit = $FS::UID::AutoCommit;
3763   local $FS::UID::AutoCommit = 0;
3764   my $dbh = dbh;
3765
3766   foreach my $cust_svc ( $self->cust_svc ) {
3767     #false laziness w/svc_Common::insert
3768     my $svc_x = $cust_svc->svc_x;
3769     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
3770       my $error = $part_export->export_insert($svc_x);
3771       if ( $error ) {
3772         $dbh->rollback if $oldAutoCommit;
3773         return $error;
3774       }
3775     }
3776   }
3777
3778   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3779   '';
3780
3781 }
3782
3783 =item export_pkg_change OLD_CUST_PKG
3784
3785 Calls the "pkg_change" export action for all services attached to this package.
3786
3787 =cut
3788
3789 sub export_pkg_change {
3790   my( $self, $old )  = ( shift, shift );
3791
3792   my $oldAutoCommit = $FS::UID::AutoCommit;
3793   local $FS::UID::AutoCommit = 0;
3794   my $dbh = dbh;
3795
3796   foreach my $svc_x ( map $_->svc_x, $self->cust_svc ) {
3797     my $error = $svc_x->export('pkg_change', $self, $old);
3798     if ( $error ) {
3799       $dbh->rollback if $oldAutoCommit;
3800       return $error;
3801     }
3802   }
3803
3804   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3805   '';
3806
3807 }
3808
3809 =item insert_reason
3810
3811 Associates this package with a (suspension or cancellation) reason (see
3812 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
3813 L<FS::reason>).
3814
3815 Available options are:
3816
3817 =over 4
3818
3819 =item reason
3820
3821 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.
3822
3823 =item reason_otaker
3824
3825 the access_user (see L<FS::access_user>) providing the reason
3826
3827 =item date
3828
3829 a unix timestamp
3830
3831 =item action
3832
3833 the action (cancel, susp, adjourn, expire) associated with the reason
3834
3835 =back
3836
3837 If there is an error, returns the error, otherwise returns false.
3838
3839 =cut
3840
3841 sub insert_reason {
3842   my ($self, %options) = @_;
3843
3844   my $otaker = $options{reason_otaker} ||
3845                $FS::CurrentUser::CurrentUser->username;
3846
3847   my $reasonnum;
3848   if ( $options{'reason'} =~ /^(\d+)$/ ) {
3849
3850     $reasonnum = $1;
3851
3852   } elsif ( ref($options{'reason'}) ) {
3853
3854     return 'Enter a new reason (or select an existing one)'
3855       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
3856
3857     my $reason = new FS::reason({
3858       'reason_type' => $options{'reason'}->{'typenum'},
3859       'reason'      => $options{'reason'}->{'reason'},
3860     });
3861     my $error = $reason->insert;
3862     return $error if $error;
3863
3864     $reasonnum = $reason->reasonnum;
3865
3866   } else {
3867     return "Unparsable reason: ". $options{'reason'};
3868   }
3869
3870   my $cust_pkg_reason =
3871     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
3872                               'reasonnum' => $reasonnum,
3873                               'otaker'    => $otaker,
3874                               'action'    => substr(uc($options{'action'}),0,1),
3875                               'date'      => $options{'date'}
3876                                                ? $options{'date'}
3877                                                : time,
3878                             });
3879
3880   $cust_pkg_reason->insert;
3881 }
3882
3883 =item insert_discount
3884
3885 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
3886 inserting a new discount on the fly (see L<FS::discount>).
3887
3888 Available options are:
3889
3890 =over 4
3891
3892 =item discountnum
3893
3894 =back
3895
3896 If there is an error, returns the error, otherwise returns false.
3897
3898 =cut
3899
3900 sub insert_discount {
3901   #my ($self, %options) = @_;
3902   my $self = shift;
3903
3904   my $cust_pkg_discount = new FS::cust_pkg_discount {
3905     'pkgnum'      => $self->pkgnum,
3906     'discountnum' => $self->discountnum,
3907     'months_used' => 0,
3908     'end_date'    => '', #XXX
3909     #for the create a new discount case
3910     '_type'       => $self->discountnum__type,
3911     'amount'      => $self->discountnum_amount,
3912     'percent'     => $self->discountnum_percent,
3913     'months'      => $self->discountnum_months,
3914     'setup'      => $self->discountnum_setup,
3915     #'disabled'    => $self->discountnum_disabled,
3916   };
3917
3918   $cust_pkg_discount->insert;
3919 }
3920
3921 =item set_usage USAGE_VALUE_HASHREF
3922
3923 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3924 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
3925 upbytes, downbytes, and totalbytes are appropriate keys.
3926
3927 All svc_accts which are part of this package have their values reset.
3928
3929 =cut
3930
3931 sub set_usage {
3932   my ($self, $valueref, %opt) = @_;
3933
3934   #only svc_acct can set_usage for now
3935   foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
3936     my $svc_x = $cust_svc->svc_x;
3937     $svc_x->set_usage($valueref, %opt)
3938       if $svc_x->can("set_usage");
3939   }
3940 }
3941
3942 =item recharge USAGE_VALUE_HASHREF
3943
3944 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3945 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
3946 upbytes, downbytes, and totalbytes are appropriate keys.
3947
3948 All svc_accts which are part of this package have their values incremented.
3949
3950 =cut
3951
3952 sub recharge {
3953   my ($self, $valueref) = @_;
3954
3955   #only svc_acct can set_usage for now
3956   foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
3957     my $svc_x = $cust_svc->svc_x;
3958     $svc_x->recharge($valueref)
3959       if $svc_x->can("recharge");
3960   }
3961 }
3962
3963 =item apply_usageprice
3964
3965 =cut
3966
3967 sub apply_usageprice {
3968   my $self = shift;
3969
3970   my $oldAutoCommit = $FS::UID::AutoCommit;
3971   local $FS::UID::AutoCommit = 0;
3972   my $dbh = dbh;
3973
3974   my $error = '';
3975
3976   foreach my $cust_pkg_usageprice ( $self->cust_pkg_usageprice ) {
3977     $error ||= $cust_pkg_usageprice->apply;
3978   }
3979
3980   if ( $error ) {
3981     $dbh->rollback if $oldAutoCommit;
3982     die "error applying part_pkg_usageprice add-ons, pkgnum ". $self->pkgnum.
3983         ": $error\n";
3984   } else {
3985     $dbh->commit if $oldAutoCommit;
3986   }
3987
3988
3989 }
3990
3991 =item cust_pkg_discount
3992
3993 =item cust_pkg_discount_active
3994
3995 =cut
3996
3997 sub cust_pkg_discount_active {
3998   my $self = shift;
3999   grep { $_->status eq 'active' } $self->cust_pkg_discount;
4000 }
4001
4002 =item cust_pkg_usage
4003
4004 Returns a list of all voice usage counters attached to this package.
4005
4006 =item apply_usage OPTIONS
4007
4008 Takes the following options:
4009 - cdr: a call detail record (L<FS::cdr>)
4010 - rate_detail: the rate determined for this call (L<FS::rate_detail>)
4011 - minutes: the maximum number of minutes to be charged
4012
4013 Finds available usage minutes for a call of this class, and subtracts
4014 up to that many minutes from the usage pool.  If the usage pool is empty,
4015 and the C<cdr-minutes_priority> global config option is set, minutes may
4016 be taken from other calls as well.  Either way, an allocation record will
4017 be created (L<FS::cdr_cust_pkg_usage>) and this method will return the
4018 number of minutes of usage applied to the call.
4019
4020 =cut
4021
4022 sub apply_usage {
4023   my ($self, %opt) = @_;
4024   my $cdr = $opt{cdr};
4025   my $rate_detail = $opt{rate_detail};
4026   my $minutes = $opt{minutes};
4027   my $classnum = $rate_detail->classnum;
4028   my $pkgnum = $self->pkgnum;
4029   my $custnum = $self->custnum;
4030
4031   my $oldAutoCommit = $FS::UID::AutoCommit;
4032   local $FS::UID::AutoCommit = 0;
4033   my $dbh = dbh;
4034
4035   my $order = FS::Conf->new->config('cdr-minutes_priority');
4036
4037   my $is_classnum;
4038   if ( $classnum ) {
4039     $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum;
4040   } else {
4041     $is_classnum = ' part_pkg_usage_class.classnum IS NULL';
4042   }
4043   my @usage_recs = qsearch({
4044       'table'     => 'cust_pkg_usage',
4045       'addl_from' => ' JOIN part_pkg_usage       USING (pkgusagepart)'.
4046                      ' JOIN cust_pkg             USING (pkgnum)'.
4047                      ' JOIN part_pkg_usage_class USING (pkgusagepart)',
4048       'select'    => 'cust_pkg_usage.*',
4049       'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ".
4050                      " ( cust_pkg.custnum = $custnum AND ".
4051                      " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4052                      $is_classnum . ' AND '.
4053                      " cust_pkg_usage.minutes > 0",
4054       'order_by'  => " ORDER BY priority ASC",
4055   });
4056
4057   my $orig_minutes = $minutes;
4058   my $error;
4059   while (!$error and $minutes > 0 and @usage_recs) {
4060     my $cust_pkg_usage = shift @usage_recs;
4061     $cust_pkg_usage->select_for_update;
4062     my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({
4063         pkgusagenum => $cust_pkg_usage->pkgusagenum,
4064         acctid      => $cdr->acctid,
4065         minutes     => min($cust_pkg_usage->minutes, $minutes),
4066     });
4067     $cust_pkg_usage->set('minutes',
4068       $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes
4069     );
4070     $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert;
4071     $minutes -= $cdr_cust_pkg_usage->minutes;
4072   }
4073   if ( $order and $minutes > 0 and !$error ) {
4074     # then try to steal minutes from another call
4075     my %search = (
4076         'table'     => 'cdr_cust_pkg_usage',
4077         'addl_from' => ' JOIN cust_pkg_usage        USING (pkgusagenum)'.
4078                        ' JOIN part_pkg_usage        USING (pkgusagepart)'.
4079                        ' JOIN cust_pkg              USING (pkgnum)'.
4080                        ' JOIN part_pkg_usage_class  USING (pkgusagepart)'.
4081                        ' JOIN cdr                   USING (acctid)',
4082         'select'    => 'cdr_cust_pkg_usage.*',
4083         'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ".
4084                        " ( cust_pkg.pkgnum = $pkgnum OR ".
4085                        " ( cust_pkg.custnum = $custnum AND ".
4086                        " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4087                        " part_pkg_usage_class.classnum = $classnum",
4088         'order_by'  => ' ORDER BY part_pkg_usage.priority ASC',
4089     );
4090     if ( $order eq 'time' ) {
4091       # find CDRs that are using minutes, but have a later startdate
4092       # than this call
4093       my $startdate = $cdr->startdate;
4094       if ($startdate !~ /^\d+$/) {
4095         die "bad cdr startdate '$startdate'";
4096       }
4097       $search{'extra_sql'} .= " AND cdr.startdate > $startdate";
4098       # minimize needless reshuffling
4099       $search{'order_by'} .= ', cdr.startdate DESC';
4100     } else {
4101       # XXX may not work correctly with rate_time schedules.  Could
4102       # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I
4103       # think...
4104       $search{'addl_from'} .=
4105         ' JOIN rate_detail'.
4106         ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)';
4107       if ( $order eq 'rate_high' ) {
4108         $search{'extra_sql'} .= ' AND rate_detail.min_charge < '.
4109                                 $rate_detail->min_charge;
4110         $search{'order_by'} .= ', rate_detail.min_charge ASC';
4111       } elsif ( $order eq 'rate_low' ) {
4112         $search{'extra_sql'} .= ' AND rate_detail.min_charge > '.
4113                                 $rate_detail->min_charge;
4114         $search{'order_by'} .= ', rate_detail.min_charge DESC';
4115       } else {
4116         #  this should really never happen
4117         die "invalid cdr-minutes_priority value '$order'\n";
4118       }
4119     }
4120     my @cdr_usage_recs = qsearch(\%search);
4121     my %reproc_cdrs;
4122     while (!$error and @cdr_usage_recs and $minutes > 0) {
4123       my $cdr_cust_pkg_usage = shift @cdr_usage_recs;
4124       my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage;
4125       my $old_cdr = $cdr_cust_pkg_usage->cdr;
4126       $reproc_cdrs{$old_cdr->acctid} = $old_cdr;
4127       $cdr_cust_pkg_usage->select_for_update;
4128       $old_cdr->select_for_update;
4129       $cust_pkg_usage->select_for_update;
4130       # in case someone else stole the usage from this CDR
4131       # while waiting for the lock...
4132       next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid;
4133       # steal the usage allocation and flag the old CDR for reprocessing
4134       $cdr_cust_pkg_usage->set('acctid', $cdr->acctid);
4135       # if the allocation is more minutes than we need, adjust it...
4136       my $delta = $cdr_cust_pkg_usage->minutes - $minutes;
4137       if ( $delta > 0 ) {
4138         $cdr_cust_pkg_usage->set('minutes', $minutes);
4139         $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta);
4140         $error = $cust_pkg_usage->replace;
4141       }
4142       #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n";
4143       $error ||= $cdr_cust_pkg_usage->replace;
4144       # deduct the stolen minutes
4145       $minutes -= $cdr_cust_pkg_usage->minutes;
4146     }
4147     # after all minute-stealing is done, reset the affected CDRs
4148     foreach (values %reproc_cdrs) {
4149       $error ||= $_->set_status('');
4150       # XXX or should we just call $cdr->rate right here?
4151       # it's not like we can create a loop this way, since the min_charge
4152       # or call time has to go monotonically in one direction.
4153       # we COULD get some very deep recursions going, though...
4154     }
4155   } # if $order and $minutes
4156   if ( $error ) {
4157     $dbh->rollback;
4158     die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n"
4159   } else {
4160     $dbh->commit if $oldAutoCommit;
4161     return $orig_minutes - $minutes;
4162   }
4163 }
4164
4165 =item supplemental_pkgs
4166
4167 Returns a list of all packages supplemental to this one.
4168
4169 =cut
4170
4171 sub supplemental_pkgs {
4172   my $self = shift;
4173   qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
4174 }
4175
4176 =item main_pkg
4177
4178 Returns the package that this one is supplemental to, if any.
4179
4180 =cut
4181
4182 sub main_pkg {
4183   my $self = shift;
4184   if ( $self->main_pkgnum ) {
4185     return FS::cust_pkg->by_key($self->main_pkgnum);
4186   }
4187   return;
4188 }
4189
4190 =back
4191
4192 =head1 CLASS METHODS
4193
4194 =over 4
4195
4196 =item recurring_sql
4197
4198 Returns an SQL expression identifying recurring packages.
4199
4200 =cut
4201
4202 sub recurring_sql { "
4203   '0' != ( select freq from part_pkg
4204              where cust_pkg.pkgpart = part_pkg.pkgpart )
4205 "; }
4206
4207 =item onetime_sql
4208
4209 Returns an SQL expression identifying one-time packages.
4210
4211 =cut
4212
4213 sub onetime_sql { "
4214   '0' = ( select freq from part_pkg
4215             where cust_pkg.pkgpart = part_pkg.pkgpart )
4216 "; }
4217
4218 =item ordered_sql
4219
4220 Returns an SQL expression identifying ordered packages (recurring packages not
4221 yet billed).
4222
4223 =cut
4224
4225 sub ordered_sql {
4226    $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
4227 }
4228
4229 =item active_sql
4230
4231 Returns an SQL expression identifying active packages.
4232
4233 =cut
4234
4235 sub active_sql {
4236   $_[0]->recurring_sql. "
4237   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4238   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4239   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
4240 "; }
4241
4242 =item not_yet_billed_sql
4243
4244 Returns an SQL expression identifying packages which have not yet been billed.
4245
4246 =cut
4247
4248 sub not_yet_billed_sql { "
4249       ( cust_pkg.setup  IS NULL OR cust_pkg.setup  = 0 )
4250   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4251   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
4252 "; }
4253
4254 =item inactive_sql
4255
4256 Returns an SQL expression identifying inactive packages (one-time packages
4257 that are otherwise unsuspended/uncancelled).
4258
4259 =cut
4260
4261 sub inactive_sql { "
4262   ". $_[0]->onetime_sql(). "
4263   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4264   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4265   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
4266 "; }
4267
4268 =item on_hold_sql
4269
4270 Returns an SQL expression identifying on-hold packages.
4271
4272 =cut
4273
4274 sub on_hold_sql {
4275   #$_[0]->recurring_sql(). ' AND '.
4276   "
4277         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel  = 0 )
4278     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp   != 0
4279     AND ( cust_pkg.setup  IS     NULL  OR cust_pkg.setup   = 0 )
4280   ";
4281 }
4282
4283 =item susp_sql
4284 =item suspended_sql
4285
4286 Returns an SQL expression identifying suspended packages.
4287
4288 =cut
4289
4290 sub suspended_sql { susp_sql(@_); }
4291 sub susp_sql {
4292   #$_[0]->recurring_sql(). ' AND '.
4293   "
4294         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
4295     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
4296     AND   cust_pkg.setup  IS NOT NULL AND cust_pkg.setup != 0
4297   ";
4298 }
4299
4300 =item cancel_sql
4301 =item cancelled_sql
4302
4303 Returns an SQL exprression identifying cancelled packages.
4304
4305 =cut
4306
4307 sub cancelled_sql { cancel_sql(@_); }
4308 sub cancel_sql {
4309   #$_[0]->recurring_sql(). ' AND '.
4310   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
4311 }
4312
4313 =item status_sql
4314
4315 Returns an SQL expression to give the package status as a string.
4316
4317 =cut
4318
4319 sub status_sql {
4320 "CASE
4321   WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
4322   WHEN ( cust_pkg.susp IS NOT NULL AND cust_pkg.setup IS NULL ) THEN 'on hold'
4323   WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
4324   WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
4325   WHEN ".onetime_sql()." THEN 'one-time charge'
4326   ELSE 'active'
4327 END"
4328 }
4329
4330 =item fcc_477_count
4331
4332 Returns a list of two package counts.  The first is a count of packages
4333 based on the supplied criteria and the second is the count of residential
4334 packages with those same criteria.  Criteria are specified as in the search
4335 method.
4336
4337 =cut
4338
4339 sub fcc_477_count {
4340   my ($class, $params) = @_;
4341
4342   my $sql_query = $class->search( $params );
4343
4344   my $count_sql = delete($sql_query->{'count_query'});
4345   $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
4346     or die "couldn't parse count_sql";
4347
4348   my $count_sth = dbh->prepare($count_sql)
4349     or die "Error preparing $count_sql: ". dbh->errstr;
4350   $count_sth->execute
4351     or die "Error executing $count_sql: ". $count_sth->errstr;
4352   my $count_arrayref = $count_sth->fetchrow_arrayref;
4353
4354   return ( @$count_arrayref );
4355
4356 }
4357
4358 =item tax_locationnum_sql
4359
4360 Returns an SQL expression for the tax location for a package, based
4361 on the settings of 'tax-pkg_address' and 'tax-ship_address'.
4362
4363 =cut
4364
4365 sub tax_locationnum_sql {
4366   my $conf = FS::Conf->new;
4367   if ( $conf->exists('tax-pkg_address') ) {
4368     'cust_pkg.locationnum';
4369   }
4370   elsif ( $conf->exists('tax-ship_address') ) {
4371     'cust_main.ship_locationnum';
4372   }
4373   else {
4374     'cust_main.bill_locationnum';
4375   }
4376 }
4377
4378 =item location_sql
4379
4380 Returns a list: the first item is an SQL fragment identifying matching
4381 packages/customers via location (taking into account shipping and package
4382 address taxation, if enabled), and subsequent items are the parameters to
4383 substitute for the placeholders in that fragment.
4384
4385 =cut
4386
4387 sub location_sql {
4388   my($class, %opt) = @_;
4389   my $ornull = $opt{'ornull'};
4390
4391   my $conf = new FS::Conf;
4392
4393   # '?' placeholders in _location_sql_where
4394   my $x = $ornull ? 3 : 2;
4395   my @bill_param = (
4396     ('district')x3,
4397     ('city')x3,
4398     ('county')x$x,
4399     ('state')x$x,
4400     'country'
4401   );
4402
4403   my $main_where;
4404   my @main_param;
4405   if ( $conf->exists('tax-ship_address') ) {
4406
4407     $main_where = "(
4408          (     ( ship_last IS NULL     OR  ship_last  = '' )
4409            AND ". _location_sql_where('cust_main', '', $ornull ). "
4410          )
4411       OR (       ship_last IS NOT NULL AND ship_last != ''
4412            AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
4413          )
4414     )";
4415     #    AND payby != 'COMP'
4416
4417     @main_param = ( @bill_param, @bill_param );
4418
4419   } else {
4420
4421     $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
4422     @main_param = @bill_param;
4423
4424   }
4425
4426   my $where;
4427   my @param;
4428   if ( $conf->exists('tax-pkg_address') ) {
4429
4430     my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
4431
4432     $where = " (
4433                     ( cust_pkg.locationnum IS     NULL AND $main_where )
4434                  OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where  )
4435                )
4436              ";
4437     @param = ( @main_param, @bill_param );
4438
4439   } else {
4440
4441     $where = $main_where;
4442     @param = @main_param;
4443
4444   }
4445
4446   ( $where, @param );
4447
4448 }
4449
4450 #subroutine, helper for location_sql
4451 sub _location_sql_where {
4452   my $table  = shift;
4453   my $prefix = @_ ? shift : '';
4454   my $ornull = @_ ? shift : '';
4455
4456 #  $ornull             = $ornull          ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
4457
4458   $ornull = $ornull ? ' OR ? IS NULL ' : '';
4459
4460   my $or_empty_city     = " OR ( ? = '' AND $table.${prefix}city     IS NULL )";
4461   my $or_empty_county   = " OR ( ? = '' AND $table.${prefix}county   IS NULL )";
4462   my $or_empty_state    = " OR ( ? = '' AND $table.${prefix}state    IS NULL )";
4463
4464   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
4465
4466 #        ( $table.${prefix}city    = ? $or_empty_city   $ornull )
4467   "
4468         ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL )
4469     AND ( $table.${prefix}city     = ? OR ? = '' OR CAST(? AS $text) IS NULL )
4470     AND ( $table.${prefix}county   = ? $or_empty_county $ornull )
4471     AND ( $table.${prefix}state    = ? $or_empty_state  $ornull )
4472     AND   $table.${prefix}country  = ?
4473   ";
4474 }
4475
4476 sub _X_show_zero {
4477   my( $self, $what ) = @_;
4478
4479   my $what_show_zero = $what. '_show_zero';
4480   length($self->$what_show_zero())
4481     ? ($self->$what_show_zero() eq 'Y')
4482     : $self->part_pkg->$what_show_zero();
4483 }
4484
4485 =head1 SUBROUTINES
4486
4487 =over 4
4488
4489 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
4490
4491 CUSTNUM is a customer (see L<FS::cust_main>)
4492
4493 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
4494 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
4495 permitted.
4496
4497 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
4498 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
4499 new billing items.  An error is returned if this is not possible (see
4500 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
4501 parameter.
4502
4503 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
4504 newly-created cust_pkg objects.
4505
4506 REFNUM, if specified, will specify the FS::pkg_referral record to be created
4507 and inserted.  Multiple FS::pkg_referral records can be created by
4508 setting I<refnum> to an array reference of refnums or a hash reference with
4509 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
4510 record will be created corresponding to cust_main.refnum.
4511
4512 =cut
4513
4514 sub order {
4515   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
4516
4517   my $conf = new FS::Conf;
4518
4519   # Transactionize this whole mess
4520   my $oldAutoCommit = $FS::UID::AutoCommit;
4521   local $FS::UID::AutoCommit = 0;
4522   my $dbh = dbh;
4523
4524   my $error;
4525 #  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
4526 #  return "Customer not found: $custnum" unless $cust_main;
4527
4528   warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
4529     if $DEBUG;
4530
4531   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
4532                          @$remove_pkgnum;
4533
4534   my $change = scalar(@old_cust_pkg) != 0;
4535
4536   my %hash = ();
4537   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
4538
4539     warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
4540          " to pkgpart ". $pkgparts->[0]. "\n"
4541       if $DEBUG;
4542
4543     my $err_or_cust_pkg =
4544       $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
4545                                 'refnum'  => $refnum,
4546                               );
4547
4548     unless (ref($err_or_cust_pkg)) {
4549       $dbh->rollback if $oldAutoCommit;
4550       return $err_or_cust_pkg;
4551     }
4552
4553     push @$return_cust_pkg, $err_or_cust_pkg;
4554     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4555     return '';
4556
4557   }
4558
4559   # Create the new packages.
4560   foreach my $pkgpart (@$pkgparts) {
4561
4562     warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
4563
4564     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
4565                                       pkgpart => $pkgpart,
4566                                       refnum  => $refnum,
4567                                       %hash,
4568                                     };
4569     $error = $cust_pkg->insert( 'change' => $change );
4570     push @$return_cust_pkg, $cust_pkg;
4571
4572     foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) {
4573       my $supp_pkg = FS::cust_pkg->new({
4574           custnum => $custnum,
4575           pkgpart => $link->dst_pkgpart,
4576           refnum  => $refnum,
4577           main_pkgnum => $cust_pkg->pkgnum,
4578           %hash,
4579       });
4580       $error ||= $supp_pkg->insert( 'change' => $change );
4581       push @$return_cust_pkg, $supp_pkg;
4582     }
4583
4584     if ($error) {
4585       $dbh->rollback if $oldAutoCommit;
4586       return $error;
4587     }
4588
4589   }
4590   # $return_cust_pkg now contains refs to all of the newly
4591   # created packages.
4592
4593   # Transfer services and cancel old packages.
4594   foreach my $old_pkg (@old_cust_pkg) {
4595
4596     warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
4597       if $DEBUG;
4598
4599     foreach my $new_pkg (@$return_cust_pkg) {
4600       $error = $old_pkg->transfer($new_pkg);
4601       if ($error and $error == 0) {
4602         # $old_pkg->transfer failed.
4603         $dbh->rollback if $oldAutoCommit;
4604         return $error;
4605       }
4606     }
4607
4608     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
4609       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
4610       foreach my $new_pkg (@$return_cust_pkg) {
4611         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
4612         if ($error and $error == 0) {
4613           # $old_pkg->transfer failed.
4614         $dbh->rollback if $oldAutoCommit;
4615         return $error;
4616         }
4617       }
4618     }
4619
4620     if ($error > 0) {
4621       # Transfers were successful, but we went through all of the
4622       # new packages and still had services left on the old package.
4623       # We can't cancel the package under the circumstances, so abort.
4624       $dbh->rollback if $oldAutoCommit;
4625       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
4626     }
4627     $error = $old_pkg->cancel( quiet=>1 );
4628     if ($error) {
4629       $dbh->rollback;
4630       return $error;
4631     }
4632   }
4633   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4634   '';
4635 }
4636
4637 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
4638
4639 A bulk change method to change packages for multiple customers.
4640
4641 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
4642 L<FS::part_pkg>) to order for each customer.  Duplicates are of course
4643 permitted.
4644
4645 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
4646 replace.  The services (see L<FS::cust_svc>) are moved to the
4647 new billing items.  An error is returned if this is not possible (see
4648 L<FS::pkg_svc>).
4649
4650 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
4651 newly-created cust_pkg objects.
4652
4653 =cut
4654
4655 sub bulk_change {
4656   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
4657
4658   # Transactionize this whole mess
4659   my $oldAutoCommit = $FS::UID::AutoCommit;
4660   local $FS::UID::AutoCommit = 0;
4661   my $dbh = dbh;
4662
4663   my @errors;
4664   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
4665                          @$remove_pkgnum;
4666
4667   while(scalar(@old_cust_pkg)) {
4668     my @return = ();
4669     my $custnum = $old_cust_pkg[0]->custnum;
4670     my (@remove) = map { $_->pkgnum }
4671                    grep { $_->custnum == $custnum } @old_cust_pkg;
4672     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
4673
4674     my $error = order $custnum, $pkgparts, \@remove, \@return;
4675
4676     push @errors, $error
4677       if $error;
4678     push @$return_cust_pkg, @return;
4679   }
4680
4681   if (scalar(@errors)) {
4682     $dbh->rollback if $oldAutoCommit;
4683     return join(' / ', @errors);
4684   }
4685
4686   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4687   '';
4688 }
4689
4690 # Used by FS::Upgrade to migrate to a new database.
4691 sub _upgrade_data {  # class method
4692   my ($class, %opts) = @_;
4693   $class->_upgrade_otaker(%opts);
4694   my @statements = (
4695     # RT#10139, bug resulting in contract_end being set when it shouldn't
4696   'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
4697     # RT#10830, bad calculation of prorate date near end of year
4698     # the date range for bill is December 2009, and we move it forward
4699     # one year if it's before the previous bill date (which it should
4700     # never be)
4701   'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
4702   AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
4703   WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
4704     # RT6628, add order_date to cust_pkg
4705     'update cust_pkg set order_date = (select history_date from h_cust_pkg
4706         where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
4707         history_action = \'insert\') where order_date is null',
4708   );
4709   foreach my $sql (@statements) {
4710     my $sth = dbh->prepare($sql);
4711     $sth->execute or die $sth->errstr;
4712   }
4713 }
4714
4715 =back
4716
4717 =head1 BUGS
4718
4719 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
4720
4721 In sub order, the @pkgparts array (passed by reference) is clobbered.
4722
4723 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
4724 method to pass dates to the recur_prog expression, it should do so.
4725
4726 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
4727 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
4728 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
4729 configuration values.  Probably need a subroutine which decides what to do
4730 based on whether or not we've fetched the user yet, rather than a hash.  See
4731 FS::UID and the TODO.
4732
4733 Now that things are transactional should the check in the insert method be
4734 moved to check ?
4735
4736 =head1 SEE ALSO
4737
4738 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
4739 L<FS::pkg_svc>, schema.html from the base documentation
4740
4741 =cut
4742
4743 1;
4744