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_domain;
  19 use FS::svc_www;
  20 use FS::svc_forward;
  21
  22 @ISA = qw( FS::Record );
  23
  24 sub _cache {
  25   my $self = shift;
  26   my ( $hashref, $cache ) = @_;
  27   #if ( $hashref->{'pkgpart'} ) {
  28   if ( $hashref->{'pkg'} ) {
  29     # #@{ $self->{'_pkgnum'} } = ();
  30     # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
  31     # $self->{'_pkgpart'} = $subcache;
  32     # #push @{ $self->{'_pkgnum'} },
  33     #   FS::part_pkg->new_or_cached($hashref, $subcache);
  34     $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
  35   }
  36   if ( exists $hashref->{'svcnum'} ) {
  37     #@{ $self->{'_pkgnum'} } = ();
  38     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
  39     $self->{'_svcnum'} = $subcache;
  40     #push @{ $self->{'_pkgnum'} },
  41     FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
  42   }
  43 }
  44
  45 =head1 NAME
  46
  47 FS::cust_pkg - Object methods for cust_pkg objects
  48
  49 =head1 SYNOPSIS
  50
  51   use FS::cust_pkg;
  52
  53   $record = new FS::cust_pkg \%hash;
  54   $record = new FS::cust_pkg { 'column' => 'value' };
  55
  56   $error = $record->insert;
  57
  58   $error = $new_record->replace($old_record);
  59
  60   $error = $record->delete;
  61
  62   $error = $record->check;
  63
  64   $error = $record->cancel;
  65
  66   $error = $record->suspend;
  67
  68   $error = $record->unsuspend;
  69
  70   $part_pkg = $record->part_pkg;
  71
  72   @labels = $record->labels;
  73
  74   $seconds = $record->seconds_since($timestamp);
  75
  76   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
  77   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
  78
  79 =head1 DESCRIPTION
  80
  81 An FS::cust_pkg object represents a customer billing item.  FS::cust_pkg
  82 inherits from FS::Record.  The following fields are currently supported:
  83
  84 =over 4
  85
  86 =item pkgnum - primary key (assigned automatically for new billing items)
  87
  88 =item custnum - Customer (see L<FS::cust_main>)
  89
  90 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
  91
  92 =item setup - date
  93
  94 =item bill - date (next bill date)
  95
  96 =item susp - date
  97
  98 =item expire - date
  99
 100 =item cancel - date
 101
 102 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
 103
 104 =item manual_flag - If this field is set to 1, disables the automatic
 105 unsuspension of this package when using the B<unsuspendauto> config file.
 106
 107 =back
 108
 109 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
 110 see L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for
 111 conversion functions.
 112
 113 =head1 METHODS
 114
 115 =over 4
 116
 117 =item new HASHREF
 118
 119 Create a new billing item.  To add the item to the database, see L<"insert">.
 120
 121 =cut
 122
 123 sub table { 'cust_pkg'; }
 124
 125 =item insert
 126
 127 Adds this billing item to the database ("Orders" the item).  If there is an
 128 error, returns the error, otherwise returns false.
 129
 130 =cut
 131
 132 sub insert {
 133   my $self = shift;
 134
 135   # custnum might not have have been defined in sub check (for one-shot new
 136   # customers), so check it here instead
 137   # (is this still necessary with transactions?)
 138
 139   my $error = $self->ut_number('custnum');
 140   return $error if $error;
 141
 142   my $cust_main = $self->cust_main;
 143   return "Unknown customer ". $self->custnum unless $cust_main;
 144
 145   my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
 146   my $pkgpart_href = $agent->pkgpart_hashref;
 147   return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart
 148     unless $pkgpart_href->{ $self->pkgpart };
 149
 150   $self->SUPER::insert;
 151
 152 }
 153
 154 =item delete
 155
 156 This method now works but you probably shouldn't use it.
 157
 158 You don't want to delete billing items, because there would then be no record
 159 the customer ever purchased the item.  Instead, see the cancel method.
 160
 161 =cut
 162
 163 #sub delete {
 164 #  return "Can't delete cust_pkg records!";
 165 #}
 166
 167 =item replace OLD_RECORD
 168
 169 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 170 returns the error, otherwise returns false.
 171
 172 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
 173
 174 Changing pkgpart may have disasterous effects.  See the order subroutine.
 175
 176 setup and bill are normally updated by calling the bill method of a customer
 177 object (see L<FS::cust_main>).
 178
 179 suspend is normally updated by the suspend and unsuspend methods.
 180
 181 cancel is normally updated by the cancel method (and also the order subroutine
 182 in some cases).
 183
 184 =cut
 185
 186 sub replace {
 187   my( $new, $old ) = ( shift, shift );
 188
 189   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
 190   return "Can't change otaker!" if $old->otaker ne $new->otaker;
 191
 192   #allow this *sigh*
 193   #return "Can't change setup once it exists!"
 194   #  if $old->getfield('setup') &&
 195   #     $old->getfield('setup') != $new->getfield('setup');
 196
 197   #some logic for bill, susp, cancel?
 198
 199   $new->SUPER::replace($old);
 200 }
 201
 202 =item check
 203
 204 Checks all fields to make sure this is a valid billing item.  If there is an
 205 error, returns the error, otherwise returns false.  Called by the insert and
 206 replace methods.
 207
 208 =cut
 209
 210 sub check {
 211   my $self = shift;
 212
 213   my $error =
 214     $self->ut_numbern('pkgnum')
 215     || $self->ut_numbern('custnum')
 216     || $self->ut_number('pkgpart')
 217     || $self->ut_numbern('setup')
 218     || $self->ut_numbern('bill')
 219     || $self->ut_numbern('susp')
 220     || $self->ut_numbern('cancel')
 221   ;
 222   return $error if $error;
 223
 224   if ( $self->custnum ) {
 225     return "Unknown customer ". $self->custnum unless $self->cust_main;
 226   }
 227
 228   return "Unknown pkgpart: ". $self->pkgpart
 229     unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 230
 231   $self->otaker(getotaker) unless $self->otaker;
 232   $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
 233   $self->otaker($1);
 234
 235   if ( $self->dbdef_table->column('manual_flag') ) {
 236     $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
 237     $self->manual_flag($1);
 238   }
 239
 240   ''; #no error
 241 }
 242
 243 =item cancel
 244
 245 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 246 in this package, then cancels the package itself (sets the cancel field to
 247 now).
 248
 249 If there is an error, returns the error, otherwise returns false.
 250
 251 =cut
 252
 253 sub cancel {
 254   my $self = shift;
 255   my $error;
 256
 257   local $SIG{HUP} = 'IGNORE';
 258   local $SIG{INT} = 'IGNORE';
 259   local $SIG{QUIT} = 'IGNORE';
 260   local $SIG{TERM} = 'IGNORE';
 261   local $SIG{TSTP} = 'IGNORE';
 262   local $SIG{PIPE} = 'IGNORE';
 263
 264   my $oldAutoCommit = $FS::UID::AutoCommit;
 265   local $FS::UID::AutoCommit = 0;
 266   my $dbh = dbh;
 267
 268   foreach my $cust_svc (
 269     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 270   ) {
 271     my $error = $cust_svc->cancel;
 272
 273     if ( $error ) {
 274       $dbh->rollback if $oldAutoCommit;
 275       return "Error cancelling cust_svc: $error";
 276     }
 277
 278   }
 279
 280   unless ( $self->getfield('cancel') ) {
 281     my %hash = $self->hash;
 282     $hash{'cancel'} = time;
 283     my $new = new FS::cust_pkg ( \%hash );
 284     $error = $new->replace($self);
 285     if ( $error ) {
 286       $dbh->rollback if $oldAutoCommit;
 287       return $error;
 288     }
 289   }
 290
 291   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 292
 293   ''; #no errors
 294 }
 295
 296 =item suspend
 297
 298 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 299 package, then suspends the package itself (sets the susp field to now).
 300
 301 If there is an error, returns the error, otherwise returns false.
 302
 303 =cut
 304
 305 sub suspend {
 306   my $self = shift;
 307   my $error ;
 308
 309   local $SIG{HUP} = 'IGNORE';
 310   local $SIG{INT} = 'IGNORE';
 311   local $SIG{QUIT} = 'IGNORE';
 312   local $SIG{TERM} = 'IGNORE';
 313   local $SIG{TSTP} = 'IGNORE';
 314   local $SIG{PIPE} = 'IGNORE';
 315
 316   my $oldAutoCommit = $FS::UID::AutoCommit;
 317   local $FS::UID::AutoCommit = 0;
 318   my $dbh = dbh;
 319
 320   foreach my $cust_svc (
 321     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 322   ) {
 323     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 324
 325     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 326       $dbh->rollback if $oldAutoCommit;
 327       return "Illegal svcdb value in part_svc!";
 328     };
 329     my $svcdb = $1;
 330     require "FS/$svcdb.pm";
 331
 332     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 333     if ($svc) {
 334       $error = $svc->suspend;
 335       if ( $error ) {
 336         $dbh->rollback if $oldAutoCommit;
 337         return $error;
 338       }
 339     }
 340
 341   }
 342
 343   unless ( $self->getfield('susp') ) {
 344     my %hash = $self->hash;
 345     $hash{'susp'} = time;
 346     my $new = new FS::cust_pkg ( \%hash );
 347     $error = $new->replace($self);
 348     if ( $error ) {
 349       $dbh->rollback if $oldAutoCommit;
 350       return $error;
 351     }
 352   }
 353
 354   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 355
 356   ''; #no errors
 357 }
 358
 359 =item unsuspend
 360
 361 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 362 package, then unsuspends the package itself (clears the susp field).
 363
 364 If there is an error, returns the error, otherwise returns false.
 365
 366 =cut
 367
 368 sub unsuspend {
 369   my $self = shift;
 370   my($error);
 371
 372   local $SIG{HUP} = 'IGNORE';
 373   local $SIG{INT} = 'IGNORE';
 374   local $SIG{QUIT} = 'IGNORE';
 375   local $SIG{TERM} = 'IGNORE';
 376   local $SIG{TSTP} = 'IGNORE';
 377   local $SIG{PIPE} = 'IGNORE';
 378
 379   my $oldAutoCommit = $FS::UID::AutoCommit;
 380   local $FS::UID::AutoCommit = 0;
 381   my $dbh = dbh;
 382
 383   foreach my $cust_svc (
 384     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
 385   ) {
 386     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 387
 388     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 389       $dbh->rollback if $oldAutoCommit;
 390       return "Illegal svcdb value in part_svc!";
 391     };
 392     my $svcdb = $1;
 393     require "FS/$svcdb.pm";
 394
 395     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 396     if ($svc) {
 397       $error = $svc->unsuspend;
 398       if ( $error ) {
 399         $dbh->rollback if $oldAutoCommit;
 400         return $error;
 401       }
 402     }
 403
 404   }
 405
 406   unless ( ! $self->getfield('susp') ) {
 407     my %hash = $self->hash;
 408     $hash{'susp'} = '';
 409     my $new = new FS::cust_pkg ( \%hash );
 410     $error = $new->replace($self);
 411     if ( $error ) {
 412       $dbh->rollback if $oldAutoCommit;
 413       return $error;
 414     }
 415   }
 416
 417   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 418
 419   ''; #no errors
 420 }
 421
 422 =item last_bill
 423
 424 Returns the last bill date, or if there is no last bill date, the setup date.
 425 Useful for billing metered services.
 426
 427 =cut
 428
 429 sub last_bill {
 430   my $self = shift;
 431   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
 432                                                   'edate'  => $self->bill,  } );
 433   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
 434 }
 435
 436 =item part_pkg
 437
 438 Returns the definition for this billing item, as an FS::part_pkg object (see
 439 L<FS::part_pkg>).
 440
 441 =cut
 442
 443 sub part_pkg {
 444   my $self = shift;
 445   #exists( $self->{'_pkgpart'} )
 446   $self->{'_pkgpart'}
 447     ? $self->{'_pkgpart'}
 448     : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 449 }
 450
 451 =item cust_svc
 452
 453 Returns the services for this package, as FS::cust_svc objects (see
 454 L<FS::cust_svc>)
 455
 456 =cut
 457
 458 sub cust_svc {
 459   my $self = shift;
 460   if ( $self->{'_svcnum'} ) {
 461     values %{ $self->{'_svcnum'}->cache };
 462   } else {
 463     qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
 464   }
 465 }
 466
 467 =item labels
 468
 469 Returns a list of lists, calling the label method for all services
 470 (see L<FS::cust_svc>) of this billing item.
 471
 472 =cut
 473
 474 sub labels {
 475   my $self = shift;
 476   map { [ $_->label ] } $self->cust_svc;
 477 }
 478
 479 =item cust_main
 480
 481 Returns the parent customer object (see L<FS::cust_main>).
 482
 483 =cut
 484
 485 sub cust_main {
 486   my $self = shift;
 487   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 488 }
 489
 490 =item seconds_since TIMESTAMP
 491
 492 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
 493 package have been online since TIMESTAMP, according to the session monitor.
 494
 495 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 496 L<Time::Local> and L<Date::Parse> for conversion functions.
 497
 498 =cut
 499
 500 sub seconds_since {
 501   my($self, $since) = @_;
 502   my $seconds = 0;
 503
 504   foreach my $cust_svc (
 505     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
 506   ) {
 507     $seconds += $cust_svc->seconds_since($since);
 508   }
 509
 510   $seconds;
 511
 512 }
 513
 514 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 515
 516 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
 517 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
 518 (exclusive).
 519
 520 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 521 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 522 functions.
 523
 524
 525 =cut
 526
 527 sub seconds_since_sqlradacct {
 528   my($self, $start, $end) = @_;
 529
 530   my $seconds = 0;
 531
 532   foreach my $cust_svc (
 533     grep {
 534       my $part_svc = $_->part_svc;
 535       $part_svc->svcdb eq 'svc_acct'
 536         && scalar($part_svc->part_export('sqlradius'));
 537     } $self->cust_svc
 538   ) {
 539     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
 540   }
 541
 542   $seconds;
 543
 544 }
 545
 546 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 547
 548 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
 549 in this package for sessions ending between TIMESTAMP_START (inclusive) and
 550 TIMESTAMP_END
 551 (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_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
 768 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
 769 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
 770 configuration values.  Probably need a subroutine which decides what to do
 771 based on whether or not we've fetched the user yet, rather than a hash.  See
 772 FS::UID and the TODO.
 773
 774 Now that things are transactional should the check in the insert method be
 775 moved to check ?
 776
 777 =head1 SEE ALSO
 778
 779 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
 780 L<FS::pkg_svc>, schema.html from the base documentation
 781
 782 =cut
 783
 784 1;
 785