X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=1cc83b6a0795eba4a7c394c172619b7cbc685c1b;hb=4d0db1129018d2f598091edbbffeb09b23c64d99;hp=b1cdf45d46f538a897568747cd343ee5883708a6;hpb=71b86f3f89e8fdeb7142fa82cdbe3e3afce7a903;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index b1cdf45d4..1cc83b6a0 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::cust_pkg::Search +use base qw( FS::cust_pkg::Search 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 @@ -241,6 +241,39 @@ sub cust_unlinked_msg { ' (cust_pkg.pkgnum '. $self->pkgnum. ')'; } +=item set_initial_timers + +If required by the package definition, sets any automatic expire, adjourn, +or contract_end timers to some number of months after the start date +(or setup date, if the package has already been setup). If the package has +a delayed setup fee after a period of "free days", will also set the +start date to the end of that period. + +=cut + +sub set_initial_timers { + my $self = shift; + my $part_pkg = $self->part_pkg; + foreach my $action ( qw(expire adjourn contract_end) ) { + my $months = $part_pkg->option("${action}_months",1); + if($months and !$self->get($action)) { + my $start = $self->start_date || $self->setup || time; + $self->set($action, $part_pkg->add_freq($start, $months) ); + } + } + + # if this package has "free days" and delayed setup fee, then + # set start date that many days in the future. + # (this should have been set in the UI, but enforce it here) + if ( $part_pkg->option('free_days',1) + && $part_pkg->option('delay_setup',1) + ) + { + $self->start_date( $part_pkg->default_start_date ); + } + ''; +} + =item insert [ OPTION => VALUE ... ] Adds this billing item to the database ("Orders" the item). If there is an @@ -305,6 +338,9 @@ sub insert { if ( ! $import && ! $options{'change'} ) { + # set order date to now + $self->order_date(time) unless ($import && $self->order_date); + # 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]; @@ -313,35 +349,17 @@ 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) { - my $start = $self->start_date || $self->setup || time; - $self->$action( $part_pkg->add_freq($start, $months) ); - } - } - - # if this package has "free days" and delayed setup fee, then - # set start date that many days in the future. - # (this should have been set in the UI, but enforce it here) - if ( ! $options{'change'} - && $part_pkg->option('free_days', 1) - && $part_pkg->option('delay_setup',1) - #&& ! $self->start_date - ) - { - $self->start_date( $part_pkg->default_start_date ); + if ($self->susp eq 'now' or $part_pkg->start_on_hold) { + # if the package was ordered on hold: + # - suspend it + # - don't set the start date (it will be started manually) + $self->set('susp', $self->order_date); + $self->set('start_date', ''); + } else { + # set expire/adjourn/contract_end timers, and free days, if appropriate + $self->set_initial_timers; } - } - - # set order date unless it was specified as part of an import - # or this was previously a different package - $self->order_date(time) unless ($import && $self->order_date) - or $self->change_pkgnum; - - $self->susp( $self->order_date ) if $self->susp eq 'now'; + } # else this is a package change, and shouldn't have "new package" behavior my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; @@ -777,7 +795,9 @@ sub cancel { my $error; # pass all suspend/cancel actions to the main package - if ( $self->main_pkgnum and !$options{'from_main'} ) { + # (unless the pkglinknum has been removed, then the link is defunct and + # this package can be canceled on its own) + if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) { return $self->main_pkg->cancel(%options); } @@ -803,6 +823,20 @@ sub cancel { my $date = $options{'date'} if $options{'date'}; # expire/cancel later $date = '' if ($date && $date <= $cancel_time); # complain instead? + my $delay_cancel = undef; + if ( !$date && $self->part_pkg->option('delay_cancel',1) + && (($self->status eq 'active') || ($self->status eq 'suspended')) + ) { + my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1; + my $expsecs = 60*60*24*$expdays; + my $suspfor = $self->susp ? $cancel_time - $self->susp : 0; + $expsecs = $expsecs - $suspfor if $suspfor; + unless ($expsecs <= 0) { #if it's already been suspended long enough, don't re-suspend + $delay_cancel = 1; + $date = $cancel_time + $expsecs; + } + } + #race condition: usage could be ongoing until unprovisioned #resolved by performing a change package instead (which unprovisions) and #later cancelling @@ -873,11 +907,22 @@ sub cancel { my %hash = $self->hash; if ( $date ) { $hash{'expire'} = $date; + if ($delay_cancel) { + $hash{'susp'} = $cancel_time unless $self->susp; + $hash{'adjourn'} = undef; + $hash{'resume'} = undef; + } } else { $hash{'cancel'} = $cancel_time; } $hash{'change_custnum'} = $options{'change_custnum'}; + # if this is a supplemental package that's lost its part_pkg_link, and it's + # being canceled for real, unlink it completely + if ( !$date and ! $self->pkglinknum ) { + $hash{main_pkgnum} = ''; + } + my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); if ( $self->change_to_pkgnum ) { @@ -921,7 +966,7 @@ sub cancel { } else { $error = send_email( - 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), + 'from' => $conf->invoice_from_full( $self->cust_main->agentnum ), 'to' => \@invoicing_list, 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), 'body' => [ map "$_\n", $conf->config('cancelmessage') ], @@ -1181,7 +1226,7 @@ Available options are: =over 4 -=item reason - can be set to a cancellation reason (see L), +=item reason - can be set to a cancellation reason (see L), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: - typenum - Reason type (see L @@ -1271,6 +1316,16 @@ sub suspend { } } + # if a reasonnum was passed, get the actual reason object so we can check + # unused_credit + # (passing a reason hashref is still allowed, but it can't be used with + # the fancy behavioral options.) + + my $reason; + if ($options{'reason'} =~ /^\d+$/) { + $reason = FS::reason->by_key($options{'reason'}); + } + my %hash = $self->hash; if ( $date ) { $hash{'adjourn'} = $date; @@ -1295,9 +1350,15 @@ sub suspend { return $error; } - unless ( $date ) { + unless ( $date ) { # then we are suspending now + # credit remaining time if appropriate - if ( $self->part_pkg->option('unused_credit_suspend', 1) ) { + # (if required by the package def, or the suspend reason) + my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1) + || ( defined($reason) && $reason->unused_credit ); + + if ( $unused_credit ) { + warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG; my $error = $self->credit_remaining('suspend', $suspend_time); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -1382,6 +1443,21 @@ are mandatory. =cut +# Implementation note: +# +# If you pkgpart-change a package that has been billed, and it's set to give +# credit on package change, then this method gets called and then the new +# package will have no last_bill date. Therefore the customer will be credited +# only once (per billing period) even if there are multiple package changes. +# +# If you location-change a package that has been billed, this method will NOT +# be called and the new package WILL have the last bill date of the old +# package. +# +# If the new package is then canceled within the same billing cycle, +# credit_remaining needs to run calc_remain on the OLD package to determine +# the amount of unused time to credit. + sub credit_remaining { # Add a credit for remaining service my ($self, $mode, $time) = @_; @@ -1398,7 +1474,30 @@ sub credit_remaining { and $next_bill > 0 # the package has a next bill date and $next_bill >= $time # which is in the future ) { - my $remaining_value = $self->calc_remain('time' => $time); + my @cust_credit_source_bill_pkg = (); + my $remaining_value = 0; + + my $remain_pkg = $self; + $remaining_value = $remain_pkg->calc_remain( + 'time' => $time, + 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg, + ); + + # we may have to walk back past some package changes to get to the + # one that actually has unused time + while ( $remaining_value == 0 ) { + if ( $remain_pkg->change_pkgnum ) { + $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum); + } else { + # the package has really never been billed + return; + } + $remaining_value = $remain_pkg->calc_remain( + 'time' => $time, + 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg, + ); + } + if ( $remaining_value > 0 ) { warn "Crediting for $remaining_value on package ".$self->pkgnum."\n" if $DEBUG; @@ -1406,6 +1505,7 @@ sub credit_remaining { $remaining_value, 'Credit for unused time on '. $self->part_pkg->pkg, 'reason_type' => $reason_type, + 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg, ); return "Error crediting customer \$$remaining_value for unused time". " on ". $self->part_pkg->pkg. ": $error" @@ -1470,6 +1570,8 @@ sub unsuspend { return ""; # no error # complain instead? } + # handle the case of setting a future unsuspend (resume) date + # and do not continue to actually unsuspend the package my $date = $opt{'date'}; if ( $date and $date > time ) { # return an error if $date <= time? @@ -1493,6 +1595,11 @@ sub unsuspend { } #if $date + if (!$self->setup) { + # then this package is being released from on-hold status + $self->set_initial_timers; + } + my @labels = (); foreach my $cust_svc ( @@ -1529,19 +1636,41 @@ sub unsuspend { my $conf = new FS::Conf; #adjust the next bill date forward - $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive - if $inactive > 0 + # increment next bill date if certain conditions are met: + # - it was due to be billed at some point + # - either the global or local config says to do this + my $adjust_bill = 0; + if ( + $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ) && ( $opt{'adjust_next_bill'} || $conf->exists('unsuspend-always_adjust_next_bill_date') || $self->part_pkg->option('unsuspend_adjust_bill', 1) ) - && ! $self->option('suspend_bill',1) - && ( ! $self->part_pkg->option('suspend_bill',1) - || $self->option('no_suspend_bill',1) - ) - && $hash{'order_date'} != $hash{'susp'} - ; + ) { + $adjust_bill = 1; + } + + # but not if: + # - the package billed during suspension + # - or it was ordered on hold + # - or the customer was credited for the unused time + + if ( $self->option('suspend_bill',1) + or ( $self->part_pkg->option('suspend_bill',1) + and ! $self->option('no_suspend_bill',1) + ) + or $hash{'order_date'} == $hash{'susp'} + or $self->part_pkg->option('unused_credit_suspend') + or ( ref($reason) and $reason->unused_credit ) + ) { + $adjust_bill = 0; + } + + # then add the length of time suspended to the bill date + if ( $adjust_bill ) { + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive + } $hash{'susp'} = ''; $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time; @@ -2313,29 +2442,46 @@ sub modify_charge { } if ( !$self->get('setup') ) { - # not yet billed, so allow amount and quantity + # not yet billed, so allow amount, setup_cost, quantity and start_date + + if ( exists($opt{'amount'}) + and $part_pkg->option('setup_fee') != $opt{'amount'} + and $opt{'amount'} > 0 ) { + + $pkg_opt{'setup_fee'} = $opt{'amount'}; + $pkg_opt_modified = 1; + } + + if ( exists($opt{'setup_cost'}) + and $part_pkg->setup_cost != $opt{'setup_cost'} + and $opt{'setup_cost'} > 0 ) { + + $part_pkg->set('setup_cost', $opt{'setup_cost'}); + } + if ( exists($opt{'quantity'}) and $opt{'quantity'} != $self->quantity and $opt{'quantity'} > 0 ) { $self->set('quantity', $opt{'quantity'}); } + if ( exists($opt{'start_date'}) and $opt{'start_date'} != $self->start_date ) { $self->set('start_date', $opt{'start_date'}); } - if ( exists($opt{'amount'}) - and $part_pkg->option('setup_fee') != $opt{'amount'} - and $opt{'amount'} > 0 ) { - - $pkg_opt{'setup_fee'} = $opt{'amount'}; - $pkg_opt_modified = 1; - } } # else simply ignore them; the UI shouldn't allow editing the fields + + if ( exists($opt{'taxclass'}) + and $part_pkg->taxclass ne $opt{'taxclass'}) { + + $part_pkg->set('taxclass', $opt{'taxclass'}); + } + my $error; if ( $part_pkg->modified or $pkg_opt_modified ) { # can we safely modify the package def? @@ -2433,12 +2579,10 @@ sub modify_charge { -use Storable 'thaw'; -use MIME::Base64; use Data::Dumper; sub process_bulk_cust_pkg { my $job = shift; - my $param = thaw(decode_base64(shift)); + my $param = shift; warn Dumper($param) if $DEBUG; my $old_part_pkg = qsearchs('part_pkg', @@ -2718,7 +2862,7 @@ sub set_cust_pkg_detail { =item cust_event -Returns the new-style customer billing events (see L) for this invoice. +Returns the customer billing events (see L) for this invoice. =cut @@ -2735,19 +2879,41 @@ sub cust_event { =item num_cust_event -Returns the number of new-style customer billing events (see L) for this invoice. +Returns the number of customer billing events (see L) for this package. =cut #false laziness w/cust_bill.pm sub num_cust_event { my $self = shift; - my $sql = - "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ". - " WHERE tablenum = ? AND eventtable = 'cust_pkg'"; + my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where; + $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0]; +} + +=item exists_cust_event + +Returns true if there are customer billing events (see L) for this package. More efficient than using num_cust_event. + +=cut + +sub exists_cust_event { + my $self = shift; + my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1"; + my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref; + $row ? $row->[0] : ''; +} + +sub _from_cust_event_where { + #my $self = shift; + " FROM cust_event JOIN part_event USING ( eventpart ) ". + " WHERE tablenum = ? AND eventtable = 'cust_pkg' "; +} + +sub _prep_ex { + my( $self, $sql, @args ) = @_; my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql"; - $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql"; - $sth->fetchrow_arrayref->[0]; + $sth->execute(@args) or die $sth->errstr. " executing $sql"; + $sth; } =item part_pkg_currency_option OPTIONNAME @@ -2799,7 +2965,7 @@ sub cust_svc_unsorted { sub cust_svc_unsorted_arrayref { my $self = shift; - return () unless $self->num_cust_svc(@_); + return [] unless $self->num_cust_svc(@_); my %opt = (); if ( @_ && $_[0] =~ /^\d+/ ) { @@ -2855,12 +3021,16 @@ sub h_cust_svc { if $DEBUG; my ($end, $start, $mode) = @_; + + local($FS::Record::qsearch_qualify_columns) = 0; + my @cust_svc = $self->_sort_cust_svc( [ qsearch( 'h_cust_svc', { 'pkgnum' => $self->pkgnum, }, FS::h_cust_svc->sql_h_search(@_), ) ] ); + if ( defined($mode) && $mode eq 'I' ) { my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc; return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc; @@ -3163,7 +3333,7 @@ Class method that returns the list of possible status strings for packages tie my %statuscolor, 'Tie::IxHash', 'on hold' => '7E0079', #purple! 'not yet billed' => '009999', #teal? cyan? - 'one-time charge' => '000000', + 'one-time charge' => '0000CC', #blue #'000000', 'active' => '00CC00', 'suspended' => 'FF9900', 'cancelled' => 'FF0000', @@ -3176,6 +3346,11 @@ sub statuses { keys %statuscolor; } +sub statuscolors { + #my $self = shift; + \%statuscolor; +} + =item statuscolor Returns a hex triplet color string for this package's status. @@ -3187,6 +3362,31 @@ sub statuscolor { $statuscolor{$self->status}; } +=item is_status_delay_cancel + +Returns true if part_pkg has option delay_cancel, +cust_pkg status is 'suspended' and expire is set +to cancel package within the next day (or however +many days are set in global config part_pkg-delay_cancel-days. + +This is not a real status, this only meant for hacking display +values, because otherwise treating the package as suspended is +really the whole point of the delay_cancel option. + +=cut + +sub is_status_delay_cancel { + my ($self) = @_; + return 0 unless $self->part_pkg->option('delay_cancel',1); + return 0 unless $self->status eq 'suspended'; + return 0 unless $self->expire; + my $conf = new FS::Conf; + my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1; + my $expsecs = 60*60*24*$expdays; + return 0 unless $self->expire < time + $expsecs; + return 1; +} + =item pkg_label Returns a label for this package. (Currently "pkgnum: pkg - comment" or @@ -3586,7 +3786,7 @@ sub transfer { return ('Package does not exist: '.$dest_pkgnum) unless $dest; foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) { - $target{$pkg_svc->svcpart} = $pkg_svc->quantity; + $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 ); } foreach my $cust_svc ($dest->cust_svc) { @@ -3814,7 +4014,7 @@ sub insert_reason { $reasonnum = $reason->reasonnum; } else { - return "Unparsable reason: ". $options{'reason'}; + return "Unparseable reason: ". $options{'reason'}; } my $cust_pkg_reason = @@ -4015,7 +4215,7 @@ sub apply_usage { minutes => min($cust_pkg_usage->minutes, $minutes), }); $cust_pkg_usage->set('minutes', - sprintf('%.0f', $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes) + $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes ); $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert; $minutes -= $cdr_cust_pkg_usage->minutes; @@ -4660,6 +4860,23 @@ sub _upgrade_data { # class method my $sth = dbh->prepare($sql); $sth->execute or die $sth->errstr; } + + # RT31194: supplemental package links that are deleted don't clean up + # linked records + my @pkglinknums = qsearch({ + 'select' => 'DISTINCT cust_pkg.pkglinknum', + 'table' => 'cust_pkg', + 'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ', + 'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL + AND part_pkg_link.pkglinknum IS NULL', + }); + foreach (@pkglinknums) { + my $pkglinknum = $_->pkglinknum; + warn "cleaning part_pkg_link #$pkglinknum\n"; + my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum}); + my $error = $part_pkg_link->remove_linked; + die $error if $error; + } } =back