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