FS/FS/cust_pkg.pm

   1 package FS::cust_pkg;
   2
   3 use strict;
   4 use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
   5              FS::m2m_Common FS::option_Common );
   6 use vars qw($disable_agentcheck $DEBUG $me);
   7 use Carp qw(cluck);
   8 use Scalar::Util qw( blessed );
   9 use List::Util qw(max);
  10 use Tie::IxHash;
  11 use Time::Local qw( timelocal_nocheck );
  12 use MIME::Entity;
  13 use FS::UID qw( getotaker dbh );
  14 use FS::Misc qw( send_email );
  15 use FS::Record qw( qsearch qsearchs );
  16 use FS::CurrentUser;
  17 use FS::cust_svc;
  18 use FS::part_pkg;
  19 use FS::cust_main;
  20 use FS::cust_location;
  21 use FS::pkg_svc;
  22 use FS::cust_bill_pkg;
  23 use FS::cust_pkg_detail;
  24 use FS::cust_event;
  25 use FS::h_cust_svc;
  26 use FS::reg_code;
  27 use FS::part_svc;
  28 use FS::cust_pkg_reason;
  29 use FS::reason;
  30 use FS::cust_pkg_discount;
  31 use FS::discount;
  32 use FS::UI::Web;
  33
  34 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
  35 # setup }
  36 # because they load configuration by setting FS::UID::callback (see TODO)
  37 use FS::svc_acct;
  38 use FS::svc_domain;
  39 use FS::svc_www;
  40 use FS::svc_forward;
  41
  42 # for sending cancel emails in sub cancel
  43 use FS::Conf;
  44
  45 $DEBUG = 0;
  46 $me = '[FS::cust_pkg]';
  47
  48 $disable_agentcheck = 0;
  49
  50 sub _cache {
  51   my $self = shift;
  52   my ( $hashref, $cache ) = @_;
  53   #if ( $hashref->{'pkgpart'} ) {
  54   if ( $hashref->{'pkg'} ) {
  55     # #@{ $self->{'_pkgnum'} } = ();
  56     # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
  57     # $self->{'_pkgpart'} = $subcache;
  58     # #push @{ $self->{'_pkgnum'} },
  59     #   FS::part_pkg->new_or_cached($hashref, $subcache);
  60     $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
  61   }
  62   if ( exists $hashref->{'svcnum'} ) {
  63     #@{ $self->{'_pkgnum'} } = ();
  64     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
  65     $self->{'_svcnum'} = $subcache;
  66     #push @{ $self->{'_pkgnum'} },
  67     FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
  68   }
  69 }
  70
  71 =head1 NAME
  72
  73 FS::cust_pkg - Object methods for cust_pkg objects
  74
  75 =head1 SYNOPSIS
  76
  77   use FS::cust_pkg;
  78
  79   $record = new FS::cust_pkg \%hash;
  80   $record = new FS::cust_pkg { 'column' => 'value' };
  81
  82   $error = $record->insert;
  83
  84   $error = $new_record->replace($old_record);
  85
  86   $error = $record->delete;
  87
  88   $error = $record->check;
  89
  90   $error = $record->cancel;
  91
  92   $error = $record->suspend;
  93
  94   $error = $record->unsuspend;
  95
  96   $part_pkg = $record->part_pkg;
  97
  98   @labels = $record->labels;
  99
 100   $seconds = $record->seconds_since($timestamp);
 101
 102   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
 103   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
 104
 105 =head1 DESCRIPTION
 106
 107 An FS::cust_pkg object represents a customer billing item.  FS::cust_pkg
 108 inherits from FS::Record.  The following fields are currently supported:
 109
 110 =over 4
 111
 112 =item pkgnum
 113
 114 Primary key (assigned automatically for new billing items)
 115
 116 =item custnum
 117
 118 Customer (see L<FS::cust_main>)
 119
 120 =item pkgpart
 121
 122 Billing item definition (see L<FS::part_pkg>)
 123
 124 =item locationnum
 125
 126 Optional link to package location (see L<FS::location>)
 127
 128 =item order_date
 129
 130 date package was ordered (also remains same on changes)
 131
 132 =item start_date
 133
 134 date
 135
 136 =item setup
 137
 138 date
 139
 140 =item bill
 141
 142 date (next bill date)
 143
 144 =item last_bill
 145
 146 last bill date
 147
 148 =item adjourn
 149
 150 date
 151
 152 =item susp
 153
 154 date
 155
 156 =item expire
 157
 158 date
 159
 160 =item contract_end
 161
 162 date
 163
 164 =item cancel
 165
 166 date
 167
 168 =item usernum
 169
 170 order taker (see L<FS::access_user>)
 171
 172 =item manual_flag
 173
 174 If this field is set to 1, disables the automatic
 175 unsuspension of this package when using the B<unsuspendauto> config option.
 176
 177 =item quantity
 178
 179 If not set, defaults to 1
 180
 181 =item change_date
 182
 183 Date of change from previous package
 184
 185 =item change_pkgnum
 186
 187 Previous pkgnum
 188
 189 =item change_pkgpart
 190
 191 Previous pkgpart
 192
 193 =item change_locationnum
 194
 195 Previous locationnum
 196
 197 =back
 198
 199 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
 200 are specified as UNIX timestamps; see L<perlfunc/"time">.  Also see
 201 L<Time::Local> and L<Date::Parse> for conversion functions.
 202
 203 =head1 METHODS
 204
 205 =over 4
 206
 207 =item new HASHREF
 208
 209 Create a new billing item.  To add the item to the database, see L<"insert">.
 210
 211 =cut
 212
 213 sub table { 'cust_pkg'; }
 214 sub cust_linked { $_[0]->cust_main_custnum; }
 215 sub cust_unlinked_msg {
 216   my $self = shift;
 217   "WARNING: can't find cust_main.custnum ". $self->custnum.
 218   ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
 219 }
 220
 221 =item insert [ OPTION => VALUE ... ]
 222
 223 Adds this billing item to the database ("Orders" the item).  If there is an
 224 error, returns the error, otherwise returns false.
 225
 226 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
 227 will be used to look up the package definition and agent restrictions will be
 228 ignored.
 229
 230 If the additional field I<refnum> is defined, an FS::pkg_referral record will
 231 be created and inserted.  Multiple FS::pkg_referral records can be created by
 232 setting I<refnum> to an array reference of refnums or a hash reference with
 233 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
 234 record will be created corresponding to cust_main.refnum.
 235
 236 The following options are available:
 237
 238 =over 4
 239
 240 =item change
 241
 242 If set true, supresses any referral credit to a referring customer.
 243
 244 =item options
 245
 246 cust_pkg_option records will be created
 247
 248 =item ticket_subject
 249
 250 a ticket will be added to this customer with this subject
 251
 252 =item ticket_queue
 253
 254 an optional queue name for ticket additions
 255
 256 =back
 257
 258 =cut
 259
 260 sub insert {
 261   my( $self, %options ) = @_;
 262
 263   my $error = $self->check_pkgpart;
 264   return $error if $error;
 265
 266   if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) {
 267     my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
 268     $mon += 1 unless $mday == 1;
 269     until ( $mon < 12 ) { $mon -= 12; $year++; }
 270     $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
 271   }
 272
 273   foreach my $action ( qw(expire adjourn contract_end) ) {
 274     my $months = $self->part_pkg->option("${action}_months",1);
 275     if($months and !$self->$action) {
 276       my $start = $self->start_date || $self->setup || time;
 277       $self->$action( $self->part_pkg->add_freq($start, $months) );
 278     }
 279   }
 280
 281   $self->order_date(time);
 282
 283   local $SIG{HUP} = 'IGNORE';
 284   local $SIG{INT} = 'IGNORE';
 285   local $SIG{QUIT} = 'IGNORE';
 286   local $SIG{TERM} = 'IGNORE';
 287   local $SIG{TSTP} = 'IGNORE';
 288   local $SIG{PIPE} = 'IGNORE';
 289
 290   my $oldAutoCommit = $FS::UID::AutoCommit;
 291   local $FS::UID::AutoCommit = 0;
 292   my $dbh = dbh;
 293
 294   $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
 295   if ( $error ) {
 296     $dbh->rollback if $oldAutoCommit;
 297     return $error;
 298   }
 299
 300   $self->refnum($self->cust_main->refnum) unless $self->refnum;
 301   $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
 302   $self->process_m2m( 'link_table'   => 'pkg_referral',
 303                       'target_table' => 'part_referral',
 304                       'params'       => $self->refnum,
 305                     );
 306
 307   if ( $self->discountnum ) {
 308     my $error = $self->insert_discount();
 309     if ( $error ) {
 310       $dbh->rollback if $oldAutoCommit;
 311       return $error;
 312     }
 313   }
 314
 315   #if ( $self->reg_code ) {
 316   #  my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
 317   #  $error = $reg_code->delete;
 318   #  if ( $error ) {
 319   #    $dbh->rollback if $oldAutoCommit;
 320   #    return $error;
 321   #  }
 322   #}
 323
 324   my $conf = new FS::Conf;
 325
 326   if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
 327
 328     #eval '
 329     #  use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
 330     #  use RT;
 331     #';
 332     #die $@ if $@;
 333     #
 334     #RT::LoadConfig();
 335     #RT::Init();
 336     use FS::TicketSystem;
 337     FS::TicketSystem->init();
 338
 339     my $q = new RT::Queue($RT::SystemUser);
 340     $q->Load($options{ticket_queue}) if $options{ticket_queue};
 341     my $t = new RT::Ticket($RT::SystemUser);
 342     my $mime = new MIME::Entity;
 343     $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
 344     $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
 345                 Subject => $options{ticket_subject},
 346                 MIMEObj => $mime,
 347               );
 348     $t->AddLink( Type   => 'MemberOf',
 349                  Target => 'freeside://freeside/cust_main/'. $self->custnum,
 350                );
 351   }
 352
 353   if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
 354     my $queue = new FS::queue {
 355       'job'     => 'FS::cust_main::queueable_print',
 356     };
 357     $error = $queue->insert(
 358       'custnum'  => $self->custnum,
 359       'template' => 'welcome_letter',
 360     );
 361
 362     if ($error) {
 363       warn "can't send welcome letter: $error";
 364     }
 365
 366   }
 367
 368   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 369   '';
 370
 371 }
 372
 373 =item delete
 374
 375 This method now works but you probably shouldn't use it.
 376
 377 You don't want to delete packages, because there would then be no record
 378 the customer ever purchased the package.  Instead, see the cancel method and
 379 hide cancelled packages.
 380
 381 =cut
 382
 383 sub delete {
 384   my $self = shift;
 385
 386   local $SIG{HUP} = 'IGNORE';
 387   local $SIG{INT} = 'IGNORE';
 388   local $SIG{QUIT} = 'IGNORE';
 389   local $SIG{TERM} = 'IGNORE';
 390   local $SIG{TSTP} = 'IGNORE';
 391   local $SIG{PIPE} = 'IGNORE';
 392
 393   my $oldAutoCommit = $FS::UID::AutoCommit;
 394   local $FS::UID::AutoCommit = 0;
 395   my $dbh = dbh;
 396
 397   foreach my $cust_pkg_discount ($self->cust_pkg_discount) {
 398     my $error = $cust_pkg_discount->delete;
 399     if ( $error ) {
 400       $dbh->rollback if $oldAutoCommit;
 401       return $error;
 402     }
 403   }
 404   #cust_bill_pkg_discount?
 405
 406   foreach my $cust_pkg_detail ($self->cust_pkg_detail) {
 407     my $error = $cust_pkg_detail->delete;
 408     if ( $error ) {
 409       $dbh->rollback if $oldAutoCommit;
 410       return $error;
 411     }
 412   }
 413
 414   foreach my $cust_pkg_reason (
 415     qsearchs( {
 416                 'table' => 'cust_pkg_reason',
 417                 'hashref' => { 'pkgnum' => $self->pkgnum },
 418               }
 419             )
 420   ) {
 421     my $error = $cust_pkg_reason->delete;
 422     if ( $error ) {
 423       $dbh->rollback if $oldAutoCommit;
 424       return $error;
 425     }
 426   }
 427
 428   #pkg_referral?
 429
 430   my $error = $self->SUPER::delete(@_);
 431   if ( $error ) {
 432     $dbh->rollback if $oldAutoCommit;
 433     return $error;
 434   }
 435
 436   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 437
 438   '';
 439
 440 }
 441
 442 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
 443
 444 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 445 returns the error, otherwise returns false.
 446
 447 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
 448
 449 Changing pkgpart may have disasterous effects.  See the order subroutine.
 450
 451 setup and bill are normally updated by calling the bill method of a customer
 452 object (see L<FS::cust_main>).
 453
 454 suspend is normally updated by the suspend and unsuspend methods.
 455
 456 cancel is normally updated by the cancel method (and also the order subroutine
 457 in some cases).
 458
 459 Available options are:
 460
 461 =over 4
 462
 463 =item reason
 464
 465 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.
 466
 467 =item reason_otaker
 468
 469 the access_user (see L<FS::access_user>) providing the reason
 470
 471 =item options
 472
 473 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
 474
 475 =back
 476
 477 =cut
 478
 479 sub replace {
 480   my $new = shift;
 481
 482   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 483               ? shift
 484               : $new->replace_old;
 485
 486   my $options =
 487     ( ref($_[0]) eq 'HASH' )
 488       ? shift
 489       : { @_ };
 490
 491   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
 492   #return "Can't change otaker!" if $old->otaker ne $new->otaker;
 493
 494   #allow this *sigh*
 495   #return "Can't change setup once it exists!"
 496   #  if $old->getfield('setup') &&
 497   #     $old->getfield('setup') != $new->getfield('setup');
 498
 499   #some logic for bill, susp, cancel?
 500
 501   local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
 502
 503   local $SIG{HUP} = 'IGNORE';
 504   local $SIG{INT} = 'IGNORE';
 505   local $SIG{QUIT} = 'IGNORE';
 506   local $SIG{TERM} = 'IGNORE';
 507   local $SIG{TSTP} = 'IGNORE';
 508   local $SIG{PIPE} = 'IGNORE';
 509
 510   my $oldAutoCommit = $FS::UID::AutoCommit;
 511   local $FS::UID::AutoCommit = 0;
 512   my $dbh = dbh;
 513
 514   foreach my $method ( qw(adjourn expire) ) {  # How many reasons?
 515     if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
 516       my $error = $new->insert_reason(
 517         'reason'        => $options->{'reason'},
 518         'date'          => $new->$method,
 519         'action'        => $method,
 520         'reason_otaker' => $options->{'reason_otaker'},
 521       );
 522       if ( $error ) {
 523         dbh->rollback if $oldAutoCommit;
 524         return "Error inserting cust_pkg_reason: $error";
 525       }
 526     }
 527   }
 528
 529   #save off and freeze RADIUS attributes for any associated svc_acct records
 530   my @svc_acct = ();
 531   if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
 532
 533                 #also check for specific exports?
 534                 # to avoid spurious modify export events
 535     @svc_acct = map  { $_->svc_x }
 536                 grep { $_->part_svc->svcdb eq 'svc_acct' }
 537                      $old->cust_svc;
 538
 539     $_->snapshot foreach @svc_acct;
 540
 541   }
 542
 543   my $error = $new->SUPER::replace($old,
 544                                    $options->{options} ? $options->{options} : ()
 545                                   );
 546   if ( $error ) {
 547     $dbh->rollback if $oldAutoCommit;
 548     return $error;
 549   }
 550
 551   #for prepaid packages,
 552   #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
 553   foreach my $old_svc_acct ( @svc_acct ) {
 554     my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
 555     my $s_error =
 556       $new_svc_acct->replace( $old_svc_acct,
 557                               'depend_jobnum' => $options->{depend_jobnum},
 558                             );
 559     if ( $s_error ) {
 560       $dbh->rollback if $oldAutoCommit;
 561       return $s_error;
 562     }
 563   }
 564
 565   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 566   '';
 567
 568 }
 569
 570 =item check
 571
 572 Checks all fields to make sure this is a valid billing item.  If there is an
 573 error, returns the error, otherwise returns false.  Called by the insert and
 574 replace methods.
 575
 576 =cut
 577
 578 sub check {
 579   my $self = shift;
 580
 581   $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
 582
 583   my $error =
 584     $self->ut_numbern('pkgnum')
 585     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
 586     || $self->ut_numbern('pkgpart')
 587     || $self->check_pkgpart
 588     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 589     || $self->ut_numbern('start_date')
 590     || $self->ut_numbern('setup')
 591     || $self->ut_numbern('bill')
 592     || $self->ut_numbern('susp')
 593     || $self->ut_numbern('cancel')
 594     || $self->ut_numbern('adjourn')
 595     || $self->ut_numbern('expire')
 596     || $self->ut_enum('no_auto', [ '', 'Y' ])
 597   ;
 598   return $error if $error;
 599
 600   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 601
 602   if ( $self->dbdef_table->column('manual_flag') ) {
 603     $self->manual_flag('') if $self->manual_flag eq ' ';
 604     $self->manual_flag =~ /^([01]?)$/
 605       or return "Illegal manual_flag ". $self->manual_flag;
 606     $self->manual_flag($1);
 607   }
 608
 609   $self->SUPER::check;
 610 }
 611
 612 =item check_pkgpart
 613
 614 =cut
 615
 616 sub check_pkgpart {
 617   my $self = shift;
 618
 619   my $error = $self->ut_numbern('pkgpart');
 620   return $error if $error;
 621
 622   if ( $self->reg_code ) {
 623
 624     unless ( grep { $self->pkgpart == $_->pkgpart }
 625              map  { $_->reg_code_pkg }
 626              qsearchs( 'reg_code', { 'code'     => $self->reg_code,
 627                                      'agentnum' => $self->cust_main->agentnum })
 628            ) {
 629       return "Unknown registration code";
 630     }
 631
 632   } elsif ( $self->promo_code ) {
 633
 634     my $promo_part_pkg =
 635       qsearchs('part_pkg', {
 636         'pkgpart'    => $self->pkgpart,
 637         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
 638       } );
 639     return 'Unknown promotional code' unless $promo_part_pkg;
 640
 641   } else {
 642
 643     unless ( $disable_agentcheck ) {
 644       my $agent =
 645         qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
 646       return "agent ". $agent->agentnum. ':'. $agent->agent.
 647              " can't purchase pkgpart ". $self->pkgpart
 648         unless $agent->pkgpart_hashref->{ $self->pkgpart }
 649             || $agent->agentnum == $self->part_pkg->agentnum;
 650     }
 651
 652     $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
 653     return $error if $error;
 654
 655   }
 656
 657   '';
 658
 659 }
 660
 661 =item cancel [ OPTION => VALUE ... ]
 662
 663 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 664 in this package, then cancels the package itself (sets the cancel field to
 665 now).
 666
 667 Available options are:
 668
 669 =over 4
 670
 671 =item quiet - can be set true to supress email cancellation notices.
 672
 673 =item time -  can be set to cancel the package based on a specific future or historical date.  Using time ensures that the remaining amount is calculated correctly.  Note however that this is an immediate cancel and just changes the date.  You are PROBABLY looking to expire the account instead of using this.
 674
 675 =item reason - 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.
 676
 677 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
 678
 679 =item nobill - can be set true to skip billing if it might otherwise be done.
 680
 681 =item unused_credit - can be set to 1 to credit the remaining time, or 0 to
 682 not credit it.  This must be set (by change()) when changing the package
 683 to a different pkgpart or location, and probably shouldn't be in any other
 684 case.  If it's not set, the 'unused_credit_cancel' part_pkg option will
 685 be used.
 686
 687 =back
 688
 689 If there is an error, returns the error, otherwise returns false.
 690
 691 =cut
 692
 693 sub cancel {
 694   my( $self, %options ) = @_;
 695   my $error;
 696
 697   my $conf = new FS::Conf;
 698
 699   warn "cust_pkg::cancel called with options".
 700        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 701     if $DEBUG;
 702
 703   local $SIG{HUP} = 'IGNORE';
 704   local $SIG{INT} = 'IGNORE';
 705   local $SIG{QUIT} = 'IGNORE';
 706   local $SIG{TERM} = 'IGNORE';
 707   local $SIG{TSTP} = 'IGNORE';
 708   local $SIG{PIPE} = 'IGNORE';
 709
 710   my $oldAutoCommit = $FS::UID::AutoCommit;
 711   local $FS::UID::AutoCommit = 0;
 712   my $dbh = dbh;
 713
 714   my $old = $self->select_for_update;
 715
 716   if ( $old->get('cancel') || $self->get('cancel') ) {
 717     dbh->rollback if $oldAutoCommit;
 718     return "";  # no error
 719   }
 720
 721   my $date = $options{date} if $options{date}; # expire/cancel later
 722   $date = '' if ($date && $date <= time);      # complain instead?
 723
 724   #race condition: usage could be ongoing until unprovisioned
 725   #resolved by performing a change package instead (which unprovisions) and
 726   #later cancelling
 727   if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
 728       my $copy = $self->new({$self->hash});
 729       my $error =
 730         $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
 731       warn "Error billing during cancel, custnum ".
 732         #$self->cust_main->custnum. ": $error"
 733         ": $error"
 734         if $error;
 735   }
 736
 737   my $cancel_time = $options{'time'} || time;
 738
 739   if ( $options{'reason'} ) {
 740     $error = $self->insert_reason( 'reason' => $options{'reason'},
 741                                    'action' => $date ? 'expire' : 'cancel',
 742                                    'date'   => $date ? $date : $cancel_time,
 743                                    'reason_otaker' => $options{'reason_otaker'},
 744                                  );
 745     if ( $error ) {
 746       dbh->rollback if $oldAutoCommit;
 747       return "Error inserting cust_pkg_reason: $error";
 748     }
 749   }
 750
 751   my %svc;
 752   unless ( $date ) {
 753
 754     foreach my $cust_svc (
 755       #schwartz
 756       map  { $_->[0] }
 757       sort { $a->[1] <=> $b->[1] }
 758       map  { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
 759       qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 760     ) {
 761       my $error = $cust_svc->cancel;
 762
 763       if ( $error ) {
 764         $dbh->rollback if $oldAutoCommit;
 765         return "Error cancelling cust_svc: $error";
 766       }
 767     }
 768
 769     # Add a credit for remaining service
 770     my $last_bill = $self->getfield('last_bill') || 0;
 771     my $next_bill = $self->getfield('bill') || 0;
 772     my $do_credit;
 773     if ( exists($options{'unused_credit'}) ) {
 774       $do_credit = $options{'unused_credit'};
 775     }
 776     else {
 777       $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
 778     }
 779     if ( $do_credit
 780           and $last_bill > 0 # the package has been billed
 781           and $next_bill > 0 # the package has a next bill date
 782           and $next_bill >= $cancel_time # which is in the future
 783     ) {
 784       my $remaining_value = $self->calc_remain('time' => $cancel_time);
 785       if ( $remaining_value > 0 ) {
 786         # && !$options{'no_credit'} ) {
 787         # Undocumented, unused option.
 788         # part_pkg configuration should decide this anyway.
 789         my $error = $self->cust_main->credit(
 790           $remaining_value,
 791           'Credit for unused time on '. $self->part_pkg->pkg,
 792           'reason_type' => $conf->config('cancel_credit_type'),
 793         );
 794         if ($error) {
 795           $dbh->rollback if $oldAutoCommit;
 796           return "Error crediting customer \$$remaining_value for unused time".
 797                  " on ".  $self->part_pkg->pkg. ": $error";
 798         }
 799       } #if $remaining_value
 800     } #if $do_credit
 801
 802   } #unless $date
 803
 804   my %hash = $self->hash;
 805   $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
 806   my $new = new FS::cust_pkg ( \%hash );
 807   $error = $new->replace( $self, options => { $self->options } );
 808   if ( $error ) {
 809     $dbh->rollback if $oldAutoCommit;
 810     return $error;
 811   }
 812
 813   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 814   return '' if $date; #no errors
 815
 816   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
 817   if ( !$options{'quiet'} &&
 818         $conf->exists('emailcancel', $self->cust_main->agentnum) &&
 819         @invoicing_list ) {
 820     my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
 821     my $error = '';
 822     if ( $msgnum ) {
 823       my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
 824       $error = $msg_template->send( 'cust_main' => $self->cust_main,
 825                                     'object'    => $self );
 826     }
 827     else {
 828       $error = send_email(
 829         'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
 830         'to'      => \@invoicing_list,
 831         'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
 832         'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
 833       );
 834     }
 835     #should this do something on errors?
 836   }
 837
 838   ''; #no errors
 839
 840 }
 841
 842 =item cancel_if_expired [ NOW_TIMESTAMP ]
 843
 844 Cancels this package if its expire date has been reached.
 845
 846 =cut
 847
 848 sub cancel_if_expired {
 849   my $self = shift;
 850   my $time = shift || time;
 851   return '' unless $self->expire && $self->expire <= $time;
 852   my $error = $self->cancel;
 853   if ( $error ) {
 854     return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
 855            $self->custnum. ": $error";
 856   }
 857   '';
 858 }
 859
 860 =item unexpire
 861
 862 Cancels any pending expiration (sets the expire field to null).
 863
 864 If there is an error, returns the error, otherwise returns false.
 865
 866 =cut
 867
 868 sub unexpire {
 869   my( $self, %options ) = @_;
 870   my $error;
 871
 872   local $SIG{HUP} = 'IGNORE';
 873   local $SIG{INT} = 'IGNORE';
 874   local $SIG{QUIT} = 'IGNORE';
 875   local $SIG{TERM} = 'IGNORE';
 876   local $SIG{TSTP} = 'IGNORE';
 877   local $SIG{PIPE} = 'IGNORE';
 878
 879   my $oldAutoCommit = $FS::UID::AutoCommit;
 880   local $FS::UID::AutoCommit = 0;
 881   my $dbh = dbh;
 882
 883   my $old = $self->select_for_update;
 884
 885   my $pkgnum = $old->pkgnum;
 886   if ( $old->get('cancel') || $self->get('cancel') ) {
 887     dbh->rollback if $oldAutoCommit;
 888     return "Can't unexpire cancelled package $pkgnum";
 889     # or at least it's pointless
 890   }
 891
 892   unless ( $old->get('expire') && $self->get('expire') ) {
 893     dbh->rollback if $oldAutoCommit;
 894     return "";  # no error
 895   }
 896
 897   my %hash = $self->hash;
 898   $hash{'expire'} = '';
 899   my $new = new FS::cust_pkg ( \%hash );
 900   $error = $new->replace( $self, options => { $self->options } );
 901   if ( $error ) {
 902     $dbh->rollback if $oldAutoCommit;
 903     return $error;
 904   }
 905
 906   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 907
 908   ''; #no errors
 909
 910 }
 911
 912 =item suspend [ OPTION => VALUE ... ]
 913
 914 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 915 package, then suspends the package itself (sets the susp field to now).
 916
 917 Available options are:
 918
 919 =over 4
 920
 921 =item reason - 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.
 922
 923 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
 924
 925 =back
 926
 927 If there is an error, returns the error, otherwise returns false.
 928
 929 =cut
 930
 931 sub suspend {
 932   my( $self, %options ) = @_;
 933   my $error;
 934
 935   local $SIG{HUP} = 'IGNORE';
 936   local $SIG{INT} = 'IGNORE';
 937   local $SIG{QUIT} = 'IGNORE';
 938   local $SIG{TERM} = 'IGNORE';
 939   local $SIG{TSTP} = 'IGNORE';
 940   local $SIG{PIPE} = 'IGNORE';
 941
 942   my $oldAutoCommit = $FS::UID::AutoCommit;
 943   local $FS::UID::AutoCommit = 0;
 944   my $dbh = dbh;
 945
 946   my $old = $self->select_for_update;
 947
 948   my $pkgnum = $old->pkgnum;
 949   if ( $old->get('cancel') || $self->get('cancel') ) {
 950     dbh->rollback if $oldAutoCommit;
 951     return "Can't suspend cancelled package $pkgnum";
 952   }
 953
 954   if ( $old->get('susp') || $self->get('susp') ) {
 955     dbh->rollback if $oldAutoCommit;
 956     return "";  # no error                     # complain on adjourn?
 957   }
 958
 959   my $date = $options{date} if $options{date}; # adjourn/suspend later
 960   $date = '' if ($date && $date <= time);      # complain instead?
 961
 962   if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
 963     dbh->rollback if $oldAutoCommit;
 964     return "Package $pkgnum expires before it would be suspended.";
 965   }
 966
 967   my $suspend_time = $options{'time'} || time;
 968
 969   if ( $options{'reason'} ) {
 970     $error = $self->insert_reason( 'reason' => $options{'reason'},
 971                                    'action' => $date ? 'adjourn' : 'suspend',
 972                                    'date'   => $date ? $date : $suspend_time,
 973                                    'reason_otaker' => $options{'reason_otaker'},
 974                                  );
 975     if ( $error ) {
 976       dbh->rollback if $oldAutoCommit;
 977       return "Error inserting cust_pkg_reason: $error";
 978     }
 979   }
 980
 981   unless ( $date ) {
 982
 983     my @labels = ();
 984
 985     foreach my $cust_svc (
 986       qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 987     ) {
 988       my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 989
 990       $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 991         $dbh->rollback if $oldAutoCommit;
 992         return "Illegal svcdb value in part_svc!";
 993       };
 994       my $svcdb = $1;
 995       require "FS/$svcdb.pm";
 996
 997       my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 998       if ($svc) {
 999         $error = $svc->suspend;
1000         if ( $error ) {
1001           $dbh->rollback if $oldAutoCommit;
1002           return $error;
1003         }
1004         my( $label, $value ) = $cust_svc->label;
1005         push @labels, "$label: $value";
1006       }
1007     }
1008
1009     my $conf = new FS::Conf;
1010     if ( $conf->config('suspend_email_admin') ) {
1011
1012       my $error = send_email(
1013         'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
1014                                    #invoice_from ??? well as good as any
1015         'to'      => $conf->config('suspend_email_admin'),
1016         'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
1017         'body'    => [
1018           "This is an automatic message from your Freeside installation\n",
1019           "informing you that the following customer package has been suspended:\n",
1020           "\n",
1021           'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1022           'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1023           ( map { "Service : $_\n" } @labels ),
1024         ],
1025       );
1026
1027       if ( $error ) {
1028         warn "WARNING: can't send suspension admin email (suspending anyway): ".
1029              "$error\n";
1030       }
1031
1032     }
1033
1034   }
1035
1036   my %hash = $self->hash;
1037   if ( $date ) {
1038     $hash{'adjourn'} = $date;
1039   } else {
1040     $hash{'susp'} = $suspend_time;
1041   }
1042   my $new = new FS::cust_pkg ( \%hash );
1043   $error = $new->replace( $self, options => { $self->options } );
1044   if ( $error ) {
1045     $dbh->rollback if $oldAutoCommit;
1046     return $error;
1047   }
1048
1049   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1050
1051   ''; #no errors
1052 }
1053
1054 =item unsuspend [ OPTION => VALUE ... ]
1055
1056 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1057 package, then unsuspends the package itself (clears the susp field and the
1058 adjourn field if it is in the past).
1059
1060 Available options are:
1061
1062 =over 4
1063
1064 =item adjust_next_bill
1065
1066 Can be set true to adjust the next bill date forward by
1067 the amount of time the account was inactive.  This was set true by default
1068 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
1069 explicitly requested.  Price plans for which this makes sense (anniversary-date
1070 based than prorate or subscription) could have an option to enable this
1071 behaviour?
1072
1073 =back
1074
1075 If there is an error, returns the error, otherwise returns false.
1076
1077 =cut
1078
1079 sub unsuspend {
1080   my( $self, %opt ) = @_;
1081   my $error;
1082
1083   local $SIG{HUP} = 'IGNORE';
1084   local $SIG{INT} = 'IGNORE';
1085   local $SIG{QUIT} = 'IGNORE';
1086   local $SIG{TERM} = 'IGNORE';
1087   local $SIG{TSTP} = 'IGNORE';
1088   local $SIG{PIPE} = 'IGNORE';
1089
1090   my $oldAutoCommit = $FS::UID::AutoCommit;
1091   local $FS::UID::AutoCommit = 0;
1092   my $dbh = dbh;
1093
1094   my $old = $self->select_for_update;
1095
1096   my $pkgnum = $old->pkgnum;
1097   if ( $old->get('cancel') || $self->get('cancel') ) {
1098     dbh->rollback if $oldAutoCommit;
1099     return "Can't unsuspend cancelled package $pkgnum";
1100   }
1101
1102   unless ( $old->get('susp') && $self->get('susp') ) {
1103     dbh->rollback if $oldAutoCommit;
1104     return "";  # no error                     # complain instead?
1105   }
1106
1107   foreach my $cust_svc (
1108     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1109   ) {
1110     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1111
1112     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1113       $dbh->rollback if $oldAutoCommit;
1114       return "Illegal svcdb value in part_svc!";
1115     };
1116     my $svcdb = $1;
1117     require "FS/$svcdb.pm";
1118
1119     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1120     if ($svc) {
1121       $error = $svc->unsuspend;
1122       if ( $error ) {
1123         $dbh->rollback if $oldAutoCommit;
1124         return $error;
1125       }
1126     }
1127
1128   }
1129
1130   my %hash = $self->hash;
1131   my $inactive = time - $hash{'susp'};
1132
1133   my $conf = new FS::Conf;
1134
1135   if ( $inactive > 0 &&
1136        ( $hash{'bill'} || $hash{'setup'} ) &&
1137        ( $opt{'adjust_next_bill'} ||
1138          $conf->exists('unsuspend-always_adjust_next_bill_date') ||
1139          $self->part_pkg->option('unsuspend_adjust_bill', 1) )
1140      ) {
1141
1142     $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1143
1144   }
1145
1146   $hash{'susp'} = '';
1147   $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1148   my $new = new FS::cust_pkg ( \%hash );
1149   $error = $new->replace( $self, options => { $self->options } );
1150   if ( $error ) {
1151     $dbh->rollback if $oldAutoCommit;
1152     return $error;
1153   }
1154
1155   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1156
1157   ''; #no errors
1158 }
1159
1160 =item unadjourn
1161
1162 Cancels any pending suspension (sets the adjourn field to null).
1163
1164 If there is an error, returns the error, otherwise returns false.
1165
1166 =cut
1167
1168 sub unadjourn {
1169   my( $self, %options ) = @_;
1170   my $error;
1171
1172   local $SIG{HUP} = 'IGNORE';
1173   local $SIG{INT} = 'IGNORE';
1174   local $SIG{QUIT} = 'IGNORE';
1175   local $SIG{TERM} = 'IGNORE';
1176   local $SIG{TSTP} = 'IGNORE';
1177   local $SIG{PIPE} = 'IGNORE';
1178
1179   my $oldAutoCommit = $FS::UID::AutoCommit;
1180   local $FS::UID::AutoCommit = 0;
1181   my $dbh = dbh;
1182
1183   my $old = $self->select_for_update;
1184
1185   my $pkgnum = $old->pkgnum;
1186   if ( $old->get('cancel') || $self->get('cancel') ) {
1187     dbh->rollback if $oldAutoCommit;
1188     return "Can't unadjourn cancelled package $pkgnum";
1189     # or at least it's pointless
1190   }
1191
1192   if ( $old->get('susp') || $self->get('susp') ) {
1193     dbh->rollback if $oldAutoCommit;
1194     return "Can't unadjourn suspended package $pkgnum";
1195     # perhaps this is arbitrary
1196   }
1197
1198   unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1199     dbh->rollback if $oldAutoCommit;
1200     return "";  # no error
1201   }
1202
1203   my %hash = $self->hash;
1204   $hash{'adjourn'} = '';
1205   my $new = new FS::cust_pkg ( \%hash );
1206   $error = $new->replace( $self, options => { $self->options } );
1207   if ( $error ) {
1208     $dbh->rollback if $oldAutoCommit;
1209     return $error;
1210   }
1211
1212   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1213
1214   ''; #no errors
1215
1216 }
1217
1218
1219 =item change HASHREF | OPTION => VALUE ...
1220
1221 Changes this package: cancels it and creates a new one, with a different
1222 pkgpart or locationnum or both.  All services are transferred to the new
1223 package (no change will be made if this is not possible).
1224
1225 Options may be passed as a list of key/value pairs or as a hash reference.
1226 Options are:
1227
1228 =over 4
1229
1230 =item locationnum
1231
1232 New locationnum, to change the location for this package.
1233
1234 =item cust_location
1235
1236 New FS::cust_location object, to create a new location and assign it
1237 to this package.
1238
1239 =item pkgpart
1240
1241 New pkgpart (see L<FS::part_pkg>).
1242
1243 =item refnum
1244
1245 New refnum (see L<FS::part_referral>).
1246
1247 =item keep_dates
1248
1249 Set to true to transfer billing dates (start_date, setup, last_bill, bill,
1250 susp, adjourn, cancel, expire, and contract_end) to the new package.
1251
1252 =back
1253
1254 At least one of locationnum, cust_location, pkgpart, refnum must be specified
1255 (otherwise, what's the point?)
1256
1257 Returns either the new FS::cust_pkg object or a scalar error.
1258
1259 For example:
1260
1261   my $err_or_new_cust_pkg = $old_cust_pkg->change
1262
1263 =cut
1264
1265 #some false laziness w/order
1266 sub change {
1267   my $self = shift;
1268   my $opt = ref($_[0]) ? shift : { @_ };
1269
1270 #  my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1271 #
1272
1273   my $conf = new FS::Conf;
1274
1275   # Transactionize this whole mess
1276   local $SIG{HUP} = 'IGNORE';
1277   local $SIG{INT} = 'IGNORE';
1278   local $SIG{QUIT} = 'IGNORE';
1279   local $SIG{TERM} = 'IGNORE';
1280   local $SIG{TSTP} = 'IGNORE';
1281   local $SIG{PIPE} = 'IGNORE';
1282
1283   my $oldAutoCommit = $FS::UID::AutoCommit;
1284   local $FS::UID::AutoCommit = 0;
1285   my $dbh = dbh;
1286
1287   my $error;
1288
1289   my %hash = ();
1290
1291   my $time = time;
1292
1293   #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1294
1295   #$hash{$_} = $self->$_() foreach qw( setup );
1296
1297   $hash{'setup'} = $time if $self->setup;
1298
1299   $hash{'change_date'} = $time;
1300   $hash{"change_$_"}  = $self->$_()
1301     foreach qw( pkgnum pkgpart locationnum );
1302
1303   if ( $opt->{'cust_location'} &&
1304        ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1305     $error = $opt->{'cust_location'}->insert;
1306     if ( $error ) {
1307       $dbh->rollback if $oldAutoCommit;
1308       return "inserting cust_location (transaction rolled back): $error";
1309     }
1310     $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1311   }
1312
1313   my $unused_credit = 0;
1314   if ( $opt->{'keep_dates'} ) {
1315     foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
1316                           start_date contract_end ) ) {
1317       $hash{$date} = $self->getfield($date);
1318     }
1319   }
1320   # Special case.  If the pkgpart is changing, and the customer is
1321   # going to be credited for remaining time, don't keep setup, bill,
1322   # or last_bill dates, and DO pass the flag to cancel() to credit
1323   # the customer.
1324   if ( $opt->{'pkgpart'}
1325       and $opt->{'pkgpart'} != $self->pkgpart
1326       and $self->part_pkg->option('unused_credit_change', 1) ) {
1327     $unused_credit = 1;
1328     $hash{$_} = '' foreach qw(setup bill last_bill);
1329   }
1330
1331   # Create the new package.
1332   my $cust_pkg = new FS::cust_pkg {
1333     custnum      => $self->custnum,
1334     pkgpart      => ( $opt->{'pkgpart'}     || $self->pkgpart      ),
1335     refnum       => ( $opt->{'refnum'}      || $self->refnum       ),
1336     locationnum  => ( $opt->{'locationnum'} || $self->locationnum  ),
1337     %hash,
1338   };
1339
1340   $error = $cust_pkg->insert( 'change' => 1 );
1341   if ($error) {
1342     $dbh->rollback if $oldAutoCommit;
1343     return $error;
1344   }
1345
1346   # Transfer services and cancel old package.
1347
1348   $error = $self->transfer($cust_pkg);
1349   if ($error and $error == 0) {
1350     # $old_pkg->transfer failed.
1351     $dbh->rollback if $oldAutoCommit;
1352     return $error;
1353   }
1354
1355   if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1356     warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1357     $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1358     if ($error and $error == 0) {
1359       # $old_pkg->transfer failed.
1360       $dbh->rollback if $oldAutoCommit;
1361       return $error;
1362     }
1363   }
1364
1365   if ($error > 0) {
1366     # Transfers were successful, but we still had services left on the old
1367     # package.  We can't change the package under this circumstances, so abort.
1368     $dbh->rollback if $oldAutoCommit;
1369     return "Unable to transfer all services from package ". $self->pkgnum;
1370   }
1371
1372   #reset usage if changing pkgpart
1373   # AND usage rollover is off (otherwise adds twice, now and at package bill)
1374   if ($self->pkgpart != $cust_pkg->pkgpart) {
1375     my $part_pkg = $cust_pkg->part_pkg;
1376     $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1377                                                  ? ()
1378                                                  : ( 'null' => 1 )
1379                                    )
1380       if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
1381
1382     if ($error) {
1383       $dbh->rollback if $oldAutoCommit;
1384       return "Error setting usage values: $error";
1385     }
1386   }
1387
1388   #Good to go, cancel old package.  Notify 'cancel' of whether to credit
1389   #remaining time.
1390   $error = $self->cancel( quiet=>1, unused_credit => $unused_credit );
1391   if ($error) {
1392     $dbh->rollback if $oldAutoCommit;
1393     return $error;
1394   }
1395
1396   if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1397     #$self->cust_main
1398     my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1399     if ( $error ) {
1400       $dbh->rollback if $oldAutoCommit;
1401       return $error;
1402     }
1403   }
1404
1405   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1406
1407   $cust_pkg;
1408
1409 }
1410
1411 use Data::Dumper;
1412 use Storable 'thaw';
1413 use MIME::Base64;
1414 sub process_bulk_cust_pkg {
1415   my $job = shift;
1416   my $param = thaw(decode_base64(shift));
1417   warn Dumper($param) if $DEBUG;
1418
1419   my $old_part_pkg = qsearchs('part_pkg',
1420                               { pkgpart => $param->{'old_pkgpart'} });
1421   my $new_part_pkg = qsearchs('part_pkg',
1422                               { pkgpart => $param->{'new_pkgpart'} });
1423   die "Must select a new package type\n" unless $new_part_pkg;
1424   #my $keep_dates = $param->{'keep_dates'} || 0;
1425   my $keep_dates = 1; # there is no good reason to turn this off
1426
1427   local $SIG{HUP} = 'IGNORE';
1428   local $SIG{INT} = 'IGNORE';
1429   local $SIG{QUIT} = 'IGNORE';
1430   local $SIG{TERM} = 'IGNORE';
1431   local $SIG{TSTP} = 'IGNORE';
1432   local $SIG{PIPE} = 'IGNORE';
1433
1434   my $oldAutoCommit = $FS::UID::AutoCommit;
1435   local $FS::UID::AutoCommit = 0;
1436   my $dbh = dbh;
1437
1438   my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
1439
1440   my $i = 0;
1441   foreach my $old_cust_pkg ( @cust_pkgs ) {
1442     $i++;
1443     $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
1444     if ( $old_cust_pkg->getfield('cancel') ) {
1445       warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
1446         $old_cust_pkg->pkgnum."\n"
1447         if $DEBUG;
1448       next;
1449     }
1450     warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
1451       if $DEBUG;
1452     my $error = $old_cust_pkg->change(
1453       'pkgpart'     => $param->{'new_pkgpart'},
1454       'keep_dates'  => $keep_dates
1455     );
1456     if ( !ref($error) ) { # change returns the cust_pkg on success
1457       $dbh->rollback;
1458       die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
1459     }
1460   }
1461   $dbh->commit if $oldAutoCommit;
1462   return;
1463 }
1464
1465 =item last_bill
1466
1467 Returns the last bill date, or if there is no last bill date, the setup date.
1468 Useful for billing metered services.
1469
1470 =cut
1471
1472 sub last_bill {
1473   my $self = shift;
1474   return $self->setfield('last_bill', $_[0]) if @_;
1475   return $self->getfield('last_bill') if $self->getfield('last_bill');
1476   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1477                                                   'edate'  => $self->bill,  } );
1478   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1479 }
1480
1481 =item last_cust_pkg_reason ACTION
1482
1483 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1484 Returns false if there is no reason or the package is not currenly ACTION'd
1485 ACTION is one of adjourn, susp, cancel, or expire.
1486
1487 =cut
1488
1489 sub last_cust_pkg_reason {
1490   my ( $self, $action ) = ( shift, shift );
1491   my $date = $self->get($action);
1492   qsearchs( {
1493               'table' => 'cust_pkg_reason',
1494               'hashref' => { 'pkgnum' => $self->pkgnum,
1495                              'action' => substr(uc($action), 0, 1),
1496                              'date'   => $date,
1497                            },
1498               'order_by' => 'ORDER BY num DESC LIMIT 1',
1499            } );
1500 }
1501
1502 =item last_reason ACTION
1503
1504 Returns the most recent ACTION FS::reason associated with the package.
1505 Returns false if there is no reason or the package is not currenly ACTION'd
1506 ACTION is one of adjourn, susp, cancel, or expire.
1507
1508 =cut
1509
1510 sub last_reason {
1511   my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1512   $cust_pkg_reason->reason
1513     if $cust_pkg_reason;
1514 }
1515
1516 =item part_pkg
1517
1518 Returns the definition for this billing item, as an FS::part_pkg object (see
1519 L<FS::part_pkg>).
1520
1521 =cut
1522
1523 sub part_pkg {
1524   my $self = shift;
1525   return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1526   cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1527   qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1528 }
1529
1530 =item old_cust_pkg
1531
1532 Returns the cancelled package this package was changed from, if any.
1533
1534 =cut
1535
1536 sub old_cust_pkg {
1537   my $self = shift;
1538   return '' unless $self->change_pkgnum;
1539   qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1540 }
1541
1542 =item calc_setup
1543
1544 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1545 item.
1546
1547 =cut
1548
1549 sub calc_setup {
1550   my $self = shift;
1551   $self->part_pkg->calc_setup($self, @_);
1552 }
1553
1554 =item calc_recur
1555
1556 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1557 item.
1558
1559 =cut
1560
1561 sub calc_recur {
1562   my $self = shift;
1563   $self->part_pkg->calc_recur($self, @_);
1564 }
1565
1566 =item base_recur
1567
1568 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
1569 item.
1570
1571 =cut
1572
1573 sub base_recur {
1574   my $self = shift;
1575   $self->part_pkg->base_recur($self, @_);
1576 }
1577
1578 =item calc_remain
1579
1580 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1581 billing item.
1582
1583 =cut
1584
1585 sub calc_remain {
1586   my $self = shift;
1587   $self->part_pkg->calc_remain($self, @_);
1588 }
1589
1590 =item calc_cancel
1591
1592 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1593 billing item.
1594
1595 =cut
1596
1597 sub calc_cancel {
1598   my $self = shift;
1599   $self->part_pkg->calc_cancel($self, @_);
1600 }
1601
1602 =item cust_bill_pkg
1603
1604 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1605
1606 =cut
1607
1608 sub cust_bill_pkg {
1609   my $self = shift;
1610   qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1611 }
1612
1613 =item cust_pkg_detail [ DETAILTYPE ]
1614
1615 Returns any customer package details for this package (see
1616 L<FS::cust_pkg_detail>).
1617
1618 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1619
1620 =cut
1621
1622 sub cust_pkg_detail {
1623   my $self = shift;
1624   my %hash = ( 'pkgnum' => $self->pkgnum );
1625   $hash{detailtype} = shift if @_;
1626   qsearch({
1627     'table'    => 'cust_pkg_detail',
1628     'hashref'  => \%hash,
1629     'order_by' => 'ORDER BY weight, pkgdetailnum',
1630   });
1631 }
1632
1633 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1634
1635 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1636
1637 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1638
1639 If there is an error, returns the error, otherwise returns false.
1640
1641 =cut
1642
1643 sub set_cust_pkg_detail {
1644   my( $self, $detailtype, @details ) = @_;
1645
1646   local $SIG{HUP} = 'IGNORE';
1647   local $SIG{INT} = 'IGNORE';
1648   local $SIG{QUIT} = 'IGNORE';
1649   local $SIG{TERM} = 'IGNORE';
1650   local $SIG{TSTP} = 'IGNORE';
1651   local $SIG{PIPE} = 'IGNORE';
1652
1653   my $oldAutoCommit = $FS::UID::AutoCommit;
1654   local $FS::UID::AutoCommit = 0;
1655   my $dbh = dbh;
1656
1657   foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1658     my $error = $current->delete;
1659     if ( $error ) {
1660       $dbh->rollback if $oldAutoCommit;
1661       return "error removing old detail: $error";
1662     }
1663   }
1664
1665   foreach my $detail ( @details ) {
1666     my $cust_pkg_detail = new FS::cust_pkg_detail {
1667       'pkgnum'     => $self->pkgnum,
1668       'detailtype' => $detailtype,
1669       'detail'     => $detail,
1670     };
1671     my $error = $cust_pkg_detail->insert;
1672     if ( $error ) {
1673       $dbh->rollback if $oldAutoCommit;
1674       return "error adding new detail: $error";
1675     }
1676
1677   }
1678
1679   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1680   '';
1681
1682 }
1683
1684 =item cust_event
1685
1686 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1687
1688 =cut
1689
1690 #false laziness w/cust_bill.pm
1691 sub cust_event {
1692   my $self = shift;
1693   qsearch({
1694     'table'     => 'cust_event',
1695     'addl_from' => 'JOIN part_event USING ( eventpart )',
1696     'hashref'   => { 'tablenum' => $self->pkgnum },
1697     'extra_sql' => " AND eventtable = 'cust_pkg' ",
1698   });
1699 }
1700
1701 =item num_cust_event
1702
1703 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1704
1705 =cut
1706
1707 #false laziness w/cust_bill.pm
1708 sub num_cust_event {
1709   my $self = shift;
1710   my $sql =
1711     "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1712     "  WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1713   my $sth = dbh->prepare($sql) or die  dbh->errstr. " preparing $sql";
1714   $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1715   $sth->fetchrow_arrayref->[0];
1716 }
1717
1718 =item cust_svc [ SVCPART ]
1719
1720 Returns the services for this package, as FS::cust_svc objects (see
1721 L<FS::cust_svc>).  If a svcpart is specified, return only the matching
1722 services.
1723
1724 =cut
1725
1726 sub cust_svc {
1727   my $self = shift;
1728
1729   return () unless $self->num_cust_svc(@_);
1730
1731   if ( @_ ) {
1732     return qsearch( 'cust_svc', { 'pkgnum'  => $self->pkgnum,
1733                                   'svcpart' => shift,          } );
1734   }
1735
1736   cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1737
1738   #if ( $self->{'_svcnum'} ) {
1739   #  values %{ $self->{'_svcnum'}->cache };
1740   #} else {
1741     $self->_sort_cust_svc(
1742       [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1743     );
1744   #}
1745
1746 }
1747
1748 =item overlimit [ SVCPART ]
1749
1750 Returns the services for this package which have exceeded their
1751 usage limit as FS::cust_svc objects (see L<FS::cust_svc>).  If a svcpart
1752 is specified, return only the matching services.
1753
1754 =cut
1755
1756 sub overlimit {
1757   my $self = shift;
1758   return () unless $self->num_cust_svc(@_);
1759   grep { $_->overlimit } $self->cust_svc(@_);
1760 }
1761
1762 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
1763
1764 Returns historical services for this package created before END TIMESTAMP and
1765 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1766 (see L<FS::h_cust_svc>).  If MODE is 'I' (for 'invoice'), services with the
1767 I<pkg_svc.hidden> flag will be omitted.
1768
1769 =cut
1770
1771 sub h_cust_svc {
1772   my $self = shift;
1773   my ($end, $start, $mode) = @_;
1774   my @cust_svc = $self->_sort_cust_svc(
1775     [ qsearch( 'h_cust_svc',
1776       { 'pkgnum' => $self->pkgnum, },
1777       FS::h_cust_svc->sql_h_search(@_),
1778     ) ]
1779   );
1780   if ( $mode eq 'I' ) {
1781     my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
1782     return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
1783   }
1784   else {
1785     return @cust_svc;
1786   }
1787 }
1788
1789 sub _sort_cust_svc {
1790   my( $self, $arrayref ) = @_;
1791
1792   my $sort =
1793     sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] };
1794
1795   map  { $_->[0] }
1796   sort $sort
1797   map {
1798         my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1799                                              'svcpart' => $_->svcpart     } );
1800         [ $_,
1801           $pkg_svc ? $pkg_svc->primary_svc : '',
1802           $pkg_svc ? $pkg_svc->quantity : 0,
1803         ];
1804       }
1805   @$arrayref;
1806
1807 }
1808
1809 =item num_cust_svc [ SVCPART ]
1810
1811 Returns the number of provisioned services for this package.  If a svcpart is
1812 specified, counts only the matching services.
1813
1814 =cut
1815
1816 sub num_cust_svc {
1817   my $self = shift;
1818
1819   return $self->{'_num_cust_svc'}
1820     if !scalar(@_)
1821        && exists($self->{'_num_cust_svc'})
1822        && $self->{'_num_cust_svc'} =~ /\d/;
1823
1824   cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1825     if $DEBUG > 2;
1826
1827   my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1828   $sql .= ' AND svcpart = ?' if @_;
1829
1830   my $sth = dbh->prepare($sql)     or die  dbh->errstr;
1831   $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1832   $sth->fetchrow_arrayref->[0];
1833 }
1834
1835 =item available_part_svc
1836
1837 Returns a list of FS::part_svc objects representing services included in this
1838 package but not yet provisioned.  Each FS::part_svc object also has an extra
1839 field, I<num_avail>, which specifies the number of available services.
1840
1841 =cut
1842
1843 sub available_part_svc {
1844   my $self = shift;
1845   grep { $_->num_avail > 0 }
1846     map {
1847           my $part_svc = $_->part_svc;
1848           $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1849             $_->quantity - $self->num_cust_svc($_->svcpart);
1850
1851           # more evil encapsulation breakage
1852           if($part_svc->{'Hash'}{'num_avail'} > 0) {
1853             my @exports = $part_svc->part_export_did;
1854             $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
1855           }
1856
1857           $part_svc;
1858         }
1859       $self->part_pkg->pkg_svc;
1860 }
1861
1862 =item part_svc
1863
1864 Returns a list of FS::part_svc objects representing provisioned and available
1865 services included in this package.  Each FS::part_svc object also has the
1866 following extra fields:
1867
1868 =over 4
1869
1870 =item num_cust_svc  (count)
1871
1872 =item num_avail     (quantity - count)
1873
1874 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1875
1876 svcnum
1877 label -> ($cust_svc->label)[1]
1878
1879 =back
1880
1881 =cut
1882
1883 sub part_svc {
1884   my $self = shift;
1885
1886   #XXX some sort of sort order besides numeric by svcpart...
1887   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1888     my $pkg_svc = $_;
1889     my $part_svc = $pkg_svc->part_svc;
1890     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1891     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1892     $part_svc->{'Hash'}{'num_avail'}    =
1893       max( 0, $pkg_svc->quantity - $num_cust_svc );
1894     $part_svc->{'Hash'}{'cust_pkg_svc'} =
1895       $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1896     $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
1897     $part_svc;
1898   } $self->part_pkg->pkg_svc;
1899
1900   #extras
1901   push @part_svc, map {
1902     my $part_svc = $_;
1903     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1904     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1905     $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
1906     $part_svc->{'Hash'}{'cust_pkg_svc'} =
1907       $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1908     $part_svc;
1909   } $self->extra_part_svc;
1910
1911   @part_svc;
1912
1913 }
1914
1915 =item extra_part_svc
1916
1917 Returns a list of FS::part_svc objects corresponding to services in this
1918 package which are still provisioned but not (any longer) available in the
1919 package definition.
1920
1921 =cut
1922
1923 sub extra_part_svc {
1924   my $self = shift;
1925
1926   my $pkgnum  = $self->pkgnum;
1927   my $pkgpart = $self->pkgpart;
1928
1929 #  qsearch( {
1930 #    'table'     => 'part_svc',
1931 #    'hashref'   => {},
1932 #    'extra_sql' =>
1933 #      "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1934 #                     WHERE pkg_svc.svcpart = part_svc.svcpart
1935 #                       AND pkg_svc.pkgpart = ?
1936 #                       AND quantity > 0
1937 #                 )
1938 #        AND 0 < ( SELECT COUNT(*) FROM cust_svc
1939 #                       LEFT JOIN cust_pkg USING ( pkgnum )
1940 #                     WHERE cust_svc.svcpart = part_svc.svcpart
1941 #                       AND pkgnum = ?
1942 #                 )",
1943 #    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1944 #  } );
1945
1946 #seems to benchmark slightly faster...
1947   qsearch( {
1948     #'select'      => 'DISTINCT ON (svcpart) part_svc.*',
1949     #MySQL doesn't grok DISINCT ON
1950     'select'      => 'DISTINCT part_svc.*',
1951     'table'       => 'part_svc',
1952     'addl_from'   =>
1953       'LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart
1954                                AND pkg_svc.pkgpart   = ?
1955                                AND quantity > 0
1956                              )
1957        LEFT JOIN cust_svc ON (     cust_svc.svcpart = part_svc.svcpart )
1958        LEFT JOIN cust_pkg USING ( pkgnum )
1959       ',
1960     'hashref'     => {},
1961     'extra_sql'   => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1962     'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1963   } );
1964 }
1965
1966 =item status
1967
1968 Returns a short status string for this package, currently:
1969
1970 =over 4
1971
1972 =item not yet billed
1973
1974 =item one-time charge
1975
1976 =item active
1977
1978 =item suspended
1979
1980 =item cancelled
1981
1982 =back
1983
1984 =cut
1985
1986 sub status {
1987   my $self = shift;
1988
1989   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1990
1991   return 'cancelled' if $self->get('cancel');
1992   return 'suspended' if $self->susp;
1993   return 'not yet billed' unless $self->setup;
1994   return 'one-time charge' if $freq =~ /^(0|$)/;
1995   return 'active';
1996 }
1997
1998 =item ucfirst_status
1999
2000 Returns the status with the first character capitalized.
2001
2002 =cut
2003
2004 sub ucfirst_status {
2005   ucfirst(shift->status);
2006 }
2007
2008 =item statuses
2009
2010 Class method that returns the list of possible status strings for packages
2011 (see L<the status method|/status>).  For example:
2012
2013   @statuses = FS::cust_pkg->statuses();
2014
2015 =cut
2016
2017 tie my %statuscolor, 'Tie::IxHash',
2018   'not yet billed'  => '009999', #teal? cyan?
2019   'one-time charge' => '000000',
2020   'active'          => '00CC00',
2021   'suspended'       => 'FF9900',
2022   'cancelled'       => 'FF0000',
2023 ;
2024
2025 sub statuses {
2026   my $self = shift; #could be class...
2027   #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
2028   #                                    # mayble split btw one-time vs. recur
2029     keys %statuscolor;
2030 }
2031
2032 =item statuscolor
2033
2034 Returns a hex triplet color string for this package's status.
2035
2036 =cut
2037
2038 sub statuscolor {
2039   my $self = shift;
2040   $statuscolor{$self->status};
2041 }
2042
2043 =item pkg_label
2044
2045 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
2046 "pkg-comment" depending on user preference).
2047
2048 =cut
2049
2050 sub pkg_label {
2051   my $self = shift;
2052   my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
2053   $label = $self->pkgnum. ": $label"
2054     if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
2055   $label;
2056 }
2057
2058 =item pkg_label_long
2059
2060 Returns a long label for this package, adding the primary service's label to
2061 pkg_label.
2062
2063 =cut
2064
2065 sub pkg_label_long {
2066   my $self = shift;
2067   my $label = $self->pkg_label;
2068   my $cust_svc = $self->primary_cust_svc;
2069   $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
2070   $label;
2071 }
2072
2073 =item primary_cust_svc
2074
2075 Returns a primary service (as FS::cust_svc object) if one can be identified.
2076
2077 =cut
2078
2079 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
2080
2081 sub primary_cust_svc {
2082   my $self = shift;
2083
2084   my @cust_svc = $self->cust_svc;
2085
2086   return '' unless @cust_svc; #no serivces - irrelevant then
2087
2088   return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
2089
2090   # primary service as specified in the package definition
2091   # or exactly one service definition with quantity one
2092   my $svcpart = $self->part_pkg->svcpart;
2093   @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
2094   return $cust_svc[0] if scalar(@cust_svc) == 1;
2095
2096   #couldn't identify one thing..
2097   return '';
2098 }
2099
2100 =item labels
2101
2102 Returns a list of lists, calling the label method for all services
2103 (see L<FS::cust_svc>) of this billing item.
2104
2105 =cut
2106
2107 sub labels {
2108   my $self = shift;
2109   map { [ $_->label ] } $self->cust_svc;
2110 }
2111
2112 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2113
2114 Like the labels method, but returns historical information on services that
2115 were active as of END_TIMESTAMP and (optionally) not cancelled before
2116 START_TIMESTAMP.  If MODE is 'I' (for 'invoice'), services with the
2117 I<pkg_svc.hidden> flag will be omitted.
2118
2119 Returns a list of lists, calling the label method for all (historical) services
2120 (see L<FS::h_cust_svc>) of this billing item.
2121
2122 =cut
2123
2124 sub h_labels {
2125   my $self = shift;
2126   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
2127 }
2128
2129 =item labels_short
2130
2131 Like labels, except returns a simple flat list, and shortens long
2132 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2133 identical services to one line that lists the service label and the number of
2134 individual services rather than individual items.
2135
2136 =cut
2137
2138 sub labels_short {
2139   shift->_labels_short( 'labels', @_ );
2140 }
2141
2142 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
2143
2144 Like h_labels, except returns a simple flat list, and shortens long
2145 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2146 identical services to one line that lists the service label and the number of
2147 individual services rather than individual items.
2148
2149 =cut
2150
2151 sub h_labels_short {
2152   shift->_labels_short( 'h_labels', @_ );
2153 }
2154
2155 sub _labels_short {
2156   my( $self, $method ) = ( shift, shift );
2157
2158   my $conf = new FS::Conf;
2159   my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
2160
2161   my %labels;
2162   #tie %labels, 'Tie::IxHash';
2163   push @{ $labels{$_->[0]} }, $_->[1]
2164     foreach $self->$method(@_);
2165   my @labels;
2166   foreach my $label ( keys %labels ) {
2167     my %seen = ();
2168     my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
2169     my $num = scalar(@values);
2170     if ( $num > $max_same_services ) {
2171       push @labels, "$label ($num)";
2172     } else {
2173       if ( $conf->exists('cust_bill-consolidate_services') ) {
2174         # push @labels, "$label: ". join(', ', @values);
2175         while ( @values ) {
2176           my $detail = "$label: ";
2177           $detail .= shift(@values). ', '
2178             while @values && length($detail.$values[0]) < 78;
2179           $detail =~ s/, $//;
2180           push @labels, $detail;
2181         }
2182       } else {
2183         push @labels, map { "$label: $_" } @values;
2184       }
2185     }
2186   }
2187
2188  @labels;
2189
2190 }
2191
2192 =item cust_main
2193
2194 Returns the parent customer object (see L<FS::cust_main>).
2195
2196 =cut
2197
2198 sub cust_main {
2199   my $self = shift;
2200   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
2201 }
2202
2203 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
2204
2205 =item cust_location
2206
2207 Returns the location object, if any (see L<FS::cust_location>).
2208
2209 =item cust_location_or_main
2210
2211 If this package is associated with a location, returns the locaiton (see
2212 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2213
2214 =item location_label [ OPTION => VALUE ... ]
2215
2216 Returns the label of the location object (see L<FS::cust_location>).
2217
2218 =cut
2219
2220 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2221
2222 =item seconds_since TIMESTAMP
2223
2224 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2225 package have been online since TIMESTAMP, according to the session monitor.
2226
2227 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
2228 L<Time::Local> and L<Date::Parse> for conversion functions.
2229
2230 =cut
2231
2232 sub seconds_since {
2233   my($self, $since) = @_;
2234   my $seconds = 0;
2235
2236   foreach my $cust_svc (
2237     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2238   ) {
2239     $seconds += $cust_svc->seconds_since($since);
2240   }
2241
2242   $seconds;
2243
2244 }
2245
2246 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2247
2248 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2249 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2250 (exclusive).
2251
2252 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2253 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
2254 functions.
2255
2256
2257 =cut
2258
2259 sub seconds_since_sqlradacct {
2260   my($self, $start, $end) = @_;
2261
2262   my $seconds = 0;
2263
2264   foreach my $cust_svc (
2265     grep {
2266       my $part_svc = $_->part_svc;
2267       $part_svc->svcdb eq 'svc_acct'
2268         && scalar($part_svc->part_export('sqlradius'));
2269     } $self->cust_svc
2270   ) {
2271     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2272   }
2273
2274   $seconds;
2275
2276 }
2277
2278 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2279
2280 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2281 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2282 TIMESTAMP_END
2283 (exclusive).
2284
2285 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2286 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
2287 functions.
2288
2289 =cut
2290
2291 sub attribute_since_sqlradacct {
2292   my($self, $start, $end, $attrib) = @_;
2293
2294   my $sum = 0;
2295
2296   foreach my $cust_svc (
2297     grep {
2298       my $part_svc = $_->part_svc;
2299       $part_svc->svcdb eq 'svc_acct'
2300         && scalar($part_svc->part_export('sqlradius'));
2301     } $self->cust_svc
2302   ) {
2303     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2304   }
2305
2306   $sum;
2307
2308 }
2309
2310 =item quantity
2311
2312 =cut
2313
2314 sub quantity {
2315   my( $self, $value ) = @_;
2316   if ( defined($value) ) {
2317     $self->setfield('quantity', $value);
2318   }
2319   $self->getfield('quantity') || 1;
2320 }
2321
2322 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2323
2324 Transfers as many services as possible from this package to another package.
2325
2326 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2327 object.  The destination package must already exist.
2328
2329 Services are moved only if the destination allows services with the correct
2330 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
2331 this option with caution!  No provision is made for export differences
2332 between the old and new service definitions.  Probably only should be used
2333 when your exports for all service definitions of a given svcdb are identical.
2334 (attempt a transfer without it first, to move all possible svcpart-matching
2335 services)
2336
2337 Any services that can't be moved remain in the original package.
2338
2339 Returns an error, if there is one; otherwise, returns the number of services
2340 that couldn't be moved.
2341
2342 =cut
2343
2344 sub transfer {
2345   my ($self, $dest_pkgnum, %opt) = @_;
2346
2347   my $remaining = 0;
2348   my $dest;
2349   my %target;
2350
2351   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2352     $dest = $dest_pkgnum;
2353     $dest_pkgnum = $dest->pkgnum;
2354   } else {
2355     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2356   }
2357
2358   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2359
2360   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2361     $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2362   }
2363
2364   foreach my $cust_svc ($dest->cust_svc) {
2365     $target{$cust_svc->svcpart}--;
2366   }
2367
2368   my %svcpart2svcparts = ();
2369   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2370     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2371     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2372       next if exists $svcpart2svcparts{$svcpart};
2373       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2374       $svcpart2svcparts{$svcpart} = [
2375         map  { $_->[0] }
2376         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
2377         map {
2378               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2379                                                    'svcpart' => $_          } );
2380               [ $_,
2381                 $pkg_svc ? $pkg_svc->primary_svc : '',
2382                 $pkg_svc ? $pkg_svc->quantity : 0,
2383               ];
2384             }
2385
2386         grep { $_ != $svcpart }
2387         map  { $_->svcpart }
2388         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2389       ];
2390       warn "alternates for svcpart $svcpart: ".
2391            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2392         if $DEBUG;
2393     }
2394   }
2395
2396   foreach my $cust_svc ($self->cust_svc) {
2397     if($target{$cust_svc->svcpart} > 0) {
2398       $target{$cust_svc->svcpart}--;
2399       my $new = new FS::cust_svc { $cust_svc->hash };
2400       $new->pkgnum($dest_pkgnum);
2401       my $error = $new->replace($cust_svc);
2402       return $error if $error;
2403     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2404       if ( $DEBUG ) {
2405         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2406         warn "alternates to consider: ".
2407              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2408       }
2409       my @alternate = grep {
2410                              warn "considering alternate svcpart $_: ".
2411                                   "$target{$_} available in new package\n"
2412                                if $DEBUG;
2413                              $target{$_} > 0;
2414                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
2415       if ( @alternate ) {
2416         warn "alternate(s) found\n" if $DEBUG;
2417         my $change_svcpart = $alternate[0];
2418         $target{$change_svcpart}--;
2419         my $new = new FS::cust_svc { $cust_svc->hash };
2420         $new->svcpart($change_svcpart);
2421         $new->pkgnum($dest_pkgnum);
2422         my $error = $new->replace($cust_svc);
2423         return $error if $error;
2424       } else {
2425         $remaining++;
2426       }
2427     } else {
2428       $remaining++
2429     }
2430   }
2431   return $remaining;
2432 }
2433
2434 =item reexport
2435
2436 This method is deprecated.  See the I<depend_jobnum> option to the insert and
2437 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2438
2439 =cut
2440
2441 sub reexport {
2442   my $self = shift;
2443
2444   local $SIG{HUP} = 'IGNORE';
2445   local $SIG{INT} = 'IGNORE';
2446   local $SIG{QUIT} = 'IGNORE';
2447   local $SIG{TERM} = 'IGNORE';
2448   local $SIG{TSTP} = 'IGNORE';
2449   local $SIG{PIPE} = 'IGNORE';
2450
2451   my $oldAutoCommit = $FS::UID::AutoCommit;
2452   local $FS::UID::AutoCommit = 0;
2453   my $dbh = dbh;
2454
2455   foreach my $cust_svc ( $self->cust_svc ) {
2456     #false laziness w/svc_Common::insert
2457     my $svc_x = $cust_svc->svc_x;
2458     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2459       my $error = $part_export->export_insert($svc_x);
2460       if ( $error ) {
2461         $dbh->rollback if $oldAutoCommit;
2462         return $error;
2463       }
2464     }
2465   }
2466
2467   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2468   '';
2469
2470 }
2471
2472 =item insert_reason
2473
2474 Associates this package with a (suspension or cancellation) reason (see
2475 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2476 L<FS::reason>).
2477
2478 Available options are:
2479
2480 =over 4
2481
2482 =item reason
2483
2484 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.
2485
2486 =item reason_otaker
2487
2488 the access_user (see L<FS::access_user>) providing the reason
2489
2490 =item date
2491
2492 a unix timestamp
2493
2494 =item action
2495
2496 the action (cancel, susp, adjourn, expire) associated with the reason
2497
2498 =back
2499
2500 If there is an error, returns the error, otherwise returns false.
2501
2502 =cut
2503
2504 sub insert_reason {
2505   my ($self, %options) = @_;
2506
2507   my $otaker = $options{reason_otaker} ||
2508                $FS::CurrentUser::CurrentUser->username;
2509
2510   my $reasonnum;
2511   if ( $options{'reason'} =~ /^(\d+)$/ ) {
2512
2513     $reasonnum = $1;
2514
2515   } elsif ( ref($options{'reason'}) ) {
2516
2517     return 'Enter a new reason (or select an existing one)'
2518       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2519
2520     my $reason = new FS::reason({
2521       'reason_type' => $options{'reason'}->{'typenum'},
2522       'reason'      => $options{'reason'}->{'reason'},
2523     });
2524     my $error = $reason->insert;
2525     return $error if $error;
2526
2527     $reasonnum = $reason->reasonnum;
2528
2529   } else {
2530     return "Unparsable reason: ". $options{'reason'};
2531   }
2532
2533   my $cust_pkg_reason =
2534     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
2535                               'reasonnum' => $reasonnum,
2536                               'otaker'    => $otaker,
2537                               'action'    => substr(uc($options{'action'}),0,1),
2538                               'date'      => $options{'date'}
2539                                                ? $options{'date'}
2540                                                : time,
2541                             });
2542
2543   $cust_pkg_reason->insert;
2544 }
2545
2546 =item insert_discount
2547
2548 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2549 inserting a new discount on the fly (see L<FS::discount>).
2550
2551 Available options are:
2552
2553 =over 4
2554
2555 =item discountnum
2556
2557 =back
2558
2559 If there is an error, returns the error, otherwise returns false.
2560
2561 =cut
2562
2563 sub insert_discount {
2564   #my ($self, %options) = @_;
2565   my $self = shift;
2566
2567   my $cust_pkg_discount = new FS::cust_pkg_discount {
2568     'pkgnum'      => $self->pkgnum,
2569     'discountnum' => $self->discountnum,
2570     'months_used' => 0,
2571     'end_date'    => '', #XXX
2572     #for the create a new discount case
2573     '_type'       => $self->discountnum__type,
2574     'amount'      => $self->discountnum_amount,
2575     'percent'     => $self->discountnum_percent,
2576     'months'      => $self->discountnum_months,
2577     #'disabled'    => $self->discountnum_disabled,
2578   };
2579
2580   $cust_pkg_discount->insert;
2581 }
2582
2583 =item set_usage USAGE_VALUE_HASHREF
2584
2585 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2586 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2587 upbytes, downbytes, and totalbytes are appropriate keys.
2588
2589 All svc_accts which are part of this package have their values reset.
2590
2591 =cut
2592
2593 sub set_usage {
2594   my ($self, $valueref, %opt) = @_;
2595
2596   foreach my $cust_svc ($self->cust_svc){
2597     my $svc_x = $cust_svc->svc_x;
2598     $svc_x->set_usage($valueref, %opt)
2599       if $svc_x->can("set_usage");
2600   }
2601 }
2602
2603 =item recharge USAGE_VALUE_HASHREF
2604
2605 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2606 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2607 upbytes, downbytes, and totalbytes are appropriate keys.
2608
2609 All svc_accts which are part of this package have their values incremented.
2610
2611 =cut
2612
2613 sub recharge {
2614   my ($self, $valueref) = @_;
2615
2616   foreach my $cust_svc ($self->cust_svc){
2617     my $svc_x = $cust_svc->svc_x;
2618     $svc_x->recharge($valueref)
2619       if $svc_x->can("recharge");
2620   }
2621 }
2622
2623 =item cust_pkg_discount
2624
2625 =cut
2626
2627 sub cust_pkg_discount {
2628   my $self = shift;
2629   qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2630 }
2631
2632 =item cust_pkg_discount_active
2633
2634 =cut
2635
2636 sub cust_pkg_discount_active {
2637   my $self = shift;
2638   grep { $_->status eq 'active' } $self->cust_pkg_discount;
2639 }
2640
2641 =back
2642
2643 =head1 CLASS METHODS
2644
2645 =over 4
2646
2647 =item recurring_sql
2648
2649 Returns an SQL expression identifying recurring packages.
2650
2651 =cut
2652
2653 sub recurring_sql { "
2654   '0' != ( select freq from part_pkg
2655              where cust_pkg.pkgpart = part_pkg.pkgpart )
2656 "; }
2657
2658 =item onetime_sql
2659
2660 Returns an SQL expression identifying one-time packages.
2661
2662 =cut
2663
2664 sub onetime_sql { "
2665   '0' = ( select freq from part_pkg
2666             where cust_pkg.pkgpart = part_pkg.pkgpart )
2667 "; }
2668
2669 =item ordered_sql
2670
2671 Returns an SQL expression identifying ordered packages (recurring packages not
2672 yet billed).
2673
2674 =cut
2675
2676 sub ordered_sql {
2677    $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2678 }
2679
2680 =item active_sql
2681
2682 Returns an SQL expression identifying active packages.
2683
2684 =cut
2685
2686 sub active_sql {
2687   $_[0]->recurring_sql. "
2688   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2689   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2690   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2691 "; }
2692
2693 =item not_yet_billed_sql
2694
2695 Returns an SQL expression identifying packages which have not yet been billed.
2696
2697 =cut
2698
2699 sub not_yet_billed_sql { "
2700       ( cust_pkg.setup  IS NULL OR cust_pkg.setup  = 0 )
2701   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2702   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2703 "; }
2704
2705 =item inactive_sql
2706
2707 Returns an SQL expression identifying inactive packages (one-time packages
2708 that are otherwise unsuspended/uncancelled).
2709
2710 =cut
2711
2712 sub inactive_sql { "
2713   ". $_[0]->onetime_sql(). "
2714   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2715   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2716   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2717 "; }
2718
2719 =item susp_sql
2720 =item suspended_sql
2721
2722 Returns an SQL expression identifying suspended packages.
2723
2724 =cut
2725
2726 sub suspended_sql { susp_sql(@_); }
2727 sub susp_sql {
2728   #$_[0]->recurring_sql(). ' AND '.
2729   "
2730         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
2731     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
2732   ";
2733 }
2734
2735 =item cancel_sql
2736 =item cancelled_sql
2737
2738 Returns an SQL exprression identifying cancelled packages.
2739
2740 =cut
2741
2742 sub cancelled_sql { cancel_sql(@_); }
2743 sub cancel_sql {
2744   #$_[0]->recurring_sql(). ' AND '.
2745   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2746 }
2747
2748 =item status_sql
2749
2750 Returns an SQL expression to give the package status as a string.
2751
2752 =cut
2753
2754 sub status_sql {
2755 "CASE
2756   WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
2757   WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
2758   WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
2759   WHEN ".onetime_sql()." THEN 'one-time charge'
2760   ELSE 'active'
2761 END"
2762 }
2763
2764 =item search HASHREF
2765
2766 (Class method)
2767
2768 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2769 Valid parameters are
2770
2771 =over 4
2772
2773 =item agentnum
2774
2775 =item magic
2776
2777 active, inactive, suspended, cancel (or cancelled)
2778
2779 =item status
2780
2781 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2782
2783 =item custom
2784
2785  boolean selects custom packages
2786
2787 =item classnum
2788
2789 =item pkgpart
2790
2791 pkgpart or arrayref or hashref of pkgparts
2792
2793 =item setup
2794
2795 arrayref of beginning and ending epoch date
2796
2797 =item last_bill
2798
2799 arrayref of beginning and ending epoch date
2800
2801 =item bill
2802
2803 arrayref of beginning and ending epoch date
2804
2805 =item adjourn
2806
2807 arrayref of beginning and ending epoch date
2808
2809 =item susp
2810
2811 arrayref of beginning and ending epoch date
2812
2813 =item expire
2814
2815 arrayref of beginning and ending epoch date
2816
2817 =item cancel
2818
2819 arrayref of beginning and ending epoch date
2820
2821 =item query
2822
2823 pkgnum or APKG_pkgnum
2824
2825 =item cust_fields
2826
2827 a value suited to passing to FS::UI::Web::cust_header
2828
2829 =item CurrentUser
2830
2831 specifies the user for agent virtualization
2832
2833 =item fcc_line
2834
2835  boolean selects packages containing fcc form 477 telco lines
2836
2837 =back
2838
2839 =cut
2840
2841 sub search {
2842   my ($class, $params) = @_;
2843   my @where = ();
2844
2845   ##
2846   # parse agent
2847   ##
2848
2849   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2850     push @where,
2851       "cust_main.agentnum = $1";
2852   }
2853
2854   ##
2855   # parse custnum
2856   ##
2857
2858   if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2859     push @where,
2860       "cust_pkg.custnum = $1";
2861   }
2862
2863   ##
2864   # custbatch
2865   ##
2866
2867   if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
2868     push @where,
2869       "cust_pkg.pkgbatch = '$1'";
2870   }
2871
2872   ##
2873   # parse status
2874   ##
2875
2876   if (    $params->{'magic'}  eq 'active'
2877        || $params->{'status'} eq 'active' ) {
2878
2879     push @where, FS::cust_pkg->active_sql();
2880
2881   } elsif (    $params->{'magic'}  =~ /^not[ _]yet[ _]billed$/
2882             || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2883
2884     push @where, FS::cust_pkg->not_yet_billed_sql();
2885
2886   } elsif (    $params->{'magic'}  =~ /^(one-time charge|inactive)/
2887             || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2888
2889     push @where, FS::cust_pkg->inactive_sql();
2890
2891   } elsif (    $params->{'magic'}  eq 'suspended'
2892             || $params->{'status'} eq 'suspended'  ) {
2893
2894     push @where, FS::cust_pkg->suspended_sql();
2895
2896   } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
2897             || $params->{'status'} =~ /^cancell?ed$/ ) {
2898
2899     push @where, FS::cust_pkg->cancelled_sql();
2900
2901   }
2902
2903   ###
2904   # parse package class
2905   ###
2906
2907   #false lazinessish w/graph/cust_bill_pkg.cgi
2908   my $classnum = 0;
2909   my @pkg_class = ();
2910   if ( exists($params->{'classnum'})
2911        && $params->{'classnum'} =~ /^(\d*)$/
2912      )
2913   {
2914     $classnum = $1;
2915     if ( $classnum ) { #a specific class
2916       push @where, "part_pkg.classnum = $classnum";
2917
2918       #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2919       #die "classnum $classnum not found!" unless $pkg_class[0];
2920       #$title .= $pkg_class[0]->classname.' ';
2921
2922     } elsif ( $classnum eq '' ) { #the empty class
2923
2924       push @where, "part_pkg.classnum IS NULL";
2925       #$title .= 'Empty class ';
2926       #@pkg_class = ( '(empty class)' );
2927     } elsif ( $classnum eq '0' ) {
2928       #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2929       #push @pkg_class, '(empty class)';
2930     } else {
2931       die "illegal classnum";
2932     }
2933   }
2934   #eslaf
2935
2936   ###
2937   # parse package report options
2938   ###
2939
2940   my @report_option = ();
2941   if ( exists($params->{'report_option'})
2942        && $params->{'report_option'} =~ /^([,\d]*)$/
2943      )
2944   {
2945     @report_option = split(',', $1);
2946   }
2947
2948   if (@report_option) {
2949     # this will result in the empty set for the dangling comma case as it should
2950     push @where,
2951       map{ "0 < ( SELECT count(*) FROM part_pkg_option
2952                     WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2953                     AND optionname = 'report_option_$_'
2954                     AND optionvalue = '1' )"
2955          } @report_option;
2956   }
2957
2958   #eslaf
2959
2960   ###
2961   # parse custom
2962   ###
2963
2964   push @where,  "part_pkg.custom = 'Y'" if $params->{custom};
2965
2966   ###
2967   # parse fcc_line
2968   ###
2969
2970   push @where,  "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2971
2972   ###
2973   # parse censustract
2974   ###
2975
2976   if ( exists($params->{'censustract'}) ) {
2977     $params->{'censustract'} =~ /^([.\d]*)$/;
2978     my $censustract = "cust_main.censustract = '$1'";
2979     $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2980     push @where,  "( $censustract )";
2981   }
2982
2983   ###
2984   # parse part_pkg
2985   ###
2986
2987   if ( ref($params->{'pkgpart'}) ) {
2988
2989     my @pkgpart = ();
2990     if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2991       @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2992     } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2993       @pkgpart = @{ $params->{'pkgpart'} };
2994     } else {
2995       die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2996     }
2997
2998     @pkgpart = grep /^(\d+)$/, @pkgpart;
2999
3000     push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
3001
3002   } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3003     push @where, "pkgpart = $1";
3004   }
3005
3006   ###
3007   # parse dates
3008   ###
3009
3010   my $orderby = '';
3011
3012   #false laziness w/report_cust_pkg.html
3013   my %disable = (
3014     'all'             => {},
3015     'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
3016     'active'          => { 'susp'=>1, 'cancel'=>1 },
3017     'suspended'       => { 'cancel' => 1 },
3018     'cancelled'       => {},
3019     ''                => {},
3020   );
3021
3022   if( exists($params->{'active'} ) ) {
3023     # This overrides all the other date-related fields
3024     my($beginning, $ending) = @{$params->{'active'}};
3025     push @where,
3026       "cust_pkg.setup IS NOT NULL",
3027       "cust_pkg.setup <= $ending",
3028       "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
3029       "NOT (".FS::cust_pkg->onetime_sql . ")";
3030   }
3031   else {
3032     foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
3033
3034       next unless exists($params->{$field});
3035
3036       my($beginning, $ending) = @{$params->{$field}};
3037
3038       next if $beginning == 0 && $ending == 4294967295;
3039
3040       push @where,
3041         "cust_pkg.$field IS NOT NULL",
3042         "cust_pkg.$field >= $beginning",
3043         "cust_pkg.$field <= $ending";
3044
3045       $orderby ||= "ORDER BY cust_pkg.$field";
3046
3047     }
3048   }
3049
3050   $orderby ||= 'ORDER BY bill';
3051
3052   ###
3053   # parse magic, legacy, etc.
3054   ###
3055
3056   if ( $params->{'magic'} &&
3057        $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
3058   ) {
3059
3060     $orderby = 'ORDER BY pkgnum';
3061
3062     if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3063       push @where, "pkgpart = $1";
3064     }
3065
3066   } elsif ( $params->{'query'} eq 'pkgnum' ) {
3067
3068     $orderby = 'ORDER BY pkgnum';
3069
3070   } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
3071
3072     $orderby = 'ORDER BY pkgnum';
3073
3074     push @where, '0 < (
3075       SELECT count(*) FROM pkg_svc
3076        WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
3077          AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
3078                                    WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
3079                                      AND cust_svc.svcpart = pkg_svc.svcpart
3080                                 )
3081     )';
3082
3083   }
3084
3085   ##
3086   # setup queries, links, subs, etc. for the search
3087   ##
3088
3089   # here is the agent virtualization
3090   if ($params->{CurrentUser}) {
3091     my $access_user =
3092       qsearchs('access_user', { username => $params->{CurrentUser} });
3093
3094     if ($access_user) {
3095       push @where, $access_user->agentnums_sql('table'=>'cust_main');
3096     } else {
3097       push @where, "1=0";
3098     }
3099   } else {
3100     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
3101   }
3102
3103   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
3104
3105   my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
3106                   'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
3107                   'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
3108
3109   my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
3110
3111   my $sql_query = {
3112     'table'       => 'cust_pkg',
3113     'hashref'     => {},
3114     'select'      => join(', ',
3115                                 'cust_pkg.*',
3116                                 ( map "part_pkg.$_", qw( pkg freq ) ),
3117                                 'pkg_class.classname',
3118                                 'cust_main.custnum AS cust_main_custnum',
3119                                 FS::UI::Web::cust_sql_fields(
3120                                   $params->{'cust_fields'}
3121                                 ),
3122                      ),
3123     'extra_sql'   => "$extra_sql $orderby",
3124     'addl_from'   => $addl_from,
3125     'count_query' => $count_query,
3126   };
3127
3128 }
3129
3130 =item fcc_477_count
3131
3132 Returns a list of two package counts.  The first is a count of packages
3133 based on the supplied criteria and the second is the count of residential
3134 packages with those same criteria.  Criteria are specified as in the search
3135 method.
3136
3137 =cut
3138
3139 sub fcc_477_count {
3140   my ($class, $params) = @_;
3141
3142   my $sql_query = $class->search( $params );
3143
3144   my $count_sql = delete($sql_query->{'count_query'});
3145   $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
3146     or die "couldn't parse count_sql";
3147
3148   my $count_sth = dbh->prepare($count_sql)
3149     or die "Error preparing $count_sql: ". dbh->errstr;
3150   $count_sth->execute
3151     or die "Error executing $count_sql: ". $count_sth->errstr;
3152   my $count_arrayref = $count_sth->fetchrow_arrayref;
3153
3154   return ( @$count_arrayref );
3155
3156 }
3157
3158
3159 =item location_sql
3160
3161 Returns a list: the first item is an SQL fragment identifying matching
3162 packages/customers via location (taking into account shipping and package
3163 address taxation, if enabled), and subsequent items are the parameters to
3164 substitute for the placeholders in that fragment.
3165
3166 =cut
3167
3168 sub location_sql {
3169   my($class, %opt) = @_;
3170   my $ornull = $opt{'ornull'};
3171
3172   my $conf = new FS::Conf;
3173
3174   # '?' placeholders in _location_sql_where
3175   my $x = $ornull ? 3 : 2;
3176   my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
3177
3178   my $main_where;
3179   my @main_param;
3180   if ( $conf->exists('tax-ship_address') ) {
3181
3182     $main_where = "(
3183          (     ( ship_last IS NULL     OR  ship_last  = '' )
3184            AND ". _location_sql_where('cust_main', '', $ornull ). "
3185          )
3186       OR (       ship_last IS NOT NULL AND ship_last != ''
3187            AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
3188          )
3189     )";
3190     #    AND payby != 'COMP'
3191
3192     @main_param = ( @bill_param, @bill_param );
3193
3194   } else {
3195
3196     $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
3197     @main_param = @bill_param;
3198
3199   }
3200
3201   my $where;
3202   my @param;
3203   if ( $conf->exists('tax-pkg_address') ) {
3204
3205     my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
3206
3207     $where = " (
3208                     ( cust_pkg.locationnum IS     NULL AND $main_where )
3209                  OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where  )
3210                )
3211              ";
3212     @param = ( @main_param, @bill_param );
3213
3214   } else {
3215
3216     $where = $main_where;
3217     @param = @main_param;
3218
3219   }
3220
3221   ( $where, @param );
3222
3223 }
3224
3225 #subroutine, helper for location_sql
3226 sub _location_sql_where {
3227   my $table  = shift;
3228   my $prefix = @_ ? shift : '';
3229   my $ornull = @_ ? shift : '';
3230
3231 #  $ornull             = $ornull          ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3232
3233   $ornull = $ornull ? ' OR ? IS NULL ' : '';
3234
3235   my $or_empty_city   = " OR ( ? = '' AND $table.${prefix}city   IS NULL ) ";
3236   my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3237   my $or_empty_state =  " OR ( ? = '' AND $table.${prefix}state  IS NULL ) ";
3238
3239 #        ( $table.${prefix}city    = ? $or_empty_city   $ornull )
3240   "
3241         ( $table.${prefix}city    = ? OR ? = '' OR CAST(? AS text) IS NULL )
3242     AND ( $table.${prefix}county  = ? $or_empty_county $ornull )
3243     AND ( $table.${prefix}state   = ? $or_empty_state  $ornull )
3244     AND   $table.${prefix}country = ?
3245   ";
3246 }
3247
3248 =head1 SUBROUTINES
3249
3250 =over 4
3251
3252 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3253
3254 CUSTNUM is a customer (see L<FS::cust_main>)
3255
3256 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3257 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
3258 permitted.
3259
3260 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3261 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
3262 new billing items.  An error is returned if this is not possible (see
3263 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
3264 parameter.
3265
3266 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3267 newly-created cust_pkg objects.
3268
3269 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3270 and inserted.  Multiple FS::pkg_referral records can be created by
3271 setting I<refnum> to an array reference of refnums or a hash reference with
3272 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
3273 record will be created corresponding to cust_main.refnum.
3274
3275 =cut
3276
3277 sub order {
3278   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3279
3280   my $conf = new FS::Conf;
3281
3282   # Transactionize this whole mess
3283   local $SIG{HUP} = 'IGNORE';
3284   local $SIG{INT} = 'IGNORE';
3285   local $SIG{QUIT} = 'IGNORE';
3286   local $SIG{TERM} = 'IGNORE';
3287   local $SIG{TSTP} = 'IGNORE';
3288   local $SIG{PIPE} = 'IGNORE';
3289
3290   my $oldAutoCommit = $FS::UID::AutoCommit;
3291   local $FS::UID::AutoCommit = 0;
3292   my $dbh = dbh;
3293
3294   my $error;
3295 #  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3296 #  return "Customer not found: $custnum" unless $cust_main;
3297
3298   warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3299     if $DEBUG;
3300
3301   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3302                          @$remove_pkgnum;
3303
3304   my $change = scalar(@old_cust_pkg) != 0;
3305
3306   my %hash = ();
3307   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3308
3309     warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3310          " to pkgpart ". $pkgparts->[0]. "\n"
3311       if $DEBUG;
3312
3313     my $err_or_cust_pkg =
3314       $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3315                                 'refnum'  => $refnum,
3316                               );
3317
3318     unless (ref($err_or_cust_pkg)) {
3319       $dbh->rollback if $oldAutoCommit;
3320       return $err_or_cust_pkg;
3321     }
3322
3323     push @$return_cust_pkg, $err_or_cust_pkg;
3324     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3325     return '';
3326
3327   }
3328
3329   # Create the new packages.
3330   foreach my $pkgpart (@$pkgparts) {
3331
3332     warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3333
3334     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3335                                       pkgpart => $pkgpart,
3336                                       refnum  => $refnum,
3337                                       %hash,
3338                                     };
3339     $error = $cust_pkg->insert( 'change' => $change );
3340     if ($error) {
3341       $dbh->rollback if $oldAutoCommit;
3342       return $error;
3343     }
3344     push @$return_cust_pkg, $cust_pkg;
3345   }
3346   # $return_cust_pkg now contains refs to all of the newly
3347   # created packages.
3348
3349   # Transfer services and cancel old packages.
3350   foreach my $old_pkg (@old_cust_pkg) {
3351
3352     warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3353       if $DEBUG;
3354
3355     foreach my $new_pkg (@$return_cust_pkg) {
3356       $error = $old_pkg->transfer($new_pkg);
3357       if ($error and $error == 0) {
3358         # $old_pkg->transfer failed.
3359         $dbh->rollback if $oldAutoCommit;
3360         return $error;
3361       }
3362     }
3363
3364     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3365       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3366       foreach my $new_pkg (@$return_cust_pkg) {
3367         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3368         if ($error and $error == 0) {
3369           # $old_pkg->transfer failed.
3370         $dbh->rollback if $oldAutoCommit;
3371         return $error;
3372         }
3373       }
3374     }
3375
3376     if ($error > 0) {
3377       # Transfers were successful, but we went through all of the
3378       # new packages and still had services left on the old package.
3379       # We can't cancel the package under the circumstances, so abort.
3380       $dbh->rollback if $oldAutoCommit;
3381       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3382     }
3383     $error = $old_pkg->cancel( quiet=>1 );
3384     if ($error) {
3385       $dbh->rollback;
3386       return $error;
3387     }
3388   }
3389   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3390   '';
3391 }
3392
3393 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3394
3395 A bulk change method to change packages for multiple customers.
3396
3397 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3398 L<FS::part_pkg>) to order for each customer.  Duplicates are of course
3399 permitted.
3400
3401 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3402 replace.  The services (see L<FS::cust_svc>) are moved to the
3403 new billing items.  An error is returned if this is not possible (see
3404 L<FS::pkg_svc>).
3405
3406 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3407 newly-created cust_pkg objects.
3408
3409 =cut
3410
3411 sub bulk_change {
3412   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3413
3414   # Transactionize this whole mess
3415   local $SIG{HUP} = 'IGNORE';
3416   local $SIG{INT} = 'IGNORE';
3417   local $SIG{QUIT} = 'IGNORE';
3418   local $SIG{TERM} = 'IGNORE';
3419   local $SIG{TSTP} = 'IGNORE';
3420   local $SIG{PIPE} = 'IGNORE';
3421
3422   my $oldAutoCommit = $FS::UID::AutoCommit;
3423   local $FS::UID::AutoCommit = 0;
3424   my $dbh = dbh;
3425
3426   my @errors;
3427   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3428                          @$remove_pkgnum;
3429
3430   while(scalar(@old_cust_pkg)) {
3431     my @return = ();
3432     my $custnum = $old_cust_pkg[0]->custnum;
3433     my (@remove) = map { $_->pkgnum }
3434                    grep { $_->custnum == $custnum } @old_cust_pkg;
3435     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3436
3437     my $error = order $custnum, $pkgparts, \@remove, \@return;
3438
3439     push @errors, $error
3440       if $error;
3441     push @$return_cust_pkg, @return;
3442   }
3443
3444   if (scalar(@errors)) {
3445     $dbh->rollback if $oldAutoCommit;
3446     return join(' / ', @errors);
3447   }
3448
3449   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3450   '';
3451 }
3452
3453 # Used by FS::Upgrade to migrate to a new database.
3454 sub _upgrade_data {  # class method
3455   my ($class, %opts) = @_;
3456   $class->_upgrade_otaker(%opts);
3457   my @statements = (
3458     # RT#10139, bug resulting in contract_end being set when it shouldn't
3459   'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
3460     # RT#10830, bad calculation of prorate date near end of year
3461     # the date range for bill is December 2009, and we move it forward
3462     # one year if it's before the previous bill date (which it should
3463     # never be)
3464   'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
3465   AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
3466   WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
3467     # RT6628, add order_date to cust_pkg
3468     'update cust_pkg set order_date = (select history_date from h_cust_pkg
3469         where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
3470         history_action = \'insert\') where order_date is null',
3471   );
3472   foreach my $sql (@statements) {
3473     my $sth = dbh->prepare($sql);
3474     $sth->execute or die $sth->errstr;
3475   }
3476 }
3477
3478 =back
3479
3480 =head1 BUGS
3481
3482 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
3483
3484 In sub order, the @pkgparts array (passed by reference) is clobbered.
3485
3486 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
3487 method to pass dates to the recur_prog expression, it should do so.
3488
3489 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3490 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3491 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3492 configuration values.  Probably need a subroutine which decides what to do
3493 based on whether or not we've fetched the user yet, rather than a hash.  See
3494 FS::UID and the TODO.
3495
3496 Now that things are transactional should the check in the insert method be
3497 moved to check ?
3498
3499 =head1 SEE ALSO
3500
3501 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3502 L<FS::pkg_svc>, schema.html from the base documentation
3503
3504 =cut
3505
3506 1;
3507