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
2199                && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
2200           $detail =~ s/, $//;
2201           push @labels, $detail;
2202         }
2203         warn "$me _labels_short   done consolidating services\n"
2204           if $DEBUG;
2205       } else {
2206         warn "$me _labels_short   adding service data\n"
2207           if $DEBUG;
2208         push @labels, map { "$label: $_" } @values;
2209       }
2210     }
2211   }
2212
2213  @labels;
2214
2215 }
2216
2217 =item cust_main
2218
2219 Returns the parent customer object (see L<FS::cust_main>).
2220
2221 =cut
2222
2223 sub cust_main {
2224   my $self = shift;
2225   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
2226 }
2227
2228 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
2229
2230 =item cust_location
2231
2232 Returns the location object, if any (see L<FS::cust_location>).
2233
2234 =item cust_location_or_main
2235
2236 If this package is associated with a location, returns the locaiton (see
2237 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2238
2239 =item location_label [ OPTION => VALUE ... ]
2240
2241 Returns the label of the location object (see L<FS::cust_location>).
2242
2243 =cut
2244
2245 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2246
2247 =item seconds_since TIMESTAMP
2248
2249 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2250 package have been online since TIMESTAMP, according to the session monitor.
2251
2252 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
2253 L<Time::Local> and L<Date::Parse> for conversion functions.
2254
2255 =cut
2256
2257 sub seconds_since {
2258   my($self, $since) = @_;
2259   my $seconds = 0;
2260
2261   foreach my $cust_svc (
2262     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2263   ) {
2264     $seconds += $cust_svc->seconds_since($since);
2265   }
2266
2267   $seconds;
2268
2269 }
2270
2271 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2272
2273 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2274 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2275 (exclusive).
2276
2277 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2278 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
2279 functions.
2280
2281
2282 =cut
2283
2284 sub seconds_since_sqlradacct {
2285   my($self, $start, $end) = @_;
2286
2287   my $seconds = 0;
2288
2289   foreach my $cust_svc (
2290     grep {
2291       my $part_svc = $_->part_svc;
2292       $part_svc->svcdb eq 'svc_acct'
2293         && scalar($part_svc->part_export('sqlradius'));
2294     } $self->cust_svc
2295   ) {
2296     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2297   }
2298
2299   $seconds;
2300
2301 }
2302
2303 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2304
2305 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2306 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2307 TIMESTAMP_END
2308 (exclusive).
2309
2310 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2311 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
2312 functions.
2313
2314 =cut
2315
2316 sub attribute_since_sqlradacct {
2317   my($self, $start, $end, $attrib) = @_;
2318
2319   my $sum = 0;
2320
2321   foreach my $cust_svc (
2322     grep {
2323       my $part_svc = $_->part_svc;
2324       $part_svc->svcdb eq 'svc_acct'
2325         && scalar($part_svc->part_export('sqlradius'));
2326     } $self->cust_svc
2327   ) {
2328     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2329   }
2330
2331   $sum;
2332
2333 }
2334
2335 =item quantity
2336
2337 =cut
2338
2339 sub quantity {
2340   my( $self, $value ) = @_;
2341   if ( defined($value) ) {
2342     $self->setfield('quantity', $value);
2343   }
2344   $self->getfield('quantity') || 1;
2345 }
2346
2347 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2348
2349 Transfers as many services as possible from this package to another package.
2350
2351 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2352 object.  The destination package must already exist.
2353
2354 Services are moved only if the destination allows services with the correct
2355 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
2356 this option with caution!  No provision is made for export differences
2357 between the old and new service definitions.  Probably only should be used
2358 when your exports for all service definitions of a given svcdb are identical.
2359 (attempt a transfer without it first, to move all possible svcpart-matching
2360 services)
2361
2362 Any services that can't be moved remain in the original package.
2363
2364 Returns an error, if there is one; otherwise, returns the number of services
2365 that couldn't be moved.
2366
2367 =cut
2368
2369 sub transfer {
2370   my ($self, $dest_pkgnum, %opt) = @_;
2371
2372   my $remaining = 0;
2373   my $dest;
2374   my %target;
2375
2376   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2377     $dest = $dest_pkgnum;
2378     $dest_pkgnum = $dest->pkgnum;
2379   } else {
2380     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2381   }
2382
2383   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2384
2385   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2386     $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2387   }
2388
2389   foreach my $cust_svc ($dest->cust_svc) {
2390     $target{$cust_svc->svcpart}--;
2391   }
2392
2393   my %svcpart2svcparts = ();
2394   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2395     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2396     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2397       next if exists $svcpart2svcparts{$svcpart};
2398       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2399       $svcpart2svcparts{$svcpart} = [
2400         map  { $_->[0] }
2401         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
2402         map {
2403               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2404                                                    'svcpart' => $_          } );
2405               [ $_,
2406                 $pkg_svc ? $pkg_svc->primary_svc : '',
2407                 $pkg_svc ? $pkg_svc->quantity : 0,
2408               ];
2409             }
2410
2411         grep { $_ != $svcpart }
2412         map  { $_->svcpart }
2413         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2414       ];
2415       warn "alternates for svcpart $svcpart: ".
2416            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2417         if $DEBUG;
2418     }
2419   }
2420
2421   foreach my $cust_svc ($self->cust_svc) {
2422     if($target{$cust_svc->svcpart} > 0) {
2423       $target{$cust_svc->svcpart}--;
2424       my $new = new FS::cust_svc { $cust_svc->hash };
2425       $new->pkgnum($dest_pkgnum);
2426       my $error = $new->replace($cust_svc);
2427       return $error if $error;
2428     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2429       if ( $DEBUG ) {
2430         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2431         warn "alternates to consider: ".
2432              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2433       }
2434       my @alternate = grep {
2435                              warn "considering alternate svcpart $_: ".
2436                                   "$target{$_} available in new package\n"
2437                                if $DEBUG;
2438                              $target{$_} > 0;
2439                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
2440       if ( @alternate ) {
2441         warn "alternate(s) found\n" if $DEBUG;
2442         my $change_svcpart = $alternate[0];
2443         $target{$change_svcpart}--;
2444         my $new = new FS::cust_svc { $cust_svc->hash };
2445         $new->svcpart($change_svcpart);
2446         $new->pkgnum($dest_pkgnum);
2447         my $error = $new->replace($cust_svc);
2448         return $error if $error;
2449       } else {
2450         $remaining++;
2451       }
2452     } else {
2453       $remaining++
2454     }
2455   }
2456   return $remaining;
2457 }
2458
2459 =item reexport
2460
2461 This method is deprecated.  See the I<depend_jobnum> option to the insert and
2462 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2463
2464 =cut
2465
2466 sub reexport {
2467   my $self = shift;
2468
2469   local $SIG{HUP} = 'IGNORE';
2470   local $SIG{INT} = 'IGNORE';
2471   local $SIG{QUIT} = 'IGNORE';
2472   local $SIG{TERM} = 'IGNORE';
2473   local $SIG{TSTP} = 'IGNORE';
2474   local $SIG{PIPE} = 'IGNORE';
2475
2476   my $oldAutoCommit = $FS::UID::AutoCommit;
2477   local $FS::UID::AutoCommit = 0;
2478   my $dbh = dbh;
2479
2480   foreach my $cust_svc ( $self->cust_svc ) {
2481     #false laziness w/svc_Common::insert
2482     my $svc_x = $cust_svc->svc_x;
2483     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2484       my $error = $part_export->export_insert($svc_x);
2485       if ( $error ) {
2486         $dbh->rollback if $oldAutoCommit;
2487         return $error;
2488       }
2489     }
2490   }
2491
2492   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2493   '';
2494
2495 }
2496
2497 =item insert_reason
2498
2499 Associates this package with a (suspension or cancellation) reason (see
2500 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2501 L<FS::reason>).
2502
2503 Available options are:
2504
2505 =over 4
2506
2507 =item reason
2508
2509 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.
2510
2511 =item reason_otaker
2512
2513 the access_user (see L<FS::access_user>) providing the reason
2514
2515 =item date
2516
2517 a unix timestamp
2518
2519 =item action
2520
2521 the action (cancel, susp, adjourn, expire) associated with the reason
2522
2523 =back
2524
2525 If there is an error, returns the error, otherwise returns false.
2526
2527 =cut
2528
2529 sub insert_reason {
2530   my ($self, %options) = @_;
2531
2532   my $otaker = $options{reason_otaker} ||
2533                $FS::CurrentUser::CurrentUser->username;
2534
2535   my $reasonnum;
2536   if ( $options{'reason'} =~ /^(\d+)$/ ) {
2537
2538     $reasonnum = $1;
2539
2540   } elsif ( ref($options{'reason'}) ) {
2541
2542     return 'Enter a new reason (or select an existing one)'
2543       unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2544
2545     my $reason = new FS::reason({
2546       'reason_type' => $options{'reason'}->{'typenum'},
2547       'reason'      => $options{'reason'}->{'reason'},
2548     });
2549     my $error = $reason->insert;
2550     return $error if $error;
2551
2552     $reasonnum = $reason->reasonnum;
2553
2554   } else {
2555     return "Unparsable reason: ". $options{'reason'};
2556   }
2557
2558   my $cust_pkg_reason =
2559     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
2560                               'reasonnum' => $reasonnum,
2561                               'otaker'    => $otaker,
2562                               'action'    => substr(uc($options{'action'}),0,1),
2563                               'date'      => $options{'date'}
2564                                                ? $options{'date'}
2565                                                : time,
2566                             });
2567
2568   $cust_pkg_reason->insert;
2569 }
2570
2571 =item insert_discount
2572
2573 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2574 inserting a new discount on the fly (see L<FS::discount>).
2575
2576 Available options are:
2577
2578 =over 4
2579
2580 =item discountnum
2581
2582 =back
2583
2584 If there is an error, returns the error, otherwise returns false.
2585
2586 =cut
2587
2588 sub insert_discount {
2589   #my ($self, %options) = @_;
2590   my $self = shift;
2591
2592   my $cust_pkg_discount = new FS::cust_pkg_discount {
2593     'pkgnum'      => $self->pkgnum,
2594     'discountnum' => $self->discountnum,
2595     'months_used' => 0,
2596     'end_date'    => '', #XXX
2597     #for the create a new discount case
2598     '_type'       => $self->discountnum__type,
2599     'amount'      => $self->discountnum_amount,
2600     'percent'     => $self->discountnum_percent,
2601     'months'      => $self->discountnum_months,
2602     #'disabled'    => $self->discountnum_disabled,
2603   };
2604
2605   $cust_pkg_discount->insert;
2606 }
2607
2608 =item set_usage USAGE_VALUE_HASHREF
2609
2610 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2611 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2612 upbytes, downbytes, and totalbytes are appropriate keys.
2613
2614 All svc_accts which are part of this package have their values reset.
2615
2616 =cut
2617
2618 sub set_usage {
2619   my ($self, $valueref, %opt) = @_;
2620
2621   foreach my $cust_svc ($self->cust_svc){
2622     my $svc_x = $cust_svc->svc_x;
2623     $svc_x->set_usage($valueref, %opt)
2624       if $svc_x->can("set_usage");
2625   }
2626 }
2627
2628 =item recharge USAGE_VALUE_HASHREF
2629
2630 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2631 to which they should be set (see L<FS::svc_acct>).  Currently seconds,
2632 upbytes, downbytes, and totalbytes are appropriate keys.
2633
2634 All svc_accts which are part of this package have their values incremented.
2635
2636 =cut
2637
2638 sub recharge {
2639   my ($self, $valueref) = @_;
2640
2641   foreach my $cust_svc ($self->cust_svc){
2642     my $svc_x = $cust_svc->svc_x;
2643     $svc_x->recharge($valueref)
2644       if $svc_x->can("recharge");
2645   }
2646 }
2647
2648 =item cust_pkg_discount
2649
2650 =cut
2651
2652 sub cust_pkg_discount {
2653   my $self = shift;
2654   qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2655 }
2656
2657 =item cust_pkg_discount_active
2658
2659 =cut
2660
2661 sub cust_pkg_discount_active {
2662   my $self = shift;
2663   grep { $_->status eq 'active' } $self->cust_pkg_discount;
2664 }
2665
2666 =back
2667
2668 =head1 CLASS METHODS
2669
2670 =over 4
2671
2672 =item recurring_sql
2673
2674 Returns an SQL expression identifying recurring packages.
2675
2676 =cut
2677
2678 sub recurring_sql { "
2679   '0' != ( select freq from part_pkg
2680              where cust_pkg.pkgpart = part_pkg.pkgpart )
2681 "; }
2682
2683 =item onetime_sql
2684
2685 Returns an SQL expression identifying one-time packages.
2686
2687 =cut
2688
2689 sub onetime_sql { "
2690   '0' = ( select freq from part_pkg
2691             where cust_pkg.pkgpart = part_pkg.pkgpart )
2692 "; }
2693
2694 =item ordered_sql
2695
2696 Returns an SQL expression identifying ordered packages (recurring packages not
2697 yet billed).
2698
2699 =cut
2700
2701 sub ordered_sql {
2702    $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2703 }
2704
2705 =item active_sql
2706
2707 Returns an SQL expression identifying active packages.
2708
2709 =cut
2710
2711 sub active_sql {
2712   $_[0]->recurring_sql. "
2713   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2714   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2715   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2716 "; }
2717
2718 =item not_yet_billed_sql
2719
2720 Returns an SQL expression identifying packages which have not yet been billed.
2721
2722 =cut
2723
2724 sub not_yet_billed_sql { "
2725       ( cust_pkg.setup  IS NULL OR cust_pkg.setup  = 0 )
2726   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2727   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2728 "; }
2729
2730 =item inactive_sql
2731
2732 Returns an SQL expression identifying inactive packages (one-time packages
2733 that are otherwise unsuspended/uncancelled).
2734
2735 =cut
2736
2737 sub inactive_sql { "
2738   ". $_[0]->onetime_sql(). "
2739   AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2740   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2741   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2742 "; }
2743
2744 =item susp_sql
2745 =item suspended_sql
2746
2747 Returns an SQL expression identifying suspended packages.
2748
2749 =cut
2750
2751 sub suspended_sql { susp_sql(@_); }
2752 sub susp_sql {
2753   #$_[0]->recurring_sql(). ' AND '.
2754   "
2755         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
2756     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
2757   ";
2758 }
2759
2760 =item cancel_sql
2761 =item cancelled_sql
2762
2763 Returns an SQL exprression identifying cancelled packages.
2764
2765 =cut
2766
2767 sub cancelled_sql { cancel_sql(@_); }
2768 sub cancel_sql {
2769   #$_[0]->recurring_sql(). ' AND '.
2770   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2771 }
2772
2773 =item status_sql
2774
2775 Returns an SQL expression to give the package status as a string.
2776
2777 =cut
2778
2779 sub status_sql {
2780 "CASE
2781   WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
2782   WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
2783   WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
2784   WHEN ".onetime_sql()." THEN 'one-time charge'
2785   ELSE 'active'
2786 END"
2787 }
2788
2789 =item search HASHREF
2790
2791 (Class method)
2792
2793 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2794 Valid parameters are
2795
2796 =over 4
2797
2798 =item agentnum
2799
2800 =item magic
2801
2802 active, inactive, suspended, cancel (or cancelled)
2803
2804 =item status
2805
2806 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2807
2808 =item custom
2809
2810  boolean selects custom packages
2811
2812 =item classnum
2813
2814 =item pkgpart
2815
2816 pkgpart or arrayref or hashref of pkgparts
2817
2818 =item setup
2819
2820 arrayref of beginning and ending epoch date
2821
2822 =item last_bill
2823
2824 arrayref of beginning and ending epoch date
2825
2826 =item bill
2827
2828 arrayref of beginning and ending epoch date
2829
2830 =item adjourn
2831
2832 arrayref of beginning and ending epoch date
2833
2834 =item susp
2835
2836 arrayref of beginning and ending epoch date
2837
2838 =item expire
2839
2840 arrayref of beginning and ending epoch date
2841
2842 =item cancel
2843
2844 arrayref of beginning and ending epoch date
2845
2846 =item query
2847
2848 pkgnum or APKG_pkgnum
2849
2850 =item cust_fields
2851
2852 a value suited to passing to FS::UI::Web::cust_header
2853
2854 =item CurrentUser
2855
2856 specifies the user for agent virtualization
2857
2858 =item fcc_line
2859
2860  boolean selects packages containing fcc form 477 telco lines
2861
2862 =back
2863
2864 =cut
2865
2866 sub search {
2867   my ($class, $params) = @_;
2868   my @where = ();
2869
2870   ##
2871   # parse agent
2872   ##
2873
2874   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2875     push @where,
2876       "cust_main.agentnum = $1";
2877   }
2878
2879   ##
2880   # parse custnum
2881   ##
2882
2883   if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2884     push @where,
2885       "cust_pkg.custnum = $1";
2886   }
2887
2888   ##
2889   # custbatch
2890   ##
2891
2892   if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
2893     push @where,
2894       "cust_pkg.pkgbatch = '$1'";
2895   }
2896
2897   ##
2898   # parse status
2899   ##
2900
2901   if (    $params->{'magic'}  eq 'active'
2902        || $params->{'status'} eq 'active' ) {
2903
2904     push @where, FS::cust_pkg->active_sql();
2905
2906   } elsif (    $params->{'magic'}  =~ /^not[ _]yet[ _]billed$/
2907             || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2908
2909     push @where, FS::cust_pkg->not_yet_billed_sql();
2910
2911   } elsif (    $params->{'magic'}  =~ /^(one-time charge|inactive)/
2912             || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2913
2914     push @where, FS::cust_pkg->inactive_sql();
2915
2916   } elsif (    $params->{'magic'}  eq 'suspended'
2917             || $params->{'status'} eq 'suspended'  ) {
2918
2919     push @where, FS::cust_pkg->suspended_sql();
2920
2921   } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
2922             || $params->{'status'} =~ /^cancell?ed$/ ) {
2923
2924     push @where, FS::cust_pkg->cancelled_sql();
2925
2926   }
2927
2928   ###
2929   # parse package class
2930   ###
2931
2932   #false lazinessish w/graph/cust_bill_pkg.cgi
2933   my $classnum = 0;
2934   my @pkg_class = ();
2935   if ( exists($params->{'classnum'})
2936        && $params->{'classnum'} =~ /^(\d*)$/
2937      )
2938   {
2939     $classnum = $1;
2940     if ( $classnum ) { #a specific class
2941       push @where, "part_pkg.classnum = $classnum";
2942
2943       #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2944       #die "classnum $classnum not found!" unless $pkg_class[0];
2945       #$title .= $pkg_class[0]->classname.' ';
2946
2947     } elsif ( $classnum eq '' ) { #the empty class
2948
2949       push @where, "part_pkg.classnum IS NULL";
2950       #$title .= 'Empty class ';
2951       #@pkg_class = ( '(empty class)' );
2952     } elsif ( $classnum eq '0' ) {
2953       #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2954       #push @pkg_class, '(empty class)';
2955     } else {
2956       die "illegal classnum";
2957     }
2958   }
2959   #eslaf
2960
2961   ###
2962   # parse package report options
2963   ###
2964
2965   my @report_option = ();
2966   if ( exists($params->{'report_option'})
2967        && $params->{'report_option'} =~ /^([,\d]*)$/
2968      )
2969   {
2970     @report_option = split(',', $1);
2971   }
2972
2973   if (@report_option) {
2974     # this will result in the empty set for the dangling comma case as it should
2975     push @where,
2976       map{ "0 < ( SELECT count(*) FROM part_pkg_option
2977                     WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2978                     AND optionname = 'report_option_$_'
2979                     AND optionvalue = '1' )"
2980          } @report_option;
2981   }
2982
2983   #eslaf
2984
2985   ###
2986   # parse custom
2987   ###
2988
2989   push @where,  "part_pkg.custom = 'Y'" if $params->{custom};
2990
2991   ###
2992   # parse fcc_line
2993   ###
2994
2995   push @where,  "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2996
2997   ###
2998   # parse censustract
2999   ###
3000
3001   if ( exists($params->{'censustract'}) ) {
3002     $params->{'censustract'} =~ /^([.\d]*)$/;
3003     my $censustract = "cust_main.censustract = '$1'";
3004     $censustract .= ' OR cust_main.censustract is NULL' unless $1;
3005     push @where,  "( $censustract )";
3006   }
3007
3008   ###
3009   # parse part_pkg
3010   ###
3011
3012   if ( ref($params->{'pkgpart'}) ) {
3013
3014     my @pkgpart = ();
3015     if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
3016       @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
3017     } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
3018       @pkgpart = @{ $params->{'pkgpart'} };
3019     } else {
3020       die 'unhandled pkgpart ref '. $params->{'pkgpart'};
3021     }
3022
3023     @pkgpart = grep /^(\d+)$/, @pkgpart;
3024
3025     push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
3026
3027   } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3028     push @where, "pkgpart = $1";
3029   }
3030
3031   ###
3032   # parse dates
3033   ###
3034
3035   my $orderby = '';
3036
3037   #false laziness w/report_cust_pkg.html
3038   my %disable = (
3039     'all'             => {},
3040     'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
3041     'active'          => { 'susp'=>1, 'cancel'=>1 },
3042     'suspended'       => { 'cancel' => 1 },
3043     'cancelled'       => {},
3044     ''                => {},
3045   );
3046
3047   if( exists($params->{'active'} ) ) {
3048     # This overrides all the other date-related fields
3049     my($beginning, $ending) = @{$params->{'active'}};
3050     push @where,
3051       "cust_pkg.setup IS NOT NULL",
3052       "cust_pkg.setup <= $ending",
3053       "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
3054       "NOT (".FS::cust_pkg->onetime_sql . ")";
3055   }
3056   else {
3057     foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
3058
3059       next unless exists($params->{$field});
3060
3061       my($beginning, $ending) = @{$params->{$field}};
3062
3063       next if $beginning == 0 && $ending == 4294967295;
3064
3065       push @where,
3066         "cust_pkg.$field IS NOT NULL",
3067         "cust_pkg.$field >= $beginning",
3068         "cust_pkg.$field <= $ending";
3069
3070       $orderby ||= "ORDER BY cust_pkg.$field";
3071
3072     }
3073   }
3074
3075   $orderby ||= 'ORDER BY bill';
3076
3077   ###
3078   # parse magic, legacy, etc.
3079   ###
3080
3081   if ( $params->{'magic'} &&
3082        $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
3083   ) {
3084
3085     $orderby = 'ORDER BY pkgnum';
3086
3087     if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3088       push @where, "pkgpart = $1";
3089     }
3090
3091   } elsif ( $params->{'query'} eq 'pkgnum' ) {
3092
3093     $orderby = 'ORDER BY pkgnum';
3094
3095   } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
3096
3097     $orderby = 'ORDER BY pkgnum';
3098
3099     push @where, '0 < (
3100       SELECT count(*) FROM pkg_svc
3101        WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
3102          AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
3103                                    WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
3104                                      AND cust_svc.svcpart = pkg_svc.svcpart
3105                                 )
3106     )';
3107
3108   }
3109
3110   ##
3111   # setup queries, links, subs, etc. for the search
3112   ##
3113
3114   # here is the agent virtualization
3115   if ($params->{CurrentUser}) {
3116     my $access_user =
3117       qsearchs('access_user', { username => $params->{CurrentUser} });
3118
3119     if ($access_user) {
3120       push @where, $access_user->agentnums_sql('table'=>'cust_main');
3121     } else {
3122       push @where, "1=0";
3123     }
3124   } else {
3125     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
3126   }
3127
3128   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
3129
3130   my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
3131                   'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
3132                   'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
3133
3134   my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
3135
3136   my $sql_query = {
3137     'table'       => 'cust_pkg',
3138     'hashref'     => {},
3139     'select'      => join(', ',
3140                                 'cust_pkg.*',
3141                                 ( map "part_pkg.$_", qw( pkg freq ) ),
3142                                 'pkg_class.classname',
3143                                 'cust_main.custnum AS cust_main_custnum',
3144                                 FS::UI::Web::cust_sql_fields(
3145                                   $params->{'cust_fields'}
3146                                 ),
3147                      ),
3148     'extra_sql'   => "$extra_sql $orderby",
3149     'addl_from'   => $addl_from,
3150     'count_query' => $count_query,
3151   };
3152
3153 }
3154
3155 =item fcc_477_count
3156
3157 Returns a list of two package counts.  The first is a count of packages
3158 based on the supplied criteria and the second is the count of residential
3159 packages with those same criteria.  Criteria are specified as in the search
3160 method.
3161
3162 =cut
3163
3164 sub fcc_477_count {
3165   my ($class, $params) = @_;
3166
3167   my $sql_query = $class->search( $params );
3168
3169   my $count_sql = delete($sql_query->{'count_query'});
3170   $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
3171     or die "couldn't parse count_sql";
3172
3173   my $count_sth = dbh->prepare($count_sql)
3174     or die "Error preparing $count_sql: ". dbh->errstr;
3175   $count_sth->execute
3176     or die "Error executing $count_sql: ". $count_sth->errstr;
3177   my $count_arrayref = $count_sth->fetchrow_arrayref;
3178
3179   return ( @$count_arrayref );
3180
3181 }
3182
3183
3184 =item location_sql
3185
3186 Returns a list: the first item is an SQL fragment identifying matching
3187 packages/customers via location (taking into account shipping and package
3188 address taxation, if enabled), and subsequent items are the parameters to
3189 substitute for the placeholders in that fragment.
3190
3191 =cut
3192
3193 sub location_sql {
3194   my($class, %opt) = @_;
3195   my $ornull = $opt{'ornull'};
3196
3197   my $conf = new FS::Conf;
3198
3199   # '?' placeholders in _location_sql_where
3200   my $x = $ornull ? 3 : 2;
3201   my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
3202
3203   my $main_where;
3204   my @main_param;
3205   if ( $conf->exists('tax-ship_address') ) {
3206
3207     $main_where = "(
3208          (     ( ship_last IS NULL     OR  ship_last  = '' )
3209            AND ". _location_sql_where('cust_main', '', $ornull ). "
3210          )
3211       OR (       ship_last IS NOT NULL AND ship_last != ''
3212            AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
3213          )
3214     )";
3215     #    AND payby != 'COMP'
3216
3217     @main_param = ( @bill_param, @bill_param );
3218
3219   } else {
3220
3221     $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
3222     @main_param = @bill_param;
3223
3224   }
3225
3226   my $where;
3227   my @param;
3228   if ( $conf->exists('tax-pkg_address') ) {
3229
3230     my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
3231
3232     $where = " (
3233                     ( cust_pkg.locationnum IS     NULL AND $main_where )
3234                  OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where  )
3235                )
3236              ";
3237     @param = ( @main_param, @bill_param );
3238
3239   } else {
3240
3241     $where = $main_where;
3242     @param = @main_param;
3243
3244   }
3245
3246   ( $where, @param );
3247
3248 }
3249
3250 #subroutine, helper for location_sql
3251 sub _location_sql_where {
3252   my $table  = shift;
3253   my $prefix = @_ ? shift : '';
3254   my $ornull = @_ ? shift : '';
3255
3256 #  $ornull             = $ornull          ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3257
3258   $ornull = $ornull ? ' OR ? IS NULL ' : '';
3259
3260   my $or_empty_city   = " OR ( ? = '' AND $table.${prefix}city   IS NULL ) ";
3261   my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3262   my $or_empty_state =  " OR ( ? = '' AND $table.${prefix}state  IS NULL ) ";
3263
3264 #        ( $table.${prefix}city    = ? $or_empty_city   $ornull )
3265   "
3266         ( $table.${prefix}city    = ? OR ? = '' OR CAST(? AS text) IS NULL )
3267     AND ( $table.${prefix}county  = ? $or_empty_county $ornull )
3268     AND ( $table.${prefix}state   = ? $or_empty_state  $ornull )
3269     AND   $table.${prefix}country = ?
3270   ";
3271 }
3272
3273 =head1 SUBROUTINES
3274
3275 =over 4
3276
3277 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3278
3279 CUSTNUM is a customer (see L<FS::cust_main>)
3280
3281 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3282 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
3283 permitted.
3284
3285 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3286 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
3287 new billing items.  An error is returned if this is not possible (see
3288 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
3289 parameter.
3290
3291 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3292 newly-created cust_pkg objects.
3293
3294 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3295 and inserted.  Multiple FS::pkg_referral records can be created by
3296 setting I<refnum> to an array reference of refnums or a hash reference with
3297 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
3298 record will be created corresponding to cust_main.refnum.
3299
3300 =cut
3301
3302 sub order {
3303   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3304
3305   my $conf = new FS::Conf;
3306
3307   # Transactionize this whole mess
3308   local $SIG{HUP} = 'IGNORE';
3309   local $SIG{INT} = 'IGNORE';
3310   local $SIG{QUIT} = 'IGNORE';
3311   local $SIG{TERM} = 'IGNORE';
3312   local $SIG{TSTP} = 'IGNORE';
3313   local $SIG{PIPE} = 'IGNORE';
3314
3315   my $oldAutoCommit = $FS::UID::AutoCommit;
3316   local $FS::UID::AutoCommit = 0;
3317   my $dbh = dbh;
3318
3319   my $error;
3320 #  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3321 #  return "Customer not found: $custnum" unless $cust_main;
3322
3323   warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3324     if $DEBUG;
3325
3326   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3327                          @$remove_pkgnum;
3328
3329   my $change = scalar(@old_cust_pkg) != 0;
3330
3331   my %hash = ();
3332   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3333
3334     warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3335          " to pkgpart ". $pkgparts->[0]. "\n"
3336       if $DEBUG;
3337
3338     my $err_or_cust_pkg =
3339       $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3340                                 'refnum'  => $refnum,
3341                               );
3342
3343     unless (ref($err_or_cust_pkg)) {
3344       $dbh->rollback if $oldAutoCommit;
3345       return $err_or_cust_pkg;
3346     }
3347
3348     push @$return_cust_pkg, $err_or_cust_pkg;
3349     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3350     return '';
3351
3352   }
3353
3354   # Create the new packages.
3355   foreach my $pkgpart (@$pkgparts) {
3356
3357     warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3358
3359     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3360                                       pkgpart => $pkgpart,
3361                                       refnum  => $refnum,
3362                                       %hash,
3363                                     };
3364     $error = $cust_pkg->insert( 'change' => $change );
3365     if ($error) {
3366       $dbh->rollback if $oldAutoCommit;
3367       return $error;
3368     }
3369     push @$return_cust_pkg, $cust_pkg;
3370   }
3371   # $return_cust_pkg now contains refs to all of the newly
3372   # created packages.
3373
3374   # Transfer services and cancel old packages.
3375   foreach my $old_pkg (@old_cust_pkg) {
3376
3377     warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3378       if $DEBUG;
3379
3380     foreach my $new_pkg (@$return_cust_pkg) {
3381       $error = $old_pkg->transfer($new_pkg);
3382       if ($error and $error == 0) {
3383         # $old_pkg->transfer failed.
3384         $dbh->rollback if $oldAutoCommit;
3385         return $error;
3386       }
3387     }
3388
3389     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3390       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3391       foreach my $new_pkg (@$return_cust_pkg) {
3392         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3393         if ($error and $error == 0) {
3394           # $old_pkg->transfer failed.
3395         $dbh->rollback if $oldAutoCommit;
3396         return $error;
3397         }
3398       }
3399     }
3400
3401     if ($error > 0) {
3402       # Transfers were successful, but we went through all of the
3403       # new packages and still had services left on the old package.
3404       # We can't cancel the package under the circumstances, so abort.
3405       $dbh->rollback if $oldAutoCommit;
3406       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3407     }
3408     $error = $old_pkg->cancel( quiet=>1 );
3409     if ($error) {
3410       $dbh->rollback;
3411       return $error;
3412     }
3413   }
3414   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3415   '';
3416 }
3417
3418 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3419
3420 A bulk change method to change packages for multiple customers.
3421
3422 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3423 L<FS::part_pkg>) to order for each customer.  Duplicates are of course
3424 permitted.
3425
3426 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3427 replace.  The services (see L<FS::cust_svc>) are moved to the
3428 new billing items.  An error is returned if this is not possible (see
3429 L<FS::pkg_svc>).
3430
3431 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3432 newly-created cust_pkg objects.
3433
3434 =cut
3435
3436 sub bulk_change {
3437   my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3438
3439   # Transactionize this whole mess
3440   local $SIG{HUP} = 'IGNORE';
3441   local $SIG{INT} = 'IGNORE';
3442   local $SIG{QUIT} = 'IGNORE';
3443   local $SIG{TERM} = 'IGNORE';
3444   local $SIG{TSTP} = 'IGNORE';
3445   local $SIG{PIPE} = 'IGNORE';
3446
3447   my $oldAutoCommit = $FS::UID::AutoCommit;
3448   local $FS::UID::AutoCommit = 0;
3449   my $dbh = dbh;
3450
3451   my @errors;
3452   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3453                          @$remove_pkgnum;
3454
3455   while(scalar(@old_cust_pkg)) {
3456     my @return = ();
3457     my $custnum = $old_cust_pkg[0]->custnum;
3458     my (@remove) = map { $_->pkgnum }
3459                    grep { $_->custnum == $custnum } @old_cust_pkg;
3460     @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3461
3462     my $error = order $custnum, $pkgparts, \@remove, \@return;
3463
3464     push @errors, $error
3465       if $error;
3466     push @$return_cust_pkg, @return;
3467   }
3468
3469   if (scalar(@errors)) {
3470     $dbh->rollback if $oldAutoCommit;
3471     return join(' / ', @errors);
3472   }
3473
3474   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3475   '';
3476 }
3477
3478 # Used by FS::Upgrade to migrate to a new database.
3479 sub _upgrade_data {  # class method
3480   my ($class, %opts) = @_;
3481   $class->_upgrade_otaker(%opts);
3482   my @statements = (
3483     # RT#10139, bug resulting in contract_end being set when it shouldn't
3484   'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
3485     # RT#10830, bad calculation of prorate date near end of year
3486     # the date range for bill is December 2009, and we move it forward
3487     # one year if it's before the previous bill date (which it should
3488     # never be)
3489   'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
3490   AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
3491   WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
3492     # RT6628, add order_date to cust_pkg
3493     'update cust_pkg set order_date = (select history_date from h_cust_pkg
3494         where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
3495         history_action = \'insert\') where order_date is null',
3496   );
3497   foreach my $sql (@statements) {
3498     my $sth = dbh->prepare($sql);
3499     $sth->execute or die $sth->errstr;
3500   }
3501 }
3502
3503 =back
3504
3505 =head1 BUGS
3506
3507 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
3508
3509 In sub order, the @pkgparts array (passed by reference) is clobbered.
3510
3511 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
3512 method to pass dates to the recur_prog expression, it should do so.
3513
3514 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3515 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3516 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3517 configuration values.  Probably need a subroutine which decides what to do
3518 based on whether or not we've fetched the user yet, rather than a hash.  See
3519 FS::UID and the TODO.
3520
3521 Now that things are transactional should the check in the insert method be
3522 moved to check ?
3523
3524 =head1 SEE ALSO
3525
3526 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3527 L<FS::pkg_svc>, schema.html from the base documentation
3528
3529 =cut
3530
3531 1;
3532