X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Ftax_rate.pm;h=4769b32ab22cc594bb42935aaa711c28f8c2c3cb;hb=8381e7232f90ac22b3f655cdccd0d39e2bde1d63;hp=3d56a0de14312267062480f8651d55f9f14c924e;hpb=6626dc2a13c809092aa539c5a72bc72a0c56afdc;p=freeside.git diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 3d56a0de1..4769b32ab 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -5,9 +5,14 @@ use vars qw( @ISA $DEBUG $me %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities %tax_passtypes ); use Date::Parse; -use FS::Record qw( qsearchs dbh ); +use Storable qw( thaw ); +use MIME::Base64; +use FS::Record qw( qsearch qsearchs dbh ); use FS::tax_class; use FS::cust_bill_pkg; +use FS::cust_tax_location; +use FS::part_pkg_taxrate; +use FS::cust_main; @ISA = qw( FS::Record ); @@ -194,7 +199,7 @@ sub check { || $self->ut_textn('data_vendor') || $self->ut_textn('location') || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum') - || $self->ut_numbern('effective_date') + || $self->ut_snumbern('effective_date') || $self->ut_float('tax') || $self->ut_floatn('excessrate') || $self->ut_money('taxbase') @@ -214,6 +219,7 @@ sub check { || $self->ut_enum('setuptax', [ '', 'Y' ] ) || $self->ut_enum('recurtax', [ '', 'Y' ] ) || $self->ut_enum('manual', [ '', 'Y' ] ) + || $self->ut_enum('disabled', [ '', 'Y' ] ) || $self->SUPER::check ; @@ -334,16 +340,30 @@ sub passtype_name { $tax_passtypes{$self->passtype}; } -=item taxline CUST_BILL_PKG, ... +=item taxline CUST_BILL_PKG|AMOUNT, ... Returns a listref of a name and an amount of tax calculated for the list -of packages. If an error occurs, a message is returned as a scalar. +of packages/amounts. If an error occurs, a message is returned as a scalar. =cut sub taxline { my $self = shift; - my @cust_bill_pkg = @_; + + my $name = $self->taxname; + $name = 'Other surcharges' + if ($self->passtype == 2); + my $amount = 0; + + return [$name, $amount] # we always know how to handle disabled taxes + if $self->disabled; + + my $taxable_charged = 0; + my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; } @_; + + warn "calculating taxes for ". $self->taxnum. " on ". + join (",", map { $_->pkgnum } @cust_bill_pkg) + if $DEBUG; if ($self->passflag eq 'N') { return "fatal: can't (yet) handle taxes not passed to the customer"; @@ -367,12 +387,6 @@ sub taxline { '" basis'; } - my $name = $self->taxname; - $name = 'Other surcharges' - if ($self->passtype == 2); - my $amount = 0; - - my $taxable_charged = 0; unless ($self->setuptax =~ /^Y$/i) { $taxable_charged += $_->setup foreach @cust_bill_pkg; } @@ -382,7 +396,16 @@ sub taxline { my $taxable_units = 0; unless ($self->recurtax =~ /^Y$/i) { - $taxable_units += $_->units foreach @cust_bill_pkg; + if ($self->unittype == 0) { + $taxable_units += $_->units foreach @cust_bill_pkg; + }elsif ($self->unittype == 1) { + return qq!fatal: can't (yet) handle fee with minute unit type!; + }elsif ($self->unittype == 2) { + $taxable_units = 1; + }else { + return qq!fatal: can't (yet) handle unknown unit type in tax!. + $self->taxnum; + } } # @@ -395,10 +418,64 @@ sub taxline { $amount += $taxable_charged * $self->tax; $amount += $taxable_units * $self->fee; + warn "calculated taxes as [ $name, $amount ]\n" + if $DEBUG; + return [$name, $amount]; } +=item tax_on_tax CUST_MAIN + +Returns a list of taxes which are candidates for taxing taxes for the +given customer (see L) + +=cut + +sub tax_on_tax { + my $self = shift; + my $cust_main = shift; + + warn "looking up taxes on tax ". $self->taxnum. " for customer ". + $cust_main->custnum + if $DEBUG; + + my $geocode = $cust_main->geocode($self->data_vendor); + + # CCH oddness in m2m + my $dbh = dbh; + my $extra_sql = ' AND ('. + join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) } + qw(10 5 2) + ). + ')'; + + my $order_by = 'ORDER BY taxclassnum, length(geocode) desc'; + my $select = 'DISTINCT ON(taxclassnum) *'; + + # should qsearch preface columns with the table to facilitate joins? + my @taxclassnums = map { $_->taxclassnum } + qsearch( { 'table' => 'part_pkg_taxrate', + 'select' => $select, + 'hashref' => { 'data_vendor' => $self->data_vendor, + 'taxclassnumtaxed' => $self->taxclassnum, + }, + 'extra_sql' => $extra_sql, + 'order_by' => $order_by, + } ); + + return () unless @taxclassnums; + + $extra_sql = + "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")"; + + qsearch({ 'table' => 'tax_rate', + 'hashref' => { 'geocode' => $geocode, }, + 'extra_sql' => $extra_sql, + }) + +} + =back =head1 SUBROUTINES @@ -410,21 +487,38 @@ sub taxline { =cut sub batch_import { - my $param = shift; + my ($param, $job) = @_; my $fh = $param->{filehandle}; my $format = $param->{'format'}; + my %insert = (); + my %delete = (); + my @fields; my $hook; - if ( $format eq 'cch' ) { + + my $line; + my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar + if ( $job ) { + $count++ + while ( defined($line=<$fh>) ); + seek $fh, 0, 0; + } + $count *=2; + + if ( $format eq 'cch' || $format eq 'cch-update' ) { @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax excessrate effective_date taxauth taxtype taxcat taxname usetax useexcessrate fee unittype feemax maxtype passflag passtype basetype ); + push @fields, 'actionflag' if $format eq 'cch-update'; + $hook = sub { my $hash = shift; + $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch'); + $hash->{'data_vendor'} ='cch'; $hash->{'effective_date'} = str2time($hash->{'effective_date'}); my $taxclassid = @@ -435,7 +529,7 @@ sub batch_import { ); my $tax_class = qsearchs( 'tax_class', \%tax_class ); - return "Error inserting tax rate: no tax class $taxclassid" + return "Error updating tax rate: no tax class $taxclassid" unless $tax_class; $hash->{'taxclassnum'} = $tax_class->taxclassnum; @@ -456,6 +550,15 @@ sub batch_import { if length($hash->{$_}) > 80; } + my $actionflag = delete($hash->{'actionflag'}); + if ($actionflag eq 'I') { + $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = $hash; + }elsif ($actionflag eq 'D') { + $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = $hash; + }else{ + return "Unexpected action flag: ". $hash->{'actionflag'}; + } + ''; }; @@ -486,15 +589,21 @@ sub batch_import { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $line; while ( defined($line=<$fh>) ) { $csv->parse($line) or do { $dbh->rollback if $oldAutoCommit; return "can't parse: ". $csv->error_input(); }; - warn "$me batch_import: $imported\n" - if (!($imported % 100) && $DEBUG); + if ( $job ) { # progress bar + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int( 100 * $imported / $count ) + ); + die $error if $error; + $last = time; + } + } my @columns = $csv->fields(); @@ -502,23 +611,110 @@ sub batch_import { foreach my $field ( @fields ) { $tax_rate{$field} = shift @columns; } + if ( scalar( @columns ) ) { + $dbh->rollback if $oldAutoCommit; + return "Unexpected trailing columns in line (wrong format?): $line"; + } + my $error = &{$hook}(\%tax_rate); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - my $tax_rate = new FS::tax_rate( \%tax_rate ); - $error = $tax_rate->insert; + $imported++; + + } + + for (grep { !exists($delete{$_}) } keys %insert) { + if ( $job ) { # progress bar + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int( 100 * $imported / $count ) + ); + die $error if $error; + $last = time; + } + } + + my $tax_rate = new FS::tax_rate( $insert{$_} ); + my $error = $tax_rate->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; + my $hashref = $insert{$_}; + $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) ); return "can't insert tax_rate for $line: $error"; } $imported++; } + for (grep { exists($delete{$_}) } keys %insert) { + if ( $job ) { # progress bar + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int( 100 * $imported / $count ) + ); + die $error if $error; + $last = time; + } + } + + my $old = qsearchs( 'tax_rate', $delete{$_} ); + unless ($old) { + $dbh->rollback if $oldAutoCommit; + $old = $delete{$_}; + return "can't find tax_rate to replace for: ". + #join(" ", map { "$_ => ". $old->{$_} } @fields); + join(" ", map { "$_ => ". $old->{$_} } keys(%$old) ); + } + my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' }); + $new->taxnum($old->taxnum); + my $error = $new->replace($old); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + my $hashref = $insert{$_}; + $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) ); + return "can't replace tax_rate for $line: $error"; + } + + $imported++; + $imported++; + } + + for (grep { !exists($insert{$_}) } keys %delete) { + if ( $job ) { # progress bar + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int( 100 * $imported / $count ) + ); + die $error if $error; + $last = time; + } + } + + my $tax_rate = qsearchs( 'tax_rate', $delete{$_} ); + unless ($tax_rate) { + $dbh->rollback if $oldAutoCommit; + $tax_rate = $delete{$_}; + return "can't find tax_rate to delete for: ". + #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields); + join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ); + } + my $error = $tax_rate->delete; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + my $hashref = $delete{$_}; + $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) ); + return "can't delete tax_rate for $line: $error"; + } + + $imported++; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; return "Empty file!" unless $imported; @@ -527,12 +723,240 @@ sub batch_import { } +=item process_batch + +Load a batch import as a queued JSRPC job + +=cut + +sub process_batch { + my $job = shift; + + my $param = thaw(decode_base64(shift)); + my $format = $param->{'format'}; #well... this is all cch specific + + my $files = $param->{'uploaded_files'} + or die "No files provided."; + + my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files; + + if ($format eq 'cch') { + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $error = ''; + + my @list = ( 'CODE', 'codefile', \&FS::tax_class::batch_import, + 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import, + 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import, + 'DETAIL', 'detail', \&FS::tax_rate::batch_import, + ); + while( scalar(@list) ) { + my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list); + unless ($files{$file}) { + $error = "No $name supplied"; + next; + } + my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc; + my $filename = "$dir/". $files{$file}; + open my $fh, "< $filename" or $error ||= "Can't open $name file: $!"; + + $error ||= &{$import_sub}({ 'filehandle' => $fh, 'format' => $format }, $job); + close $fh; + unlink $filename or warn "Can't delete $filename: $!"; + } + + if ($error) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + }else{ + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + } + + }elsif ($format eq 'cch-update') { + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $error = ''; + my @insert_list = (); + my @delete_list = (); + + my @list = ( 'CODE', 'codefile', \&FS::tax_class::batch_import, + 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import, + 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import, + ); + my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc; + while( scalar(@list) ) { + my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list); + unless ($files{$file}) { + $error = "No $name supplied"; + next; + } + my $filename = "$dir/". $files{$file}; + open my $fh, "< $filename" or $error ||= "Can't open $name file $filename: $!"; + unlink $filename or warn "Can't delete $filename: $!"; + + my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX", + DIR => $dir, + UNLINK => 0, #meh + ) or die "can't open temp file: $!\n"; + + my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX", + DIR => $dir, + UNLINK => 0, #meh + ) or die "can't open temp file: $!\n"; + + while(<$fh>) { + my $handle = ''; + $handle = $ifh if $_ =~ /"I"\s*$/; + $handle = $dfh if $_ =~ /"D"\s*$/; + unless ($handle) { + $error = "bad input line: $_" unless $handle; + last; + } + print $handle $_; + } + close $fh; + close $ifh; + close $dfh; + + push @insert_list, $name, $ifh->filename, $import_sub; + unshift @delete_list, $name, $dfh->filename, $import_sub; + + } + while( scalar(@insert_list) ) { + my ($name, $file, $import_sub) = + (shift @insert_list, shift @insert_list, shift @insert_list); + + open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; + $error ||= + &{$import_sub}({ 'filehandle' => $fh, 'format' => $format }, $job); + close $fh; + unlink $file or warn "Can't delete $file: $!"; + } + + $error ||= "No DETAIL supplied" + unless ($files{detail}); + open my $fh, "< $dir/". $files{detail} + or $error ||= "Can't open DETAIL file: $!"; + $error ||= + &FS::tax_rate::batch_import({ 'filehandle' => $fh, 'format' => $format }, + $job); + close $fh; + unlink "$dir/". $files{detail} or warn "Can't delete $files{detail}: $!" + if $files{detail}; + + while( scalar(@delete_list) ) { + my ($name, $file, $import_sub) = + (shift @delete_list, shift @delete_list, shift @delete_list); + + open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; + $error ||= + &{$import_sub}({ 'filehandle' => $fh, 'format' => $format }, $job); + close $fh; + unlink $file or warn "Can't delete $file: $!"; + } + + if ($error) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + }else{ + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + } + + }else{ + die "Unknown format: $format"; + } + +} + +=item browse_queries PARAMS + +Returns a list consisting of a hashref suited for use as the argument +to qsearch, and sql query string. Each is based on the PARAMS hashref +of keys and values which frequently would be passed as CVars)> +from a form. This conveniently creates the query hashref and count_query +string required by the browse and search elements. As a side effect, +the PARAMS hashref is untainted and keys with unexpected values are removed. + +=cut + +sub browse_queries { + my $params = shift; + + my $query = { + 'table' => 'tax_rate', + 'hashref' => {}, + 'order_by' => 'ORDER BY geocode, taxclassnum', + }, + + my $extra_sql = ''; + + if ( $params->{data_vendor} =~ /^(\w+)$/ ) { + $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1); + } else { + delete $params->{data_vendor}; + } + + if ( $params->{geocode} =~ /^(\w+)$/ ) { + $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). + 'geocode LIKE '. dbh->quote($1.'%'); + } else { + delete $params->{geocode}; + } + + if ( $params->{taxclassnum} =~ /^(\d+)$/ && + qsearchs( 'tax_class', {'taxclassnum' => $1} ) + ) + { + $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). + ' taxclassnum = '. dbh->quote($1) + } else { + delete $params->{taxclassnun}; + } + + my $tax_type = $1 + if ( $params->{tax_type} =~ /^(\d+)$/ ); + delete $params->{tax_type} + unless $tax_type; + + my $tax_cat = $1 + if ( $params->{tax_cat} =~ /^(\d+)$/ ); + delete $params->{tax_cat} + unless $tax_cat; + + my @taxclassnum = (); + if ($tax_type || $tax_cat ) { + my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'"; + $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat); + @taxclassnum = map { $_->taxclassnum } + qsearch({ 'table' => 'tax_class', + 'hashref' => {}, + 'extra_sql' => "WHERE taxclass $compare", + }); + } + + $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '. + join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )' + if ( @taxclassnum ); + + unless ($params->{'showdisabled'}) { + $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). + "( disabled = '' OR disabled IS NULL )"; + } + + $query->{extra_sql} = $extra_sql; + + return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql"); +} + =back =head1 BUGS -regionselector? putting web ui components in here? they should probably live -somewhere else... + Mixing automatic and manual editing works poorly at present. =head1 SEE ALSO