diff options
Diffstat (limited to 'FS')
| -rwxr-xr-x | FS/FS/Cron/tax_rate_update.pm | 678 | ||||
| -rw-r--r-- | FS/FS/Misc/Geo.pm | 235 | ||||
| -rw-r--r-- | FS/FS/Schema.pm | 1 | ||||
| -rw-r--r-- | FS/FS/TaxEngine/internal.pm | 9 | ||||
| -rw-r--r-- | FS/FS/cust_main/Search.pm | 4 | ||||
| -rw-r--r-- | FS/FS/cust_main_county.pm | 298 | ||||
| -rw-r--r-- | FS/FS/pay_batch/eft_canada.pm | 56 | ||||
| -rwxr-xr-x | FS/bin/freeside-cdr-asterisk_sql | 84 | ||||
| -rwxr-xr-x | FS/bin/freeside-eftca-download | 73 | ||||
| -rwxr-xr-x | FS/bin/freeside-eftca-upload | 47 | ||||
| -rwxr-xr-x | FS/bin/freeside-upgrade | 2 |
11 files changed, 975 insertions, 512 deletions
diff --git a/FS/FS/Cron/tax_rate_update.pm b/FS/FS/Cron/tax_rate_update.pm index fec696fbb..ef529c4a5 100755 --- a/FS/FS/Cron/tax_rate_update.pm +++ b/FS/FS/Cron/tax_rate_update.pm @@ -9,106 +9,618 @@ FS::Cron::tax_rate_update Cron routine to update city/district sales tax rates in I<cust_main_county>. Currently supports sales tax in the state of Washington. +=head2 wa_sales + +=item Tax Rate Download + +Once each month, update the tax tables from the WA DOR website. + +=item Customer Address Rate Classification + +Find cust_location rows in WA with no tax district. Try to determine +a tax district. Otherwise, generate a log error that address needs +to be correctd. + =cut use strict; use warnings; -use FS::Conf; -use FS::Record qw(qsearch qsearchs dbh); -use FS::cust_main_county; -use FS::part_pkg_taxclass; +use feature 'state'; + +use Exporter; +our @EXPORT_OK = qw( + tax_rate_update + wa_sales_update_tax_table + wa_sales_log_customer_without_tax_district +); + +use Carp qw(croak); use DateTime; -use LWP::UserAgent; use File::Temp 'tempdir'; use File::Slurp qw(read_file write_file); +use LWP::UserAgent; +use Spreadsheet::XLSX; use Text::CSV; -use Exporter; -our @EXPORT_OK = qw(tax_rate_update); +use FS::Conf; +use FS::cust_main; +use FS::cust_main_county; +use FS::geocode_Mixin; +use FS::Log; +use FS::part_pkg_taxclass; +use FS::Record qw(qsearch qsearchs dbh); +use FS::upgrade_journal; + our $DEBUG = 0; +=head1 FUNCTIONS + +=head2 tax_rate_update + +Cron routine for freeside_daily. + +Run one of the available cron functions based on conf value tax_district_method + +=cut + sub tax_rate_update { - my %opt = @_; - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $conf = FS::Conf->new; - my $method = $conf->config('tax_district_method'); - return if !$method; - - my $taxname = $conf->config('tax_district_taxname') || ''; - - FS::cust_main_county->lock_table; - if ($method eq 'wa_sales') { - # download the update file - my $now = DateTime->now; - my $yr = $now->year; - my $qt = $now->quarter; - my $file = "Rates${yr}Q${qt}.zip"; - my $url = 'http://dor.wa.gov/downloads/Add_Data/'.$file; - my $dir = tempdir(); - chdir($dir); - my $ua = LWP::UserAgent->new; - warn "Downloading $url...\n" if $DEBUG; - my $response = $ua->get($url); - if ( ! $response->is_success ) { - die $response->status_line; - } - write_file($file, $response->decoded_content); + # Currently only wa_sales is supported + my $tax_district_method = conf_tax_district_method(); + + return unless $tax_district_method; + + if ( exists &{$tax_district_method} ) { + my $func = \&{$tax_district_method}; + $func->(); + } else { + my $log = FS::Log->new('tax_rate_update'); + $log->error( "Unhandled tax_district_method($tax_district_method)" ); + } + +} + +=head2 wa_sales + +Monthly: Update the complete WA state tax tables +Every Run: Log errors for cust_location records without a district + +=cut + +sub wa_sales { + + return + unless conf_tax_district_method() + && conf_tax_district_method() eq 'wa_sales'; + + my $dt_now = DateTime->now; + my $year = $dt_now->year; + my $quarter = $dt_now->quarter; + + my $journal_label = + sprintf 'wa_sales_update_tax_table_%sQ%s', $year, $quarter; + + unless ( FS::upgrade_journal->is_done( $journal_label ) ) { + local $@; + + eval{ wa_sales_update_tax_table(); }; + log_error_and_die( "Error updating tax tables: $@" ) + if $@; + FS::upgrade_journal->set_done( $journal_label ); + } + + wa_sales_log_customer_without_tax_district(); + + ''; + +} - # parse it - system('unzip', $file); - $file =~ s/\.zip$/.csv/; - if (! -f $file) { - die "$file not found in zip archive.\n"; +=head2 wa_sales_log_customer_without_tax_district + +For any cust_location records +* In WA state +* Attached to non cancelled packages +* With no tax district + +Classify the tax district for the record using the WA State Dept of +Revenue API. If this fails, generate an error into system log so +address can be corrected + +=cut + +sub wa_sales_log_customer_without_tax_district { + + return + unless conf_tax_district_method() + && conf_tax_district_method() eq 'wa_sales'; + + my %qsearch_cust_location = ( + table => 'cust_location', + select => ' + cust_location.locationnum, + cust_location.custnum, + cust_location.address1, + cust_location.city, + cust_location.state, + cust_location.zip + ', + addl_from => ' + LEFT JOIN cust_main USING (custnum) + LEFT JOIN cust_pkg ON cust_location.locationnum = cust_pkg.locationnum + ', + extra_sql => sprintf(q{ + WHERE cust_location.state = 'WA' + AND ( + cust_location.district IS NULL + or cust_location.district = '' + ) + AND cust_pkg.pkgnum IS NOT NULL + AND ( + cust_pkg.cancel > %s + OR cust_pkg.cancel IS NULL + ) + }, time() + ), + ); + + for my $cust_location ( qsearch( \%qsearch_cust_location )) { + local $@; + log_info_and_warn( + sprintf + 'Attempting to classify district for cust_location ' . + 'locationnum(%s) address(%s)', + $cust_location->locationnum, + $cust_location->address1, + ); + + eval { + FS::geocode_Mixin::process_district_update( + 'FS::cust_location', + $cust_location->locationnum + ); + }; + + if ( $@ ) { + # Error indicates a crash, not an error looking up district + # process_district_udpate will generate log messages for those errors + log_error_and_warn( + sprintf "Classify district error for cust_location(%s): %s", + $cust_location->locationnum, + $@ + ); } - open my $fh, '<', $file - or die "couldn't open $file: $!\n"; - my $csv = Text::CSV->new; - my $header = $csv->getline($fh); - $csv->column_names(@$header); - # columns we care about are headed 'Code' and 'Rate' - - my $total_changed = 0; - my $total_skipped = 0; - while ( !$csv->eof ) { - my $line = $csv->getline_hr($fh); - my $district = $line->{Code} or next; - $district = sprintf('%04d', $district); - my $tax = sprintf('%.1f', $line->{Rate} * 100); - my $changed = 0; - my $skipped = 0; - # find rate(s) in this country+state+district+taxclass that have the - # wa_sales flag and the configured taxname, and haven't been disabled. - my @rates = qsearch('cust_main_county', { - country => 'US', - state => 'WA', # this is specific to WA - district => $district, - taxname => $taxname, - source => 'wa_sales', - tax => { op => '>', value => '0' }, - }); - foreach my $rate (@rates) { - if ( $rate->tax == $tax ) { - $skipped++; - } else { - $rate->set('tax', $tax); - my $error = $rate->replace; - die "error updating district $district: $error\n" if $error; - $changed++; + + sleep 1; # Be polite to WA DOR API + } + + for my $cust_location ( qsearch( \%qsearch_cust_location )) { + log_error_and_warn( + sprintf + "Customer address in WA lacking tax district classification. ". + "custnum(%s) ". + "locationnum(%s) ". + "address(%s, %s %s, %s) ". + "[https://webgis.dor.wa.gov/taxratelookup/SalesTax.aspx]", + map { $cust_location->$_ } + qw( custnum locationnum address1 city state zip ) + ); + } + +} + + +=head2 wa_sales_update_tax_table \%args + +Update city/district sales tax rates in L<FS::cust_main_county> from the +Washington State Department of Revenue published data files. + +Creates, or updates, a L<FS::cust_main_county> row for every tax district +in Washington state. Some cities have different tax rates based on the +address, within the city. Because of this, some cities have multiple +districts. + +If tax classes are enabled, a row is created in every tax class for +every district. + +Customer addresses aren't classified into districts here. Instead, +when a Washington state address is inserted or changed in L<FS::cust_location>, +a job is queued for FS::geocode_Mixin::process_district_update, to ask the +Washington state API which tax district to use for this address. + +All arguments are optional: + + filename: Skip file download, and process the specified filename instead + + taxname: Updated or created records will be set to the given tax name. + If not specified, conf value 'tax_district_taxname' is used + + year: Specify year for tax table download. Defaults to current year + + quarter: Specify quarter for tax table download. Defaults to current quarter + +=head3 Washington State Department of Revenue Resources + +The state of Washington makes data files available via their public website. +It's possible the availability or format of these files may change. As of now, +the only data file that contains both city and county names is published in +XLSX format. + +=over 4 + +=item WA Dept of Revenue + +https://dor.wa.gov + +=item Data file downloads + +https://dor.wa.gov/find-taxes-rates/sales-and-use-tax-rates/downloadable-database + +=item XLSX file example + +https://dor.wa.gov/sites/default/files/legacy/Docs/forms/ExcsTx/LocSalUseTx/ExcelLocalSlsUserates_19_Q1.xlsx + +=item CSV file example + +https://dor.wa.gov/sites/default/files/legacy/downloads/Add_DataRates2018Q4.zip + + +=item Address lookup API tool + +http://webgis.dor.wa.gov/webapi/AddressRates.aspx?output=xml&addr=410 Terry Ave. North&city=&zip=98100 + +=back + +=cut + +sub wa_sales_update_tax_table { + my $args = shift; + + croak 'wa_sales_update_tax_table requires \$args hashref' + if $args && !ref $args; + + return + unless conf_tax_district_method() + && conf_tax_district_method() eq 'wa_sales'; + + $args->{taxname} ||= FS::Conf->new->config('tax_district_taxname'); + $args->{year} ||= DateTime->now->year; + $args->{quarter} ||= DateTime->now->quarter; + + log_info_and_warn( + "Begin wa_sales_update_tax_table() ". + join ', ' => ( + map{ "$_ => ". ( $args->{$_} || 'undef' ) } + sort keys %$args + ) + ); + + $args->{temp_dir} ||= tempdir(); + + $args->{filename} ||= wa_sales_fetch_xlsx_file( $args ); + + $args->{tax_districts} = wa_sales_parse_xlsx_file( $args ); + + wa_sales_update_cust_main_county( $args ); + + log_info_and_warn( 'Finished wa_sales_update_tax_table()' ); +} + +=head2 wa_sales_update_cust_main_county \%args + +Create or update the L<FS::cust_main_county> records with new data + +=cut + +sub wa_sales_update_cust_main_county { + my $args = shift; + + return + unless conf_tax_district_method() + && conf_tax_district_method() eq 'wa_sales'; + + croak 'wa_sales_update_cust_main_county requires $args hashref' + unless ref $args + && ref $args->{tax_districts}; + + my $insert_count = 0; + my $update_count = 0; + my $same_count = 0; + + # Work within a SQL transaction + local $FS::UID::AutoCommit = 0; + + for my $taxclass ( FS::part_pkg_taxclass->taxclass_names ) { + $taxclass ||= undef; # trap empty string when taxclasses are disabled + + my %cust_main_county = + map { $_->district => $_ } + qsearch( + cust_main_county => { + district => { op => '!=', value => undef }, + state => 'WA', + country => 'US', + source => 'wa_sales', + taxclass => $taxclass, } - } # foreach $taxclass - print "$district: updated $changed, skipped $skipped\n" - if $DEBUG and ($changed or $skipped); - $total_changed += $changed; - $total_skipped += $skipped; + ); + + for my $district ( @{ $args->{tax_districts} } ) { + if ( my $row = $cust_main_county{ $district->{district} } ) { + + # District already exists in this taxclass, update if necessary + # + # If admin updates value of conf tax_district_taxname, instead of + # creating an entire separate set of tax rows with + # the new taxname, update the taxname on existing records + + { + # Supress warning on taxname comparison, when taxname is undef + no warnings 'uninitialized'; + + if ( + $row->tax == ( $district->{tax_combined} * 100 ) + && $row->taxname eq $args->{taxname} + && uc $row->county eq uc $district->{county} + && uc $row->city eq uc $district->{city} + ) { + $same_count++; + next; + } + } + + $row->city( uc $district->{city} ); + $row->county( uc $district->{county} ); + $row->taxclass( $taxclass ); + $row->taxname( $args->{taxname} || undef ); + $row->tax( $district->{tax_combined} * 100 ); + + if ( my $error = $row->replace ) { + dbh->rollback; + local $FS::UID::AutoCommit = 1; + log_error_and_die( + sprintf + "Error updating cust_main_county row %s for district %s: %s", + $row->taxnum, + $district->{district}, + $error + ); + } + + $update_count++; + + } else { + + # District doesn't exist, create row + + my $row = FS::cust_main_county->new({ + district => $district->{district}, + city => uc $district->{city}, + county => uc $district->{county}, + state => 'WA', + country => 'US', + taxclass => $taxclass, + taxname => $args->{taxname} || undef, + tax => $district->{tax_combined} * 100, + source => 'wa_sales', + }); + + if ( my $error = $row->insert ) { + dbh->rollback; + local $FS::UID::AutoCommit = 1; + log_error_and_die( + sprintf + "Error inserting cust_main_county row for district %s: %s", + $district->{district}, + $error + ); + } + + $cust_main_county{ $district->{district} } = $row; + $insert_count++; + } + + } # /foreach $district + } # /foreach $taxclass + + dbh->commit; + + local $FS::UID::AutoCommit = 1; + log_info_and_warn( + sprintf + "WA tax table update completed. ". + "Inserted %s rows, updated %s rows, identical %s rows", + $insert_count, + $update_count, + $same_count + ); + +} + +=head2 wa_sales_parse_xlsx_file \%args + +Parse given XLSX file for tax district information +Return an arrayref of district information hashrefs + +=cut + +sub wa_sales_parse_xlsx_file { + my $args = shift; + + croak 'wa_sales_parse_xlsx_file requires $args hashref containing a filename' + unless ref $args + && $args->{filename}; + + # About the file format: + # + # The current spreadsheet contains the following @columns. + # Rows 1 and 2 are a marquee header + # Row 3 is the column labels. We will test these to detect + # changes in the data format + # Rows 4+ are the tax district data + # + # The "city" column is being parsed from "Location" + + my @columns = qw( city county district tax_local tax_state tax_combined ); + + log_error_and_die( "Unable to access XLSX file: $args->{filename}" ) + unless -r $args->{filename}; + + my $xls_parser = Spreadsheet::XLSX->new( $args->{filename} ) + or log_error_and_die( "Error parsing XLSX file: $!" ); + + my $sheet = $xls_parser->{Worksheet}->[0] + or log_error_and_die(" Unable to access worksheet 1 in XLSX file" ); + + my $cells = $sheet->{Cells} + or log_error_and_die( "Unable to read cells in XLSX file" ); + + # Read the column labels and verify + my %labels = + map{ $columns[$_] => $cells->[2][$_]->{Val} } + 0 .. scalar(@columns)-1; + + my %expected_labels = ( + city => 'Location', + county => 'County', + district => 'Location Code', + tax_local => 'Local Rate', + tax_state => 'State Rate', + tax_combined => 'Combined Sales Tax', + ); + + if ( + my @error_labels = + grep { lc $labels{$_} ne lc $expected_labels{$_} } + @columns + ) { + my $error = "Error parsing XLS file - ". + "Data format may have been updated with WA DOR! "; + $error .= "Expected column $expected_labels{$_}, found $labels{$_}! " + for @error_labels; + log_error_and_die( $error ); + } + + # Parse the rows into an array of hashes + my @districts; + for my $row ( 3..$sheet->{MaxRow} ) { + my %district = ( + map { $columns[$_] => $cells->[$row][$_]->{Val} } + 0 .. scalar(@columns)-1 + ); + + if ( + $district{city} + && $district{county} + && $district{district} =~ /^\d+$/ + && $district{tax_local} =~ /^\d?\.\d+$/ + && $district{tax_state} =~ /^\d?\.\d+$/ + && $district{tax_combined} =~ /^\d?\.\d+$/ + ) { + + # For some reason, city may contain line breaks! + $district{city} =~ s/[\r\n]//g; + + push @districts, \%district; + } else { + log_warn_and_warn( + "Non-usable row found in spreadsheet:\n" . Dumper( \%district ) + ); } - print "Updated $total_changed tax rates.\nSkipped $total_skipped unchanged rates.\n" if $DEBUG; - dbh->commit; - } # else $method isn't wa_sales, no other methods exist yet - ''; + + } + + log_error_and_die( "No \@districts found in data file!" ) + unless @districts; + + log_info_and_warn( + sprintf "Parsed %s districts from data file", scalar @districts + ); + + \@districts; + } +=head2 wa_sales_fetch_xlsx_file \%args + +Download data file from WA state DOR to temporary storage, +return filename + +=cut + +sub wa_sales_fetch_xlsx_file { + my $args = shift; + + return + unless conf_tax_district_method() + && conf_tax_district_method() eq 'wa_sales'; + + croak 'wa_sales_fetch_xlsx_file requires \$args hashref' + unless ref $args + && $args->{temp_dir}; + + my $url_base = 'https://dor.wa.gov'. + '/sites/default/files/legacy/Docs/forms/ExcsTx/LocSalUseTx'; + + my $year = $args->{year} || DateTime->now->year; + my $quarter = $args->{quarter} || DateTime->now->quarter; + $year = substr( $year, 2, 2 ) if $year >= 1000; + + my $fn = sprintf( 'ExcelLocalSlsUserates_%s_Q%s.xlsx', $year, $quarter ); + my $url = "$url_base/$fn"; + + my $write_fn = "$args->{temp_dir}/$fn"; + + log_info_and_warn( "Begin download from url: $url" ); + + my $ua = LWP::UserAgent->new; + my $res = $ua->get( $url ); + + log_error_and_die( "Download error: ".$res->status_line ) + unless $res->is_success; + + local $@; + eval { write_file( $write_fn, $res->decoded_content ); }; + log_error_and_die( "Problem writing download to disk: $@" ) + if $@; + + log_info_and_warn( "Temporary file: $write_fn" ); + $write_fn; + +} + +sub log { + state $log = FS::Log->new('tax_rate_update'); + $log; +} + +sub log_info_and_warn { + my $log_message = shift; + warn "$log_message\n"; + &log()->info( $log_message ); +} + +sub log_warn_and_warn { + my $log_message = shift; + warn "$log_message\n"; + &log()->warn( $log_message ); +} + +sub log_error_and_die { + my $log_message = shift; + &log()->error( $log_message ); + die( "$log_message\n" ); +} + +sub log_error_and_warn { + my $log_message = shift; + warn "$log_message\n"; + &log()->error( $log_message ); +} + +sub conf_tax_district_method { + state $tax_district_method = FS::Conf->new->config('tax_district_method'); + $tax_district_method; +} + + 1; diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index 6b3d6ca71..2e44364f2 100644 --- a/FS/FS/Misc/Geo.pm +++ b/FS/FS/Misc/Geo.pm @@ -14,6 +14,7 @@ use Data::Dumper; use FS::Conf; use FS::Log; use Locale::Country; +use XML::LibXML; FS::UID->install_callback( sub { $conf = new FS::Conf; @@ -141,102 +142,170 @@ sub get_district { &$method($location); } + +=head2 wa_sales location_hash + +Expects output of location_hash() as parameter + +Returns undef on error, or if tax rate cannot be found using given address + +Query the WA State Dept of Revenue API with an address, and return +tax district information for that address. + +Documentation for the API can be found here: + +L<https://dor.wa.gov/find-taxes-rates/retail-sales-tax/destination-based-sales-tax-and-streamlined-sales-tax/wa-sales-tax-rate-lookup-url-interface> + +This API does not return consistent usable county names, as the county +name may include appreviations or labels referring to PTBA (public transport +benefit area) or CEZ (community empowerment zone). It's recommended to use +the tool wa_tax_rate_update to fully populate the city/county/districts for +WA state every financial quarter. + +Returns a hashref with the following keys: + + - district the wa state tax district id + - tax the combined total tax rate, as a percentage + - city the API rate name + - county The API address PTBA + - state WA + - country US + - exempt_amount 0 + +If api returns no district for address, generates system log error +and returns undef + +=cut + sub wa_sales { - my $location = shift; - my $error = ''; - return '' if $location->{state} ne 'WA'; - my $return = { %$location }; - $return->{'exempt_amount'} = 0.00; + # + # no die(): + # freeside-queued will issue dbh->rollback on die() ... this will + # also roll back system log messages about errors :/ freeside-queued + # doesn't propgate die messages into the system log. + # - my $url = 'http://webgis2.dor.wa.gov/TaxRateLookup_AGS/TaxReport.aspx'; - my $ua = new LWP::UserAgent; + my $location_hash = shift; + + # Return when called with pointless context + return + unless $location_hash + && ref $location_hash + && $location_hash->{state} eq 'WA' + && $location_hash->{address1} + && $location_hash->{zip} + && $location_hash->{city}; + + my $log = FS::Log->new('wa_sales'); + + warn "wa_sales() called with location_hash:\n".Dumper( $location_hash)."\n" + if $DEBUG; + + my $api_url = 'http://webgis.dor.wa.gov/webapi/AddressRates.aspx'; + my @api_response_codes = ( + 'The address was found', + 'The address was not found, but the ZIP+4 was located.', + 'The address was updated and found, the user should validate the address record', + 'The address was updated and Zip+4 located, the user should validate the address record', + 'The address was corrected and found, the user should validate the address record', + 'Neither the address or ZIP+4 was found, but the 5-digit ZIP was located.', + 'The address, ZIP+4, and ZIP could not be found.', + 'Invalid Latitude/Longitude', + 'Internal error' + ); - my $delim = '<|>'; # yes, <|> - my $year = (localtime)[5] + 1900; - my $month = (localtime)[4] + 1; - my @zip = split('-', $location->{zip}); - - my @args = ( - 'TaxType=S', #sales; 'P' = property - 'Src=0', #does something complicated - 'TAXABLE=', - 'Addr='.uri_escape($location->{address1}), - 'City='.uri_escape($location->{city}), - 'Zip='.$zip[0], - 'Zip1='.($zip[1] || ''), #optional - 'Year='.$year, - 'SYear='.$year, - 'Month='.$month, - 'EMon='.$month, + my %get_query = ( + output => 'xml', + addr => $location_hash->{address1}, + city => $location_hash->{city}, + zip => substr( $location_hash->{zip}, 0, 5 ), + ); + my $get_string = join '&' => ( + map{ sprintf "%s=%s", $_, uri_escape( $get_query{$_} ) } + keys %get_query ); - - my $query_string = join($delim, @args ); - $url .= "?$query_string"; - warn "\nrequest: $url\n\n" if $DEBUG > 1; - my $res = $ua->request( GET( "$url?$query_string" ) ); + my $prepared_url = "${api_url}?$get_string"; - warn $res->as_string - if $DEBUG > 2; + warn "API call to URL: $prepared_url\n" + if $DEBUG; - if ($res->code ne '200') { - $error = $res->message; - } + my $dom; + local $@; + eval { $dom = XML::LibXML->load_xml( location => $prepared_url ); }; + if ( $@ ) { + my $error = + sprintf "Problem parsing XML from API URL(%s): %s", + $prepared_url, $@; - my $content = $res->content; - my $p = new HTML::TokeParser \$content; - my $js = ''; - while ( my $t = $p->get_tag('script') ) { - my $u = $p->get_token; #either enclosed text or the </script> tag - if ( $u->[0] eq 'T' and $u->[1] =~ /tblSales/ ) { - $js = $u->[1]; - last; - } + $log->error( $error ); + warn $error; + return; } - if ( $js ) { #found it - # strip down to the quoted string, which contains escaped single quotes. - $js =~ s/.*\('tblSales'\);c.innerHTML='//s; - $js =~ s/(?<!\\)'.*//s; # (?<!\\) means "not preceded by a backslash" - warn "\n\n innerHTML:\n$js\n\n" if $DEBUG > 2; - - $p = new HTML::TokeParser \$js; - TD: while ( my $td = $p->get_tag('td') ) { - while ( my $u = $p->get_token ) { - next TD if $u->[0] eq 'E' and $u->[1] eq 'td'; - next if $u->[0] ne 'T'; # skip non-text - my $text = $u->[1]; - - if ( lc($text) eq 'location code' ) { - $p->get_tag('td'); # skip to the next column - undef $u; - $u = $p->get_token until ($u->[0] || '') eq 'T'; # and then skip non-text - $return->{'district'} = $u->[1]; - } - elsif ( lc($text) eq 'total tax rate' ) { - $p->get_tag('td'); - undef $u; - $u = $p->get_token until ($u->[0] || '') eq 'T'; - $return->{'tax'} = $u->[1]; - } - } # get_token - } # TD - - # just to make sure - if ( $return->{'district'} =~ /^\d+$/ and $return->{'tax'} =~ /^.\d+$/ ) { - $return->{'tax'} *= 100; #percentage - warn Dumper($return) if $DEBUG > 1; - return $return; - } - else { - $error = 'district code/tax rate not found'; - } + + my ($res_root) = $dom->findnodes('/response'); + my ($res_addressline) = $dom->findnodes('/response/addressline'); + my ($res_rate) = $dom->findnodes('/response/rate'); + + my $res_code = $res_root->getAttribute('code') + if $res_root; + + unless ( + ref $res_root + && ref $res_addressline + && ref $res_rate + && $res_code <= 5 + && $res_root->getAttribute('rate') > 0 + ) { + my $error = + sprintf + "Problem querying WA DOR tax district - " . + "code( %s %s ) " . + "address( %s ) " . + "url( %s )", + $res_code || 'n/a', + $res_code ? $api_response_codes[$res_code] : 'n/a', + $location_hash->{address1}, + $prepared_url; + + $log->error( $error ); + warn "$error\n"; + return; } - else { - $error = "failed to parse document"; + + my %response = ( + exempt_amount => 0, + state => 'WA', + country => 'US', + district => $res_root->getAttribute('loccode'), + tax => $res_root->getAttribute('rate') * 100, + county => uc $res_addressline->getAttribute('ptba'), + city => uc $res_rate->getAttribute('name') + ); + + $response{county} =~ s/ PTBA//i; + + if ( $DEBUG ) { + warn "XML document: $dom\n"; + warn "API parsed response: ".Dumper( \%response )."\n"; } - die "WA tax district lookup error: $error"; + my $info_message = + sprintf + "Tax district(%s) selected for address(%s %s %s %s)", + $response{district}, + $location_hash->{address1}, + $location_hash->{city}, + $location_hash->{state}, + $location_hash->{zip}; + + $log->info( $info_message ); + warn "$info_message\n" + if $DEBUG; + + \%response; + } ###### USPS Standardization ###### diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 7cc84a9f0..290c89daf 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2318,6 +2318,7 @@ sub tables_hashref { 'setuptax', 'char', 'NULL', 1, '', '', # Y = setup tax exempt 'recurtax', 'char', 'NULL', 1, '', '', # Y = recur tax exempt 'source', 'varchar', 'NULL', $char_d, '', '', + 'charge_prediscount', 'char', 'NULL', 1, '', '', # Y = charge this tax pre discount ], 'primary_key' => 'taxnum', 'unique' => [], diff --git a/FS/FS/TaxEngine/internal.pm b/FS/FS/TaxEngine/internal.pm index 5f5d2295a..6fb1ca756 100644 --- a/FS/FS/TaxEngine/internal.pm +++ b/FS/FS/TaxEngine/internal.pm @@ -105,6 +105,15 @@ sub taxline { my $taxable_charged = $cust_bill_pkg->setup + $cust_bill_pkg->recur or next; # don't create zero-amount exemptions + ## re-add the discounted amount if the tax needs to be charged pre discount + if ($tax_object->charge_prediscount) { + my $discount_amount = 0; + foreach my $discount (@{$cust_bill_pkg->discounts}) { + $discount_amount += $discount->amount; + } + $taxable_charged += $discount_amount; + } + # XXX the following procedure should probably be in cust_bill_pkg if ( $exempt_cust ) { diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm index 3e77704e6..26f6f0394 100644 --- a/FS/FS/cust_main/Search.pm +++ b/FS/FS/cust_main/Search.pm @@ -1086,8 +1086,6 @@ sub search { # (maybe we should be using FS::UI::Web::join_cust_main instead?) $addl_from .= ' LEFT JOIN (select refnum, referral from part_referral) AS part_referral_x ON (cust_main.refnum = part_referral_x.refnum) '; - my $count_query = "SELECT COUNT(*) FROM cust_main $addl_from $extra_sql"; - my @select = ( 'cust_main.custnum', 'cust_main.salesnum', @@ -1140,6 +1138,8 @@ sub search { } + my $count_query = "SELECT COUNT(DISTINCT cust_main.custnum) FROM cust_main $addl_from $extra_sql"; + if ($params->{'flattened_pkgs'}) { #my $pkg_join = ''; diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index a8aaeef77..5325fa562 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -3,7 +3,7 @@ use base qw( FS::Record ); use strict; use vars qw( @EXPORT_OK $conf - @cust_main_county %cust_main_county $countyflag $DEBUG $me); # $cityflag ); + @cust_main_county %cust_main_county $countyflag ); # $cityflag ); use Exporter; use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_bill_pkg; @@ -14,9 +14,6 @@ use FS::cust_tax_exempt; use FS::cust_tax_exempt_pkg; use FS::upgrade_journal; -$DEBUG = 0; -$me = '[FS::cust_main_county]'; - @EXPORT_OK = qw( regionselector ); @cust_main_county = (); @@ -716,299 +713,6 @@ sub _merge_into { } } -=item process_edit_import - -=cut - -use Data::Dumper; -sub process_edit_import { - my $job = shift; - - my $opt = { 'table' => 'cust_main_county', - 'params' => [], #required, apparantly - 'formats' => { 'default' => [ - 'country', - 'state', - 'county', - 'city', - '', #tax class - 'taxname', - 'tax', - 'old_tax', #old tax - ] }, - 'format_headers' => { 'default' => 1, }, - 'format_types' => { 'default' => 'xls' }, - }; - - #false laziness w/ - #FS::Record::process_batch_import( $job, $opt, @_ ); - - my $table = $opt->{table}; - my @pass_params = @{ $opt->{params} }; - my %formats = %{ $opt->{formats} }; - - my $param = shift; - warn Dumper($param) if $DEBUG; - - my $files = $param->{'uploaded_files'} - or die "No files provided.\n"; - - my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files; - - my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/'; - my $file = $dir. $files{'file'}; - - my $error = - #false laziness w/ - #FS::Record::batch_import( { - FS::cust_main_county::edit_import( { - #class-static - table => $table, - formats => \%formats, - format_types => $opt->{format_types}, - format_headers => $opt->{format_headers}, - format_sep_chars => $opt->{format_sep_chars}, - format_fixedlength_formats => $opt->{format_fixedlength_formats}, - #per-import - job => $job, - file => $file, - #type => $type, - format => $param->{format}, - params => { map { $_ => $param->{$_} } @pass_params }, - #? - default_csv => $opt->{default_csv}, - } ); - - unlink $file; - - die "$error\n" if $error; - -} - -=item edit_import - -=cut - -#false laziness w/ #FS::Record::batch_import, grep "edit_import" for differences -#could be turned into callbacks or something -use Text::CSV_XS; -sub edit_import { - my $param = shift; - - warn "$me edit_import call with params: \n". Dumper($param) - if $DEBUG; - - my $table = $param->{table}; - my $formats = $param->{formats}; - - my $job = $param->{job}; - my $file = $param->{file}; - my $format = $param->{'format'}; - my $params = $param->{params} || {}; - - die "unknown format $format" unless exists $formats->{ $format }; - - my $type = $param->{'format_types'} - ? $param->{'format_types'}{ $format } - : $param->{type} || 'csv'; - - unless ( $type ) { - if ( $file =~ /\.(\w+)$/i ) { - $type = lc($1); - } else { - #or error out??? - warn "can't parse file type from filename $file; defaulting to CSV"; - $type = 'csv'; - } - $type = 'csv' - if $param->{'default_csv'} && $type ne 'xls'; - } - - my $header = $param->{'format_headers'} - ? $param->{'format_headers'}{ $param->{'format'} } - : 0; - - my $sep_char = $param->{'format_sep_chars'} - ? $param->{'format_sep_chars'}{ $param->{'format'} } - : ','; - - my $fixedlength_format = - $param->{'format_fixedlength_formats'} - ? $param->{'format_fixedlength_formats'}{ $param->{'format'} } - : ''; - - my @fields = @{ $formats->{ $format } }; - - my $row = 0; - my $count; - my $parser; - my @buffer = (); - my @header = (); #edit_import - if ( $type eq 'csv' || $type eq 'fixedlength' ) { - - if ( $type eq 'csv' ) { - - my %attr = (); - $attr{sep_char} = $sep_char if $sep_char; - $parser = new Text::CSV_XS \%attr; - - } elsif ( $type eq 'fixedlength' ) { - - eval "use Parse::FixedLength;"; - die $@ if $@; - $parser = new Parse::FixedLength $fixedlength_format; - - } else { - die "Unknown file type $type\n"; - } - - @buffer = split(/\r?\n/, slurp($file) ); - splice(@buffer, 0, ($header || 0) ); - $count = scalar(@buffer); - - } elsif ( $type eq 'xls' ) { - - eval "use Spreadsheet::ParseExcel;"; - die $@ if $@; - - eval "use DateTime::Format::Excel;"; - #for now, just let the error be thrown if it is used, since only CDR - # formats bill_west and troop use it, not other excel-parsing things - #die $@ if $@; - - my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($file); - - $parser = $excel->{Worksheet}[0]; #first sheet - - $count = $parser->{MaxRow} || $parser->{MinRow}; - $count++; - - $row = $header || 0; - - #edit_import - need some magic to parse the header - if ( $header ) { - my @header_row = @{ $parser->{Cells}[$0] }; - @header = map $_->{Val}, @header_row; - } - - } else { - die "Unknown file type $type\n"; - } - - #my $columns; - - 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 $line; - my $imported = 0; - my( $last, $min_sec ) = ( time, 5 ); #progressbar foo - while (1) { - - my @columns = (); - if ( $type eq 'csv' ) { - - last unless scalar(@buffer); - $line = shift(@buffer); - - $parser->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $parser->error_input(); - }; - @columns = $parser->fields(); - - } elsif ( $type eq 'fixedlength' ) { - - @columns = $parser->parse($line); - - } elsif ( $type eq 'xls' ) { - - last if $row > ($parser->{MaxRow} || $parser->{MinRow}) - || ! $parser->{Cells}[$row]; - - my @row = @{ $parser->{Cells}[$row] }; - @columns = map $_->{Val}, @row; - - #my $z = 'A'; - #warn $z++. ": $_\n" for @columns; - - } else { - die "Unknown file type $type\n"; - } - - #edit_import loop - - my %hash = %$params; - my @later; - - foreach my $field ( @fields ) { - - my $value = shift @columns; - - if ( ref($field) eq 'CODE' ) { - #&{$field}(\%hash, $value); - push @later, $field, $value; - } elsif ($field) { #edit_import - $hash{$field} = $value if defined($value) && length($value); - } - - } - - my $class = "FS::$table"; - - my $record = $class->new( \%hash ); - - while ( scalar(@later) ) { - my $sub = shift @later; - my $data = shift @later; - &{$sub}($record, $data); #edit_import - don't have $conf - } - - #edit_import update or insert, not just insert - my $old = qsearchs({ - 'table' => $table, - 'hashref' => { map { $_ => $record->$_() } qw(country state county city taxname) }, - }); - - my $error; - if ( $old ) { - $record->taxnum($old->taxnum); - $error = $record->replace($old) - } else { - $record->insert; - } - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't insert record". ( $line ? " for $line" : '' ). ": $error"; - } - - $row++; - $imported++; - - if ( $job && time - $min_sec > $last ) { #progress bar - $job->update_statustext( int(100 * $imported / $count) ); - $last = time; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit;; - - return "Empty file!" unless $imported || $param->{empty_ok}; - - ''; #no error - -} - sub _upgrade_data { my $class = shift; # assume taxes in Washington with district numbers, and null name, or diff --git a/FS/FS/pay_batch/eft_canada.pm b/FS/FS/pay_batch/eft_canada.pm index 3995ac3d2..4726f8888 100644 --- a/FS/FS/pay_batch/eft_canada.pm +++ b/FS/FS/pay_batch/eft_canada.pm @@ -51,6 +51,62 @@ my %holiday = ( 9 => { map {$_=>1} 3 }, #labour day 10 => { map {$_=>1} 8 }, #thanksgiving }, + 2019 => { 2 => { map {$_=>1} 18 }, #family day + 4 => { map {$_=>1} 19 }, #good friday + 4 => { map {$_=>1} 22 }, #easter monday + 5 => { map {$_=>1} 20 }, #victoria day + 8 => { map {$_=>1} 5 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 2 }, #labour day + 10 => { map {$_=>1} 14 }, #thanksgiving + }, + 2020 => { 2 => { map {$_=>1} 17 }, #family day + 4 => { map {$_=>1} 10 }, #good friday + 4 => { map {$_=>1} 13 }, #easter monday + 5 => { map {$_=>1} 18 }, #victoria day + 8 => { map {$_=>1} 3 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 7 }, #labour day + 10 => { map {$_=>1} 12 }, #thanksgiving + }, + 2021 => { 2 => { map {$_=>1} 15 }, #family day + 4 => { map {$_=>1} 2 }, #good friday + 4 => { map {$_=>1} 5 }, #easter monday + 5 => { map {$_=>1} 24 }, #victoria day + 8 => { map {$_=>1} 2 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 6 }, #labour day + 10 => { map {$_=>1} 11 }, #thanksgiving + }, + 2022 => { 2 => { map {$_=>1} 21 }, #family day + 4 => { map {$_=>1} 15 }, #good friday + 4 => { map {$_=>1} 18 }, #easter monday + 5 => { map {$_=>1} 23 }, #victoria day + 8 => { map {$_=>1} 1 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 5 }, #labour day + 10 => { map {$_=>1} 10 }, #thanksgiving + }, + 2023 => { 2 => { map {$_=>1} 20 }, #family day + 4 => { map {$_=>1} 7 }, #good friday + 4 => { map {$_=>1} 10 }, #easter monday + 5 => { map {$_=>1} 22 }, #victoria day + 8 => { map {$_=>1} 7 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 4 }, #labour day + 10 => { map {$_=>1} 9 }, #thanksgiving + }, + 2024 => { 2 => { map {$_=>1} 19 }, #family day + 3 => { map {$_=>1} 29 }, #good friday + 4 => { map {$_=>1} 1 }, #easter monday + 5 => { map {$_=>1} 20 }, #victoria day + 8 => { map {$_=>1} 5 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 2 }, #labour day + 10 => { map {$_=>1} 14 }, #thanksgiving + }, + 2025 => { 2 => { map {$_=>1} 17 }, #family day + 4 => { map {$_=>1} 18 }, #good friday + 4 => { map {$_=>1} 21 }, #easter monday + 5 => { map {$_=>1} 19 }, #victoria day + 8 => { map {$_=>1} 4 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 1 }, #labour day + 10 => { map {$_=>1} 13 }, #thanksgiving + }, ); sub is_holiday { diff --git a/FS/bin/freeside-cdr-asterisk_sql b/FS/bin/freeside-cdr-asterisk_sql index 529ec9bb9..e32ccfe82 100755 --- a/FS/bin/freeside-cdr-asterisk_sql +++ b/FS/bin/freeside-cdr-asterisk_sql @@ -5,6 +5,7 @@ use vars qw( $DEBUG ); use Date::Parse 'str2time'; use Date::Format 'time2str'; use FS::UID qw(adminsuidsetup dbh); +use FS::Log; use FS::cdr; use DBI; use Getopt::Std; @@ -21,11 +22,22 @@ my $dsn = "dbi:$engine"; $dsn .= ":database=$opt{D}"; # if $opt{D}; $dsn .= ";host=$opt{H}" if $opt{H}; -my $dbi = DBI->connect($dsn, $opt{U}, $opt{P}) - or die $DBI::errstr; - adminsuidsetup $user; +my $log = FS::Log->new( 'freeside-cdr-asterisk_sql' ); + +my $dbi = DBI->connect($dsn, $opt{U}, $opt{P}) ; + +if ( $dbi ) { + log_msg( info => "Established connection to CDR database at dsn($dsn)" ); +} else { + log_and_die( error => + sprintf 'Fatal error connecting to CDR database at dsn(%s): %s', + $dsn, + $DBI::errstr + ); +} + my $fsdbh = FS::UID::dbh; my $table = $opt{T} || 'cdr'; @@ -34,11 +46,11 @@ my $table = $opt{T} || 'cdr'; if ( $engine =~ /^mysql/ ) { my $status = $dbi->selectall_arrayref("SHOW COLUMNS FROM $table WHERE Field = 'freesidestatus'"); if( ! @$status ) { - warn "Adding freesidestatus column...\n" if $DEBUG; + log_msg( warn => "Adding freesidestatus column" ); $dbi->do("ALTER TABLE $table ADD COLUMN freesidestatus varchar(32)") - or die $dbi->errstr; + or log_and_die( error => $dbi->errstr ); } else { - warn "freesidestatus column present\n" if $DEBUG; + log_msg( info => "freesidestatus column present" ); } } @@ -68,14 +80,24 @@ if ( $engine =~ /^mysql/ ) { my $sql = 'SELECT '.join(',', @cols). " FROM $table WHERE freesidestatus IS NULL"; my $sth = $dbi->prepare($sql); -$sth->execute; -warn "Importing ".$sth->rows." records...\n" if $DEBUG; +$sth->execute + or log_and_die( error => $sth->errstr ); + +log_msg( info => sprintf 'Importing %s records', $sth->rows ); my $cdr_batch = new FS::cdr_batch({ 'cdrbatch' => 'sql-import-'. time2str('%Y/%m/%d-%T',time), }); -my $error = $cdr_batch->insert; -die $error if $error; +if ( my $error = $cdr_batch->insert ) { + log_and_die( error => $error ); +} else { + log_msg( info => + sprintf 'cdrbatch %s %s', + $cdr_batch->cdrbatch, + $cdr_batch->cdrbatchnum + ); +} + my $cdrbatchnum = $cdr_batch->cdrbatchnum; my $imports = 0; @@ -97,9 +119,13 @@ while ( my $row = $sth->fetchrow_hashref ) { $cdr->cdrbatchnum($cdrbatchnum); - my $error = $cdr->insert; - if ($error) { - warn "failed import: $error\n"; + if ( my $error = $cdr->insert ) { + log_msg( error => + sprintf 'Non-fatal failure to import acctid(%s) from table(%s): %s', + $row->acctid, + $table, + $error + ); } else { $imports++; @@ -117,16 +143,44 @@ while ( my $row = $sth->fetchrow_hashref ) { if ( $dbi->do($usql, @args) ) { $updates++; } else { - warn "failed to set status: ".$dbi->errstr."\n"; + log_msg( error => + sprintf 'Non-fatal failure set status(done) acctid(%s) table(%s): %s', + $row->acctid, + $table, + $dbi->errstr + ); } } } -warn "Done.\nImported $imports CDRs, marked $updates CDRs as done.\n"; +log_and_warn( + info => "Done.\nImported $imports CDRs, marked $updates CDRs as done" +); + $dbi->disconnect; +sub log_and_die { + my ( $level, $message ) = @_; + $log->$level( $message ); + die "[$level] $message\n"; +} + +sub log_msg { + my ( $level, $message ) = @_; + $log->$level( $message ); + warn "[$level] $message\n" + if $opt{v}; +} + +sub log_and_warn { + my ( $level, $message ) = @_; + $log->$level( $message ); + warn "$message\n"; +} + + sub usage { "Usage: \n freeside-cdr-asterisk_sql\n\t-e mysql|Pg|... [ -H host ]n\t-D database\n\t[ -T table ]\n\t[ -V asterisk_version]\n\t-U user\n\t-P password\n\tfreesideuser\n"; } diff --git a/FS/bin/freeside-eftca-download b/FS/bin/freeside-eftca-download index 1b7653cb3..caf9e0e70 100755 --- a/FS/bin/freeside-eftca-download +++ b/FS/bin/freeside-eftca-download @@ -11,6 +11,7 @@ use FS::Record qw(qsearch qsearchs); use FS::pay_batch; use FS::cust_pay_batch; use FS::Conf; +use FS::Log; use vars qw( $opt_v $opt_a ); getopts('va:'); @@ -38,11 +39,15 @@ my @fields = ( my $user = shift or die &HELP_MESSAGE; adminsuidsetup $user; +my $log = FS::Log->new('freeside-eftca-download'); +log_info( "EFT Canada download started\n" ); + if ( $opt_a ) { - die "no such directory: $opt_a\n" + log_error_and_die( "no such directory: $opt_a\n" ) unless -d $opt_a; - die "archive directory $opt_a is not writable by the freeside user\n" - unless -w $opt_a; + log_error_and_die( + "archive directory $opt_a is not writable by the freeside user\n" + ) unless -w $opt_a; } #my $tmpdir = File::Temp->newdir(); @@ -63,51 +68,58 @@ foreach my $agent (@agents) { if ( $conf->exists('batch-spoolagent') ) { @batchconf = $conf->config('batchconfig-eft_canada', $agent->agentnum, 1); if ( !length($batchconf[0]) ) { - warn "agent '".$agent->agent."' has no batchconfig-eft_canada setting; skipped.\n"; + log_info( + "agent '".$agent->agent. + "' has no batchconfig-eft_canada setting; skipped.\n" + ); next; } } else { @batchconf = $conf->config('batchconfig-eft_canada'); } # user, password, transaction code, delay days - my $user = $batchconf[0] or die "no EFT Canada batch username configured\n"; - my $pass = $batchconf[1] or die "no EFT Canada batch password configured\n"; + my $user = $batchconf[0] + or log_error_and_die( "no EFT Canada batch username configured\n" ); + my $pass = $batchconf[1] + or log_error_and_die( "no EFT Canada batch password configured\n" ); my $host = 'ftp.eftcanada.com'; - print STDERR "Connecting to $user\@$host...\n" if $opt_v; + log_info( "Connecting to $user\@$host...\n" ); my $sftp = Net::SFTP::Foreign->new( host => $host, user => $user, password => $pass, timeout => 30, ); - die "failed to connect to '$user\@$host'\n(".$sftp->error.")\n" if $sftp->error; + log_error_and_die("failed to connect to '$user\@$host'\n(".$sftp->error.")\n") + if $sftp->error; $sftp->setcwd('/Returns'); my $files = $sftp->ls('.', wanted => qr/\.txt$/, names_only => 1); - die "no response files found\n" if !@$files; + log_info_and_die( "Finished: No response files found\n" ) + if !@$files; FILE: foreach my $filename (@$files) { - print STDERR "Retrieving $filename\n" if $opt_v; + log_info( "Retrieving $filename\n" ); $sftp->get("$filename", "$tmpdir/$filename"); if($sftp->error) { - warn "failed to download $filename\n"; + log_info( "failed to download $filename\n" ); next FILE; } #move to server archive dir $sftp->rename("$filename", "Archive/$filename"); if($sftp->error) { - warn "failed to archive $filename on server\n"; + log_info( "failed to archive $filename on server\n" ); } # process it anyway though #copy to local archive dir if ( $opt_a ) { - print STDERR "Copying $tmpdir/$filename to archive dir $opt_a\n" - if $opt_v; + log_info( "Copying $tmpdir/$filename to archive dir $opt_a\n" ); system 'cp', "$tmpdir/$filename", $opt_a; - warn "failed to copy $tmpdir/$filename to $opt_a: $@" if $@; + log_info( "failed to copy $tmpdir/$filename to $opt_a: $@" ) + if $@; } open my $fh, "<$tmpdir/$filename"; @@ -118,20 +130,23 @@ foreach my $agent (@agents) { while (my $line = <$fh>) { next if $line =~ /^\s*$/; $csv->parse($line) or do { - warn "can't parse $filename: ".$csv->error_input."\n"; + log_info( "can't parse $filename: ".$csv->error_input."\n" ); next FILE; #parsing errors = reading the wrong kind of file }; @hash{@fields} = $csv->fields(); - print STDERR "voiding paybatchnum#$hash{paybatchnum}\n" if $opt_v; + log_info( "voiding paybatchnum#$hash{paybatchnum}\n" ); my $cpb = qsearchs('cust_pay_batch', { paybatchnum => $hash{'paybatchnum'} }); if ( !$cpb ) { - warn "can't find paybatchnum #$hash{paybatchnum} ($hash{first} $hash{last}, $hash{paid})\n"; + log_info( + "can't find paybatchnum #$hash{paybatchnum} ". + "($hash{first} $hash{last}, $hash{paid})\n" + ); next; } my $error = $cpb->decline("Returned payment ($hash{returncode})"); if ( $error ) { - warn "can't void paybatchnum #$hash{paybatchnum}: $error\n"; + log_info( "can't void paybatchnum #$hash{paybatchnum}: $error\n" ); } } close $fh; @@ -139,7 +154,25 @@ foreach my $agent (@agents) { } -print STDERR "Finished!\n" if $opt_v; +log_info( "Finished!\n" ); + +sub log_info { + my $log_message = shift; + $log->info( $log_message ); + print STDERR $log_message if $opt_v; +} + +sub log_info_and_die { + my $log_message = shift; + $log->info( $log_message ); + die $log_message; +} + +sub log_error_and_die { + my $log_message = shift; + $log->error( $log_message ); + die $log_message; +} =head1 NAME diff --git a/FS/bin/freeside-eftca-upload b/FS/bin/freeside-eftca-upload index afe60afd9..9818cbdb5 100755 --- a/FS/bin/freeside-eftca-upload +++ b/FS/bin/freeside-eftca-upload @@ -9,6 +9,7 @@ use FS::UID qw(adminsuidsetup dbh); use FS::Record qw(qsearch qsearchs); use FS::pay_batch; use FS::Conf; +use FS::Log; use vars qw( $opt_a $opt_v ); getopts('av'); @@ -24,17 +25,20 @@ sub HELP_MESSAGE { " my $user = shift or die &HELP_MESSAGE; adminsuidsetup $user; +my $log = FS::Log->new('freeside-eftca-upload'); +log_info( "EFT Canada upload started\n" ); + my @batches; if($opt_a) { @batches = qsearch('pay_batch', { 'status' => 'O', 'payby' => 'CHEK' }) - or die "No open batches found.\n"; + or log_info_and_die( "Finished: No open batches found.\n" ); } else { my $batchnum = shift; die &HELP_MESSAGE if !$batchnum; @batches = qsearchs('pay_batch', { batchnum => $batchnum } ); - die "Can't find payment batch '$batchnum'\n" if !@batches; + log_error_and_die( "Can't find payment batch '$batchnum'\n" ) if !@batches; } my $conf = new FS::Conf; @@ -45,10 +49,10 @@ foreach my $pay_batch (@batches) { my $batchnum = $pay_batch->batchnum; my $filename = time2str('%Y%m%d', time) . '-' . sprintf('%06d.csv',$batchnum); - print STDERR "Exporting batch $batchnum to $filename...\n" if $opt_v; + log_info( "Exporting batch $batchnum to $filename...\n" ); my $text = $pay_batch->export_batch(format => 'eft_canada'); unless ($text) { - print STDERR "Batch is empty, resolving..." if $opt_v; + log_info( "Batch is empty, resolving..." ); next; } open OUT, ">$tmpdir/$filename"; @@ -56,22 +60,24 @@ foreach my $pay_batch (@batches) { close OUT; my @batchconf = $conf->config('batchconfig-eft_canada', $pay_batch->agentnum); - my $user = $batchconf[0] or die "no EFT Canada batch username configured\n"; - my $pass = $batchconf[1] or die "no EFT Canada batch password configured\n"; + my $user = $batchconf[0] + or log_error_and_die( "no EFT Canada batch username configured\n" ); + my $pass = $batchconf[1] + or log_error_and_die( "no EFT Canada batch password configured\n" ); my $host = 'ftp.eftcanada.com'; - print STDERR "Connecting to $user\@$host...\n" if $opt_v; + log_info( "Connecting to $user\@$host...\n" ); my $sftp = Net::SFTP::Foreign->new( host => $host, user => $user, password => $pass, timeout => 30, ); - die "failed to connect to '$user\@$host'\n(".$sftp->error.")\n" + log_error_and_die("failed to connect to '$user\@$host'\n(".$sftp->error.")\n") if $sftp->error; $sftp->put("$tmpdir/$filename", "$filename") - or die "failed to upload file (".$sftp->error.")\n"; + or log_error_and_die( "failed to upload file (".$sftp->error.")\n" ); undef $sftp; #$sftp->disconnect; @@ -84,10 +90,29 @@ foreach my $pay_batch (@batches) { last if $error; } $error ||= $pay_batch->set_status('R'); - die "error closing batch $batchnum: $error\n\n" if $error; + log_error_and_die( "error closing batch $batchnum: $error\n\n" ) + if $error; +} + +log_info( "Finished!\n" ); + +sub log_info { + my $log_message = shift; + $log->info( $log_message ); + print STDERR $log_message if $opt_v; } -print STDERR "Finished!\n" if $opt_v; +sub log_info_and_die { + my $log_message = shift; + $log->info( $log_message ); + die $log_message; +} + +sub log_error_and_die { + my $log_message = shift; + $log->error( $log_message ); + die $log_message; +} =head1 NAME diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade index c5df06dc3..0df388411 100755 --- a/FS/bin/freeside-upgrade +++ b/FS/bin/freeside-upgrade @@ -120,7 +120,7 @@ while ( $cf = $cfsth->fetchrow_hashref ) { my $name = $cf->{'name'}; $name = lc($name) unless driver_name =~ /^mysql/i; - @statements = grep { $_ !~ /^\s*ALTER\s+TABLE\s+(h_|)$tbl\s+DROP\s+COLUMN\s+cf_$name\s*$/i } + @statements = grep { $_ !~ /^\s*ALTER\s+TABLE\s+(h_|)$tbl DROP\s+COLUMN\s+cf_$name/i } @statements; push @statements, "ALTER TABLE $tbl ADD COLUMN cf_$name varchar(".$cf->{'length'}.")" |