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