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