FS/FS/cust_pkg.pm

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