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   warn "$me _h_cust_svc called on $self\n"
1773     if $DEBUG;
1774
1775   my ($end, $start, $mode) = @_;
1776   my @cust_svc = $self->_sort_cust_svc(
1777     [ qsearch( 'h_cust_svc',
1778       { 'pkgnum' => $self->pkgnum, },
1779       FS::h_cust_svc->sql_h_search(@_),
1780     ) ]
1781   );
1782   if ( $mode eq 'I' ) {
1783     my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
1784     return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
1785   } else {
1786     return @cust_svc;
1787   }
1788 }
1789
1790 sub _sort_cust_svc {
1791   my( $self, $arrayref ) = @_;
1792
1793   my $sort =
1794     sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] };
1795
1796   map  { $_->[0] }
1797   sort $sort
1798   map {
1799         my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1800                                              'svcpart' => $_->svcpart     } );
1801         [ $_,
1802           $pkg_svc ? $pkg_svc->primary_svc : '',
1803           $pkg_svc ? $pkg_svc->quantity : 0,
1804         ];
1805       }
1806   @$arrayref;
1807
1808 }
1809
1810 =item num_cust_svc [ SVCPART ]
1811
1812 Returns the number of provisioned services for this package.  If a svcpart is
1813 specified, counts only the matching services.
1814
1815 =cut
1816
1817 sub num_cust_svc {
1818   my $self = shift;
1819
1820   return $self->{'_num_cust_svc'}
1821     if !scalar(@_)
1822        && exists($self->{'_num_cust_svc'})
1823        && $self->{'_num_cust_svc'} =~ /\d/;
1824
1825   cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1826     if $DEBUG > 2;
1827
1828   my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1829   $sql .= ' AND svcpart = ?' if @_;
1830
1831   my $sth = dbh->prepare($sql)     or die  dbh->errstr;
1832   $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1833   $sth->fetchrow_arrayref->[0];
1834 }
1835
1836 =item available_part_svc
1837
1838 Returns a list of FS::part_svc objects representing services included in this
1839 package but not yet provisioned.  Each FS::part_svc object also has an extra
1840 field, I<num_avail>, which specifies the number of available services.
1841
1842 =cut
1843
1844 sub available_part_svc {
1845   my $self = shift;
1846   grep { $_->num_avail > 0 }
1847     map {
1848           my $part_svc = $_->part_svc;
1849           $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1850             $_->quantity - $self->num_cust_svc($_->svcpart);
1851
1852           # more evil encapsulation breakage
1853           if($part_svc->{'Hash'}{'num_avail'} > 0) {
1854             my @exports = $part_svc->part_export_did;
1855             $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
1856           }
1857
1858           $part_svc;
1859         }
1860       $self->part_pkg->pkg_svc;
1861 }
1862
1863 =item part_svc
1864
1865 Returns a list of FS::part_svc objects representing provisioned and available
1866 services included in this package.  Each FS::part_svc object also has the
1867 following extra fields:
1868
1869 =over 4
1870
1871 =item num_cust_svc  (count)
1872
1873 =item num_avail     (quantity - count)
1874
1875 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1876
1877 svcnum
1878 label -> ($cust_svc->label)[1]
1879
1880 =back
1881
1882 =cut
1883
1884 sub part_svc {
1885   my $self = shift;
1886
1887   #XXX some sort of sort order besides numeric by svcpart...
1888   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1889     my $pkg_svc = $_;
1890     my $part_svc = $pkg_svc->part_svc;
1891     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1892     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1893     $part_svc->{'Hash'}{'num_avail'}    =
1894       max( 0, $pkg_svc->quantity - $num_cust_svc );
1895     $part_svc->{'Hash'}{'cust_pkg_svc'} =
1896       $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1897     $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
1898     $part_svc;
1899   } $self->part_pkg->pkg_svc;
1900
1901   #extras
1902   push @part_svc, map {
1903     my $part_svc = $_;
1904     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1905     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1906     $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
1907     $part_svc->{'Hash'}{'cust_pkg_svc'} =
1908       $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1909     $part_svc;
1910   } $self->extra_part_svc;
1911
1912   @part_svc;
1913
1914 }
1915
1916 =item extra_part_svc
1917
1918 Returns a list of FS::part_svc objects corresponding to services in this
1919 package which are still provisioned but not (any longer) available in the
1920 package definition.
1921
1922 =cut
1923
1924 sub extra_part_svc {
1925   my $self = shift;
1926
1927   my $pkgnum  = $self->pkgnum;
1928   my $pkgpart = $self->pkgpart;
1929
1930 #  qsearch( {
1931 #    'table'     => 'part_svc',
1932 #    'hashref'   => {},
1933 #    'extra_sql' =>
1934 #      "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1935 #                     WHERE pkg_svc.svcpart = part_svc.svcpart
1936 #                       AND pkg_svc.pkgpart = ?
1937 #                       AND quantity > 0
1938 #                 )
1939 #        AND 0 < ( SELECT COUNT(*) FROM cust_svc
1940 #                       LEFT JOIN cust_pkg USING ( pkgnum )
1941 #                     WHERE cust_svc.svcpart = part_svc.svcpart
1942 #                       AND pkgnum = ?
1943 #                 )",
1944 #    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1945 #  } );
1946
1947 #seems to benchmark slightly faster...
1948   qsearch( {
1949     #'select'      => 'DISTINCT ON (svcpart) part_svc.*',
1950     #MySQL doesn't grok DISINCT ON
1951     'select'      => 'DISTINCT part_svc.*',
1952     'table'       => 'part_svc',
1953     'addl_from'   =>
1954       'LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart
1955                                AND pkg_svc.pkgpart   = ?
1956                                AND quantity > 0
1957                              )
1958        LEFT JOIN cust_svc ON (     cust_svc.svcpart = part_svc.svcpart )
1959        LEFT JOIN cust_pkg USING ( pkgnum )
1960       ',
1961     'hashref'     => {},
1962     'extra_sql'   => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1963     'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1964   } );
1965 }
1966
1967 =item status
1968
1969 Returns a short status string for this package, currently:
1970
1971 =over 4
1972
1973 =item not yet billed
1974
1975 =item one-time charge
1976
1977 =item active
1978
1979 =item suspended
1980
1981 =item cancelled
1982
1983 =back
1984
1985 =cut
1986
1987 sub status {
1988   my $self = shift;
1989
1990   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1991
1992   return 'cancelled' if $self->get('cancel');
1993   return 'suspended' if $self->susp;
1994   return 'not yet billed' unless $self->setup;
1995   return 'one-time charge' if $freq =~ /^(0|$)/;
1996   return 'active';
1997 }
1998
1999 =item ucfirst_status
2000
2001 Returns the status with the first character capitalized.
2002
2003 =cut
2004
2005 sub ucfirst_status {
2006   ucfirst(shift->status);
2007 }
2008
2009 =item statuses
2010
2011 Class method that returns the list of possible status strings for packages
2012 (see L<the status method|/status>).  For example:
2013
2014   @statuses = FS::cust_pkg->statuses();
2015
2016 =cut
2017
2018 tie my %statuscolor, 'Tie::IxHash',
2019   'not yet billed'  => '009999', #teal? cyan?
2020   'one-time charge' => '000000',
2021   'active'          => '00CC00',
2022   'suspended'       => 'FF9900',
2023   'cancelled'       => 'FF0000',
2024 ;
2025
2026 sub statuses {
2027   my $self = shift; #could be class...
2028   #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
2029   #                                    # mayble split btw one-time vs. recur
2030     keys %statuscolor;
2031 }
2032
2033 =item statuscolor
2034
2035 Returns a hex triplet color string for this package's status.
2036
2037 =cut
2038
2039 sub statuscolor {
2040   my $self = shift;
2041   $statuscolor{$self->status};
2042 }
2043
2044 =item pkg_label
2045
2046 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
2047 "pkg-comment" depending on user preference).
2048
2049 =cut
2050
2051 sub pkg_label {
2052   my $self = shift;
2053   my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
2054   $label = $self->pkgnum. ": $label"
2055     if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
2056   $label;
2057 }
2058
2059 =item pkg_label_long
2060
2061 Returns a long label for this package, adding the primary service's label to
2062 pkg_label.
2063
2064 =cut
2065
2066 sub pkg_label_long {
2067   my $self = shift;
2068   my $label = $self->pkg_label;
2069   my $cust_svc = $self->primary_cust_svc;
2070   $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
2071   $label;
2072 }
2073
2074 =item primary_cust_svc
2075
2076 Returns a primary service (as FS::cust_svc object) if one can be identified.
2077
2078 =cut
2079
2080 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
2081
2082 sub primary_cust_svc {
2083   my $self = shift;
2084
2085   my @cust_svc = $self->cust_svc;
2086
2087   return '' unless @cust_svc; #no serivces - irrelevant then
2088
2089   return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
2090
2091   # primary service as specified in the package definition
2092   # or exactly one service definition with quantity one
2093   my $svcpart = $self->part_pkg->svcpart;
2094   @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
2095   return $cust_svc[0] if scalar(@cust_svc) == 1;
2096
2097   #couldn't identify one thing..
2098   return '';
2099 }
2100
2101 =item labels
2102
2103 Returns a list of lists, calling the label method for all services
2104 (see L<FS::cust_svc>) of this billing item.
2105
2106 =cut
2107
2108 sub labels {
2109   my $self = shift;
2110   map { [ $_->label ] } $self->cust_svc;
2111 }
2112
2113 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2114
2115 Like the labels method, but returns historical information on services that
2116 were active as of END_TIMESTAMP and (optionally) not cancelled before
2117 START_TIMESTAMP.  If MODE is 'I' (for 'invoice'), services with the
2118 I<pkg_svc.hidden> flag will be omitted.
2119
2120 Returns a list of lists, calling the label method for all (historical) services
2121 (see L<FS::h_cust_svc>) of this billing item.
2122
2123 =cut
2124
2125 sub h_labels {
2126   my $self = shift;
2127   warn "$me _h_labels called on $self\n"
2128     if $DEBUG;
2129   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
2130 }
2131
2132 =item labels_short
2133
2134 Like labels, except returns a simple flat list, and shortens long
2135 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2136 identical services to one line that lists the service label and the number of
2137 individual services rather than individual items.
2138
2139 =cut
2140
2141 sub labels_short {
2142   shift->_labels_short( 'labels', @_ );
2143 }
2144
2145 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
2146
2147 Like h_labels, except returns a simple flat list, and shortens long
2148 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2149 identical services to one line that lists the service label and the number of
2150 individual services rather than individual items.
2151
2152 =cut
2153
2154 sub h_labels_short {
2155   shift->_labels_short( 'h_labels', @_ );
2156 }
2157
2158 sub _labels_short {
2159   my( $self, $method ) = ( shift, shift );
2160
2161   warn "$me _labels_short called on $self with $method method\n"
2162     if $DEBUG;
2163
2164   my $conf = new FS::Conf;
2165   my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
2166
2167   warn "$me _labels_short populating \%labels\n"
2168     if $DEBUG;
2169
2170   my %labels;
2171   #tie %labels, 'Tie::IxHash';
2172   push @{ $labels{$_->[0]} }, $_->[1]
2173     foreach $self->$method(@_);
2174
2175   warn "$me _labels_short populating \@labels\n"
2176     if $DEBUG;
2177
2178   my @labels;
2179   foreach my $label ( keys %labels ) {
2180     my %seen = ();
2181     my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
2182     my $num = scalar(@values);
2183     warn "$me _labels_short $num items for $label\n"
2184       if $DEBUG;
2185
2186     if ( $num > $max_same_services ) {
2187       warn "$me _labels_short   more than $max_same_services, so summarizing\n"
2188         if $DEBUG;
2189       push @labels, "$label ($num)";
2190     } else {
2191       if ( $conf->exists('cust_bill-consolidate_services') ) {
2192         warn "$me _labels_short   consolidating services\n"
2193           if $DEBUG;
2194         # push @labels, "$label: ". join(', ', @values);
2195         while ( @values ) {
2196           my $detail = "$label: ";
2197           $detail .= shift(@values). ', '
2198             while @values && length($detail.$values[0]) < 78;
2199           $detail =~ s/, $//;
2200           push @labels, $detail;
2201         }
2202       } else {
2203         warn "$me _labels_short   adding service data\n"
2204           if $DEBUG;
2205         push @labels, map { "$label: $_" } @values;
2206       }
2207     }
2208   }
2209
2210  @labels;
2211
2212 }
2213
2214 =item cust_main
2215
2216 Returns the parent customer object (see L<FS::cust_main>).
2217
2218 =cut
2219
2220 sub cust_main {
2221   my $self = shift;
2222   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
2223 }
2224
2225 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
2226
2227 =item cust_location
2228
2229 Returns the location object, if any (see L<FS::cust_location>).
2230
2231 =item cust_location_or_main
2232
2233 If this package is associated with a location, returns the locaiton (see
2234 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2235
2236 =item location_label [ OPTION => VALUE ... ]
2237
2238 Returns the label of the location object (see L<FS::cust_location>).
2239
2240 =cut
2241
2242 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2243
2244 =item seconds_since TIMESTAMP
2245
2246 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2247 package have been online since TIMESTAMP, according to the session monitor.
2248
2249 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
2250 L<Time::Local> and L<Date::Parse> for conversion functions.
2251
2252 =cut
2253
2254 sub seconds_since {
2255   my($self, $since) = @_;
2256   my $seconds = 0;
2257
2258   foreach my $cust_svc (
2259     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2260   ) {
2261     $seconds += $cust_svc->seconds_since($since);
2262   }
2263
2264   $seconds;
2265
2266 }
2267
2268 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2269
2270 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2271 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2272 (exclusive).
2273
2274 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2275 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
2276 functions.
2277
2278
2279 =cut
2280
2281 sub seconds_since_sqlradacct {
2282   my($self, $start, $end) = @_;
2283
2284   my $seconds = 0;
2285
2286   foreach my $cust_svc (
2287     grep {
2288       my $part_svc = $_->part_svc;
2289       $part_svc->svcdb eq 'svc_acct'
2290         && scalar($part_svc->part_export('sqlradius'));
2291     } $self->cust_svc
2292   ) {
2293     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2294   }
2295
2296   $seconds;
2297
2298 }
2299
2300 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2301
2302 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2303 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2304 TIMESTAMP_END
2305 (exclusive).
2306
2307 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2308 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
2309 functions.
2310
2311 =cut
2312
2313 sub attribute_since_sqlradacct {
2314   my($self, $start, $end, $attrib) = @_;
2315
2316   my $sum = 0;
2317
2318   foreach my $cust_svc (
2319     grep {
2320       my $part_svc = $_->part_svc;
2321       $part_svc->svcdb eq 'svc_acct'
2322         && scalar($part_svc->part_export('sqlradius'));
2323     } $self->cust_svc
2324   ) {
2325     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2326   }
2327
2328   $sum;
2329
2330 }
2331
2332 =item quantity
2333
2334 =cut
2335
2336 sub quantity {
2337   my( $self, $value ) = @_;
2338   if ( defined($value) ) {
2339     $self->setfield('quantity', $value);
2340   }
2341   $self->getfield('quantity') || 1;
2342 }
2343
2344 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2345
2346 Transfers as many services as possible from this package to another package.
2347
2348 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2349 object.  The destination package must already exist.
2350
2351 Services are moved only if the destination allows services with the correct
2352 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
2353 this option with caution!  No provision is made for export differences
2354 between the old and new service definitions.  Probably only should be used
2355 when your exports for all service definitions of a given svcdb are identical.
2356 (attempt a transfer without it first, to move all possible svcpart-matching
2357 services)
2358
2359 Any services that can't be moved remain in the original package.
2360
2361 Returns an error, if there is one; otherwise, returns the number of services
2362 that couldn't be moved.
2363
2364 =cut
2365
2366 sub transfer {
2367   my ($self, $dest_pkgnum, %opt) = @_;
2368
2369   my $remaining = 0;
2370   my $dest;
2371   my %target;
2372
2373   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2374     $dest = $dest_pkgnum;
2375     $dest_pkgnum = $dest->pkgnum;
2376   } else {
2377     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2378   }
2379
2380   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2381
2382   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2383     $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2384   }
2385
2386   foreach my $cust_svc ($dest->cust_svc) {
2387     $target{$cust_svc->svcpart}--;
2388   }
2389
2390   my %svcpart2svcparts = ();
2391   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2392     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2393     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2394       next if exists $svcpart2svcparts{$svcpart};
2395       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2396       $svcpart2svcparts{$svcpart} = [
2397         map  { $_->[0] }
2398         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
2399         map {
2400               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2401                                                    'svcpart' => $_          } );
2402               [ $_,
2403                 $pkg_svc ? $pkg_svc->primary_svc : '',
2404                 $pkg_svc ? $pkg_svc->quantity : 0,
2405               ];
2406             }
2407
2408         grep { $_ != $svcpart }
2409         map  { $_->svcpart }
2410         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2411       ];
2412       warn "alternates for svcpart $svcpart: ".
2413            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2414         if $DEBUG;
2415     }
2416   }
2417
2418   foreach my $cust_svc ($self->cust_svc) {
2419     if($target{$cust_svc->svcpart} > 0) {
2420       $target{$cust_svc->svcpart}--;
2421       my $new = new FS::cust_svc { $cust_svc->hash };
2422       $new->pkgnum($dest_pkgnum);
2423       my $error = $new->replace($cust_svc);
2424       return $error if $error;
2425     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2426       if ( $DEBUG ) {
2427         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2428         warn "alternates to consider: ".
2429              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2430       }
2431       my @alternate = grep {
2432                              warn "considering alternate svcpart $_: ".
2433                                   "$target{$_} available in new package\n"
2434                                if $DEBUG;
2435                              $target{$_} > 0;
2436                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
2437       if ( @alternate ) {
2438         warn "alternate(s) found\n" if $DEBUG;
2439         my $change_svcpart = $alternate[0];
2440         $target{$change_svcpart}--;
2441         my $new = new FS::cust_svc { $cust_svc->hash };
2442         $new->svcpart($change_svcpart);
2443         $new->pkgnum($dest_pkgnum);
2444         my $error = $new->replace($cust_svc);
2445         return $error if $error;
2446       } else {
2447         $remaining++;
2448       }
2449     } else {
2450       $remaining++
2451     }
2452   }
2453   return $remaining;
2454 }
2455
2456 =item reexport
2457
2458 This method is deprecated.  See the I<depend_jobnum> option to the insert and
2459 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2460
2461 =cut
2462
2463 sub reexport {
2464   my $self = shift;
2465
2466   local $SIG{HUP} = 'IGNORE';
2467   local $SIG{INT} = 'IGNORE';
2468   local $SIG{QUIT} = 'IGNORE';
2469   local $SIG{TERM} = 'IGNORE';
2470   local $SIG{TSTP} = 'IGNORE';
2471   local $SIG{PIPE} = 'IGNORE';
2472
2473   my $oldAutoCommit = $FS::UID::AutoCommit;
2474   local $FS::UID::AutoCommit = 0;
2475   my $dbh = dbh;
2476
2477   foreach my $cust_svc ( $self->cust_svc ) {
2478     #false laziness w/svc_Common::insert
2479     my $svc_x = $cust_svc->svc_x;
2480     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2481       my $error = $part_export->export_insert($svc_x);
2482       if ( $error ) {
2483         $dbh->rollback if $oldAutoCommit;
2484         return $error;
2485       }
2486     }
2487   }
2488
2489   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2490   '';
2491
2492 }
2493
2494 =item insert_reason
2495
2496 Associates this package with a (suspension or cancellation) reason (see
2497 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2498 L<FS::reason>).
2499
2500 Available options are:
2501
2502 =over 4
2503
2504 =item reason
2505
2506 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.
2507
2508 =item reason_otaker
2509
2510 the access_user (see L<FS::access_user>) providing the reason
2511
2512 =item date
2513
2514 a unix timestamp
2515
2516 =item action
2517
2518 the action (cancel, susp, adjourn, expire) associated with the reason
2519
2520 =back
2521
2522 If there is an error, returns the error, otherwise returns false.
2523
2524 =cut
2525
2526 sub insert_reason {
2527   my ($self, %options) = @_;
2528
2529   my $otaker = $options{reason_otaker} ||
2530                $FS::CurrentUser::CurrentUser->username;
2531
2532   my $reasonnum;
2533   if ( $options{'reason'} =~ /^(\d+)$/ ) {
2534
2535     $reasonnum = $1;
2536
2537   } elsif ( ref($options{'reason'}) ) {
2538
2539     return 'Enter a new reason (or select an existing one)'
2540       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2541
2542     my $reason = new FS::reason({
2543       'reason_type' => $options{'reason'}->{'typenum'},
2544       'reason'      => $options{'reason'}->{'reason'},
2545     });
2546     my $error = $reason->insert;
2547     return $error if $error;
2548
2549     $reasonnum = $reason->reasonnum;
2550
2551   } else {
2552     return "Unparsable reason: ". $options{'reason'};
2553   }
2554
2555   my $cust_pkg_reason =
2556     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
2557                               'reasonnum' => $reasonnum,
2558                               'otaker'    => $otaker,
2559                               'action'    => substr(uc($options{'action'}),0,1),
2560                               'date'      => $options{'date'}
2561                                                ? $options{'date'}
2562                                                : time,
2563                             });
2564
2565   $cust_pkg_reason->insert;
2566 }
2567
2568 =item insert_discount
2569
2570 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2571 inserting a new discount on the fly (see L<FS::discount>).
2572
2573 Available options are:
2574
2575 =over 4
2576
2577 =item discountnum
2578
2579 =back
2580
2581 If there is an error, returns the error, otherwise returns false.
2582
2583 =cut
2584
2585 sub insert_discount {
2586   #my ($self, %options) = @_;
2587   my $self = shift;
2588
2589   my $cust_pkg_discount = new FS::cust_pkg_discount {
2590     'pkgnum'      => $self->pkgnum,
2591     'discountnum' => $self->discountnum,
2592     'months_used' => 0,
2593     'end_date'    => '', #XXX
2594     #for the create a new discount case
2595     '_type'       => $self->discountnum__type,
2596     'amount'      => $self->discountnum_amount,
2597     'percent'     => $self->discountnum_percent,
2598     'months'      => $self->discountnum_months,
2599     #'disabled'    => $self->discountnum_disabled,
2600   };
2601
2602   $cust_pkg_discount->insert;
2603 }
2604
2605 =item set_usage USAGE_VALUE_HASHREF
2606
2607 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2608 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2609 upbytes, downbytes, and totalbytes are appropriate keys.
2610
2611 All svc_accts which are part of this package have their values reset.
2612
2613 =cut
2614
2615 sub set_usage {
2616   my ($self, $valueref, %opt) = @_;
2617
2618   foreach my $cust_svc ($self->cust_svc){
2619     my $svc_x = $cust_svc->svc_x;
2620     $svc_x->set_usage($valueref, %opt)
2621       if $svc_x->can("set_usage");
2622   }
2623 }
2624
2625 =item recharge USAGE_VALUE_HASHREF
2626
2627 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2628 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2629 upbytes, downbytes, and totalbytes are appropriate keys.
2630
2631 All svc_accts which are part of this package have their values incremented.
2632
2633 =cut
2634
2635 sub recharge {
2636   my ($self, $valueref) = @_;
2637
2638   foreach my $cust_svc ($self->cust_svc){
2639     my $svc_x = $cust_svc->svc_x;
2640     $svc_x->recharge($valueref)
2641       if $svc_x->can("recharge");
2642   }
2643 }
2644
2645 =item cust_pkg_discount
2646
2647 =cut
2648
2649 sub cust_pkg_discount {
2650   my $self = shift;
2651   qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2652 }
2653
2654 =item cust_pkg_discount_active
2655
2656 =cut
2657
2658 sub cust_pkg_discount_active {
2659   my $self = shift;
2660   grep { $_->status eq 'active' } $self->cust_pkg_discount;
2661 }
2662
2663 =back
2664
2665 =head1 CLASS METHODS
2666
2667 =over 4
2668
2669 =item recurring_sql
2670
2671 Returns an SQL expression identifying recurring packages.
2672
2673 =cut
2674
2675 sub recurring_sql { "
2676   '0' != ( select freq from part_pkg
2677              where cust_pkg.pkgpart = part_pkg.pkgpart )
2678 "; }
2679
2680 =item onetime_sql
2681
2682 Returns an SQL expression identifying one-time packages.
2683
2684 =cut
2685
2686 sub onetime_sql { "
2687   '0' = ( select freq from part_pkg
2688             where cust_pkg.pkgpart = part_pkg.pkgpart )
2689 "; }
2690
2691 =item ordered_sql
2692
2693 Returns an SQL expression identifying ordered packages (recurring packages not
2694 yet billed).
2695
2696 =cut
2697
2698 sub ordered_sql {
2699    $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2700 }
2701
2702 =item active_sql
2703
2704 Returns an SQL expression identifying active packages.
2705
2706 =cut
2707
2708 sub active_sql {
2709   $_[0]->recurring_sql. "
2710   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2711   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2712   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2713 "; }
2714
2715 =item not_yet_billed_sql
2716
2717 Returns an SQL expression identifying packages which have not yet been billed.
2718
2719 =cut
2720
2721 sub not_yet_billed_sql { "
2722       ( cust_pkg.setup  IS NULL OR cust_pkg.setup  = 0 )
2723   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2724   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2725 "; }
2726
2727 =item inactive_sql
2728
2729 Returns an SQL expression identifying inactive packages (one-time packages
2730 that are otherwise unsuspended/uncancelled).
2731
2732 =cut
2733
2734 sub inactive_sql { "
2735   ". $_[0]->onetime_sql(). "
2736   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2737   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2738   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2739 "; }
2740
2741 =item susp_sql
2742 =item suspended_sql
2743
2744 Returns an SQL expression identifying suspended packages.
2745
2746 =cut
2747
2748 sub suspended_sql { susp_sql(@_); }
2749 sub susp_sql {
2750   #$_[0]->recurring_sql(). ' AND '.
2751   "
2752         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
2753     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
2754   ";
2755 }
2756
2757 =item cancel_sql
2758 =item cancelled_sql
2759
2760 Returns an SQL exprression identifying cancelled packages.
2761
2762 =cut
2763
2764 sub cancelled_sql { cancel_sql(@_); }
2765 sub cancel_sql {
2766   #$_[0]->recurring_sql(). ' AND '.
2767   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2768 }
2769
2770 =item status_sql
2771
2772 Returns an SQL expression to give the package status as a string.
2773
2774 =cut
2775
2776 sub status_sql {
2777 "CASE
2778   WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
2779   WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
2780   WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
2781   WHEN ".onetime_sql()." THEN 'one-time charge'
2782   ELSE 'active'
2783 END"
2784 }
2785
2786 =item search HASHREF
2787
2788 (Class method)
2789
2790 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2791 Valid parameters are
2792
2793 =over 4
2794
2795 =item agentnum
2796
2797 =item magic
2798
2799 active, inactive, suspended, cancel (or cancelled)
2800
2801 =item status
2802
2803 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2804
2805 =item custom
2806
2807  boolean selects custom packages
2808
2809 =item classnum
2810
2811 =item pkgpart
2812
2813 pkgpart or arrayref or hashref of pkgparts
2814
2815 =item setup
2816
2817 arrayref of beginning and ending epoch date
2818
2819 =item last_bill
2820
2821 arrayref of beginning and ending epoch date
2822
2823 =item bill
2824
2825 arrayref of beginning and ending epoch date
2826
2827 =item adjourn
2828
2829 arrayref of beginning and ending epoch date
2830
2831 =item susp
2832
2833 arrayref of beginning and ending epoch date
2834
2835 =item expire
2836
2837 arrayref of beginning and ending epoch date
2838
2839 =item cancel
2840
2841 arrayref of beginning and ending epoch date
2842
2843 =item query
2844
2845 pkgnum or APKG_pkgnum
2846
2847 =item cust_fields
2848
2849 a value suited to passing to FS::UI::Web::cust_header
2850
2851 =item CurrentUser
2852
2853 specifies the user for agent virtualization
2854
2855 =item fcc_line
2856
2857  boolean selects packages containing fcc form 477 telco lines
2858
2859 =back
2860
2861 =cut
2862
2863 sub search {
2864   my ($class, $params) = @_;
2865   my @where = ();
2866
2867   ##
2868   # parse agent
2869   ##
2870
2871   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2872     push @where,
2873       "cust_main.agentnum = $1";
2874   }
2875
2876   ##
2877   # parse custnum
2878   ##
2879
2880   if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2881     push @where,
2882       "cust_pkg.custnum = $1";
2883   }
2884
2885   ##
2886   # custbatch
2887   ##
2888
2889   if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
2890     push @where,
2891       "cust_pkg.pkgbatch = '$1'";
2892   }
2893
2894   ##
2895   # parse status
2896   ##
2897
2898   if (    $params->{'magic'}  eq 'active'
2899        || $params->{'status'} eq 'active' ) {
2900
2901     push @where, FS::cust_pkg->active_sql();
2902
2903   } elsif (    $params->{'magic'}  =~ /^not[ _]yet[ _]billed$/
2904             || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2905
2906     push @where, FS::cust_pkg->not_yet_billed_sql();
2907
2908   } elsif (    $params->{'magic'}  =~ /^(one-time charge|inactive)/
2909             || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2910
2911     push @where, FS::cust_pkg->inactive_sql();
2912
2913   } elsif (    $params->{'magic'}  eq 'suspended'
2914             || $params->{'status'} eq 'suspended'  ) {
2915
2916     push @where, FS::cust_pkg->suspended_sql();
2917
2918   } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
2919             || $params->{'status'} =~ /^cancell?ed$/ ) {
2920
2921     push @where, FS::cust_pkg->cancelled_sql();
2922
2923   }
2924
2925   ###
2926   # parse package class
2927   ###
2928
2929   #false lazinessish w/graph/cust_bill_pkg.cgi
2930   my $classnum = 0;
2931   my @pkg_class = ();
2932   if ( exists($params->{'classnum'})
2933        && $params->{'classnum'} =~ /^(\d*)$/
2934      )
2935   {
2936     $classnum = $1;
2937     if ( $classnum ) { #a specific class
2938       push @where, "part_pkg.classnum = $classnum";
2939
2940       #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2941       #die "classnum $classnum not found!" unless $pkg_class[0];
2942       #$title .= $pkg_class[0]->classname.' ';
2943
2944     } elsif ( $classnum eq '' ) { #the empty class
2945
2946       push @where, "part_pkg.classnum IS NULL";
2947       #$title .= 'Empty class ';
2948       #@pkg_class = ( '(empty class)' );
2949     } elsif ( $classnum eq '0' ) {
2950       #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2951       #push @pkg_class, '(empty class)';
2952     } else {
2953       die "illegal classnum";
2954     }
2955   }
2956   #eslaf
2957
2958   ###
2959   # parse package report options
2960   ###
2961
2962   my @report_option = ();
2963   if ( exists($params->{'report_option'})
2964        && $params->{'report_option'} =~ /^([,\d]*)$/
2965      )
2966   {
2967     @report_option = split(',', $1);
2968   }
2969
2970   if (@report_option) {
2971     # this will result in the empty set for the dangling comma case as it should
2972     push @where,
2973       map{ "0 < ( SELECT count(*) FROM part_pkg_option
2974                     WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2975                     AND optionname = 'report_option_$_'
2976                     AND optionvalue = '1' )"
2977          } @report_option;
2978   }
2979
2980   #eslaf
2981
2982   ###
2983   # parse custom
2984   ###
2985
2986   push @where,  "part_pkg.custom = 'Y'" if $params->{custom};
2987
2988   ###
2989   # parse fcc_line
2990   ###
2991
2992   push @where,  "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2993
2994   ###
2995   # parse censustract
2996   ###
2997
2998   if ( exists($params->{'censustract'}) ) {
2999     $params->{'censustract'} =~ /^([.\d]*)$/;
3000     my $censustract = "cust_main.censustract = '$1'";
3001     $censustract .= ' OR cust_main.censustract is NULL' unless $1;
3002     push @where,  "( $censustract )";
3003   }
3004
3005   ###
3006   # parse part_pkg
3007   ###
3008
3009   if ( ref($params->{'pkgpart'}) ) {
3010
3011     my @pkgpart = ();
3012     if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
3013       @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
3014     } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
3015       @pkgpart = @{ $params->{'pkgpart'} };
3016     } else {
3017       die 'unhandled pkgpart ref '. $params->{'pkgpart'};
3018     }
3019
3020     @pkgpart = grep /^(\d+)$/, @pkgpart;
3021
3022     push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
3023
3024   } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3025     push @where, "pkgpart = $1";
3026   }
3027
3028   ###
3029   # parse dates
3030   ###
3031
3032   my $orderby = '';
3033
3034   #false laziness w/report_cust_pkg.html
3035   my %disable = (
3036     'all'             => {},
3037     'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
3038     'active'          => { 'susp'=>1, 'cancel'=>1 },
3039     'suspended'       => { 'cancel' => 1 },
3040     'cancelled'       => {},
3041     ''                => {},
3042   );
3043
3044   if( exists($params->{'active'} ) ) {
3045     # This overrides all the other date-related fields
3046     my($beginning, $ending) = @{$params->{'active'}};
3047     push @where,
3048       "cust_pkg.setup IS NOT NULL",
3049       "cust_pkg.setup <= $ending",
3050       "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
3051       "NOT (".FS::cust_pkg->onetime_sql . ")";
3052   }
3053   else {
3054     foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
3055
3056       next unless exists($params->{$field});
3057
3058       my($beginning, $ending) = @{$params->{$field}};
3059
3060       next if $beginning == 0 && $ending == 4294967295;
3061
3062       push @where,
3063         "cust_pkg.$field IS NOT NULL",
3064         "cust_pkg.$field >= $beginning",
3065         "cust_pkg.$field <= $ending";
3066
3067       $orderby ||= "ORDER BY cust_pkg.$field";
3068
3069     }
3070   }
3071
3072   $orderby ||= 'ORDER BY bill';
3073
3074   ###
3075   # parse magic, legacy, etc.
3076   ###
3077
3078   if ( $params->{'magic'} &&
3079        $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
3080   ) {
3081
3082     $orderby = 'ORDER BY pkgnum';
3083
3084     if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3085       push @where, "pkgpart = $1";
3086     }
3087
3088   } elsif ( $params->{'query'} eq 'pkgnum' ) {
3089
3090     $orderby = 'ORDER BY pkgnum';
3091
3092   } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
3093
3094     $orderby = 'ORDER BY pkgnum';
3095
3096     push @where, '0 < (
3097       SELECT count(*) FROM pkg_svc
3098        WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
3099          AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
3100                                    WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
3101                                      AND cust_svc.svcpart = pkg_svc.svcpart
3102                                 )
3103     )';
3104
3105   }
3106
3107   ##
3108   # setup queries, links, subs, etc. for the search
3109   ##
3110
3111   # here is the agent virtualization
3112   if ($params->{CurrentUser}) {
3113     my $access_user =
3114       qsearchs('access_user', { username => $params->{CurrentUser} });
3115
3116     if ($access_user) {
3117       push @where, $access_user->agentnums_sql('table'=>'cust_main');
3118     } else {
3119       push @where, "1=0";
3120     }
3121   } else {
3122     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
3123   }
3124
3125   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
3126
3127   my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
3128                   'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
3129                   'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
3130
3131   my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
3132
3133   my $sql_query = {
3134     'table'       => 'cust_pkg',
3135     'hashref'     => {},
3136     'select'      => join(', ',
3137                                 'cust_pkg.*',
3138                                 ( map "part_pkg.$_", qw( pkg freq ) ),
3139                                 'pkg_class.classname',
3140                                 'cust_main.custnum AS cust_main_custnum',
3141                                 FS::UI::Web::cust_sql_fields(
3142                                   $params->{'cust_fields'}
3143                                 ),
3144                      ),
3145     'extra_sql'   => "$extra_sql $orderby",
3146     'addl_from'   => $addl_from,
3147     'count_query' => $count_query,
3148   };
3149
3150 }
3151
3152 =item fcc_477_count
3153
3154 Returns a list of two package counts.  The first is a count of packages
3155 based on the supplied criteria and the second is the count of residential
3156 packages with those same criteria.  Criteria are specified as in the search
3157 method.
3158
3159 =cut
3160
3161 sub fcc_477_count {
3162   my ($class, $params) = @_;
3163
3164   my $sql_query = $class->search( $params );
3165
3166   my $count_sql = delete($sql_query->{'count_query'});
3167   $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
3168     or die "couldn't parse count_sql";
3169
3170   my $count_sth = dbh->prepare($count_sql)
3171     or die "Error preparing $count_sql: ". dbh->errstr;
3172   $count_sth->execute
3173     or die "Error executing $count_sql: ". $count_sth->errstr;
3174   my $count_arrayref = $count_sth->fetchrow_arrayref;
3175
3176   return ( @$count_arrayref );
3177
3178 }
3179
3180
3181 =item location_sql
3182
3183 Returns a list: the first item is an SQL fragment identifying matching
3184 packages/customers via location (taking into account shipping and package
3185 address taxation, if enabled), and subsequent items are the parameters to
3186 substitute for the placeholders in that fragment.
3187
3188 =cut
3189
3190 sub location_sql {
3191   my($class, %opt) = @_;
3192   my $ornull = $opt{'ornull'};
3193
3194   my $conf = new FS::Conf;
3195
3196   # '?' placeholders in _location_sql_where
3197   my $x = $ornull ? 3 : 2;
3198   my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
3199
3200   my $main_where;
3201   my @main_param;
3202   if ( $conf->exists('tax-ship_address') ) {
3203
3204     $main_where = "(
3205          (     ( ship_last IS NULL     OR  ship_last  = '' )
3206            AND ". _location_sql_where('cust_main', '', $ornull ). "
3207          )
3208       OR (       ship_last IS NOT NULL AND ship_last != ''
3209            AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
3210          )
3211     )";
3212     #    AND payby != 'COMP'
3213
3214     @main_param = ( @bill_param, @bill_param );
3215
3216   } else {
3217
3218     $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
3219     @main_param = @bill_param;
3220
3221   }
3222
3223   my $where;
3224   my @param;
3225   if ( $conf->exists('tax-pkg_address') ) {
3226
3227     my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
3228
3229     $where = " (
3230                     ( cust_pkg.locationnum IS     NULL AND $main_where )
3231                  OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where  )
3232                )
3233              ";
3234     @param = ( @main_param, @bill_param );
3235
3236   } else {
3237
3238     $where = $main_where;
3239     @param = @main_param;
3240
3241   }
3242
3243   ( $where, @param );
3244
3245 }
3246
3247 #subroutine, helper for location_sql
3248 sub _location_sql_where {
3249   my $table  = shift;
3250   my $prefix = @_ ? shift : '';
3251   my $ornull = @_ ? shift : '';
3252
3253 #  $ornull             = $ornull          ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3254
3255   $ornull = $ornull ? ' OR ? IS NULL ' : '';
3256
3257   my $or_empty_city   = " OR ( ? = '' AND $table.${prefix}city   IS NULL ) ";
3258   my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3259   my $or_empty_state =  " OR ( ? = '' AND $table.${prefix}state  IS NULL ) ";
3260
3261 #        ( $table.${prefix}city    = ? $or_empty_city   $ornull )
3262   "
3263         ( $table.${prefix}city    = ? OR ? = '' OR CAST(? AS text) IS NULL )
3264     AND ( $table.${prefix}county  = ? $or_empty_county $ornull )
3265     AND ( $table.${prefix}state   = ? $or_empty_state  $ornull )
3266     AND   $table.${prefix}country = ?
3267   ";
3268 }
3269
3270 =head1 SUBROUTINES
3271
3272 =over 4
3273
3274 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3275
3276 CUSTNUM is a customer (see L<FS::cust_main>)
3277
3278 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3279 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
3280 permitted.
3281
3282 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3283 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
3284 new billing items.  An error is returned if this is not possible (see
3285 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
3286 parameter.
3287
3288 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3289 newly-created cust_pkg objects.
3290
3291 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3292 and inserted.  Multiple FS::pkg_referral records can be created by
3293 setting I<refnum> to an array reference of refnums or a hash reference with
3294 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
3295 record will be created corresponding to cust_main.refnum.
3296
3297 =cut
3298
3299 sub order {
3300   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3301
3302   my $conf = new FS::Conf;
3303
3304   # Transactionize this whole mess
3305   local $SIG{HUP} = 'IGNORE';
3306   local $SIG{INT} = 'IGNORE';
3307   local $SIG{QUIT} = 'IGNORE';
3308   local $SIG{TERM} = 'IGNORE';
3309   local $SIG{TSTP} = 'IGNORE';
3310   local $SIG{PIPE} = 'IGNORE';
3311
3312   my $oldAutoCommit = $FS::UID::AutoCommit;
3313   local $FS::UID::AutoCommit = 0;
3314   my $dbh = dbh;
3315
3316   my $error;
3317 #  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3318 #  return "Customer not found: $custnum" unless $cust_main;
3319
3320   warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3321     if $DEBUG;
3322
3323   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3324                          @$remove_pkgnum;
3325
3326   my $change = scalar(@old_cust_pkg) != 0;
3327
3328   my %hash = ();
3329   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3330
3331     warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3332          " to pkgpart ". $pkgparts->[0]. "\n"
3333       if $DEBUG;
3334
3335     my $err_or_cust_pkg =
3336       $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3337                                 'refnum'  => $refnum,
3338                               );
3339
3340     unless (ref($err_or_cust_pkg)) {
3341       $dbh->rollback if $oldAutoCommit;
3342       return $err_or_cust_pkg;
3343     }
3344
3345     push @$return_cust_pkg, $err_or_cust_pkg;
3346     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3347     return '';
3348
3349   }
3350
3351   # Create the new packages.
3352   foreach my $pkgpart (@$pkgparts) {
3353
3354     warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3355
3356     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3357                                       pkgpart => $pkgpart,
3358                                       refnum  => $refnum,
3359                                       %hash,
3360                                     };
3361     $error = $cust_pkg->insert( 'change' => $change );
3362     if ($error) {
3363       $dbh->rollback if $oldAutoCommit;
3364       return $error;
3365     }
3366     push @$return_cust_pkg, $cust_pkg;
3367   }
3368   # $return_cust_pkg now contains refs to all of the newly
3369   # created packages.
3370
3371   # Transfer services and cancel old packages.
3372   foreach my $old_pkg (@old_cust_pkg) {
3373
3374     warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3375       if $DEBUG;
3376
3377     foreach my $new_pkg (@$return_cust_pkg) {
3378       $error = $old_pkg->transfer($new_pkg);
3379       if ($error and $error == 0) {
3380         # $old_pkg->transfer failed.
3381         $dbh->rollback if $oldAutoCommit;
3382         return $error;
3383       }
3384     }
3385
3386     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3387       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3388       foreach my $new_pkg (@$return_cust_pkg) {
3389         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3390         if ($error and $error == 0) {
3391           # $old_pkg->transfer failed.
3392         $dbh->rollback if $oldAutoCommit;
3393         return $error;
3394         }
3395       }
3396     }
3397
3398     if ($error > 0) {
3399       # Transfers were successful, but we went through all of the
3400       # new packages and still had services left on the old package.
3401       # We can't cancel the package under the circumstances, so abort.
3402       $dbh->rollback if $oldAutoCommit;
3403       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3404     }
3405     $error = $old_pkg->cancel( quiet=>1 );
3406     if ($error) {
3407       $dbh->rollback;
3408       return $error;
3409     }
3410   }
3411   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3412   '';
3413 }
3414
3415 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3416
3417 A bulk change method to change packages for multiple customers.
3418
3419 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3420 L<FS::part_pkg>) to order for each customer.  Duplicates are of course
3421 permitted.
3422
3423 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3424 replace.  The services (see L<FS::cust_svc>) are moved to the
3425 new billing items.  An error is returned if this is not possible (see
3426 L<FS::pkg_svc>).
3427
3428 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3429 newly-created cust_pkg objects.
3430
3431 =cut
3432
3433 sub bulk_change {
3434   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3435
3436   # Transactionize this whole mess
3437   local $SIG{HUP} = 'IGNORE';
3438   local $SIG{INT} = 'IGNORE';
3439   local $SIG{QUIT} = 'IGNORE';
3440   local $SIG{TERM} = 'IGNORE';
3441   local $SIG{TSTP} = 'IGNORE';
3442   local $SIG{PIPE} = 'IGNORE';
3443
3444   my $oldAutoCommit = $FS::UID::AutoCommit;
3445   local $FS::UID::AutoCommit = 0;
3446   my $dbh = dbh;
3447
3448   my @errors;
3449   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3450                          @$remove_pkgnum;
3451
3452   while(scalar(@old_cust_pkg)) {
3453     my @return = ();
3454     my $custnum = $old_cust_pkg[0]->custnum;
3455     my (@remove) = map { $_->pkgnum }
3456                    grep { $_->custnum == $custnum } @old_cust_pkg;
3457     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3458
3459     my $error = order $custnum, $pkgparts, \@remove, \@return;
3460
3461     push @errors, $error
3462       if $error;
3463     push @$return_cust_pkg, @return;
3464   }
3465
3466   if (scalar(@errors)) {
3467     $dbh->rollback if $oldAutoCommit;
3468     return join(' / ', @errors);
3469   }
3470
3471   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3472   '';
3473 }
3474
3475 # Used by FS::Upgrade to migrate to a new database.
3476 sub _upgrade_data {  # class method
3477   my ($class, %opts) = @_;
3478   $class->_upgrade_otaker(%opts);
3479   my @statements = (
3480     # RT#10139, bug resulting in contract_end being set when it shouldn't
3481   'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
3482     # RT#10830, bad calculation of prorate date near end of year
3483     # the date range for bill is December 2009, and we move it forward
3484     # one year if it's before the previous bill date (which it should
3485     # never be)
3486   'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
3487   AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
3488   WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
3489     # RT6628, add order_date to cust_pkg
3490     'update cust_pkg set order_date = (select history_date from h_cust_pkg
3491         where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
3492         history_action = \'insert\') where order_date is null',
3493   );
3494   foreach my $sql (@statements) {
3495     my $sth = dbh->prepare($sql);
3496     $sth->execute or die $sth->errstr;
3497   }
3498 }
3499
3500 =back
3501
3502 =head1 BUGS
3503
3504 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
3505
3506 In sub order, the @pkgparts array (passed by reference) is clobbered.
3507
3508 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
3509 method to pass dates to the recur_prog expression, it should do so.
3510
3511 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3512 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3513 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3514 configuration values.  Probably need a subroutine which decides what to do
3515 based on whether or not we've fetched the user yet, rather than a hash.  See
3516 FS::UID and the TODO.
3517
3518 Now that things are transactional should the check in the insert method be
3519 moved to check ?
3520
3521 =head1 SEE ALSO
3522
3523 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3524 L<FS::pkg_svc>, schema.html from the base documentation
3525
3526 =cut
3527
3528 1;
3529