FS/FS/cust_pkg.pm

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