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.
153 # custnum might not have have been defined in sub check (for one-shot new
154 # customers), so check it here instead
155 # (is this still necessary with transactions?)
157 my $error = $self->ut_number('custnum');
158 return $error if $error;
160 my $cust_main = $self->cust_main;
161 return "Unknown custnum: ". $self->custnum unless $cust_main;
163 unless ( $disable_agentcheck ) {
164 my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
165 my $pkgpart_href = $agent->pkgpart_hashref;
166 return "agent ". $agent->agentnum.
167 " can't purchase pkgpart ". $self->pkgpart
168 unless $pkgpart_href->{ $self->pkgpart };
171 $self->SUPER::insert;
177 This method now works but you probably shouldn't use it.
179 You don't want to delete billing items, because there would then be no record
180 the customer ever purchased the item. Instead, see the cancel method.
185 # return "Can't delete cust_pkg records!";
188 =item replace OLD_RECORD
190 Replaces the OLD_RECORD with this one in the database. If there is an error,
191 returns the error, otherwise returns false.
193 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
195 Changing pkgpart may have disasterous effects. See the order subroutine.
197 setup and bill are normally updated by calling the bill method of a customer
198 object (see L<FS::cust_main>).
200 suspend is normally updated by the suspend and unsuspend methods.
202 cancel is normally updated by the cancel method (and also the order subroutine
208 my( $new, $old ) = ( shift, shift );
210 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
211 return "Can't change otaker!" if $old->otaker ne $new->otaker;
214 #return "Can't change setup once it exists!"
215 # if $old->getfield('setup') &&
216 # $old->getfield('setup') != $new->getfield('setup');
218 #some logic for bill, susp, cancel?
220 $new->SUPER::replace($old);
225 Checks all fields to make sure this is a valid billing item. If there is an
226 error, returns the error, otherwise returns false. Called by the insert and
235 $self->ut_numbern('pkgnum')
236 || $self->ut_numbern('custnum')
237 || $self->ut_number('pkgpart')
238 || $self->ut_numbern('setup')
239 || $self->ut_numbern('bill')
240 || $self->ut_numbern('susp')
241 || $self->ut_numbern('cancel')
243 return $error if $error;
245 if ( $self->custnum ) {
246 return "Unknown customer ". $self->custnum unless $self->cust_main;
249 return "Unknown pkgpart: ". $self->pkgpart
250 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
252 $self->otaker(getotaker) unless $self->otaker;
253 $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
256 if ( $self->dbdef_table->column('manual_flag') ) {
257 $self->manual_flag('') if $self->manual_flag eq ' ';
258 $self->manual_flag =~ /^([01]?)$/
259 or return "Illegal manual_flag ". $self->manual_flag;
260 $self->manual_flag($1);
266 =item cancel [ OPTION => VALUE ... ]
268 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
269 in this package, then cancels the package itself (sets the cancel field to
272 Available options are: I<quiet>
274 I<quiet> can be set true to supress email cancellation notices.
276 If there is an error, returns the error, otherwise returns false.
281 my( $self, %options ) = @_;
284 local $SIG{HUP} = 'IGNORE';
285 local $SIG{INT} = 'IGNORE';
286 local $SIG{QUIT} = 'IGNORE';
287 local $SIG{TERM} = 'IGNORE';
288 local $SIG{TSTP} = 'IGNORE';
289 local $SIG{PIPE} = 'IGNORE';
291 my $oldAutoCommit = $FS::UID::AutoCommit;
292 local $FS::UID::AutoCommit = 0;
296 foreach my $cust_svc (
297 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
299 push @{ $svc{$cust_svc->part_svc->svcdb} }, $cust_svc;
302 foreach my $svcdb (@SVCDB_CANCEL_SEQ) {
303 foreach my $cust_svc (@{ $svc{$svcdb} }) {
304 my $error = $cust_svc->cancel;
307 $dbh->rollback if $oldAutoCommit;
308 return "Error cancelling cust_svc: $error";
313 unless ( $self->getfield('cancel') ) {
314 my %hash = $self->hash;
315 $hash{'cancel'} = time;
316 my $new = new FS::cust_pkg ( \%hash );
317 $error = $new->replace($self);
319 $dbh->rollback if $oldAutoCommit;
324 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
326 my $conf = new FS::Conf;
327 my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list;
328 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
329 my $conf = new FS::Conf;
330 my $error = send_email(
331 'from' => $conf->config('invoice_from'),
332 'to' => \@invoicing_list,
333 'subject' => $conf->config('cancelsubject'),
334 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
336 #should this do something on errors?
345 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
346 package, then suspends the package itself (sets the susp field to now).
348 If there is an error, returns the error, otherwise returns false.
356 local $SIG{HUP} = 'IGNORE';
357 local $SIG{INT} = 'IGNORE';
358 local $SIG{QUIT} = 'IGNORE';
359 local $SIG{TERM} = 'IGNORE';
360 local $SIG{TSTP} = 'IGNORE';
361 local $SIG{PIPE} = 'IGNORE';
363 my $oldAutoCommit = $FS::UID::AutoCommit;
364 local $FS::UID::AutoCommit = 0;
367 foreach my $cust_svc (
368 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
370 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
372 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
373 $dbh->rollback if $oldAutoCommit;
374 return "Illegal svcdb value in part_svc!";
377 require "FS/$svcdb.pm";
379 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
381 $error = $svc->suspend;
383 $dbh->rollback if $oldAutoCommit;
390 unless ( $self->getfield('susp') ) {
391 my %hash = $self->hash;
392 $hash{'susp'} = time;
393 my $new = new FS::cust_pkg ( \%hash );
394 $error = $new->replace($self);
396 $dbh->rollback if $oldAutoCommit;
401 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
408 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
409 package, then unsuspends the package itself (clears the susp field).
411 If there is an error, returns the error, otherwise returns false.
419 local $SIG{HUP} = 'IGNORE';
420 local $SIG{INT} = 'IGNORE';
421 local $SIG{QUIT} = 'IGNORE';
422 local $SIG{TERM} = 'IGNORE';
423 local $SIG{TSTP} = 'IGNORE';
424 local $SIG{PIPE} = 'IGNORE';
426 my $oldAutoCommit = $FS::UID::AutoCommit;
427 local $FS::UID::AutoCommit = 0;
430 foreach my $cust_svc (
431 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
433 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
435 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
436 $dbh->rollback if $oldAutoCommit;
437 return "Illegal svcdb value in part_svc!";
440 require "FS/$svcdb.pm";
442 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
444 $error = $svc->unsuspend;
446 $dbh->rollback if $oldAutoCommit;
453 unless ( ! $self->getfield('susp') ) {
454 my %hash = $self->hash;
455 my $inactive = time - $hash{'susp'};
457 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
458 if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
459 my $new = new FS::cust_pkg ( \%hash );
460 $error = $new->replace($self);
462 $dbh->rollback if $oldAutoCommit;
467 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
474 Returns the last bill date, or if there is no last bill date, the setup date.
475 Useful for billing metered services.
481 if ( $self->dbdef_table->column('last_bill') ) {
482 return $self->setfield('last_bill', $_[0]) if @_;
483 return $self->getfield('last_bill') if $self->getfield('last_bill');
485 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
486 'edate' => $self->bill, } );
487 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
492 Returns the definition for this billing item, as an FS::part_pkg object (see
499 #exists( $self->{'_pkgpart'} )
501 ? $self->{'_pkgpart'}
502 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
507 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
514 $self->part_pkg->calc_setup($self, @_);
519 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
526 $self->part_pkg->calc_recur($self, @_);
529 =item cust_svc [ SVCPART ]
531 Returns the services for this package, as FS::cust_svc objects (see
532 L<FS::cust_svc>). If a svcpart is specified, return only the matching
541 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
542 'svcpart' => shift, } );
545 #if ( $self->{'_svcnum'} ) {
546 # values %{ $self->{'_svcnum'}->cache };
549 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
551 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
552 'svcpart' => $_->svcpart } );
554 $pkg_svc ? $pkg_svc->primary_svc : '',
555 $pkg_svc ? $pkg_svc->quantity : 0,
558 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
563 =item num_cust_svc [ SVCPART ]
565 Returns the number of provisioned services for this package. If a svcpart is
566 specified, counts only the matching services.
572 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
573 $sql .= ' AND svcpart = ?' if @_;
574 my $sth = dbh->prepare($sql) or die dbh->errstr;
575 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
576 $sth->fetchrow_arrayref->[0];
579 =item available_part_svc
581 Returns a list FS::part_svc objects representing services included in this
582 package but not yet provisioned. Each FS::part_svc object also has an extra
583 field, I<num_avail>, which specifies the number of available services.
587 sub available_part_svc {
589 grep { $_->num_avail > 0 }
591 my $part_svc = $_->part_svc;
592 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
593 $_->quantity - $self->num_cust_svc($_->svcpart);
596 $self->part_pkg->pkg_svc;
601 Returns a list of lists, calling the label method for all services
602 (see L<FS::cust_svc>) of this billing item.
608 map { [ $_->label ] } $self->cust_svc;
613 Returns the parent customer object (see L<FS::cust_main>).
619 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
622 =item seconds_since TIMESTAMP
624 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
625 package have been online since TIMESTAMP, according to the session monitor.
627 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
628 L<Time::Local> and L<Date::Parse> for conversion functions.
633 my($self, $since) = @_;
636 foreach my $cust_svc (
637 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
639 $seconds += $cust_svc->seconds_since($since);
646 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
648 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
649 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
652 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
653 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
659 sub seconds_since_sqlradacct {
660 my($self, $start, $end) = @_;
664 foreach my $cust_svc (
666 my $part_svc = $_->part_svc;
667 $part_svc->svcdb eq 'svc_acct'
668 && scalar($part_svc->part_export('sqlradius'));
671 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
678 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
680 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
681 in this package for sessions ending between TIMESTAMP_START (inclusive) and
685 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
686 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
691 sub attribute_since_sqlradacct {
692 my($self, $start, $end, $attrib) = @_;
696 foreach my $cust_svc (
698 my $part_svc = $_->part_svc;
699 $part_svc->svcdb eq 'svc_acct'
700 && scalar($part_svc->part_export('sqlradius'));
703 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
710 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
712 Transfers as many services as possible from this package to another package.
714 The destination package can be specified by pkgnum by passing an FS::cust_pkg
715 object. The destination package must already exist.
717 Services are moved only if the destination allows services with the correct
718 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
719 this option with caution! No provision is made for export differences
720 between the old and new service definitions. Probably only should be used
721 when your exports for all service definitions of a given svcdb are identical.
722 (attempt a transfer without it first, to move all possible svcpart-matching
725 Any services that can't be moved remain in the original package.
727 Returns an error, if there is one; otherwise, returns the number of services
728 that couldn't be moved.
733 my ($self, $dest_pkgnum, %opt) = @_;
739 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
740 $dest = $dest_pkgnum;
741 $dest_pkgnum = $dest->pkgnum;
743 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
746 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
748 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
749 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
752 foreach my $cust_svc ($dest->cust_svc) {
753 $target{$cust_svc->svcpart}--;
756 my %svcpart2svcparts = ();
757 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
758 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
759 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
760 next if exists $svcpart2svcparts{$svcpart};
761 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
762 $svcpart2svcparts{$svcpart} = [
764 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
766 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
769 $pkg_svc ? $pkg_svc->primary_svc : '',
770 $pkg_svc ? $pkg_svc->quantity : 0,
774 grep { $_ != $svcpart }
776 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
778 warn "alternates for svcpart $svcpart: ".
779 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
784 foreach my $cust_svc ($self->cust_svc) {
785 if($target{$cust_svc->svcpart} > 0) {
786 $target{$cust_svc->svcpart}--;
787 my $new = new FS::cust_svc {
788 svcnum => $cust_svc->svcnum,
789 svcpart => $cust_svc->svcpart,
790 pkgnum => $dest_pkgnum,
792 my $error = $new->replace($cust_svc);
793 return $error if $error;
794 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
796 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
797 warn "alternates to consider: ".
798 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
800 my @alternate = grep {
801 warn "considering alternate svcpart $_: ".
802 "$target{$_} available in new package\n"
805 } @{$svcpart2svcparts{$cust_svc->svcpart}};
807 warn "alternate(s) found\n" if $DEBUG;
808 my $change_svcpart = $alternate[0];
809 $target{$change_svcpart}--;
810 my $new = new FS::cust_svc {
811 svcnum => $cust_svc->svcnum,
812 svcpart => $change_svcpart,
813 pkgnum => $dest_pkgnum,
815 my $error = $new->replace($cust_svc);
816 return $error if $error;
829 This method is deprecated. See the I<depend_jobnum> option to the insert and
830 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
837 local $SIG{HUP} = 'IGNORE';
838 local $SIG{INT} = 'IGNORE';
839 local $SIG{QUIT} = 'IGNORE';
840 local $SIG{TERM} = 'IGNORE';
841 local $SIG{TSTP} = 'IGNORE';
842 local $SIG{PIPE} = 'IGNORE';
844 my $oldAutoCommit = $FS::UID::AutoCommit;
845 local $FS::UID::AutoCommit = 0;
848 foreach my $cust_svc ( $self->cust_svc ) {
849 #false laziness w/svc_Common::insert
850 my $svc_x = $cust_svc->svc_x;
851 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
852 my $error = $part_export->export_insert($svc_x);
854 $dbh->rollback if $oldAutoCommit;
860 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
871 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
873 CUSTNUM is a customer (see L<FS::cust_main>)
875 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
876 L<FS::part_pkg>) to order for this customer. Duplicates are of course
879 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
880 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
881 new billing items. An error is returned if this is not possible (see
882 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
885 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
886 newly-created cust_pkg objects.
891 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
893 my $conf = new FS::Conf;
895 # Transactionize this whole mess
896 local $SIG{HUP} = 'IGNORE';
897 local $SIG{INT} = 'IGNORE';
898 local $SIG{QUIT} = 'IGNORE';
899 local $SIG{TERM} = 'IGNORE';
900 local $SIG{TSTP} = 'IGNORE';
901 local $SIG{PIPE} = 'IGNORE';
903 my $oldAutoCommit = $FS::UID::AutoCommit;
904 local $FS::UID::AutoCommit = 0;
908 my $cust_main = qsearchs('cust_main', { custnum => $custnum });
909 return "Customer not found: $custnum" unless $cust_main;
911 # Create the new packages.
913 foreach (@$pkgparts) {
914 $cust_pkg = new FS::cust_pkg { custnum => $custnum,
916 $error = $cust_pkg->insert;
918 $dbh->rollback if $oldAutoCommit;
921 push @$return_cust_pkg, $cust_pkg;
923 # $return_cust_pkg now contains refs to all of the newly
926 # Transfer services and cancel old packages.
927 foreach my $old_pkgnum (@$remove_pkgnum) {
928 my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum });
930 foreach my $new_pkg (@$return_cust_pkg) {
931 $error = $old_pkg->transfer($new_pkg);
932 if ($error and $error == 0) {
933 # $old_pkg->transfer failed.
934 $dbh->rollback if $oldAutoCommit;
939 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
940 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
941 foreach my $new_pkg (@$return_cust_pkg) {
942 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
943 if ($error and $error == 0) {
944 # $old_pkg->transfer failed.
945 $dbh->rollback if $oldAutoCommit;
952 # Transfers were successful, but we went through all of the
953 # new packages and still had services left on the old package.
954 # We can't cancel the package under the circumstances, so abort.
955 $dbh->rollback if $oldAutoCommit;
956 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
958 $error = $old_pkg->cancel;
964 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
972 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
974 In sub order, the @pkgparts array (passed by reference) is clobbered.
976 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
977 method to pass dates to the recur_prog expression, it should do so.
979 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
980 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
981 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
982 configuration values. Probably need a subroutine which decides what to do
983 based on whether or not we've fetched the user yet, rather than a hash. See
984 FS::UID and the TODO.
986 Now that things are transactional should the check in the insert method be
991 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
992 L<FS::pkg_svc>, schema.html from the base documentation