4 use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);
5 use FS::UID qw( getotaker dbh );
6 use FS::Record qw( qsearch qsearchs );
7 use FS::Misc qw( send_email );
13 use FS::cust_bill_pkg;
15 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
17 # because they load configuraion by setting FS::UID::callback (see TODO)
23 # for sending cancel emails in sub cancel
26 @ISA = qw( FS::Record );
30 $disable_agentcheck = 0;
32 # The order in which to unprovision services.
33 @SVCDB_CANCEL_SEQ = qw( svc_external
42 my ( $hashref, $cache ) = @_;
43 #if ( $hashref->{'pkgpart'} ) {
44 if ( $hashref->{'pkg'} ) {
45 # #@{ $self->{'_pkgnum'} } = ();
46 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
47 # $self->{'_pkgpart'} = $subcache;
48 # #push @{ $self->{'_pkgnum'} },
49 # FS::part_pkg->new_or_cached($hashref, $subcache);
50 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
52 if ( exists $hashref->{'svcnum'} ) {
53 #@{ $self->{'_pkgnum'} } = ();
54 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
55 $self->{'_svcnum'} = $subcache;
56 #push @{ $self->{'_pkgnum'} },
57 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
63 FS::cust_pkg - Object methods for cust_pkg objects
69 $record = new FS::cust_pkg \%hash;
70 $record = new FS::cust_pkg { 'column' => 'value' };
72 $error = $record->insert;
74 $error = $new_record->replace($old_record);
76 $error = $record->delete;
78 $error = $record->check;
80 $error = $record->cancel;
82 $error = $record->suspend;
84 $error = $record->unsuspend;
86 $part_pkg = $record->part_pkg;
88 @labels = $record->labels;
90 $seconds = $record->seconds_since($timestamp);
92 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
93 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
97 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
98 inherits from FS::Record. The following fields are currently supported:
102 =item pkgnum - primary key (assigned automatically for new billing items)
104 =item custnum - Customer (see L<FS::cust_main>)
106 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
110 =item bill - date (next bill date)
112 =item last_bill - last bill date
120 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
122 =item manual_flag - If this field is set to 1, disables the automatic
123 unsuspension of this package when using the B<unsuspendauto> config file.
127 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
128 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
129 conversion functions.
137 Create a new billing item. To add the item to the database, see L<"insert">.
141 sub table { 'cust_pkg'; }
145 Adds this billing item to the database ("Orders" the item). If there is an
146 error, returns the error, otherwise returns false.
148 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
149 will be used to look up the package definition and agent restrictions will be
154 This method now works but you probably shouldn't use it.
156 You don't want to delete billing items, because there would then be no record
157 the customer ever purchased the item. Instead, see the cancel method.
162 # return "Can't delete cust_pkg records!";
165 =item replace OLD_RECORD
167 Replaces the OLD_RECORD with this one in the database. If there is an error,
168 returns the error, otherwise returns false.
170 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
172 Changing pkgpart may have disasterous effects. See the order subroutine.
174 setup and bill are normally updated by calling the bill method of a customer
175 object (see L<FS::cust_main>).
177 suspend is normally updated by the suspend and unsuspend methods.
179 cancel is normally updated by the cancel method (and also the order subroutine
185 my( $new, $old ) = ( shift, shift );
187 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
188 return "Can't change otaker!" if $old->otaker ne $new->otaker;
191 #return "Can't change setup once it exists!"
192 # if $old->getfield('setup') &&
193 # $old->getfield('setup') != $new->getfield('setup');
195 #some logic for bill, susp, cancel?
197 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
199 $new->SUPER::replace($old);
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
214 $self->ut_numbern('pkgnum')
215 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
216 || $self->ut_numbern('pkgpart')
217 || $self->ut_numbern('setup')
218 || $self->ut_numbern('bill')
219 || $self->ut_numbern('susp')
220 || $self->ut_numbern('cancel')
222 return $error if $error;
224 if ( $self->promo_code ) {
227 qsearchs('part_pkg', {
228 'pkgpart' => $self->pkgpart,
229 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
231 return 'Unknown promotional code' unless $promo_part_pkg;
232 $self->pkgpart($promo_part_pkg->pkgpart);
236 unless ( $disable_agentcheck ) {
238 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
239 my $pkgpart_href = $agent->pkgpart_hashref;
240 return "agent ". $agent->agentnum.
241 " can't purchase pkgpart ". $self->pkgpart
242 unless $pkgpart_href->{ $self->pkgpart };
245 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
246 return $error if $error;
250 $self->otaker(getotaker) unless $self->otaker;
251 $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
254 if ( $self->dbdef_table->column('manual_flag') ) {
255 $self->manual_flag('') if $self->manual_flag eq ' ';
256 $self->manual_flag =~ /^([01]?)$/
257 or return "Illegal manual_flag ". $self->manual_flag;
258 $self->manual_flag($1);
264 =item cancel [ OPTION => VALUE ... ]
266 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
267 in this package, then cancels the package itself (sets the cancel field to
270 Available options are: I<quiet>
272 I<quiet> can be set true to supress email cancellation notices.
274 If there is an error, returns the error, otherwise returns false.
279 my( $self, %options ) = @_;
282 local $SIG{HUP} = 'IGNORE';
283 local $SIG{INT} = 'IGNORE';
284 local $SIG{QUIT} = 'IGNORE';
285 local $SIG{TERM} = 'IGNORE';
286 local $SIG{TSTP} = 'IGNORE';
287 local $SIG{PIPE} = 'IGNORE';
289 my $oldAutoCommit = $FS::UID::AutoCommit;
290 local $FS::UID::AutoCommit = 0;
294 foreach my $cust_svc (
295 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
297 push @{ $svc{$cust_svc->part_svc->svcdb} }, $cust_svc;
300 foreach my $svcdb (@SVCDB_CANCEL_SEQ) {
301 foreach my $cust_svc (@{ $svc{$svcdb} }) {
302 my $error = $cust_svc->cancel;
305 $dbh->rollback if $oldAutoCommit;
306 return "Error cancelling cust_svc: $error";
311 unless ( $self->getfield('cancel') ) {
312 my %hash = $self->hash;
313 $hash{'cancel'} = time;
314 my $new = new FS::cust_pkg ( \%hash );
315 $error = $new->replace($self);
317 $dbh->rollback if $oldAutoCommit;
322 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
324 my $conf = new FS::Conf;
325 my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list;
326 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
327 my $conf = new FS::Conf;
328 my $error = send_email(
329 'from' => $conf->config('invoice_from'),
330 'to' => \@invoicing_list,
331 'subject' => $conf->config('cancelsubject'),
332 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
334 #should this do something on errors?
343 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
344 package, then suspends the package itself (sets the susp field to now).
346 If there is an error, returns the error, otherwise returns false.
354 local $SIG{HUP} = 'IGNORE';
355 local $SIG{INT} = 'IGNORE';
356 local $SIG{QUIT} = 'IGNORE';
357 local $SIG{TERM} = 'IGNORE';
358 local $SIG{TSTP} = 'IGNORE';
359 local $SIG{PIPE} = 'IGNORE';
361 my $oldAutoCommit = $FS::UID::AutoCommit;
362 local $FS::UID::AutoCommit = 0;
365 foreach my $cust_svc (
366 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
368 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
370 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
371 $dbh->rollback if $oldAutoCommit;
372 return "Illegal svcdb value in part_svc!";
375 require "FS/$svcdb.pm";
377 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
379 $error = $svc->suspend;
381 $dbh->rollback if $oldAutoCommit;
388 unless ( $self->getfield('susp') ) {
389 my %hash = $self->hash;
390 $hash{'susp'} = time;
391 my $new = new FS::cust_pkg ( \%hash );
392 $error = $new->replace($self);
394 $dbh->rollback if $oldAutoCommit;
399 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
406 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
407 package, then unsuspends the package itself (clears the susp field).
409 If there is an error, returns the error, otherwise returns false.
417 local $SIG{HUP} = 'IGNORE';
418 local $SIG{INT} = 'IGNORE';
419 local $SIG{QUIT} = 'IGNORE';
420 local $SIG{TERM} = 'IGNORE';
421 local $SIG{TSTP} = 'IGNORE';
422 local $SIG{PIPE} = 'IGNORE';
424 my $oldAutoCommit = $FS::UID::AutoCommit;
425 local $FS::UID::AutoCommit = 0;
428 foreach my $cust_svc (
429 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
431 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
433 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
434 $dbh->rollback if $oldAutoCommit;
435 return "Illegal svcdb value in part_svc!";
438 require "FS/$svcdb.pm";
440 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
442 $error = $svc->unsuspend;
444 $dbh->rollback if $oldAutoCommit;
451 unless ( ! $self->getfield('susp') ) {
452 my %hash = $self->hash;
453 my $inactive = time - $hash{'susp'};
455 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
456 if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
457 my $new = new FS::cust_pkg ( \%hash );
458 $error = $new->replace($self);
460 $dbh->rollback if $oldAutoCommit;
465 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
472 Returns the last bill date, or if there is no last bill date, the setup date.
473 Useful for billing metered services.
479 if ( $self->dbdef_table->column('last_bill') ) {
480 return $self->setfield('last_bill', $_[0]) if @_;
481 return $self->getfield('last_bill') if $self->getfield('last_bill');
483 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
484 'edate' => $self->bill, } );
485 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
490 Returns the definition for this billing item, as an FS::part_pkg object (see
497 #exists( $self->{'_pkgpart'} )
499 ? $self->{'_pkgpart'}
500 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
505 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
512 $self->part_pkg->calc_setup($self, @_);
517 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
524 $self->part_pkg->calc_recur($self, @_);
527 =item cust_svc [ SVCPART ]
529 Returns the services for this package, as FS::cust_svc objects (see
530 L<FS::cust_svc>). If a svcpart is specified, return only the matching
539 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
540 'svcpart' => shift, } );
543 #if ( $self->{'_svcnum'} ) {
544 # values %{ $self->{'_svcnum'}->cache };
547 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
549 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
550 'svcpart' => $_->svcpart } );
552 $pkg_svc ? $pkg_svc->primary_svc : '',
553 $pkg_svc ? $pkg_svc->quantity : 0,
556 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
561 =item num_cust_svc [ SVCPART ]
563 Returns the number of provisioned services for this package. If a svcpart is
564 specified, counts only the matching services.
570 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
571 $sql .= ' AND svcpart = ?' if @_;
572 my $sth = dbh->prepare($sql) or die dbh->errstr;
573 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
574 $sth->fetchrow_arrayref->[0];
577 =item available_part_svc
579 Returns a list FS::part_svc objects representing services included in this
580 package but not yet provisioned. Each FS::part_svc object also has an extra
581 field, I<num_avail>, which specifies the number of available services.
585 sub available_part_svc {
587 grep { $_->num_avail > 0 }
589 my $part_svc = $_->part_svc;
590 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
591 $_->quantity - $self->num_cust_svc($_->svcpart);
594 $self->part_pkg->pkg_svc;
599 Returns a list of lists, calling the label method for all services
600 (see L<FS::cust_svc>) of this billing item.
606 map { [ $_->label ] } $self->cust_svc;
611 Returns the parent customer object (see L<FS::cust_main>).
617 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
620 =item seconds_since TIMESTAMP
622 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
623 package have been online since TIMESTAMP, according to the session monitor.
625 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
626 L<Time::Local> and L<Date::Parse> for conversion functions.
631 my($self, $since) = @_;
634 foreach my $cust_svc (
635 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
637 $seconds += $cust_svc->seconds_since($since);
644 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
646 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
647 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
650 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
651 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
657 sub seconds_since_sqlradacct {
658 my($self, $start, $end) = @_;
662 foreach my $cust_svc (
664 my $part_svc = $_->part_svc;
665 $part_svc->svcdb eq 'svc_acct'
666 && scalar($part_svc->part_export('sqlradius'));
669 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
676 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
678 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
679 in this package for sessions ending between TIMESTAMP_START (inclusive) and
683 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
684 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
689 sub attribute_since_sqlradacct {
690 my($self, $start, $end, $attrib) = @_;
694 foreach my $cust_svc (
696 my $part_svc = $_->part_svc;
697 $part_svc->svcdb eq 'svc_acct'
698 && scalar($part_svc->part_export('sqlradius'));
701 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
708 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
710 Transfers as many services as possible from this package to another package.
712 The destination package can be specified by pkgnum by passing an FS::cust_pkg
713 object. The destination package must already exist.
715 Services are moved only if the destination allows services with the correct
716 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
717 this option with caution! No provision is made for export differences
718 between the old and new service definitions. Probably only should be used
719 when your exports for all service definitions of a given svcdb are identical.
720 (attempt a transfer without it first, to move all possible svcpart-matching
723 Any services that can't be moved remain in the original package.
725 Returns an error, if there is one; otherwise, returns the number of services
726 that couldn't be moved.
731 my ($self, $dest_pkgnum, %opt) = @_;
737 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
738 $dest = $dest_pkgnum;
739 $dest_pkgnum = $dest->pkgnum;
741 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
744 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
746 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
747 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
750 foreach my $cust_svc ($dest->cust_svc) {
751 $target{$cust_svc->svcpart}--;
754 my %svcpart2svcparts = ();
755 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
756 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
757 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
758 next if exists $svcpart2svcparts{$svcpart};
759 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
760 $svcpart2svcparts{$svcpart} = [
762 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
764 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
767 $pkg_svc ? $pkg_svc->primary_svc : '',
768 $pkg_svc ? $pkg_svc->quantity : 0,
772 grep { $_ != $svcpart }
774 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
776 warn "alternates for svcpart $svcpart: ".
777 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
782 foreach my $cust_svc ($self->cust_svc) {
783 if($target{$cust_svc->svcpart} > 0) {
784 $target{$cust_svc->svcpart}--;
785 my $new = new FS::cust_svc {
786 svcnum => $cust_svc->svcnum,
787 svcpart => $cust_svc->svcpart,
788 pkgnum => $dest_pkgnum,
790 my $error = $new->replace($cust_svc);
791 return $error if $error;
792 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
794 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
795 warn "alternates to consider: ".
796 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
798 my @alternate = grep {
799 warn "considering alternate svcpart $_: ".
800 "$target{$_} available in new package\n"
803 } @{$svcpart2svcparts{$cust_svc->svcpart}};
805 warn "alternate(s) found\n" if $DEBUG;
806 my $change_svcpart = $alternate[0];
807 $target{$change_svcpart}--;
808 my $new = new FS::cust_svc {
809 svcnum => $cust_svc->svcnum,
810 svcpart => $change_svcpart,
811 pkgnum => $dest_pkgnum,
813 my $error = $new->replace($cust_svc);
814 return $error if $error;
827 This method is deprecated. See the I<depend_jobnum> option to the insert and
828 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
835 local $SIG{HUP} = 'IGNORE';
836 local $SIG{INT} = 'IGNORE';
837 local $SIG{QUIT} = 'IGNORE';
838 local $SIG{TERM} = 'IGNORE';
839 local $SIG{TSTP} = 'IGNORE';
840 local $SIG{PIPE} = 'IGNORE';
842 my $oldAutoCommit = $FS::UID::AutoCommit;
843 local $FS::UID::AutoCommit = 0;
846 foreach my $cust_svc ( $self->cust_svc ) {
847 #false laziness w/svc_Common::insert
848 my $svc_x = $cust_svc->svc_x;
849 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
850 my $error = $part_export->export_insert($svc_x);
852 $dbh->rollback if $oldAutoCommit;
858 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
869 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
871 CUSTNUM is a customer (see L<FS::cust_main>)
873 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
874 L<FS::part_pkg>) to order for this customer. Duplicates are of course
877 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
878 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
879 new billing items. An error is returned if this is not possible (see
880 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
883 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
884 newly-created cust_pkg objects.
889 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
891 my $conf = new FS::Conf;
893 # Transactionize this whole mess
894 local $SIG{HUP} = 'IGNORE';
895 local $SIG{INT} = 'IGNORE';
896 local $SIG{QUIT} = 'IGNORE';
897 local $SIG{TERM} = 'IGNORE';
898 local $SIG{TSTP} = 'IGNORE';
899 local $SIG{PIPE} = 'IGNORE';
901 my $oldAutoCommit = $FS::UID::AutoCommit;
902 local $FS::UID::AutoCommit = 0;
906 my $cust_main = qsearchs('cust_main', { custnum => $custnum });
907 return "Customer not found: $custnum" unless $cust_main;
909 # Create the new packages.
911 foreach (@$pkgparts) {
912 $cust_pkg = new FS::cust_pkg { custnum => $custnum,
914 $error = $cust_pkg->insert;
916 $dbh->rollback if $oldAutoCommit;
919 push @$return_cust_pkg, $cust_pkg;
921 # $return_cust_pkg now contains refs to all of the newly
924 # Transfer services and cancel old packages.
925 foreach my $old_pkgnum (@$remove_pkgnum) {
926 my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum });
928 foreach my $new_pkg (@$return_cust_pkg) {
929 $error = $old_pkg->transfer($new_pkg);
930 if ($error and $error == 0) {
931 # $old_pkg->transfer failed.
932 $dbh->rollback if $oldAutoCommit;
937 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
938 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
939 foreach my $new_pkg (@$return_cust_pkg) {
940 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
941 if ($error and $error == 0) {
942 # $old_pkg->transfer failed.
943 $dbh->rollback if $oldAutoCommit;
950 # Transfers were successful, but we went through all of the
951 # new packages and still had services left on the old package.
952 # We can't cancel the package under the circumstances, so abort.
953 $dbh->rollback if $oldAutoCommit;
954 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
956 $error = $old_pkg->cancel;
962 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
970 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
972 In sub order, the @pkgparts array (passed by reference) is clobbered.
974 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
975 method to pass dates to the recur_prog expression, it should do so.
977 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
978 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
979 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
980 configuration values. Probably need a subroutine which decides what to do
981 based on whether or not we've fetched the user yet, rather than a hash. See
982 FS::UID and the TODO.
984 Now that things are transactional should the check in the insert method be
989 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
990 L<FS::pkg_svc>, schema.html from the base documentation