X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=e6374decfc08e39c2c4de1e17f16c3bc1b29f7bb;hb=6401184cc06d3a324a230490097289d0d6e7fa91;hp=8bf98e64fd90b4b7e3fd5a283ae7485392a58352;hpb=a563768f26549778585a03835e655e65e2dd6919;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 8bf98e64f..e6374decf 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,5 +1,5 @@ package FS::cust_pkg; -use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin +use base qw( FS::cust_pkg::API FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin FS::contact_Mixin FS::location_Mixin FS::m2m_Common FS::option_Common ); @@ -56,18 +56,27 @@ $disable_agentcheck = 0; $upgrade = 0; #go away after setup+start dates cleaned up for old customers +our $cache_enabled = 0; + +sub _simplecache { + my( $self, $hashref ) = @_; + if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) { + $self->{'_pkgpart'} = FS::part_pkg->new($hashref); + } +} + sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; - #if ( $hashref->{'pkgpart'} ) { - if ( $hashref->{'pkg'} ) { - # #@{ $self->{'_pkgnum'} } = (); - # my $subcache = $cache->subcache('pkgpart', 'part_pkg'); - # $self->{'_pkgpart'} = $subcache; - # #push @{ $self->{'_pkgnum'} }, - # FS::part_pkg->new_or_cached($hashref, $subcache); - $self->{'_pkgpart'} = FS::part_pkg->new($hashref); - } +# #if ( $hashref->{'pkgpart'} ) { +# if ( $hashref->{'pkg'} ) { +# # #@{ $self->{'_pkgnum'} } = (); +# # my $subcache = $cache->subcache('pkgpart', 'part_pkg'); +# # $self->{'_pkgpart'} = $subcache; +# # #push @{ $self->{'_pkgnum'} }, +# # FS::part_pkg->new_or_cached($hashref, $subcache); +# $self->{'_pkgpart'} = FS::part_pkg->new($hashref); +# } if ( exists $hashref->{'svcnum'} ) { #@{ $self->{'_pkgnum'} } = (); my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum}); @@ -180,11 +189,6 @@ date order taker (see L) -=item manual_flag - -If this field is set to 1, disables the automatic -unsuspension of this package when using the B config option. - =item quantity If not set, defaults to 1 @@ -393,6 +397,21 @@ sub insert { my $conf = new FS::Conf; + if ($self->locationnum) { + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_location-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_pkg_location($self); #, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + if ( $conf->config('ticket_system') && $options{ticket_subject} ) { #this init stuff is still inefficient, but at least its limited to @@ -638,6 +657,24 @@ sub replace { } } + # also run exports if removing locationnum? + # doesn't seem to happen, and we don't export blank locationnum on insert... + if ($new->locationnum and ($new->locationnum != $old->locationnum)) { + my $conf = new FS::Conf; + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_location-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_pkg_location($new); #, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -912,13 +949,28 @@ sub cancel { } } + # if a reasonnum was passed, get the actual reason object so we can check + # unused_credit + + my $reason; + if ($options{'reason'} =~ /^\d+$/) { + $reason = FS::reason->by_key($options{'reason'}); + } + unless ($date) { - # credit remaining time if appropriate + # credit remaining time if any of these are true: + # - unused_credit => 1 was passed (this happens when canceling a package + # for a package change when unused_credit_change is set) + # - no unused_credit option, and there is a cancel reason, and the cancel + # reason says to credit the package + # - no unused_credit option, and the package definition says to credit the + # package on cancellation my $do_credit; if ( exists($options{'unused_credit'}) ) { $do_credit = $options{'unused_credit'}; - } - else { + } elsif ( defined($reason) && $reason->unused_credit ) { + $do_credit = 1; + } else { $do_credit = $self->part_pkg->option('unused_credit_cancel', 1); } if ( $do_credit ) { @@ -1221,14 +1273,15 @@ sub uncancel { =item unexpire -Cancels any pending expiration (sets the expire field to null). +Cancels any pending expiration (sets the expire field to null) +for this package and any supplemental packages. If there is an error, returns the error, otherwise returns false. =cut sub unexpire { - my( $self, %options ) = @_; + my( $self ) = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -1265,6 +1318,14 @@ sub unexpire { return $error; } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->unexpire; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "unexpiring supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1866,14 +1927,15 @@ sub unsuspend { =item unadjourn -Cancels any pending suspension (sets the adjourn field to null). +Cancels any pending suspension (sets the adjourn field to null) +for this package and any supplemental packages. If there is an error, returns the error, otherwise returns false. =cut sub unadjourn { - my( $self, %options ) = @_; + my( $self ) = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -1917,6 +1979,14 @@ sub unadjourn { return $error; } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->unadjourn; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "unadjourning supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1979,6 +2049,13 @@ can't be transferred (also see the I config option). If unprotect_svcs is true, this method will transfer as many services as it can and then unconditionally cancel the old package. +=item contract_end + +If specified, sets this value for the contract_end date on the new package +(without regard for keep_dates or the usual date-preservation behavior.) +Will throw an error if defined but false; the UI doesn't allow editing +this unless it already exists, making removal impossible to undo. + =back At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or @@ -1992,6 +2069,33 @@ For example: =cut +#used by change and change_later +#didn't put with documented check methods because it depends on change-specific opts +#and it also possibly edits the value of opts +sub _check_change { + my $self = shift; + my $opt = shift; + if ( defined($opt->{'contract_end'}) ) { + my $current_contract_end = $self->get('contract_end'); + unless ($opt->{'contract_end'}) { + if ($current_contract_end) { + return "Cannot remove contract end date when changing packages"; + } else { + #shouldn't even pass this option if there's not a current value + #but can be handled gracefully if the option is empty + warn "Contract end date passed unexpectedly"; + delete $opt->{'contract_end'}; + return ''; + } + } + unless ($current_contract_end) { + #option shouldn't be passed, throw error if it's non-empty + return "Cannot add contract end date when changing packages " . $self->pkgnum; + } + } + return ''; +} + #some false laziness w/order sub change { my $self = shift; @@ -1999,6 +2103,16 @@ sub change { my $conf = new FS::Conf; + # handle contract_end on cust_pkg same as passed option + if ( $opt->{'cust_pkg'} ) { + $opt->{'contract_end'} = $opt->{'cust_pkg'}->contract_end; + delete $opt->{'contract_end'} unless $opt->{'contract_end'}; + } + + # check contract_end, prevent adding/removing + my $error = $self->_check_change($opt); + return $error if $error; + # Transactionize this whole mess local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -2011,8 +2125,6 @@ sub change { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error; - if ( $opt->{'cust_location'} ) { $error = $opt->{'cust_location'}->find_or_insert; if ( $error ) { @@ -2037,6 +2149,9 @@ sub change { if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) { $self->set_initial_timers; } + # but if contract_end was explicitly specified, that overrides all else + $self->set('contract_end', $opt->{'contract_end'}) + if $opt->{'contract_end'}; $error = $self->replace; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -2051,7 +2166,7 @@ sub change { my $time = time; - $hash{'setup'} = $time if $self->setup; + $hash{'setup'} = $time if $self->get('setup'); $hash{'change_date'} = $time; $hash{"change_$_"} = $self->$_() @@ -2072,16 +2187,18 @@ sub change { my $unused_credit = 0; my $keep_dates = $opt->{'keep_dates'}; - # Special case. If the pkgpart is changing, and the customer is - # going to be credited for remaining time, don't keep setup, bill, - # or last_bill dates, and DO pass the flag to cancel() to credit - # the customer. + # Special case. If the pkgpart is changing, and the customer is going to be + # credited for remaining time, don't keep setup, bill, or last_bill dates, + # and DO pass the flag to cancel() to credit the customer. If the old + # package had a setup date, set the new package's setup to the package + # change date so that it has the same status as before. if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart and $self->part_pkg->option('unused_credit_change', 1) ) { $unused_credit = 1; $keep_dates = 0; - $hash{$_} = '' foreach qw(setup bill last_bill); + $hash{'last_bill'} = ''; + $hash{'bill'} = ''; } if ( $keep_dates ) { @@ -2094,6 +2211,9 @@ sub change { start_date contract_end)) { $hash{$date} = $self->getfield($date); } + # but if contract_end was explicitly specified, that overrides all else + $hash{'contract_end'} = $opt->{'contract_end'} + if $opt->{'contract_end'}; # allow $opt->{'locationnum'} = '' to specifically set it to null # (i.e. customer default location) @@ -2244,6 +2364,21 @@ sub change { return "transferring package notes: $error"; } } + + # transfer scheduled expire/adjourn reasons + foreach my $action ('expire', 'adjourn') { + if ( $cust_pkg->get($action) ) { + my $reason = $self->last_cust_pkg_reason($action); + if ( $reason ) { + $reason->set('pkgnum', $cust_pkg->pkgnum); + $error = $reason->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "transferring $action reason: $error"; + } + } + } + } my @new_supp_pkgs; @@ -2366,8 +2501,10 @@ The date for the package change. Required, and must be in the future. =item quantity -The pkgpart. locationnum, and quantity of the new package, with the same -meaning as in C. +=item contract_end + +The pkgpart, locationnum, quantity and optional contract_end of the new +package, with the same meaning as in C. =back @@ -2377,6 +2514,10 @@ sub change_later { my $self = shift; my $opt = ref($_[0]) ? shift : { @_ }; + # check contract_end, prevent adding/removing + my $error = $self->_check_change($opt); + return $error if $error; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -2390,7 +2531,15 @@ sub change_later { return "start_date $date is in the past"; } - my $error; + # If the user entered a new location, set it up now. + if ( $opt->{'cust_location'} ) { + $error = $opt->{'cust_location'}->find_or_insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "creating location record: $error"; + } + $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum; + } if ( $self->change_to_pkgnum ) { my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum); @@ -2400,7 +2549,9 @@ sub change_later { if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum; my $new_quantity = $opt->{'quantity'} if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity; - if ( $new_pkgpart or $new_locationnum or $new_quantity ) { + my $new_contract_end = $opt->{'contract_end'} + if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end; + if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) { # it hasn't been billed yet, so in principle we could just edit # it in place (w/o a package change), but that's bad form. # So change the package according to the new options... @@ -2415,8 +2566,10 @@ sub change_later { $error = $self->replace || $err_or_pkg->replace || - $change_to->cancel('no_delay_cancel' => 1) || - $change_to->delete; + #because change() might've edited existing scheduled change in place + (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' : + $change_to->cancel('no_delay_cancel' => 1) || + $change_to->delete); } else { $error = $err_or_pkg; } @@ -2440,8 +2593,10 @@ sub change_later { if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum; my $new_quantity = $opt->{'quantity'} if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity; + my $new_contract_end = $opt->{'contract_end'} + if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end; - return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything + return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything # allow $opt->{'locationnum'} = '' to specifically set it to null # (i.e. customer default location) @@ -2452,7 +2607,7 @@ sub change_later { locationnum => $opt->{'locationnum'}, start_date => $date, map { $_ => ( $opt->{$_} || $self->$_() ) } - qw( pkgpart quantity refnum salesnum ) + qw( pkgpart quantity refnum salesnum contract_end ) } ); $error = $new->insert('change' => 1, 'allow_pkgpart' => ($new_pkgpart ? 0 : 1)); @@ -2901,6 +3056,20 @@ sub calc_recur { $self->part_pkg->calc_recur($self, @_); } +=item base_setup + +Returns the base setup fee (per unit) of this package, from the package +definition. + +=cut + +# minimal version for 3.x; in 4.x this can invoke currency conversion + +sub base_setup { + my $self = shift; + $self->part_pkg->unit_setup($self); +} + =item base_recur Calls the I of the FS::part_pkg object associated with this billing @@ -3116,16 +3285,15 @@ sub cust_svc_unsorted_arrayref { } my %search = ( - 'table' => 'cust_svc', - 'hashref' => { 'pkgnum' => $self->pkgnum }, + 'select' => 'cust_svc.*, part_svc.*', + 'table' => 'cust_svc', + 'hashref' => { 'pkgnum' => $self->pkgnum }, + 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )', ); - if ( $opt{svcpart} ) { - $search{hashref}->{svcpart} = $opt{'svcpart'}; - } - if ( $opt{'svcdb'} ) { - $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) '; - $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} ); - } + $search{hashref}->{svcpart} = $opt{svcpart} + if $opt{svcpart}; + $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{svcdb} ) + if $opt{svcdb}; [ qsearch(\%search) ]; @@ -3250,28 +3418,33 @@ Returns a list of FS::part_svc objects representing services included in this package but not yet provisioned. Each FS::part_svc object also has an extra field, I, which specifies the number of available services. +Accepts option I; if true, only returns part_svc for which the +associated pkg_svc has the provision_hold flag set. + =cut sub available_part_svc { my $self = shift; + my %opt = @_; my $pkg_quantity = $self->quantity || 1; grep { $_->num_avail > 0 } - map { - my $part_svc = $_->part_svc; - $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking - $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart); - - # more evil encapsulation breakage - if($part_svc->{'Hash'}{'num_avail'} > 0) { - my @exports = $part_svc->part_export_did; - $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports); - } - - $part_svc; - } - $self->part_pkg->pkg_svc; + map { + my $part_svc = $_->part_svc; + $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking + $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart); + + # more evil encapsulation breakage + if ($part_svc->{'Hash'}{'num_avail'} > 0) { + my @exports = $part_svc->part_export_did; + $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports); + } + + $part_svc; + } + grep { $opt{'provision_hold'} ? $_->provision_hold : 1 } + $self->part_pkg->pkg_svc; } =item part_svc [ OPTION => VALUE ... ] @@ -3611,23 +3784,27 @@ sub labels { map { [ $_->label ] } $self->cust_svc; } -=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ] +=item h_labels END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ] Like the labels method, but returns historical information on services that were active as of END_TIMESTAMP and (optionally) not cancelled before START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the I flag will be omitted. -Returns a list of lists, calling the label method for all (historical) services -(see L) of this billing item. +If LOCALE is passed, service definition names will be localized. + +Returns a list of lists, calling the label method for all (historical) +services (see L) of this billing item. =cut sub h_labels { my $self = shift; - warn "$me _h_labels called on $self\n" + my ($end, $start, $mode, $locale) = @_; + warn "$me h_labels\n" if $DEBUG; - map { [ $_->label(@_) ] } $self->h_cust_svc(@_); + map { [ $_->label($end, $start, $locale) ] } + $self->h_cust_svc($end, $start, $mode); } =item labels_short @@ -3640,15 +3817,15 @@ individual services rather than individual items. =cut sub labels_short { - shift->_labels_short( 'labels', @_ ); + shift->_labels_short( 'labels' ); # 'labels' takes no further arguments } -=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ] +=item h_labels_short END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ] Like h_labels, except returns a simple flat list, and shortens long -(currently >5 or the cust_bill-max_same_services configuration value) lists of -identical services to one line that lists the service label and the number of -individual services rather than individual items. +(currently >5 or the cust_bill-max_same_services configuration value) lists +of identical services to one line that lists the service label and the +number of individual services rather than individual items. =cut @@ -3656,6 +3833,9 @@ sub h_labels_short { shift->_labels_short( 'h_labels', @_ ); } +# takes a method name ('labels' or 'h_labels') and all its arguments; +# maybe should be "shorten($self->h_labels( ... ) )" + sub _labels_short { my( $self, $method ) = ( shift, shift ); @@ -3723,6 +3903,7 @@ Returns the parent customer object (see L). sub cust_main { my $self = shift; + cluck 'cust_pkg->cust_main called' if $DEBUG; qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); }