FS/FS/cust_pkg.pm

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