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