=item change
-If set true, supresses any referral credit to a referring customer.
+If set true, supresses actions that should only be taken for new package
+orders. (Currently this includes: intro periods when delay_setup is on.)
=item options
my $part_pkg = $self->part_pkg;
+ # if the package def says to start only on the first of the month:
if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
$mon += 1 unless $mday == 1;
$self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
}
+ # set up any automatic expire/adjourn/contract_end timers
+ # based on the start date
foreach my $action ( qw(expire adjourn contract_end) ) {
my $months = $part_pkg->option("${action}_months",1);
if($months and !$self->$action) {
}
}
- my $free_days = $part_pkg->option('free_days',1);
- if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date
- my ($mday,$mon,$year) = (localtime(time) )[3,4,5];
- #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days;
- my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days;
- $self->start_date($start_date);
+ # if this package has "free days" and delayed setup fee, tehn
+ # set start date that many days in the future.
+ # (this should have been set in the UI, but enforce it here)
+ if ( ! $options{'change'}
+ && ( my $free_days = $part_pkg->option('free_days',1) )
+ && $part_pkg->option('delay_setup',1)
+ #&& ! $self->start_date
+ )
+ {
+ $self->start_date( $part_pkg->default_start_date );
}
$self->order_date(time);
}
- my $error = $new->SUPER::replace($old,
- $options->{options} ? $options->{options} : ()
- );
+ my $error = $new->export_pkg_change($old)
+ || $new->SUPER::replace( $old,
+ $options->{options}
+ ? $options->{options}
+ : ()
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
$dbh->rollback if $oldAutoCommit;
return $svc_error;
} else {
+ # if we've failed to insert the svc_x object, svc_Common->insert
+ # will have removed the cust_svc already. if not, then both records
+ # were inserted but we failed for some other reason (export, most
+ # likely). in that case, report the error and delete the records.
push @svc_errors, $svc_error;
- # is this necessary? svc_Common::insert already deletes the
- # cust_svc if inserting svc_x fails.
my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
if ( $cust_svc ) {
- my $cs_error = $cust_svc->delete;
- if ( $cs_error ) {
+ # except if export_insert failed, export_delete probably won't be
+ # much better
+ local $FS::svc_Common::noexport_hack = 1;
+ my $cleanup_error = $svc_x->delete; # also deletes cust_svc
+ if ( $cleanup_error ) { # and if THAT fails, then run away
$dbh->rollback if $oldAutoCommit;
- return $cs_error;
+ return $cleanup_error;
}
}
} # svc_fatal
=item cust_svc [ OPTION => VALUE ... ] (current usage)
+=item cust_svc_unsorted [ OPTION => VALUE ... ]
+
Returns the services for this package, as FS::cust_svc objects (see
L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
spcififed, returns only the matching services.
+As an optimization, use the cust_svc_unsorted version if you are not displaying
+the results.
+
=cut
sub cust_svc {
my $self = shift;
+ cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
+ $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
+}
+
+sub cust_svc_unsorted {
+ my $self = shift;
+ @{ $self->cust_svc_unsorted_arrayref(@_) };
+}
+
+sub cust_svc_unsorted_arrayref {
+ my $self = shift;
return () unless $self->num_cust_svc(@_);
$search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
}
- cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
-
- #if ( $self->{'_svcnum'} ) {
- # values %{ $self->{'_svcnum'}->cache };
- #} else {
- $self->_sort_cust_svc( [ qsearch(\%search) ] );
- #}
+ [ qsearch(\%search) ];
}
qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
}
+=item balance
+
+Returns the balance for this specific package, when using
+experimental package balance.
+
+=cut
+
+sub balance {
+ my $self = shift;
+ $self->cust_main->balance_pkgnum( $self->pkgnum );
+}
+
#these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
=item cust_location
}
+=item export_pkg_change OLD_CUST_PKG
+
+Calls the "pkg_change" export action for all services attached to this package.
+
+=cut
+
+sub export_pkg_change {
+ my( $self, $old ) = ( shift, shift );
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $svc_x ( map $_->svc_x, $self->cust_svc ) {
+ my $error = $svc_x->export('pkg_change', $self, $old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=item insert_reason
Associates this package with a (suspension or cancellation) reason (see
projects / freeside.git / blobdiff