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