X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=e2d337546cb5b624a5f72c9bdc04453db740c5e5;hb=5bb3332639ffadd71b00ad41fd2a7cbb038092ab;hp=fb774c6f36e4bc2e74369ecb0ce5ea799cfee404;hpb=a40226e5f72ae19a9c59135113b71639e7cfda93;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index fb774c6f3..e2d337546 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -242,7 +242,8 @@ The following options are available: =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 @@ -268,6 +269,7 @@ sub insert { 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; @@ -275,6 +277,8 @@ sub insert { $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) { @@ -283,12 +287,16 @@ sub insert { } } - 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); @@ -553,9 +561,12 @@ sub replace { } - 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; @@ -979,15 +990,20 @@ sub uncancel { $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 @@ -2016,14 +2032,30 @@ sub num_cust_event { =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). 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(@_); @@ -2048,13 +2080,7 @@ sub 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) ]; } @@ -2572,6 +2598,18 @@ sub cust_main { 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 @@ -2841,6 +2879,39 @@ sub reexport { } +=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