FS/FS/cust_pkg.pm

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