diff options
author | Ivan Kohler <ivan@freeside.biz> | 2013-10-19 22:31:58 -0700 |
---|---|---|
committer | Ivan Kohler <ivan@freeside.biz> | 2013-10-19 22:31:58 -0700 |
commit | ecc15d03711690d2b2aeeda2bd8ff1119956c583 (patch) | |
tree | 39803c33eda9afbbd7dd85fc59939ffddff92bc2 /FS | |
parent | 6bcf9060e47a38b1e209b2be09f70dcce4b0e8c0 (diff) | |
parent | 0af30a9f44dc538f8696e20d02e32183b8ccf82b (diff) |
Merge branch 'master' of git.freeside.biz:/home/git/freeside
Diffstat (limited to 'FS')
-rw-r--r-- | FS/FS/AccessRight.pm | 1 | ||||
-rw-r--r-- | FS/FS/Mason.pm | 1 | ||||
-rw-r--r-- | FS/FS/Misc/Geo.pm | 9 | ||||
-rw-r--r-- | FS/FS/Report/Table/Daily.pm | 4 | ||||
-rw-r--r-- | FS/FS/Schema.pm | 31 | ||||
-rw-r--r-- | FS/FS/cust_credit.pm | 52 | ||||
-rw-r--r-- | FS/FS/cust_credit_void.pm | 134 | ||||
-rw-r--r-- | FS/FS/cust_main.pm | 28 | ||||
-rw-r--r-- | FS/FS/cust_pkg.pm | 152 | ||||
-rw-r--r-- | FS/FS/part_pkg.pm | 11 | ||||
-rw-r--r-- | FS/FS/part_pkg/prorate_calendar.pm | 223 | ||||
-rw-r--r-- | FS/FS/sales.pm | 80 | ||||
-rw-r--r-- | FS/MANIFEST | 2 | ||||
-rw-r--r-- | FS/t/cust_credit_void.t | 5 |
14 files changed, 704 insertions, 29 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 2783adac2..ca96eb52f 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -130,6 +130,7 @@ tie my %rights, 'Tie::IxHash', 'View customer packages', #NEW 'Order customer package', 'One-time charge', + 'Modify one-time charge', 'Change customer package', 'Detach customer package', 'Bulk change customer packages', diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 1215ca414..398d78561 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -356,6 +356,7 @@ if ( -e $addl_handler_use_file ) { use FS::invoice_mode; use FS::invoice_conf; use FS::cable_provider; + use FS::cust_credit_void; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index d9dcf3fd1..6bd817cfc 100644 --- a/FS/FS/Misc/Geo.pm +++ b/FS/FS/Misc/Geo.pm @@ -6,6 +6,7 @@ use vars qw( $DEBUG @EXPORT_OK $conf ); use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common qw( GET POST ); +use HTTP::Cookies; use HTML::TokeParser; use URI::Escape 3.31; use Data::Dumper; @@ -48,19 +49,20 @@ sub get_censustract_ffiec { my $return = {}; my $error = ''; - my $ua = new LWP::UserAgent; + my $ua = new LWP::UserAgent('cookie_jar' => HTTP::Cookies->new); my $res = $ua->request( GET( $url ) ); warn $res->as_string if $DEBUG > 2; - unless ($res->code eq '200') { + if (!$res->is_success) { $error = $res->message; } else { my $content = $res->content; + my $p = new HTML::TokeParser \$content; my $viewstate; my $eventvalidation; @@ -74,7 +76,7 @@ sub get_censustract_ffiec { last if $viewstate && $eventvalidation; } - unless ($viewstate && $eventvalidation ) { + if (!$viewstate or !$eventvalidation ) { $error = "either no __VIEWSTATE or __EVENTVALIDATION found"; @@ -86,6 +88,7 @@ sub get_censustract_ffiec { my @ffiec_args = ( __VIEWSTATE => $viewstate, __EVENTVALIDATION => $eventvalidation, + __VIEWSTATEENCRYPTED => '', ddlbYear => $year, txtAddress => $location->{address1}, txtCity => $location->{city}, diff --git a/FS/FS/Report/Table/Daily.pm b/FS/FS/Report/Table/Daily.pm index 6087b0dcc..570fefe4d 100644 --- a/FS/FS/Report/Table/Daily.pm +++ b/FS/FS/Report/Table/Daily.pm @@ -27,6 +27,7 @@ FS::Report::Table::Daily - Tables of report data, indexed daily 'end_day' => 27, #opt 'agentnum' => 54 + 'cust_classnum' => [ 1,2,4 ], 'params' => [ [ 'paramsfor', 'item_one' ], [ 'item', 'two' ] ], # ... 'remove_empty' => 1, #collapse empty rows, default 0 'item_labels' => [ ], #useful with remove_empty @@ -54,6 +55,8 @@ sub data { my $emonth = $self->{'end_month'}; my $eyear = $self->{'end_year'}; my $agentnum = $self->{'agentnum'}; + my $cust_classnum = $self->{'cust_classnum'} || []; + $cust_classnum = [ $cust_classnum ] if !ref($cust_classnum); my %data; @@ -83,6 +86,7 @@ sub data { for ( $i = 0; $i < scalar(@items); $i++ ) { my $item = $items[$i]; my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: (); + push @param, 'cust_classnum' => $cust_classnum if @$cust_classnum; my $value = $self->$item($speriod, $eperiod, $agentnum, @param); push @{$data{data}->[$col++]}, $value; } diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index b6f3cf3ee..3029ab579 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1018,6 +1018,37 @@ sub tables_hashref { ], }, + 'cust_credit_void' => { + 'columns' => [ + 'crednum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'amount',@money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', + 'otaker', 'varchar', 'NULL', 32, '', '', + 'usernum', 'int', 'NULL', '', '', '', + 'reason', 'text', 'NULL', '', '', '', + 'reasonnum', 'int', 'NULL', '', '', '', + 'addlinfo', 'text', 'NULL', '', '', '', + 'closed', 'char', 'NULL', 1, '', '', + 'pkgnum', 'int', 'NULL', '', '','', + 'eventnum', 'int', 'NULL', '', '','', + 'commission_agentnum', 'int', 'NULL', '', '', '', + 'commission_salesnum', 'int', 'NULL', '', '', '', + 'commission_pkgnum', 'int', 'NULL', '', '', '', + #void fields + 'void_date', @date_type, '', '', + 'void_reason', 'varchar', 'NULL', $char_d, '', '', + 'void_usernum', 'int', 'NULL', '', '', '', + ], + 'primary_key' => 'crednum', + 'unique' => [], + 'index' => [ ['custnum'], ['_date'], ['usernum'], ['eventnum'], + [ 'commission_salesnum' ], + ], + }, + + 'cust_credit_bill' => { 'columns' => [ 'creditbillnum', 'serial', '', '', '', '', diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index bd92bdc75..96789343a 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -21,6 +21,7 @@ use FS::reason; use FS::cust_event; use FS::agent; use FS::sales; +use FS::cust_credit_void; $me = '[ FS::cust_credit ]'; $DEBUG = 0; @@ -203,6 +204,8 @@ the void method instead to leave a record of the deleted credit. # very similar to FS::cust_pay::delete sub delete { my $self = shift; + my %opt = @_; + return "Can't delete closed credit" if $self->closed =~ /^Y/i; local $SIG{HUP} = 'IGNORE'; @@ -238,7 +241,7 @@ sub delete { return $error; } - if ( $conf->config('deletecredits') ne '' ) { + if ( !$opt{void} and $conf->config('deletecredits') ne '' ) { my $cust_main = $self->cust_main; @@ -336,6 +339,53 @@ sub check { $self->SUPER::check; } +=item void [ REASON ] + +Voids this credit: deletes the credit and all associated applications and +adds a record of the voided credit to the cust_credit_void table. + +=cut + +# yes, false laziness with cust_pay and cust_bill +# but frankly I don't have time to fix it now + +sub void { + my $self = shift; + my $reason = 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; + + my $cust_credit_void = new FS::cust_credit_void ( { + map { $_ => $self->get($_) } $self->fields + } ); + $cust_credit_void->set('void_reason', $reason); + my $error = $cust_credit_void->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $error = $self->delete(void => 1); # suppress deletecredits warning + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item cust_credit_refund Returns all refund applications (see L<FS::cust_credit_refund>) for this credit. diff --git a/FS/FS/cust_credit_void.pm b/FS/FS/cust_credit_void.pm new file mode 100644 index 000000000..ac47d954a --- /dev/null +++ b/FS/FS/cust_credit_void.pm @@ -0,0 +1,134 @@ +package FS::cust_credit_void; + +use strict; +use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record ); +use FS::Record qw(qsearch qsearchs dbh fields); +use FS::CurrentUser; +use FS::access_user; +use FS::cust_credit; + +=head1 NAME + +FS::cust_credit_void - Object methods for cust_credit_void objects + +=head1 SYNOPSIS + + use FS::cust_credit_void; + + $record = new FS::cust_credit_void \%hash; + $record = new FS::cust_credit_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_credit_void object represents a voided credit. All fields in +FS::cust_credit are present, as well as: + +=over 4 + +=item void_date - the date (unix timestamp) that the credit was voided + +=item void_reason - the reason (a freeform string) + +=item void_usernum - the user (L<FS::access_user>) who voided it + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new voided credit record. + +=cut + +sub table { 'cust_credit_void'; } + +=item insert + +Adds this voided credit to the database. + +=item check + +Checks all fields to make sure this is a valid voided credit. If there is an +error, returns the error, otherwise returns false. Called by the insert +method. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('crednum') + || $self->ut_number('custnum') + || $self->ut_numbern('_date') + || $self->ut_money('amount') + || $self->ut_alphan('otaker') + || $self->ut_textn('reason') + || $self->ut_textn('addlinfo') + || $self->ut_enum('closed', [ '', 'Y' ]) + || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_keyn('eventnum', 'cust_event', 'eventnum') + || $self->ut_foreign_keyn('commission_agentnum', 'agent', 'agentnum') + || $self->ut_foreign_keyn('commission_salesnum', 'sales', 'salesnum') + || $self->ut_foreign_keyn('commission_pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_numbern('void_date') + || $self->ut_textn('void_reason') + || $self->ut_foreign_keyn('void_usernum', 'access_user', 'usernum') + ; + return $error if $error; + + $self->void_date(time) unless $self->void_date; + + $self->void_usernum($FS::CurrentUser::CurrentUser->usernum) + unless $self->void_usernum; + + $self->SUPER::check; +} + +=item cust_main + +Returns the parent customer object (see L<FS::cust_main>). + +=cut + +sub cust_main { + my $self = shift; + qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); +} + +=item void_access_user + +Returns the voiding employee object (see L<FS::access_user>). + +=cut + +sub void_access_user { + my $self = shift; + qsearchs('access_user', { 'usernum' => $self->void_usernum } ); +} + +=back + +=head1 BUGS + +Doesn't yet support unvoid. + +=head1 SEE ALSO + +L<FS::cust_credit>, L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index a9a4cb0ef..3e36c6049 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1243,13 +1243,14 @@ sub merge { } tie my %financial_tables, 'Tie::IxHash', - 'cust_bill' => 'invoices', - 'cust_bill_void' => 'voided invoices', - 'cust_statement' => 'statements', - 'cust_credit' => 'credits', - 'cust_pay' => 'payments', - 'cust_pay_void' => 'voided payments', - 'cust_refund' => 'refunds', + 'cust_bill' => 'invoices', + 'cust_bill_void' => 'voided invoices', + 'cust_statement' => 'statements', + 'cust_credit' => 'credits', + 'cust_credit_void' => 'voided credits', + 'cust_pay' => 'payments', + 'cust_pay_void' => 'voided payments', + 'cust_refund' => 'refunds', ; foreach my $table ( keys %financial_tables ) { @@ -3732,6 +3733,19 @@ sub cust_credit_pkgnum { ); } +=item cust_credit_void + +Returns all voided credits (see L<FS::cust_credit_void>) for this customer. + +=cut + +sub cust_credit_void { + my $self = shift; + map { $_ } + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } ) +} + =item cust_pay Returns all the payments (see L<FS::cust_pay>) for this customer. diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 066b98755..009c81e06 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -35,6 +35,8 @@ use FS::cust_pkg_discount; use FS::discount; use FS::UI::Web; use FS::sales; +# for modify_charge +use FS::cust_credit; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -2256,8 +2258,128 @@ sub set_salesnum { $self = $self->replace_old; # just to make sure $self->salesnum(shift); $self->replace; + # XXX this should probably reassign any credit that's already been given } +=item modify_charge OPTIONS + +Change the properties of a one-time charge. Currently the only properties +that can be changed this way are those that have no impact on billing +calculations: +- pkg: the package description +- classnum: the package class +- additional: arrayref of additional invoice details to add to this package + +If you pass 'adjust_commission' => 1, and the classnum changes, and there are +commission credits linked to this charge, they will be recalculated. + +=cut + +sub modify_charge { + my $self = shift; + my %opt = @_; + my $part_pkg = $self->part_pkg; + my $pkgnum = $self->pkgnum; + + my $dbh = dbh; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + return "Can't use modify_charge except on one-time charges" + unless $part_pkg->freq eq '0'; + + if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) { + $part_pkg->set('pkg', $opt{'pkg'}); + } + + my %pkg_opt = $part_pkg->options; + if ( ref($opt{'additional'}) ) { + delete $pkg_opt{$_} foreach grep /^additional/, keys %pkg_opt; + my $i; + for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) { + $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i]; + } + $pkg_opt{'additional_count'} = $i if $i > 0; + } + + my $old_classnum; + if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} ) { + # remember it + $old_classnum = $part_pkg->classnum; + $part_pkg->set('classnum', $opt{'classnum'}); + } + + my $error = $part_pkg->replace( options => \%pkg_opt ); + return $error if $error; + + if (defined $old_classnum) { + # fix invoice grouping records + my $old_catname = $old_classnum + ? FS::pkg_class->by_key($old_classnum)->categoryname + : ''; + my $new_catname = $opt{'classnum'} + ? $part_pkg->pkg_class->categoryname + : ''; + if ( $old_catname ne $new_catname ) { + foreach my $cust_bill_pkg ($self->cust_bill_pkg) { + # (there should only be one...) + my @display = qsearch( 'cust_bill_pkg_display', { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'section' => $old_catname, + }); + foreach (@display) { + $_->set('section', $new_catname); + $error = $_->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } # foreach $cust_bill_pkg + } + + if ( $opt{'adjust_commission'} ) { + # fix commission credits...tricky. + foreach my $cust_event ($self->cust_event) { + my $part_event = $cust_event->part_event; + foreach my $table (qw(sales agent)) { + my $class = + "FS::part_event::Action::Mixin::credit_${table}_pkg_class"; + my $credit = qsearchs('cust_credit', { + 'eventnum' => $cust_event->eventnum, + }); + if ( $part_event->isa($class) ) { + # Yes, this results in current commission rates being applied + # retroactively to a one-time charge. For accounting purposes + # there ought to be some kind of time limit on doing this. + my $amount = $part_event->_calc_credit($self); + if ( $credit and $credit->amount ne $amount ) { + # Void the old credit. + $error = $credit->void('Package class changed'); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "$error (adjusting commission credit)"; + } + } + # redo the event action to recreate the credit. + local $@ = ''; + eval { $part_event->do_action( $self, $cust_event ) }; + if ( $@ ) { + $dbh->rollback if $oldAutoCommit; + return $@; + } + } # if $part_event->isa($class) + } # foreach $table + } # foreach $cust_event + } # if $opt{'adjust_commission'} + } # if defined $old_classnum + + $dbh->commit if $oldAutoCommit; + ''; +} + + + use Storable 'thaw'; use MIME::Base64; use Data::Dumper; @@ -4161,6 +4283,24 @@ boolean; if true, returns only packages with more than 0 FCC phone lines. Limit to packages with a service location in the specified state and country. For FCC 477 reporting, mostly. +=item location_cust + +Limit to packages whose service location is the same as the customer's +default service location. + +=item location_nocust + +Limit to packages whose service location is not the customer's default +service location. + +=item location_census + +Limit to packages whose service location has a census tract. + +=item location_nocensus + +Limit to packages whose service location doesn't have a census tract. + =back =cut @@ -4393,6 +4533,18 @@ sub search { } ### + # location_* flags + ### + if ( $params->{location_cust} xor $params->{location_nocust} ) { + my $op = $params->{location_cust} ? '=' : '!='; + push @where, "cust_location.locationnum $op cust_main.ship_locationnum"; + } + if ( $params->{location_census} xor $params->{location_nocensus} ) { + my $op = $params->{location_census} ? "IS NOT NULL" : "IS NULL"; + push @where, "cust_location.censustract $op"; + } + + ### # parse part_pkg ### diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 9e3b67ef1..9ce2e9687 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1650,6 +1650,17 @@ sub cust_bill_pkg_recur { $cust_bill_pkg->recur; } +=item unit_setup CUST_PKG + +Returns the setup fee for one unit of the package. + +=cut + +sub unit_setup { + my ($self, $cust_pkg) = @_; + $self->option('setup_fee') || 0; +} + =item format OPTION DATA Returns data formatted according to the function 'format' described diff --git a/FS/FS/part_pkg/prorate_calendar.pm b/FS/FS/part_pkg/prorate_calendar.pm new file mode 100644 index 000000000..83a80f5d0 --- /dev/null +++ b/FS/FS/part_pkg/prorate_calendar.pm @@ -0,0 +1,223 @@ +package FS::part_pkg::prorate_calendar; + +use strict; +use vars qw(@ISA %info); +use DateTime; +use Tie::IxHash; +use base 'FS::part_pkg::flat'; + +# weird stuff in here + +%info = ( + 'name' => 'Prorate to specific calendar day(s), then flat-rate', + 'shortname' => 'Prorate (calendar cycle)', + 'inherit_fields' => [ 'flat', 'usage_Mixin', 'global_Mixin' ], + 'fields' => { + 'recur_temporality' => {'disabled' => 1}, + 'sync_bill_date' => {'disabled' => 1},# god help us all + + 'cutoff_day' => { 'name' => 'Billing day (1 - end of cycle)', + 'default' => 1, + }, + + # add_full_period is not allowed + + # prorate_round_day is always on + 'prorate_round_day' => { 'disabled' => 1 }, + + 'prorate_defer_bill'=> { + 'name' => 'Defer the first bill until the billing day', + 'type' => 'checkbox', + }, + 'prorate_verbose' => { + 'name' => 'Show prorate details on the invoice', + 'type' => 'checkbox', + }, + }, + 'fieldorder' => [ 'cutoff_day', 'prorate_defer_bill', 'prorate_round_day', 'prorate_verbose' ], + 'freq' => 'm', + 'weight' => 20, +); + +my %freq_max_days = ( # the length of the shortest period of each cycle type + '1' => 28, + '2' => 59, # Jan - Feb + '3' => 90, # Jan - Mar + '4' => 120, # Jan - Apr + '6' => 181, # Jan - Jun + '12' => 365, +); + +my %freq_cutoff_days = ( + '1' => [ 31, 28, 31, 30, 31, 30, + 31, 31, 30, 31, 30, 31 ], + '2' => [ 59, 61, 61, 62, 61, 61 ], + '3' => [ 90, 91, 92, 92 ], + '4' => [ 120, 123, 122 ], + '6' => [ 181, 184 ], + '12' => [ 365 ], +); + +sub check { + # yes, this package plan is such a special snowflake it needs its own + # check method. + my $self = shift; + + if ( !exists($freq_max_days{$self->freq}) ) { + return 'Prorate (calendar cycle) billing interval must be an integer factor of one year'; + } + $self->SUPER::check; +} + +sub cutoff_day { + my( $self, $cust_pkg ) = @_; + my @periods = @{ $freq_cutoff_days{$self->freq} }; + my @cutoffs = ($self->option('cutoff_day') || 1); # Jan 1 = 1 + pop @periods; # we don't care about the last one + foreach (@periods) { + push @cutoffs, $cutoffs[-1] + $_; + } + @cutoffs; +} + +sub calc_prorate { + # it's not the same algorithm + my ($self, $cust_pkg, $sdate, $details, $param, @cutoff_days) = @_; + die "no cutoff_day" unless @cutoff_days; + die "prepaid terms not supported with calendar prorate packages" + if $param->{freq_override}; # XXX if we ever use this again + + #XXX should we still be doing this with multi-currency support? + my $money_char = FS::Conf->new->config('money_char') || '$'; + + my $charge = $self->base_recur($cust_pkg, $sdate) || 0; + my $now = DateTime->from_epoch(epoch => $$sdate, time_zone => 'local'); + + my $add_period = 0; + # if this is the first bill but the bill date has been set + # (by prorate_defer_bill), calculate from the setup date, + # append the setup fee to @$details, and make sure to bill for + # a full period after the bill date. + + if ( $self->option('prorate_defer_bill', 1) + and !$cust_pkg->getfield('last_bill') + and $cust_pkg->setup ) + { + $param->{'setup_fee'} = $self->calc_setup($cust_pkg, $$sdate, $details); + $now = DateTime->from_epoch(epoch => $cust_pkg->setup, time_zone => 'local'); + $add_period = 1; + } + + # DON'T sync to the existing billing day; cutoff days work differently here. + + $now->truncate(to => 'day'); + my ($end, $start) = $self->calendar_endpoints($now, @cutoff_days); + + #warn "[prorate_calendar] now = ".$now->ymd.", start = ".$start->ymd.", end = ".$end->ymd."\n"; + + my $periods = $end->delta_days($now)->delta_days / + $end->delta_days($start)->delta_days; + if ( $periods < 1 and $add_period ) { + $periods++; # charge for the extra time + $start->add(months => $self->freq); # and push the next bill date forward + } + if ( $self->option('prorate_verbose',1) and $periods > 0 ) { + if ( $periods < 1 ) { + push @$details, + 'Prorated (' . $now->strftime('%b %d') . + ' - ' . $end->strftime('%b %d') . '): ' . $money_char . + sprintf('%.2f', $charge * $periods + 0.00000001); + } elsif ( $periods > 1 ) { + push @$details, + 'Prorated (' . $now->strftime('%b %d') . + ' - ' . $end->strftime('%b %d') . '): ' . $money_char . + sprintf('%.2f', $charge * ($periods - 1) + 0.00000001), + + 'First full period: ' . $money_char . sprintf('%.2f', $charge); + } # else exactly one period + } + + $$sdate = $start->epoch; + return sprintf('%.2f', $charge * $periods + 0.00000001); +} + +sub prorate_setup { + my $self = shift; + my ($cust_pkg, $sdate) = @_; + my @cutoff_days = $self->cutoff_day; + if ( ! $cust_pkg->bill + and $self->option('prorate_defer_bill') + and @cutoff_days ) + { + my $now = DateTime->from_epoch(epoch => $sdate, time_zone => 'local'); + $now->truncate(to => 'day'); + my ($end, $start) = $self->calendar_endpoints($now, @cutoff_days); + if ( $now->compare($start) == 0 ) { + $cust_pkg->setup($start->epoch); + $cust_pkg->bill($start->epoch); + } else { + $cust_pkg->bill($end->epoch); + } + return 1; + } else { + return 0; + } +} + +=item calendar_endpoints NOW CUTOFF_DAYS + +Given a current date (DateTime object) and a list of cutoff day-of-year +numbers, finds the next upcoming cutoff day (in either the current or the +upcoming year) and the cutoff day before that, and returns them both. + +=cut + +sub calendar_endpoints { + my $self = shift; + my $now = shift; + my @cutoff_day = sort {$a <=> $b} @_; + + my $year = $now->year; + my $day = $now->day_of_year; + # Feb 29 = 60 + # For cutoff day purposes, it's the same day as Feb 28 + $day-- if $now->is_leap_year and $day >= 60; + + # select the first cutoff day that's after the current day + my $i = 0; + while ( $cutoff_day[$i] and $cutoff_day[$i] <= $day ) { + $i++; + } + # $cutoff_day[$i] is now later in the calendar than today + # or today is between the last cutoff day and the end of the year + + my ($start, $end); + if ( $i == 0 ) { + # then today is on or before the first cutoff day + $start = DateTime->from_day_of_year(year => $year - 1, + day_of_year => $cutoff_day[-1], + time_zone => 'local'); + $end = DateTime->from_day_of_year(year => $year, + day_of_year => $cutoff_day[0], + time_zone => 'local'); + } elsif ( $i > 0 and $i < scalar(@cutoff_day) ) { + # today is between two cutoff days + $start = DateTime->from_day_of_year(year => $year, + day_of_year => $cutoff_day[$i - 1], + time_zone => 'local'); + $end = DateTime->from_day_of_year(year => $year, + day_of_year => $cutoff_day[$i], + time_zone => 'local'); + } else { + # today is after the last cutoff day + $start = DateTime->from_day_of_year(year => $year, + day_of_year => $cutoff_day[-1], + time_zone => 'local'); + $end = DateTime->from_day_of_year(year => $year + 1, + day_of_year => $cutoff_day[0], + time_zone => 'local'); + } + return ($end, $start); +} + +1; diff --git a/FS/FS/sales.pm b/FS/FS/sales.pm index c8604abce..bdeaf1b68 100644 --- a/FS/FS/sales.pm +++ b/FS/FS/sales.pm @@ -131,34 +131,78 @@ sub sales_cust_main { qsearchs( 'cust_main', { 'custnum' => $self->sales_custnum } ); } -sub cust_bill_pkg { +=item cust_bill_pkg START END OPTIONS + +Returns the package line items (see L<FS::cust_bill_pkg>) for which this +sales person could receive commission. + +START and END are an optional date range to limit the results. + +OPTIONS may contain: +- I<cust_main_sales>: if this is a true value, sales of packages that have no +package sales person will be included if this is their customer sales person. +- I<classnum>: limit to this package classnum. +- I<paid>: limit to sales that have no unpaid balance. + +=cut + +sub cust_bill_pkg_search { my( $self, $sdate, $edate, %search ) = @_; my $cmp_salesnum = delete $search{'cust_main_sales'} ? ' COALESCE( cust_pkg.salesnum, cust_main.salesnum )' : ' cust_pkg.salesnum '; + my $salesnum = $self->salesnum; + die "bad salesnum" unless $salesnum =~ /^(\d+)$/; + my @where = ( "$cmp_salesnum = $salesnum", + "sales_pkg_class.salesnum = $salesnum" + ); + push @where, "cust_bill._date >= $sdate" if $sdate; + push @where, "cust_bill._date < $edate" if $edate; + my $classnum_sql = ''; if ( exists( $search{'classnum'} ) ) { - my $classnum = $search{'classnum'}; - $classnum_sql = " AND part_pkg.classnum ". ( $classnum ? " = $classnum " - : ' IS NULL ' ); + my $classnum = $search{'classnum'} || ''; + die "bad classnum" unless $classnum =~ /^(\d*)$/; + + push @where, + "part_pkg.classnum ". ( $classnum ? " = $classnum " : ' IS NULL ' ); } - qsearch({ 'table' => 'cust_bill_pkg', - 'addl_from' => ' LEFT JOIN cust_bill USING ( invnum ) '. - ' LEFT JOIN cust_pkg USING ( pkgnum ) '. - ' LEFT JOIN part_pkg USING ( pkgpart ) '. - ' LEFT JOIN cust_main ON ( cust_pkg.custnum = cust_main.custnum )', - 'extra_sql' => ( keys %{ $search{'hashref'} } - ? ' AND ' : 'WHERE ' - ). - " cust_bill._date >= $sdate ". - " AND cust_bill._date < $edate ". - " AND $cmp_salesnum = ". $self->salesnum. - $classnum_sql, - #%search, - }); + # sales_pkg_class number-of-months limit, grr + # (we should be able to just check for the cust_event record from the + # commission credit, but the report is supposed to act as a check on that) + # + # Pg-specific, of course + my $setup_date = 'TO_TIMESTAMP( cust_pkg.setup )'; + my $interval = "(sales_pkg_class.commission_duration || ' months')::interval"; + my $charge_date = 'TO_TIMESTAMP( cust_bill._date )'; + push @where, "CASE WHEN sales_pkg_class.commission_duration IS NOT NULL ". + "THEN $charge_date < $setup_date + $interval ". + "ELSE TRUE END"; + + if ( $search{'paid'} ) { + push @where, FS::cust_bill_pkg->owed_sql . ' <= 0.005'; + } + + my $extra_sql = "WHERE ".join(' AND ', map {"( $_ )"} @where); + + { 'table' => 'cust_bill_pkg', + 'select' => 'cust_bill_pkg.*', + 'addl_from' => ' LEFT JOIN cust_bill USING ( invnum ) '. + ' LEFT JOIN cust_pkg USING ( pkgnum ) '. + ' LEFT JOIN part_pkg USING ( pkgpart ) '. + ' LEFT JOIN cust_main ON ( cust_pkg.custnum = cust_main.custnum )'. + ' JOIN sales_pkg_class ON ( '. + ' COALESCE( sales_pkg_class.classnum, 0) = COALESCE( part_pkg.classnum, 0) )', + 'extra_sql' => $extra_sql, + }; +} + +sub cust_bill_pkg { + my $self = shift; + qsearch( $self->cust_bill_pkg_search(@_) ) } sub cust_credit { diff --git a/FS/MANIFEST b/FS/MANIFEST index 5dbe754c1..7a460dac3 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -726,3 +726,5 @@ FS/invoice_conf.pm t/invoice_conf.t FS/cable_provider.pm t/cable_provider.t +FS/cust_credit_void.pm +t/cust_credit_void.t diff --git a/FS/t/cust_credit_void.t b/FS/t/cust_credit_void.t new file mode 100644 index 000000000..6113ef5b8 --- /dev/null +++ b/FS/t/cust_credit_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_credit_void; +$loaded=1; +print "ok 1\n"; |