FS/FS/cust_pkg.pm

   1 package FS::cust_pkg;
   2
   3 use strict;
   4 use vars qw(@ISA);
   5 use FS::UID qw( getotaker dbh );
   6 use FS::Record qw( qsearch qsearchs );
   7 use FS::cust_svc;
   8 use FS::part_pkg;
   9 use FS::cust_main;
  10 use FS::type_pkgs;
  11 use FS::pkg_svc;
  12 use FS::cust_bill_pkg;
  13
  14 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
  15 # setup }
  16 # because they load configuraion by setting FS::UID::callback (see TODO)
  17 use FS::svc_acct;
  18 use FS::svc_acct_sm;
  19 use FS::svc_domain;
  20 use FS::svc_www;
  21 use FS::svc_forward;
  22
  23 @ISA = qw( FS::Record );
  24
  25 sub _cache {
  26   my $self = shift;
  27   my ( $hashref, $cache ) = @_;
  28   #if ( $hashref->{'pkgpart'} ) {
  29   if ( $hashref->{'pkg'} ) {
  30     # #@{ $self->{'_pkgnum'} } = ();
  31     # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
  32     # $self->{'_pkgpart'} = $subcache;
  33     # #push @{ $self->{'_pkgnum'} },
  34     #   FS::part_pkg->new_or_cached($hashref, $subcache);
  35     $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
  36   }
  37   if ( exists $hashref->{'svcnum'} ) {
  38     #@{ $self->{'_pkgnum'} } = ();
  39     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
  40     $self->{'_svcnum'} = $subcache;
  41     #push @{ $self->{'_pkgnum'} },
  42     FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
  43   }
  44 }
  45
  46 =head1 NAME
  47
  48 FS::cust_pkg - Object methods for cust_pkg objects
  49
  50 =head1 SYNOPSIS
  51
  52   use FS::cust_pkg;
  53
  54   $record = new FS::cust_pkg \%hash;
  55   $record = new FS::cust_pkg { 'column' => 'value' };
  56
  57   $error = $record->insert;
  58
  59   $error = $new_record->replace($old_record);
  60
  61   $error = $record->delete;
  62
  63   $error = $record->check;
  64
  65   $error = $record->cancel;
  66
  67   $error = $record->suspend;
  68
  69   $error = $record->unsuspend;
  70
  71   $part_pkg = $record->part_pkg;
  72
  73   @labels = $record->labels;
  74
  75   $seconds = $record->seconds_since($timestamp);
  76
  77   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
  78   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
  79
  80 =head1 DESCRIPTION
  81
  82 An FS::cust_pkg object represents a customer billing item.  FS::cust_pkg
  83 inherits from FS::Record.  The following fields are currently supported:
  84
  85 =over 4
  86
  87 =item pkgnum - primary key (assigned automatically for new billing items)
  88
  89 =item custnum - Customer (see L<FS::cust_main>)
  90
  91 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
  92
  93 =item setup - date
  94
  95 =item bill - date (next bill date)
  96
  97 =item susp - date
  98
  99 =item expire - date
 100
 101 =item cancel - date
 102
 103 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
 104
 105 =item manual_flag - If this field is set to 1, disables the automatic
 106 unsuspension of this package when using the B<unsuspendauto> config file.
 107
 108 =back
 109
 110 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
 111 see L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for
 112 conversion functions.
 113
 114 =head1 METHODS
 115
 116 =over 4
 117
 118 =item new HASHREF
 119
 120 Create a new billing item.  To add the item to the database, see L<"insert">.
 121
 122 =cut
 123
 124 sub table { 'cust_pkg'; }
 125
 126 =item insert
 127
 128 Adds this billing item to the database ("Orders" the item).  If there is an
 129 error, returns the error, otherwise returns false.
 130
 131 =cut
 132
 133 sub insert {
 134   my $self = shift;
 135
 136   # custnum might not have have been defined in sub check (for one-shot new
 137   # customers), so check it here instead
 138   # (is this still necessary with transactions?)
 139
 140   my $error = $self->ut_number('custnum');
 141   return $error if $error;
 142
 143   my $cust_main = $self->cust_main;
 144   return "Unknown customer ". $self->custnum unless $cust_main;
 145
 146   my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
 147   my $pkgpart_href = $agent->pkgpart_hashref;
 148   return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart
 149     unless $pkgpart_href->{ $self->pkgpart };
 150
 151   $self->SUPER::insert;
 152
 153 }
 154
 155 =item delete
 156
 157 This method now works but you probably shouldn't use it.
 158
 159 You don't want to delete billing items, because there would then be no record
 160 the customer ever purchased the item.  Instead, see the cancel method.
 161
 162 =cut
 163
 164 #sub delete {
 165 #  return "Can't delete cust_pkg records!";
 166 #}
 167
 168 =item replace OLD_RECORD
 169
 170 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 171 returns the error, otherwise returns false.
 172
 173 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
 174
 175 Changing pkgpart may have disasterous effects.  See the order subroutine.
 176
 177 setup and bill are normally updated by calling the bill method of a customer
 178 object (see L<FS::cust_main>).
 179
 180 suspend is normally updated by the suspend and unsuspend methods.
 181
 182 cancel is normally updated by the cancel method (and also the order subroutine
 183 in some cases).
 184
 185 =cut
 186
 187 sub replace {
 188   my( $new, $old ) = ( shift, shift );
 189
 190   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
 191   return "Can't change otaker!" if $old->otaker ne $new->otaker;
 192
 193   #allow this *sigh*
 194   #return "Can't change setup once it exists!"
 195   #  if $old->getfield('setup') &&
 196   #     $old->getfield('setup') != $new->getfield('setup');
 197
 198   #some logic for bill, susp, cancel?
 199
 200   $new->SUPER::replace($old);
 201 }
 202
 203 =item check
 204
 205 Checks all fields to make sure this is a valid billing item.  If there is an
 206 error, returns the error, otherwise returns false.  Called by the insert and
 207 replace methods.
 208
 209 =cut
 210
 211 sub check {
 212   my $self = shift;
 213
 214   my $error =
 215     $self->ut_numbern('pkgnum')
 216     || $self->ut_numbern('custnum')
 217     || $self->ut_number('pkgpart')
 218     || $self->ut_numbern('setup')
 219     || $self->ut_numbern('bill')
 220     || $self->ut_numbern('susp')
 221     || $self->ut_numbern('cancel')
 222   ;
 223   return $error if $error;
 224
 225   if ( $self->custnum ) {
 226     return "Unknown customer ". $self->custnum unless $self->cust_main;
 227   }
 228
 229   return "Unknown pkgpart: ". $self->pkgpart
 230     unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 231
 232   $self->otaker(getotaker) unless $self->otaker;
 233   $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
 234   $self->otaker($1);
 235
 236   if ( $self->dbdef_table->column('manual_flag') ) {
 237     $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
 238     $self->manual_flag($1);
 239   }
 240
 241   ''; #no error
 242 }
 243
 244 =item cancel
 245
 246 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 247 in this package, then cancels the package itself (sets the cancel field to
 248 now).
 249
 250 If there is an error, returns the error, otherwise returns false.
 251
 252 =cut
 253
 254 sub cancel {
 255   my $self = shift;
 256   my $error;
 257
 258   local $SIG{HUP} = 'IGNORE';
 259   local $SIG{INT} = 'IGNORE';
 260   local $SIG{QUIT} = 'IGNORE';
 261   local $SIG{TERM} = 'IGNORE';
 262   local $SIG{TSTP} = 'IGNORE';
 263   local $SIG{PIPE} = 'IGNORE';
 264
 265   my $oldAutoCommit = $FS::UID::AutoCommit;
 266   local $FS::UID::AutoCommit = 0;
 267   my $dbh = dbh;
 268
 269   foreach my $cust_svc (
 270     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 271   ) {
 272     my $error = $cust_svc->cancel;
 273
 274     if ( $error ) {
 275       $dbh->rollback if $oldAutoCommit;
 276       return "Error cancelling cust_svc: $error";
 277     }
 278
 279   }
 280
 281   unless ( $self->getfield('cancel') ) {
 282     my %hash = $self->hash;
 283     $hash{'cancel'} = time;
 284     my $new = new FS::cust_pkg ( \%hash );
 285     $error = $new->replace($self);
 286     if ( $error ) {
 287       $dbh->rollback if $oldAutoCommit;
 288       return $error;
 289     }
 290   }
 291
 292   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 293
 294   ''; #no errors
 295 }
 296
 297 =item suspend
 298
 299 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 300 package, then suspends the package itself (sets the susp field to now).
 301
 302 If there is an error, returns the error, otherwise returns false.
 303
 304 =cut
 305
 306 sub suspend {
 307   my $self = shift;
 308   my $error ;
 309
 310   local $SIG{HUP} = 'IGNORE';
 311   local $SIG{INT} = 'IGNORE';
 312   local $SIG{QUIT} = 'IGNORE';
 313   local $SIG{TERM} = 'IGNORE';
 314   local $SIG{TSTP} = 'IGNORE';
 315   local $SIG{PIPE} = 'IGNORE';
 316
 317   my $oldAutoCommit = $FS::UID::AutoCommit;
 318   local $FS::UID::AutoCommit = 0;
 319   my $dbh = dbh;
 320
 321   foreach my $cust_svc (
 322     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 323   ) {
 324     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 325
 326     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 327       $dbh->rollback if $oldAutoCommit;
 328       return "Illegal svcdb value in part_svc!";
 329     };
 330     my $svcdb = $1;
 331     require "FS/$svcdb.pm";
 332
 333     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 334     if ($svc) {
 335       $error = $svc->suspend;
 336       if ( $error ) {
 337         $dbh->rollback if $oldAutoCommit;
 338         return $error;
 339       }
 340     }
 341
 342   }
 343
 344   unless ( $self->getfield('susp') ) {
 345     my %hash = $self->hash;
 346     $hash{'susp'} = time;
 347     my $new = new FS::cust_pkg ( \%hash );
 348     $error = $new->replace($self);
 349     if ( $error ) {
 350       $dbh->rollback if $oldAutoCommit;
 351       return $error;
 352     }
 353   }
 354
 355   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 356
 357   ''; #no errors
 358 }
 359
 360 =item unsuspend
 361
 362 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 363 package, then unsuspends the package itself (clears the susp field).
 364
 365 If there is an error, returns the error, otherwise returns false.
 366
 367 =cut
 368
 369 sub unsuspend {
 370   my $self = shift;
 371   my($error);
 372
 373   local $SIG{HUP} = 'IGNORE';
 374   local $SIG{INT} = 'IGNORE';
 375   local $SIG{QUIT} = 'IGNORE';
 376   local $SIG{TERM} = 'IGNORE';
 377   local $SIG{TSTP} = 'IGNORE';
 378   local $SIG{PIPE} = 'IGNORE';
 379
 380   my $oldAutoCommit = $FS::UID::AutoCommit;
 381   local $FS::UID::AutoCommit = 0;
 382   my $dbh = dbh;
 383
 384   foreach my $cust_svc (
 385     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
 386   ) {
 387     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 388
 389     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 390       $dbh->rollback if $oldAutoCommit;
 391       return "Illegal svcdb value in part_svc!";
 392     };
 393     my $svcdb = $1;
 394     require "FS/$svcdb.pm";
 395
 396     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 397     if ($svc) {
 398       $error = $svc->unsuspend;
 399       if ( $error ) {
 400         $dbh->rollback if $oldAutoCommit;
 401         return $error;
 402       }
 403     }
 404
 405   }
 406
 407   unless ( ! $self->getfield('susp') ) {
 408     my %hash = $self->hash;
 409     $hash{'susp'} = '';
 410     my $new = new FS::cust_pkg ( \%hash );
 411     $error = $new->replace($self);
 412     if ( $error ) {
 413       $dbh->rollback if $oldAutoCommit;
 414       return $error;
 415     }
 416   }
 417
 418   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 419
 420   ''; #no errors
 421 }
 422
 423 =item last_bill
 424
 425 Returns the last bill date, or if there is no last bill date, the setup date.
 426 Useful for billing metered services.
 427
 428 =cut
 429
 430 sub last_bill {
 431   my $self = shift;
 432   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
 433                                                   'edate'  => $self->bill,  } );
 434   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
 435 }
 436
 437 =item part_pkg
 438
 439 Returns the definition for this billing item, as an FS::part_pkg object (see
 440 L<FS::part_pkg>).
 441
 442 =cut
 443
 444 sub part_pkg {
 445   my $self = shift;
 446   #exists( $self->{'_pkgpart'} )
 447   $self->{'_pkgpart'}
 448     ? $self->{'_pkgpart'}
 449     : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 450 }
 451
 452 =item cust_svc
 453
 454 Returns the services for this package, as FS::cust_svc objects (see
 455 L<FS::cust_svc>)
 456
 457 =cut
 458
 459 sub cust_svc {
 460   my $self = shift;
 461   if ( $self->{'_svcnum'} ) {
 462     values %{ $self->{'_svcnum'}->cache };
 463   } else {
 464     qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
 465   }
 466 }
 467
 468 =item labels
 469
 470 Returns a list of lists, calling the label method for all services
 471 (see L<FS::cust_svc>) of this billing item.
 472
 473 =cut
 474
 475 sub labels {
 476   my $self = shift;
 477   map { [ $_->label ] } $self->cust_svc;
 478 }
 479
 480 =item cust_main
 481
 482 Returns the parent customer object (see L<FS::cust_main>).
 483
 484 =cut
 485
 486 sub cust_main {
 487   my $self = shift;
 488   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 489 }
 490
 491 =item seconds_since TIMESTAMP
 492
 493 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
 494 package have been online since TIMESTAMP, according to the session monitor.
 495
 496 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 497 L<Time::Local> and L<Date::Parse> for conversion functions.
 498
 499 =cut
 500
 501 sub seconds_since {
 502   my($self, $since) = @_;
 503   my $seconds = 0;
 504
 505   foreach my $cust_svc (
 506     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
 507   ) {
 508     $seconds += $cust_svc->seconds_since($since);
 509   }
 510
 511   $seconds;
 512
 513 }
 514
 515 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 516
 517 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
 518 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
 519 (exclusive).
 520
 521 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 522 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 523 functions.
 524
 525
 526 =cut
 527
 528 sub seconds_since_sqlradacct {
 529   my($self, $start, $end) = @_;
 530
 531   my $seconds = 0;
 532
 533   foreach my $cust_svc (
 534     grep {
 535       my $part_svc = $_->part_svc;
 536       $part_svc->svcdb eq 'svc_acct'
 537         && scalar($part_svc->part_export('sqlradius'));
 538     } $self->cust_svc
 539   ) {
 540     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
 541   }
 542
 543   $seconds;
 544
 545 }
 546
 547 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 548
 549 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
 550 in this package for sessions ending between TIMESTAMP_START (inclusive) and
 551 TIMESTAMP_END (exclusive).
 552
 553 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 554 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 555 functions.
 556
 557 =cut
 558
 559 sub attribute_since_sqlradacct {
 560   my($self, $start, $end, $attrib) = @_;
 561
 562   my $sum = 0;
 563
 564   foreach my $cust_svc (
 565     grep {
 566       my $part_svc = $_->part_svc;
 567       $part_svc->svcdb eq 'svc_acct'
 568         && scalar($part_svc->part_export('sqlradius'));
 569     } $self->cust_svc
 570   ) {
 571     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
 572   }
 573
 574   $sum;
 575
 576 }
 577
 578 =back
 579
 580 =head1 SUBROUTINES
 581
 582 =over 4
 583
 584 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
 585
 586 CUSTNUM is a customer (see L<FS::cust_main>)
 587
 588 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
 589 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
 590 permitted.
 591
 592 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
 593 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
 594 new billing items.  An error is returned if this is not possible (see
 595 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
 596 parameter.
 597
 598 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
 599 newly-created cust_pkg objects.
 600
 601 =cut
 602
 603 sub order {
 604   my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
 605   $remove_pkgnums = [] unless defined($remove_pkgnums);
 606
 607   my $oldAutoCommit = $FS::UID::AutoCommit;
 608   local $FS::UID::AutoCommit = 0;
 609   my $dbh = dbh;
 610
 611   # generate %part_pkg
 612   # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
 613   #
 614   my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
 615   my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
 616   my %part_pkg = %{ $agent->pkgpart_hashref };
 617
 618   my(%svcnum);
 619   # generate %svcnum
 620   # for those packages being removed:
 621   #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects
 622   my($pkgnum);
 623   foreach $pkgnum ( @{$remove_pkgnums} ) {
 624     foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
 625       push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
 626     }
 627   }
 628
 629   my @cust_svc;
 630   #generate @cust_svc
 631   # for those packages the customer is purchasing:
 632   # @{$pkgparts} is a list of said packages, by pkgpart
 633   # @cust_svc is a corresponding list of lists of FS::Record objects
 634   foreach my $pkgpart ( @{$pkgparts} ) {
 635     unless ( $part_pkg{$pkgpart} ) {
 636       $dbh->rollback if $oldAutoCommit;
 637       return "Customer not permitted to purchase pkgpart $pkgpart!";
 638     }
 639     push @cust_svc, [
 640       map {
 641         ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
 642       } map { $_->svcpart }
 643           qsearch('pkg_svc', { pkgpart  => $pkgpart,
 644                                quantity => { op=>'>', value=>'0', } } )
 645     ];
 646   }
 647
 648   #special-case until this can be handled better
 649   # move services to new svcparts - even if the svcparts don't match (svcdb
 650   # needs to...)
 651   # looks like they're moved in no particular order, ewwwwwwww
 652   # and looks like just one of each svcpart can be moved... o well
 653
 654   #start with still-leftover services
 655   #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) {
 656   foreach my $svcpart ( keys %svcnum ) {
 657     next unless @{ $svcnum{$svcpart} };
 658
 659     my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb;
 660
 661     #find an empty place to put one
 662     my $i = 0;
 663     foreach my $pkgpart ( @{$pkgparts} ) {
 664       my @pkg_svc =
 665         qsearch('pkg_svc', { pkgpart  => $pkgpart,
 666                              quantity => { op=>'>', value=>'0', } } );
 667       #my @pkg_svc =
 668       #  grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } );
 669       if ( ! @{$cust_svc[$i]} #find an empty place to put them with
 670            && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb
 671                 @pkg_svc
 672       ) {
 673         my $new_svcpart =
 674           ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart;
 675         my $cust_svc = shift @{$svcnum{$svcpart}};
 676         $cust_svc->svcpart($new_svcpart);
 677         #warn "changing from $svcpart to $new_svcpart!!!\n";
 678         $cust_svc[$i] = [ $cust_svc ];
 679       }
 680       $i++;
 681     }
 682
 683   }
 684
 685   #check for leftover services
 686   foreach (keys %svcnum) {
 687     next unless @{ $svcnum{$_} };
 688     $dbh->rollback if $oldAutoCommit;
 689     return "Leftover services, svcpart $_: svcnum ".
 690            join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
 691   }
 692
 693   #no leftover services, let's make changes.
 694
 695   local $SIG{HUP} = 'IGNORE';
 696   local $SIG{INT} = 'IGNORE';
 697   local $SIG{QUIT} = 'IGNORE';
 698   local $SIG{TERM} = 'IGNORE';
 699   local $SIG{TSTP} = 'IGNORE';
 700   local $SIG{PIPE} = 'IGNORE';
 701
 702   #first cancel old packages
 703   foreach my $pkgnum ( @{$remove_pkgnums} ) {
 704     my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
 705     unless ( $old ) {
 706       $dbh->rollback if $oldAutoCommit;
 707       return "Package $pkgnum not found to remove!";
 708     }
 709     my(%hash) = $old->hash;
 710     $hash{'cancel'}=time;
 711     my($new) = new FS::cust_pkg ( \%hash );
 712     my($error)=$new->replace($old);
 713     if ( $error ) {
 714       $dbh->rollback if $oldAutoCommit;
 715       return "Couldn't update package $pkgnum: $error";
 716     }
 717   }
 718
 719   #now add new packages, changing cust_svc records if necessary
 720   my $pkgpart;
 721   while ($pkgpart=shift @{$pkgparts} ) {
 722
 723     my $new = new FS::cust_pkg {
 724                                  'custnum' => $custnum,
 725                                  'pkgpart' => $pkgpart,
 726                                };
 727     my $error = $new->insert;
 728     if ( $error ) {
 729       $dbh->rollback if $oldAutoCommit;
 730       return "Couldn't insert new cust_pkg record: $error";
 731     }
 732     push @{$return_cust_pkg}, $new if $return_cust_pkg;
 733     my $pkgnum = $new->pkgnum;
 734
 735     foreach my $cust_svc ( @{ shift @cust_svc } ) {
 736       my(%hash) = $cust_svc->hash;
 737       $hash{'pkgnum'}=$pkgnum;
 738       my $new = new FS::cust_svc ( \%hash );
 739
 740       #avoid Record diffing missing changed svcpart field from above.
 741       my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } );
 742
 743       my $error = $new->replace($old);
 744       if ( $error ) {
 745         $dbh->rollback if $oldAutoCommit;
 746         return "Couldn't link old service to new package: $error";
 747       }
 748     }
 749   }
 750
 751   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 752
 753   ''; #no errors
 754 }
 755
 756 =back
 757
 758 =head1 BUGS
 759
 760 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
 761
 762 In sub order, the @pkgparts array (passed by reference) is clobbered.
 763
 764 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
 765 method to pass dates to the recur_prog expression, it should do so.
 766
 767 FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
 768 compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
 769 cancel } because they use %FS::UID::callback to load configuration values.
 770 Probably need a subroutine which decides what to do based on whether or not
 771 we've fetched the user yet, rather than a hash.  See FS::UID and the TODO.
 772
 773 Now that things are transactional should the check in the insert method be
 774 moved to check ?
 775
 776 =head1 SEE ALSO
 777
 778 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
 779 L<FS::pkg_svc>, schema.html from the base documentation
 780
 781 =cut
 782
 783 1;
 784