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