package FS::tax_rate; use base qw( FS::Record ); use strict; use vars qw( $DEBUG $me %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities %tax_passtypes %GetInfoType $keep_cch_files ); use Date::Parse; use DateTime; use DateTime::Format::Strptime; use IO::File; use File::Temp; use Text::CSV_XS; use URI::Escape; use LWP::UserAgent; use HTTP::Request; use HTTP::Response; use DBIx::DBSchema; use DBIx::DBSchema::Table; use DBIx::DBSchema::Column; use List::Util 'sum'; use FS::Record qw( qsearch qsearchs dbh dbdef ); use FS::Conf; use FS::tax_class; use FS::cust_bill_pkg; use FS::cust_tax_location; use FS::tax_rate_location; use FS::part_pkg_taxrate; use FS::part_pkg_taxproduct; use FS::cust_main; use FS::Misc qw( csv_from_fixed ); $DEBUG = 0; $me = '[FS::tax_rate]'; $keep_cch_files = 0; =head1 NAME FS::tax_rate - Object methods for tax_rate objects =head1 SYNOPSIS use FS::tax_rate; $record = new FS::tax_rate \%hash; $record = new FS::tax_rate { 'column' => 'value' }; $error = $record->insert; $error = $new_record->replace($old_record); $error = $record->delete; $error = $record->check; =head1 DESCRIPTION An FS::tax_rate object represents a tax rate, defined by locale. FS::tax_rate inherits from FS::Record. The following fields are currently supported: =over 4 =item taxnum primary key (assigned automatically for new tax rates) =item geocode a geographic location code provided by a tax data vendor =item data_vendor the tax data vendor =item location a location code provided by a tax authority =item taxclassnum a foreign key into FS::tax_class - the type of tax referenced by FS::part_pkg_taxrate =item effective_date the time after which the tax applies =item tax percentage =item excessrate second bracket percentage =item taxbase the amount to which the tax applies (first bracket) =item taxmax a cap on the amount of tax if a cap exists =item usetax percentage on out of jurisdiction purchases =item useexcessrate second bracket percentage on out of jurisdiction purchases =item unittype one of the values in %tax_unittypes =item fee amount of tax per unit =item excessfee second bracket amount of tax per unit =item feebase the number of units to which the fee applies (first bracket) =item feemax the most units to which fees apply (first and second brackets) =item maxtype a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc) =item taxname if defined, printed on invoices instead of "Tax" =item taxauth a value from %tax_authorities =item basetype a value from %tax_basetypes indicating the tax basis =item passtype a value from %tax_passtypes indicating how the tax should displayed to the customer =item passflag 'Y', 'N', or blank indicating the tax can be passed to the customer =item setuptax if 'Y', this tax does not apply to setup fees =item recurtax if 'Y', this tax does not apply to recurring fees =item manual if 'Y', has been manually edited =back =head1 METHODS =over 4 =item new HASHREF Creates a new tax rate. To add the tax rate to the database, see L<"insert">. =cut sub table { 'tax_rate'; } =item insert Adds this tax rate to the database. If there is an error, returns the error, otherwise returns false. =item delete Deletes this tax rate from the database. If there is an error, returns the error, otherwise returns false. =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. =item check Checks all fields to make sure this is a valid tax rate. If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. =cut sub check { my $self = shift; foreach (qw( taxbase taxmax )) { $self->$_(0) unless $self->$_; } $self->ut_numbern('taxnum') || $self->ut_text('geocode') || $self->ut_textn('data_vendor') || $self->ut_cch_textn('location') || $self->ut_foreign_keyn('taxclassnum', 'tax_class', 'taxclassnum') || $self->ut_snumbern('effective_date') || $self->ut_float('tax') || $self->ut_floatn('excessrate') || $self->ut_money('taxbase') || $self->ut_money('taxmax') || $self->ut_floatn('usetax') || $self->ut_floatn('useexcessrate') || $self->ut_numbern('unittype') || $self->ut_floatn('fee') || $self->ut_floatn('excessfee') || $self->ut_floatn('feemax') || $self->ut_numbern('maxtype') || $self->ut_textn('taxname') || $self->ut_numbern('taxauth') || $self->ut_numbern('basetype') || $self->ut_numbern('passtype') || $self->ut_enum('passflag', [ '', 'Y', 'N' ]) || $self->ut_enum('setuptax', [ '', 'Y' ] ) || $self->ut_enum('recurtax', [ '', 'Y' ] ) || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] ) || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] ) || $self->ut_enum('manual', [ '', 'Y' ] ) || $self->ut_enum('disabled', [ '', 'Y' ] ) || $self->SUPER::check ; } #ut_text / ut_textn w/ ` added cause now that's in the data sub ut_cch_textn { my($self,$field)=@_; $self->getfield($field) =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\`]*)$/ or return gettext('illegal_or_empty_text'). " $field: ". $self->getfield($field); $self->setfield($field,$1); ''; } =item taxclass_description Returns the human understandable value associated with the related FS::tax_class. =cut sub taxclass_description { my $self = shift; my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum }); $tax_class ? $tax_class->description : ''; } =item unittype_name Returns the human understandable value associated with the unittype column =cut %tax_unittypes = ( '0' => 'access line', '1' => 'minute', '2' => 'account', ); sub unittype_name { my $self = shift; $tax_unittypes{$self->unittype}; } =item maxtype_name Returns the human understandable value associated with the maxtype column. =cut # XXX these are non-functional, and most of them are horrible to implement # in our current model %tax_maxtypes = ( '0' => 'receipts per invoice', '1' => 'receipts per item', '2' => 'total utility charges per utility tax year', '3' => 'total charges per utility tax year', '4' => 'receipts per access line', '7' => 'total utility charges per calendar year', '9' => 'monthly receipts per location', '10' => 'monthly receipts exceeds taxbase and total tax per month does not exceed maxtax', # wtf? '11' => 'receipts/units per access line', '14' => 'units per invoice', '15' => 'units per month', '18' => 'units per account', ); sub maxtype_name { my $self = shift; $tax_maxtypes{$self->maxtype}; } =item basetype_name Returns the human understandable value associated with the basetype column =cut %tax_basetypes = ( '0' => 'sale price', '1' => 'gross receipts', '2' => 'sales taxable telecom revenue', '3' => 'minutes carried', '4' => 'minutes billed', '5' => 'gross operating revenue', '6' => 'access line', '7' => 'account', '8' => 'gross revenue', '9' => 'portion gross receipts attributable to interstate service', '10' => 'access line', '11' => 'gross profits', '12' => 'tariff rate', '14' => 'account', '15' => 'prior year gross receipts', ); sub basetype_name { my $self = shift; $tax_basetypes{$self->basetype}; } =item taxauth_name Returns the human understandable value associated with the taxauth column =cut %tax_authorities = ( '0' => 'federal', '1' => 'state', '2' => 'county', '3' => 'city', '4' => 'local', '5' => 'county administered by state', '6' => 'city administered by state', '7' => 'city administered by county', '8' => 'local administered by state', '9' => 'local administered by county', ); sub taxauth_name { my $self = shift; $tax_authorities{$self->taxauth}; } =item passtype_name Returns the human understandable value associated with the passtype column =cut %tax_passtypes = ( '0' => 'separate tax line', '1' => 'separate surcharge line', '2' => 'surcharge not separated', '3' => 'included in base rate', ); sub passtype_name { my $self = shift; $tax_passtypes{$self->passtype}; } =item taxline_cch TAXABLES, CLASSES Takes an arrayref of L objects representing taxable line items, and an arrayref of charge classes ('setup', 'recur', '' for unclassified usage, or an L number). Calculates the tax on each item under this tax definition and returns a list of new L objects for the taxes charged. If the taxable objects are linked to an invoice, this will also calculate per-customer exemptions (cust_exempt and cust_taxname_exempt) and attach them to the line items in the 'cust_tax_exempt_pkg' pseudo-field. For accurate calculation of per-customer or per-location taxes, ALL items appearing on the invoice (and subject to this tax) MUST be passed to this method together, and NO items from any other invoice should be included. =cut sub taxline_cch { my $self = shift; # this used to accept a hash of options but none of them did anything # so it's been removed. my $taxables = shift; my $classes = shift || []; my $name = $self->taxname; $name = 'Other surcharges' if ($self->passtype == 2); my $amount = 0; return unless @$taxables; # nothing to do return if $self->disabled; return if $self->passflag eq 'N'; # tax can't be passed to the customer # but should probably still appear on the liability report--create a # cust_tax_exempt_pkg record for it? # in 4.x, the invoice is _already inserted_ before we try to calculate # tax on it. though it may be a quotation, so be careful. my $cust_main; my $cust_bill = $taxables->[0]->cust_bill; $cust_main = $cust_bill->cust_main if $cust_bill; my $taxable_charged = 0; my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; } @$taxables; my $taxratelocationnum = $self->tax_rate_location->taxratelocationnum; warn "calculating taxes for ". $self->taxnum. " on ". join (",", map { $_->pkgnum } @cust_bill_pkg) if $DEBUG; my $maxtype = $self->maxtype || 0; if ($maxtype != 0 && $maxtype != 1 && $maxtype != 14 && $maxtype != 15 && $maxtype != 18 # sigh ) { return $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' ); } # I don't know why, it's not like there are maxtypes that we DO support # we treat gross revenue as gross receipts and expect the tax data # to DTRT (i.e. tax on tax rules) if ($self->basetype != 0 && $self->basetype != 1 && $self->basetype != 5 && $self->basetype != 6 && $self->basetype != 7 && $self->basetype != 8 && $self->basetype != 14 ) { return $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' ); } my @tax_links; # for output my %seen; # locationnum or pkgnum => 1 my $taxable_cents = 0; my $taxable_units = 0; my $tax_cents = 0; while (@$taxables) { my $cust_bill_pkg = shift @$taxables; my $class = shift @$classes; $class = 'all' if !defined($class); my %usage_map = map { $_ => $cust_bill_pkg->usage($_) } $cust_bill_pkg->usage_classes; my $usage_total = sum( values(%usage_map), 0 ); # determine if the item has exemptions that apply to this tax def my @exemptions = grep { $_->taxnum == $self->taxnum } @{ $cust_bill_pkg->cust_tax_exempt_pkg }; if ( $self->tax > 0 ) { my $taxable_charged = 0; if ($class eq 'all') { $taxable_charged = $cust_bill_pkg->setup + $cust_bill_pkg->recur; } elsif ($class eq 'setup') { $taxable_charged = $cust_bill_pkg->setup; } elsif ($class eq 'recur') { $taxable_charged = $cust_bill_pkg->recur - $usage_total; } else { $taxable_charged = $usage_map{$class} || 0; } foreach my $ex (@exemptions) { # the only cases where the exemption doesn't apply: # if it's a setup exemption and $class is not 'setup' or 'all' # if it's a recur exemption and $class is 'setup' if ( ( $ex->exempt_recur and $class eq 'setup' ) or ( $ex->exempt_setup and $class ne 'setup' and $class ne 'all' ) ) { next; } $taxable_charged -= $ex->amount; } # cust_main_county handles monthly capped exemptions; this doesn't. # # $taxable_charged can also be less than zero at this point # (recur exemption + usage class breakdown); treat that as zero. next if $taxable_charged <= 0; # yeah, some false laziness with cust_main_county my $this_tax_cents = int(100 * $taxable_charged * $self->tax); my $tax_link = FS::cust_bill_pkg_tax_rate_location->new({ 'taxnum' => $self->taxnum, 'taxtype' => ref($self), 'cents' => $this_tax_cents, # not a real field 'locationtaxid' => $self->location, # fundamentally silly 'taxable_billpkgnum' => $cust_bill_pkg->billpkgnum, 'taxable_cust_bill_pkg' => $cust_bill_pkg, 'taxratelocationnum' => $taxratelocationnum, 'taxclass' => $class, }); push @tax_links, $tax_link; $taxable_cents += 100 * $taxable_charged; $tax_cents += $this_tax_cents; } elsif ( $self->fee > 0 ) { # most CCH taxes are this type, because nearly every county has a 911 # fee my $units = 0; # since we don't support partial exemptions (except setup/recur), # if there's an exemption that applies to this package and taxrate, # don't charge ANY per-unit fees next if @exemptions; # don't apply fees to usage classes (maybe if we ever get per-minute # fees?) next unless $class eq 'setup' or $class eq 'recur' or $class eq 'all'; if ( $self->unittype == 0 ) { if ( !$seen{$cust_bill_pkg->pkgnum} ) { # per access line $units = $cust_bill_pkg->units; $seen{$cust_bill_pkg->pkgnum} = 1; } # else it's been seen, leave it at zero units } elsif ($self->unittype == 1) { # per minute # STILL not supported...fortunately these only exist if you happen # to be in Idaho or Little Rock, Arkansas # # though a voip_cdr package could easily report minutes of usage... return $self->_fatal_or_null( 'fee with minute unit type' ); } elsif ( $self->unittype == 2 ) { # per account my $locationnum = $cust_bill_pkg->tax_locationnum; if (!$locationnum and $cust_main) { $locationnum = $cust_main->ship_locationnum; } # the other case is that it's a quotation $units = 1 unless $seen{$cust_bill_pkg->tax_locationnum}; $seen{$cust_bill_pkg->tax_locationnum} = 1; } else { # Unittype 19 is used for prepaid wireless E911 charges in many states. # Apparently "per retail purchase", which for us would mean per invoice. # Unittype 20 is used for some 911 surcharges and I have no idea what # it means. return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum ); } my $this_tax_cents = int($units * $self->fee * 100); my $tax_link = FS::cust_bill_pkg_tax_rate_location->new({ 'taxnum' => $self->taxnum, 'taxtype' => ref($self), 'cents' => $this_tax_cents, 'locationtaxid' => $self->location, 'taxable_billpkgnum' => $cust_bill_pkg->billpkgnum, 'taxable_cust_bill_pkg' => $cust_bill_pkg, 'taxratelocationnum' => $taxratelocationnum, 'taxclass' => $class, }); push @tax_links, $tax_link; $taxable_units += $units; $tax_cents += $this_tax_cents; } } # foreach $cust_bill_pkg # check bracket maxima; throw an error if we've gone over, because # we don't really implement them if ( ($self->taxmax > 0 and $taxable_cents > $self->taxmax*100 ) or ($self->feemax > 0 and $taxable_units > $self->feemax) ) { # throw an error # (why not just cap taxable_charged/units at the taxmax/feemax? because # it's way more complicated than that. this won't even catch every case # where a bracket maximum should apply.) return $self->_fatal_or_null( 'tax base > taxmax/feemax for tax'.$self->taxnum ); } # round and distribute my $total_tax_cents = sprintf('%.0f', ($taxable_cents * $self->tax) + ($taxable_units * $self->fee * 100) ); my $extra_cents = sprintf('%.0f', $total_tax_cents - $tax_cents); $tax_cents += $extra_cents; my $i = 0; foreach (@tax_links) { # can never require more than a single pass, yes? my $cents = $_->get('cents'); if ( $extra_cents > 0 ) { $cents++; $extra_cents--; } $_->set('amount', sprintf('%.2f', $cents/100)); } return @tax_links; } sub _fatal_or_null { my ($self, $error) = @_; $DB::single = 1; # not a mistake my $conf = new FS::Conf; $error = "can't yet handle ". $error; my $name = $self->taxname; $name = 'Other surcharges' if ($self->passtype == 2); if ($conf->exists('ignore_incalculable_taxes')) { warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n"; return { name => $name, amount => 0 }; } else { return "fatal: $error"; } } =item tax_on_tax CUST_LOCATION Returns a list of taxes which are candidates for taxing taxes for the given service location (see L) =cut #hot sub tax_on_tax { #akshun my $self = shift; my $cust_location = shift; warn "looking up taxes on tax ". $self->taxnum. " for customer ". $cust_location->custnum if $DEBUG; my $geocode = $cust_location->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' => { 'data_vendor' => $self->data_vendor, 'geocode' => $geocode, }, 'extra_sql' => $extra_sql, }) } =item tax_rate_location Returns an object representing the location associated with this tax (see L) =cut sub tax_rate_location { my $self = shift; qsearchs({ 'table' => 'tax_rate_location', 'hashref' => { 'data_vendor' => $self->data_vendor, 'geocode' => $self->geocode, 'disabled' => '', }, }) || new FS::tax_rate_location; } =item find_or_insert Finds an existing tax definition matching the data_vendor, taxname, taxclassnum, and geocode of this one, if one exists, and sets the contents of this tax rate equal to that one (including its taxnum). If an existing definition is not found, inserts this one. Returns an error string if inserting a record failed. =cut sub find_or_insert { my $self = shift; # this doesn't uniquely identify CCH taxes (kinda goofy, I know) die "find_or_insert is not compatible with CCH taxes\n" if $self->data_vendor eq 'cch'; my @keys = (qw(data_vendor taxname taxclassnum geocode)); my %hash = map { $_ => $self->get($_) } @keys; my $existing = qsearchs('tax_rate', \%hash); if ($existing) { foreach ($self->fields) { $self->set($_, $existing->get($_)); } return; } else { return $self->insert; } } =back =head1 SUBROUTINES =over 4 =item batch_import =cut sub _progressbar_foo { return (0, time, 5); } sub batch_import { my ($param, $job) = @_; my $fh = $param->{filehandle}; my $format = $param->{'format'}; my %insert = (); my %delete = (); my @fields; my $hook; my @column_lengths = (); my @column_callbacks = (); if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) { $format =~ s/-fixed//; my $date_format = sub { my $r=''; /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1"); $r; }; my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r }; push @column_lengths, qw( 10 1 1 8 8 5 8 8 8 1 2 2 30 8 8 10 2 8 2 1 2 2 ); push @column_lengths, 1 if $format eq 'cch-update'; push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp $column_callbacks[8] = $date_format; } my $line; my ( $count, $last, $min_sec ) = _progressbar_foo(); if ( $job || scalar(@column_callbacks) ) { my $error = csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks); return $error if $error; } $count *=2; if ( $format eq 'cch' || $format eq 'cch-update' ) { #false laziness w/below (sub _perform_cch_diff) @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'; my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y", time_zone => 'floating', ); my $dt = $parser->parse_datetime( $hash->{'effective_date'} ); $hash->{'effective_date'} = $dt ? $dt->epoch : ''; $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ; $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax ); my $taxclassid = join(':', map{ $hash->{$_} } qw(taxtype taxcat) ); my %tax_class = ( 'data_vendor' => 'cch', 'taxclass' => $taxclassid, ); my $tax_class = qsearchs( 'tax_class', \%tax_class ); return "Error updating tax rate: no tax class $taxclassid" unless $tax_class; $hash->{'taxclassnum'} = $tax_class->taxclassnum; foreach (qw( taxtype taxcat )) { delete($hash->{$_}); } my %passflagmap = ( '0' => '', '1' => 'Y', '2' => 'N', ); $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}} if exists $passflagmap{$hash->{'passflag'}}; foreach (keys %$hash) { $hash->{$_} = substr($hash->{$_}, 0, 80) if length($hash->{$_}) > 80; } my $actionflag = delete($hash->{'actionflag'}); $hash->{'taxname'} =~ s/`/'/g; $hash->{'taxname'} =~ s|\\|/|g; return '' if $format eq 'cch'; # but not cch-update 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'}; } delete($hash->{$_}) for keys %$hash; ''; }; } elsif ( $format eq 'extended' ) { die "unimplemented\n"; @fields = qw( ); $hook = sub {}; } else { die "unknown format $format"; } my $csv = new Text::CSV_XS; my $imported = 0; 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; while ( defined($line=<$fh>) ) { $csv->parse($line) or do { $dbh->rollback if $oldAutoCommit; return "can't parse: ". $csv->error_input(); }; if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( int( 100 * $imported / $count ). ",Importing tax rates" ); if ($error) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; die $error; } $last = time; } } my @columns = $csv->fields(); my %tax_rate = ( 'data_vendor' => $format ); foreach my $field ( @fields ) { $tax_rate{$field} = shift @columns; } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line"; } my $error = &{$hook}(\%tax_rate); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } if (scalar(keys %tax_rate)) { #inserts only, not updates for cch my $tax_rate = new FS::tax_rate( \%tax_rate ); $error = $tax_rate->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "can't insert tax_rate for $line: $error"; } } $imported++; } my @replace = grep { exists($delete{$_}) } keys %insert; for (@replace) { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( int( 100 * $imported / $count ). ",Importing tax rates" ); if ($error) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; die $error; } $last = time; } } my $old = qsearchs( 'tax_rate', $delete{$_} ); if ( $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++; } else { $old = delete $delete{$_}; warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ". #join(" ", map { "$_ => ". $old->{$_} } @fields); join(" ", map { "$_ => ". $old->{$_} } keys(%$old) ); } $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 ). ",Importing tax rates" ); if ($error) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; die $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($insert{$_}) } keys %delete) { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( int( 100 * $imported / $count ). ",Importing tax rates" ); if ($error) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; die $error; } $last = time; } } my $tax_rate = qsearchs( 'tax_rate', $delete{$_} ); if (!$tax_rate) { $dbh->rollback if $oldAutoCommit; $tax_rate = $delete{$_}; warn "WARNING: can't find tax_rate to delete for: ". join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ). " (ignoring)\n"; } else { my $error = $tax_rate->delete; # XXX we really should not do this # (it orphans CBPTRL records) 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 || $format eq 'cch-update'); ''; #no error } =item process_batch_import Load a batch import as a queued JSRPC job =cut sub process_batch_import { my ($job, $param) = @_; if ( $param->{reload} ) { process_batch_reload($job, $param); } else { # '_perform', yuck _perform_batch_import($job, $param); } } sub _perform_batch_import { my ($job, $param) = @_; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; my $format = $param->{'format'}; my $files = $param->{'uploaded_files'} or die "No files provided."; my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() } split /,/, $files; my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc; my $error = ''; if ( $format eq 'cch' || $format eq 'cch-fixed' || $format eq 'cch-update' || $format eq 'cch-fixed-update' ) { my @insert_list = (); my @delete_list = (); my @predelete_list = (); my $insertname = ''; my $deletename = ''; my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import, 'CODE', \&FS::tax_class::batch_import, 'PLUS4', \&FS::cust_tax_location::batch_import, 'ZIP', \&FS::cust_tax_location::batch_import, 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import, 'DETAIL', \&FS::tax_rate::batch_import, ); while( scalar(@list) ) { my ( $name, $import_sub ) = splice( @list, 0, 2 ); my $file = lc($name). 'file'; unless ($files{$file}) { #$error = "No $name supplied"; next; } next if $name eq 'DETAIL' && $format =~ /update/; my $filename = "$dir/". $files{$file}; if ( $format =~ /update/ ) { ( $error, $insertname, $deletename ) = _perform_cch_insert_delete_split( $name, $filename, $dir, $format ) unless $error; last if $error; unlink $filename or warn "Can't delete $filename: $!" unless $keep_cch_files; push @insert_list, $name, $insertname, $import_sub, $format; if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better unshift @predelete_list, $name, $deletename, $import_sub, $format; } else { unshift @delete_list, $name, $deletename, $import_sub, $format; } } else { push @insert_list, $name, $filename, $import_sub, $format; } } push @insert_list, 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format if $format =~ /update/; my %addl_param = (); if ( $param->{'delete_only'} ) { $addl_param{'delete_only'} = $param->{'delete_only'}; @insert_list = () } $error ||= _perform_cch_tax_import( $job, [ @predelete_list ], [ @insert_list ], [ @delete_list ], \%addl_param, ); @list = ( @predelete_list, @insert_list, @delete_list ); while( !$keep_cch_files && scalar(@list) ) { my ( undef, $file, undef, undef ) = splice( @list, 0, 4 ); unlink $file or warn "Can't delete $file: $!"; } } elsif ( $format =~ /^billsoft-(\w+)$/ ) { my $mode = $1; my $file = $dir.'/'.$files{'file'}; open my $fh, "< $file" or $error ||= "Can't open file $file: $!"; my @param = ( { filehandle => $fh, format => 'billsoft', }, $job); if ( $mode eq 'pcode' ) { $error ||= FS::cust_tax_location::batch_import(@param); seek $fh, 0, 0; $error ||= FS::tax_rate_location::batch_import(@param); } elsif ( $mode eq 'taxclass' ) { $error ||= FS::tax_class::batch_import(@param); } elsif ( $mode eq 'taxproduct' ) { $error ||= FS::part_pkg_taxproduct::batch_import(@param); } else { die "unknown import mode 'billsoft-$mode'\n"; } } else { die "Unknown format: $format"; } if ($error) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; die $error; } else { $dbh->commit or die $dbh->errstr if $oldAutoCommit; } } # # # EVERYTHING THAT FOLLOWS IS CCH-SPECIFIC. # # sub _perform_cch_tax_import { my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_; $addl_param ||= {}; my $error = ''; foreach my $list ($predelete_list, $insert_list, $delete_list) { while( scalar(@$list) ) { my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 ); my $fmt = "$format-update"; $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' ); open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; my $param = { 'filehandle' => $fh, 'format' => $fmt, %$addl_param, }; $error ||= &{$method}($param, $job); close $fh; } } return $error; } sub _perform_cch_insert_delete_split { my ($name, $filename, $dir, $format) = @_; my $error = ''; open my $fh, "< $filename" or $error ||= "Can't open $name file $filename: $!"; my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX", DIR => $dir, UNLINK => 0, #meh ) or die "can't open temp file: $!\n"; my $insertname = $ifh->filename; my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX", DIR => $dir, UNLINK => 0, #meh ) or die "can't open temp file: $!\n"; my $deletename = $dfh->filename; my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/; my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/; while(<$fh>) { my $handle = ''; $handle = $ifh if $_ =~ /$insert_pattern/; $handle = $dfh if $_ =~ /$delete_pattern/; unless ($handle) { $error = "bad input line: $_" unless $handle; last; } print $handle $_; } close $fh; close $ifh; close $dfh; return ($error, $insertname, $deletename); } sub _perform_cch_diff { my ($name, $newdir, $olddir) = @_; my %oldlines = (); if ($olddir) { open my $oldcsvfh, "$olddir/$name.txt" or die "failed to open $olddir/$name.txt: $!\n"; while(<$oldcsvfh>) { chomp; $oldlines{$_} = 1; } close $oldcsvfh; } open my $newcsvfh, "$newdir/$name.txt" or die "failed to open $newdir/$name.txt: $!\n"; my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX", DIR => "$newdir", UNLINK => 0, #meh ) or die "can't open temp file: $!\n"; my $diffname = $dfh->filename; while(<$newcsvfh>) { chomp; if (exists($oldlines{$_})) { $oldlines{$_} = 0; } else { print $dfh $_, ',"I"', "\n"; } } close $newcsvfh; #false laziness w/above (sub batch_import) my @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 ); my $numfields = scalar(@fields); my $csv = new Text::CSV_XS { 'always_quote' => 1 }; for my $line (grep $oldlines{$_}, keys %oldlines) { $csv->parse($line) or do { #$dbh->rollback if $oldAutoCommit; die "can't parse: ". $csv->error_input(); }; my @columns = $csv->fields(); $csv->combine( splice(@columns, 0, $numfields) ); print $dfh $csv->string, ',"D"', "\n"; } close $dfh; return $diffname; } sub _cch_fetch_and_unzip { my ( $job, $urls, $secret, $dir ) = @_; my $ua = new LWP::UserAgent; foreach my $url (split ',', $urls) { my @name = split '/', $url; #somewhat restrictive my $name = pop @name; $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more $name = $1; open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n"; my ( $imported, $last, $min_sec ) = _progressbar_foo(); my $res = $ua->request( new HTTP::Request( GET => $url ), sub { print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n"; my $content_length = $_[1]->content_length; $imported += length($_[0]); if ( time - $min_sec > $last ) { my $error = $job->update_statustext( ($content_length ? int(100 * $imported/$content_length) : 0 ). ",Downloading data from CCH" ); die $error if $error; $last = time; } }, ); die "download of $url failed: ". $res->status_line unless $res->is_success; close $taxfh; my $error = $job->update_statustext( "0,Unpacking data" ); die $error if $error; $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more $secret = $1; system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0 or die "unzip -P $secret -d $dir $dir/$name failed"; #unlink "$dir/$name"; } } sub _cch_extract_csv_from_dbf { my ( $job, $dir, $name ) = @_; eval "use XBase;"; die $@ if $@; my ( $imported, $last, $min_sec ) = _progressbar_foo(); my $error = $job->update_statustext( "0,Unpacking $name" ); die $error if $error; warn "opening $dir.new/$name.dbf\n" if $DEBUG; my $table = new XBase 'name' => "$dir.new/$name.dbf"; die "failed to access $dir.new/$name.dbf: ". XBase->errstr unless defined($table); my $count = $table->last_record; # approximately; open my $csvfh, ">$dir.new/$name.txt" or die "failed to open $dir.new/$name.txt: $!\n"; my $csv = new Text::CSV_XS { 'always_quote' => 1 }; my @fields = $table->field_names; my $cursor = $table->prepare_select; my $format_date = sub { my $date = shift; $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1"); $date; }; while (my $row = $cursor->fetch_hashref) { $csv->combine( map { my $type = $table->field_type($_); if ($type eq 'D') { &{$format_date}($row->{$_}) ; } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) { sprintf('%.8f', $row->{$_}); #db row is numeric(14,8) } else { $row->{$_}; } } @fields ); print $csvfh $csv->string, "\n"; $imported++; if ( time - $min_sec > $last ) { my $error = $job->update_statustext( int(100 * $imported/$count). ",Unpacking $name" ); die $error if $error; $last = time; } } $table->close; close $csvfh; } sub _remember_disabled_taxes { my ( $job, $format, $disabled_tax_rate ) = @_; # cch specific hash my ( $imported, $last, $min_sec ) = _progressbar_foo(); my @items = qsearch( { table => 'tax_rate', hashref => { disabled => 'Y', data_vendor => $format, }, select => 'geocode, taxclassnum', } ); my $count = scalar(@items); foreach my $tax_rate ( @items ) { if ( time - $min_sec > $last ) { $job->update_statustext( int( 100 * $imported / $count ). ",Remembering disabled taxes" ); $last = time; } $imported++; my $tax_class = qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } ); unless ( $tax_class ) { warn "failed to find tax_class ". $tax_rate->taxclassnum; next; } $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1; } } sub _remember_tax_products { my ( $job, $format, $taxproduct ) = @_; # XXX FIXME this loop only works when cch is the only data provider my ( $imported, $last, $min_sec ) = _progressbar_foo(); my $extra_sql = " WHERE taxproductnum IS NOT NULL OR EXISTS ( SELECT 1 from part_pkg_option WHERE part_pkg_option.pkgpart = part_pkg.pkgpart AND optionname LIKE 'usage_taxproductnum_%' AND optionvalue != '' ) "; my @items = qsearch( { table => 'part_pkg', select => 'DISTINCT pkgpart,taxproductnum', hashref => {}, extra_sql => $extra_sql, } ); my $count = scalar(@items); foreach my $part_pkg ( @items ) { if ( time - $min_sec > $last ) { $job->update_statustext( int( 100 * $imported / $count ). ",Remembering tax products" ); $last = time; } $imported++; warn "working with package part ". $part_pkg->pkgpart. "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG; my $part_pkg_taxproduct = $part_pkg->taxproduct(''); $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format; foreach my $option ( $part_pkg->part_pkg_option ) { next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/; my $class = $1; $part_pkg_taxproduct = $part_pkg->taxproduct($class); $taxproduct->{$part_pkg->pkgpart}->{$class} = $part_pkg_taxproduct->taxproduct if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format; } } } sub _restore_remembered_tax_products { my ( $job, $format, $taxproduct ) = @_; # cch specific my ( $imported, $last, $min_sec ) = _progressbar_foo(); my $count = scalar(keys %$taxproduct); foreach my $pkgpart ( keys %$taxproduct ) { warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG; if ( time - $min_sec > $last ) { $job->update_statustext( int( 100 * $imported / $count ). ",Restoring tax products" ); $last = time; } $imported++; my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } ); unless ( $part_pkg ) { return "somehow failed to find part_pkg with pkgpart $pkgpart!\n"; } my %options = $part_pkg->options; my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc; my $primary_svc = $part_pkg->svcpart; my $new = new FS::part_pkg { $part_pkg->hash }; foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) { warn "working with class '$class'\n" if $DEBUG; my $part_pkg_taxproduct = qsearchs( 'part_pkg_taxproduct', { taxproduct => $taxproduct->{$pkgpart}->{$class}, data_vendor => $format, } ); unless ( $part_pkg_taxproduct ) { return "failed to find part_pkg_taxproduct (". $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n"; } if ( $class eq '' ) { $new->taxproductnum($part_pkg_taxproduct->taxproductnum); next; } $options{"usage_taxproductnum_$class"} = $part_pkg_taxproduct->taxproductnum; } my $error = $new->replace( $part_pkg, 'pkg_svc' => \%pkg_svc, 'primary_svc' => $primary_svc, 'options' => \%options, ); return $error if $error; } ''; } sub _restore_remembered_disabled_taxes { my ( $job, $format, $disabled_tax_rate ) = @_; my ( $imported, $last, $min_sec ) = _progressbar_foo(); my $count = scalar(keys %$disabled_tax_rate); foreach my $key (keys %$disabled_tax_rate) { if ( time - $min_sec > $last ) { $job->update_statustext( int( 100 * $imported / $count ). ",Disabling tax rates" ); $last = time; } $imported++; my ($geocode,$taxclass) = split /:/, $key, 2; my @tax_class = qsearch( 'tax_class', { data_vendor => $format, taxclass => $taxclass, } ); return "found multiple tax_class records for format $format class $taxclass" if scalar(@tax_class) > 1; unless (scalar(@tax_class)) { warn "no tax_class for format $format class $taxclass\n"; next; } my @tax_rate = qsearch('tax_rate', { data_vendor => $format, geocode => $geocode, taxclassnum => $tax_class[0]->taxclassnum, } ); if (scalar(@tax_rate) > 1) { return "found multiple tax_rate records for format $format geocode ". "$geocode and taxclass $taxclass ( taxclassnum ". $tax_class[0]->taxclassnum. " )"; } if (scalar(@tax_rate)) { $tax_rate[0]->disabled('Y'); my $error = $tax_rate[0]->replace; return $error if $error; } } } sub _remove_old_tax_data { my ( $job, $format ) = @_; my $dbh = dbh; my $error = $job->update_statustext( "0,Removing old tax data" ); die $error if $error; my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ". "WHERE data_vendor = ". $dbh->quote($format); $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; my @table = qw( tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location ); foreach my $table ( @table ) { $sql = "DELETE FROM public.$table WHERE data_vendor = ". $dbh->quote($format); $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; } if ( $format eq 'cch' ) { $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ". $dbh->quote("$format-zip"); $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; } ''; } sub _create_temporary_tables { my ( $job, $format ) = @_; my $dbh = dbh; my $error = $job->update_statustext( "0,Creating temporary tables" ); die $error if $error; my @table = qw( tax_rate tax_rate_location part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location ); foreach my $table ( @table ) { my $sql = "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )"; $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; } ''; } sub _copy_from_temp { my ( $job, $format ) = @_; my $dbh = dbh; my $error = $job->update_statustext( "0,Making permanent" ); die $error if $error; my @table = qw( tax_rate tax_rate_location part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location ); foreach my $table ( @table ) { my $sql = "INSERT INTO public.$table SELECT * from $table"; $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; } ''; } =item process_download_and_reload Download and process a tax update as a queued JSRPC job after wiping the existing wipeable tax data. =cut sub process_download_and_reload { _process_reload(\&process_download_and_update, @_); } # # # END OF CCH STUFF # # =item process_batch_reload Load and process a tax update from the provided files as a queued JSRPC job after wiping the existing wipable tax data. =cut sub process_batch_reload { _process_reload(\&_perform_batch_import, @_); } sub _process_reload { my ( $continuation, $job, $param ) = @_; my $format = $param->{'format'}; my ( $imported, $last, $min_sec ) = _progressbar_foo(); if ( $job ) { # progress bar my $error = $job->update_statustext( 0 ); die $error if $error; } my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; my $error = ''; if ( $format =~ /^cch/ ) { # no, THIS part is CCH specific my $sql = "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ". "USING (taxclassnum) WHERE data_vendor = '$format'"; my $sth = $dbh->prepare($sql) or die $dbh->errstr; $sth->execute or die "Unexpected error executing statement $sql: ". $sth->errstr; die "Don't (yet) know how to handle part_pkg_taxoverride records." if $sth->fetchrow_arrayref->[0]; # really should get a table EXCLUSIVE lock here #remember disabled taxes my %disabled_tax_rate = (); $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate ); #remember tax products my %taxproduct = (); $error ||= _remember_tax_products( $job, $format, \%taxproduct ); #create temp tables $error ||= _create_temporary_tables( $job, $format ); #import new data unless ($error) { eval { &{$continuation}( $job, $param ) }; $error = $@ if $@; } #restore taxproducts $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct ); #disable tax_rates $error ||= _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate ); #wipe out the old data $error ||= _remove_old_tax_data( $job, $format ); #untemporize $error ||= _copy_from_temp( $job, $format ); } elsif ( $format =~ /^billsoft-(\w+)/ ) { my $mode = $1; my @sql; if ( $mode eq 'pcode' ) { push @sql, "DELETE FROM cust_tax_location WHERE data_vendor = 'billsoft'", "UPDATE tax_rate_location SET disabled = 'Y' WHERE data_vendor = 'billsoft'"; } elsif ( $mode eq 'taxclass' ) { push @sql, "DELETE FROM tax_class WHERE data_vendor = 'billsoft'"; } elsif ( $mode eq 'taxproduct' ) { push @sql, "DELETE FROM part_pkg_taxproduct WHERE data_vendor = 'billsoft'"; } foreach (@sql) { if (!$dbh->do($_)) { $error = $dbh->errstr; last; } } unless ( $error ) { local $@; eval { &{ $continuation }($job, $param) }; $error = $@; } } # if ($format ...) if ($error) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; die $error; } #success! $dbh->commit or die $dbh->errstr if $oldAutoCommit; } =item process_download_and_update Download and process a tax update as a queued JSRPC job =cut sub process_download_and_update { my $job = shift; my $param = shift; my $format = $param->{'format'}; #well... this is all cch specific my ( $imported, $last, $min_sec ) = _progressbar_foo(); if ( $job ) { # progress bar my $error = $job->update_statustext( 0); die $error if $error; } my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/'; my $dir = $cache_dir. 'taxdata'; unless (-d $dir) { mkdir $dir or die "can't create $dir: $!\n"; } if ($format eq 'cch') { my @namelist = qw( code detail geocode plus4 txmatrix zip ); my $conf = new FS::Conf; die "direct download of tax data not enabled\n" unless $conf->exists('taxdatadirectdownload'); my ( $urls, $username, $secret, $states ) = $conf->config('taxdatadirectdownload'); die "No tax download URL provided. ". "Did you set the taxdatadirectdownload configuration value?\n" unless $urls; $dir .= '/cch'; my $dbh = dbh; my $error = ''; # really should get a table EXCLUSIVE lock here # check if initial import or update # # relying on mkdir "$dir.new" as a mutex my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'"; my $sth = $dbh->prepare($sql) or die $dbh->errstr; $sth->execute() or die $sth->errstr; my $update = $sth->fetchrow_arrayref->[0]; # create cache and/or rotate old tax data if (-d $dir) { if (-d "$dir.9") { opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n"; foreach my $file (readdir($dirh)) { unlink "$dir.9/$file" if (-f "$dir.9/$file"); } closedir($dirh); rmdir "$dir.9"; } for (8, 7, 6, 5, 4, 3, 2, 1) { if ( -e "$dir.$_" ) { rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n"; } } rename "$dir", "$dir.1" or die "can't rename $dir: $!\n"; } else { die "can't find previous tax data\n" if $update; } mkdir "$dir.new" or die "can't create $dir.new: $!\n"; # fetch and unpack the zip files _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" ); # extract csv files from the dbf files foreach my $name ( @namelist ) { _cch_extract_csv_from_dbf( $job, $dir, $name ); } # generate the diff files my @list = (); foreach my $name ( @namelist ) { my $difffile = "$dir.new/$name.txt"; if ($update) { my $error = $job->update_statustext( "0,Comparing to previous $name" ); die $error if $error; warn "processing $dir.new/$name.txt\n" if $DEBUG; my $olddir = $update ? "$dir.1" : ""; $difffile = _perform_cch_diff( $name, "$dir.new", $olddir ); } $difffile =~ s/^$cache_dir//; push @list, "${name}file:$difffile"; } # perform the import local $keep_cch_files = 1; $param->{uploaded_files} = join( ',', @list ); $param->{format} .= '-update' if $update; $error ||= _perform_batch_import( $job, $param ); rename "$dir.new", "$dir" or die "cch tax update processed, but can't rename $dir.new: $!\n"; }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"); } =item queue_liability_report PARAMS Launches a tax liability report. PARAMS needs to be a base64-encoded Storable hash containing: - beginning: the start date, as a I (not a timestamp). - end: the end date of the report, likewise. - agentnum: the agent to limit the report to, if any. =cut sub queue_liability_report { my $job = shift; my $param = shift; my $cgi = new CGI; $cgi->param('beginning', $param->{beginning}); $cgi->param('ending', $param->{ending}); my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi); my $agentnum = $param->{agentnum}; if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; }; generate_liability_report( 'beginning' => $beginning, 'ending' => $ending, 'agentnum' => $agentnum, 'p' => $param->{RootURL}, 'job' => $job, ); } =item generate_liability_report PARAMS Generates a tax liability report. PARAMS must include: - beginning, as a timestamp - ending, as a timestamp - p: the Freeside root URL, for generating links - agentnum (optional) =cut #shit, all sorts of false laxiness w/report_newtax.cgi sub generate_liability_report { my %args = @_; my ( $count, $last, $min_sec ) = _progressbar_foo(); #let us open the temp file early my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc; my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX', DIR => $dir, UNLINK => 0, # not so temp ) or die "can't open report file: $!\n"; my $conf = new FS::Conf; my $money_char = $conf->config('money_char') || '$'; my $join_cust = " JOIN cust_bill USING ( invnum ) LEFT JOIN cust_main USING ( custnum ) "; my $join_loc = "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )"; my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )"; my $addl_from = " $join_cust $join_loc $join_tax_loc "; my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} "; my $agentname = ''; if ( $args{agentnum} =~ /^(\d+)$/ ) { my $agent = qsearchs('agent', { 'agentnum' => $1 } ); die "agent not found" unless $agent; $agentname = $agent->agent; $where .= ' AND cust_main.agentnum = '. $agent->agentnum; } #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' ); my @taxparams = qw( city county state locationtaxid ); my @params = ('itemdesc', @taxparams); my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city'; #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up #to FS::Report or FS::Record or who the fuck knows where) my $scalar_sql = sub { my( $r, $param, $sql ) = @_; my $sth = dbh->prepare($sql) or die dbh->errstr; $sth->execute( map $r->$_(), @$param ) or die "Unexpected error executing statement $sql: ". $sth->errstr; $sth->fetchrow_arrayref->[0] || 0; }; my $tax = 0; my $credit = 0; my %taxes = (); my %basetaxes = (); my $calculated = 0; # get all distinct tuples of (tax name, state, county, city, locationtaxid) # for taxes that have been charged # (state, county, city are from tax_rate_location, not from customer data) my @tax_and_location = qsearch({ table => 'cust_bill_pkg', select => $select, hashref => { pkgpart => 0 }, addl_from => $addl_from, extra_sql => $where, debug => 1, }); $count = scalar(@tax_and_location); foreach my $t ( @tax_and_location ) { if ( $args{job} ) { if ( time - $min_sec > $last ) { $args{job}->update_statustext( int( 100 * $calculated / $count ). ",Calculating" ); $last = time; } } #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam; my $label = join('~', map { $t->$_ } @params); $label = 'Tax'. $label if $label =~ /^~/; unless ( exists( $taxes{$label} ) ) { my ($baselabel, @trash) = split /~/, $label; $taxes{$label}->{'label'} = join(', ', split(/~/, $label) ); $taxes{$label}->{'url_param'} = join(';', map { "$_=". uri_escape($t->$_) } @params); my $itemdesc_loc = " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ". "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ } @taxparams ); my $taxwhere = "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc"; my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0"; my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql ); $tax += $x; $taxes{$label}->{'tax'} += $x; my $creditfrom = "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)"; my $creditwhere = "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc"; $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ". " $creditwhere AND cust_bill_pkg.pkgnum = 0"; my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql ); $credit += $y; $taxes{$label}->{'credit'} += $y; unless ( exists( $taxes{$baselabel} ) ) { $basetaxes{$baselabel}->{'label'} = $baselabel; $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel"; $basetaxes{$baselabel}->{'base'} = 1; } $basetaxes{$baselabel}->{'tax'} += $x; $basetaxes{$baselabel}->{'credit'} += $y; } # calculate customer-exemption for this tax # calculate package-exemption for this tax # calculate monthly exemption (texas tax) for this tax # count up all the cust_tax_exempt_pkg records associated with # the actual line items. } #ordering if ( $args{job} ) { $args{job}->update_statustext( "0,Sorted" ); $last = time; } my @taxes = (); foreach my $tax ( sort { $a cmp $b } keys %taxes ) { my ($base, @trash) = split '~', $tax; my $basetax = delete( $basetaxes{$base} ); if ($basetax) { if ( $basetax->{tax} == $taxes{$tax}->{tax} ) { $taxes{$tax}->{base} = 1; } else { push @taxes, $basetax; } } push @taxes, $taxes{$tax}; } push @taxes, { 'label' => 'Total', 'url_param' => '', 'tax' => $tax, 'credit' => $credit, 'base' => 1, }; my $dateagentlink = "begin=$args{beginning};end=$args{ending}"; $dateagentlink .= ';agentnum='. $args{agentnum} if length($agentname); my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" . $dateagentlink; my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink"; print $report < <% include('/elements/table-grid.html') %> Tax invoiced      Tax credited EOF my $bgcolor1 = '#eeeeee'; my $bgcolor2 = '#ffffff'; my $bgcolor = ''; $count = scalar(@taxes); $calculated = 0; foreach my $tax ( @taxes ) { if ( $args{job} ) { if ( time - $min_sec > $last ) { $args{job}->update_statustext( int( 100 * $calculated / $count ). ",Generated" ); $last = time; } } if ( $bgcolor eq $bgcolor1 ) { $bgcolor = $bgcolor2; } else { $bgcolor = $bgcolor1; } my $link = ''; if ( $tax->{'label'} ne 'Total' ) { $link = ';'. $tax->{'url_param'}; } print $report < <% '$tax->{label}' %> <% ($tax->{base}) ? qq!! : '' %> <% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %> <% !($tax->{base}) ? qq!! : '' %> <% ($tax->{base}) ? qq!! : '' %> <% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %> <% !($tax->{base}) ? qq!! : '' %> EOF } print $report < EOF my $reportname = $report->filename; close $report; my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.'; $reportname =~ s/^$dropstring//; my $reporturl = "%%%ROOTURL%%%/misc/queued_report.html?report=$reportname"; die "view\n"; } sub _upgrade_data { my $class = shift; my $sql = "UPDATE tax_rate SET data_vendor = 'compliance_solutions' WHERE data_vendor = 'compliance solutions'"; my $sth = dbh->prepare($sql) or die $DBI::errstr; $sth->execute() or die $sth->errstr; } =back =head1 BUGS Highly specific to CCH taxes. This should arguably go in some kind of subclass (FS::tax_rate::CCH) with auto-reblessing, similar to part_pkg subclasses. But currently there aren't any other options, so. Mixing automatic and manual editing works poorly at present. Tax liability calculations take too long and arguably don't belong here. Tax liability report generation not entirely safe (escaped). Sparse documentation. =head1 SEE ALSO L, L, L =cut 1;