summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/Misc.pm10
-rw-r--r--FS/FS/Schema.pm24
-rw-r--r--FS/FS/TicketSystem/RT_Internal.pm2
-rw-r--r--FS/FS/Upgrade.pm3
-rw-r--r--FS/FS/cust_bill_ApplicationCommon.pm5
-rw-r--r--FS/FS/cust_bill_pkg.pm486
-rw-r--r--FS/FS/cust_credit_bill_pkg.pm62
-rw-r--r--FS/FS/cust_main/Billing.pm127
-rw-r--r--FS/FS/cust_main_county.pm241
-rw-r--r--FS/FS/cust_pkg_discount.pm3
-rw-r--r--FS/FS/cust_tax_exempt_pkg.pm85
-rw-r--r--FS/FS/cust_tax_exempt_pkg_void.pm9
-rw-r--r--FS/FS/discount.pm1
-rw-r--r--FS/FS/h_cust_main_exemption.pm19
-rw-r--r--FS/FS/h_part_pkg.pm37
-rw-r--r--FS/FS/part_event/Action/pkg_agent_credit.pm3
-rw-r--r--FS/FS/part_export/dma_radiusmanager.pm336
-rw-r--r--FS/FS/part_export/shellcommands.pm6
-rw-r--r--FS/FS/radius_group.pm4
-rw-r--r--FS/FS/rate.pm2
-rw-r--r--FS/FS/svc_Tower_Mixin.pm1
-rw-r--r--FS/MANIFEST1
22 files changed, 1296 insertions, 171 deletions
diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm
index 2be9ec203..297e39fbc 100644
--- a/FS/FS/Misc.pm
+++ b/FS/FS/Misc.pm
@@ -913,16 +913,6 @@ sub ocr_image {
@lines;
}
-=item spool_formats
-
-Returns a list of the invoice spool formats.
-
-=cut
-
-sub spool_formats {
- qw(default oneline billco bridgestone)
-}
-
=back
=head1 BUGS
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 7be8c664f..6ad4b742d 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -1133,7 +1133,7 @@ sub tables_hashref {
# 'middle', 'varchar', 'NULL', $char_d, '', '',
'first', 'varchar', '', $char_d, '', '',
'title', 'varchar', 'NULL', $char_d, '', '', #eg Head Bottle Washer
- 'comment', 'varchar', 'NULL', $char_d, '', '',
+ 'comment', 'varchar', 'NULL', 255, '', '',
'disabled', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'contactnum',
@@ -2688,6 +2688,8 @@ sub tables_hashref {
'groupname', 'varchar', '', $char_d, '', '',
'description', 'varchar', 'NULL', $char_d, '', '',
'priority', 'int', '', '', '1', '',
+ 'speed_up', 'int', 'NULL', '', '', '',
+ 'speed_down', 'int', 'NULL', '', '', '',
],
'primary_key' => 'groupnum',
'unique' => [ ['groupname'] ],
@@ -2740,10 +2742,16 @@ sub tables_hashref {
#'custnum', 'int', '', '', '', ''
'billpkgnum', 'int', '', '', '', '',
'taxnum', 'int', '', '', '', '',
- 'year', 'int', '', '', '', '',
- 'month', 'int', '', '', '', '',
+ 'year', 'int', 'NULL', '', '', '',
+ 'month', 'int', 'NULL', '', '', '',
'creditbillpkgnum', 'int', 'NULL', '', '', '',
'amount', @money_type, '', '',
+ # exemption type flags
+ 'exempt_cust', 'char', 'NULL', 1, '', '',
+ 'exempt_setup', 'char', 'NULL', 1, '', '',
+ 'exempt_recur', 'char', 'NULL', 1, '', '',
+ 'exempt_cust_taxname', 'char', 'NULL', 1, '', '',
+ 'exempt_monthly', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'exemptpkgnum',
'unique' => [],
@@ -2760,10 +2768,16 @@ sub tables_hashref {
#'custnum', 'int', '', '', '', ''
'billpkgnum', 'int', '', '', '', '',
'taxnum', 'int', '', '', '', '',
- 'year', 'int', '', '', '', '',
- 'month', 'int', '', '', '', '',
+ 'year', 'int', 'NULL', '', '', '',
+ 'month', 'int', 'NULL', '', '', '',
'creditbillpkgnum', 'int', 'NULL', '', '', '',
'amount', @money_type, '', '',
+ # exemption type flags
+ 'exempt_cust', 'char', 'NULL', 1, '', '',
+ 'exempt_setup', 'char', 'NULL', 1, '', '',
+ 'exempt_recur', 'char', 'NULL', 1, '', '',
+ 'exempt_cust_taxname', 'char', 'NULL', 1, '', '',
+ 'exempt_monthly', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'exemptpkgnum',
'unique' => [],
diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm
index b09647e18..01e2e2966 100644
--- a/FS/FS/TicketSystem/RT_Internal.pm
+++ b/FS/FS/TicketSystem/RT_Internal.pm
@@ -50,7 +50,7 @@ sub access_right {
sub session {
my( $self, $session ) = @_;
- if ( $session && $session->{'Current_User'} ) { # does this even work?
+ if ( $session && $session->{'CurrentUser'} ) { # does this even work?
warn "$me session: using existing session and CurrentUser: \n".
Dumper($session->{'CurrentUser'})
if $DEBUG;
diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm
index 417b2026c..8e697d31e 100644
--- a/FS/FS/Upgrade.pm
+++ b/FS/FS/Upgrade.pm
@@ -278,6 +278,9 @@ sub upgrade_data {
#set up payment gateways if needed
'pay_batch' => [],
+
+ #flag monthly tax exemptions
+ 'cust_tax_exempt_pkg' => [],
;
\%hash;
diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm
index cadb8a796..cb0705041 100644
--- a/FS/FS/cust_bill_ApplicationCommon.pm
+++ b/FS/FS/cust_bill_ApplicationCommon.pm
@@ -337,6 +337,7 @@ sub calculate_applications {
# could expand @open above, instead, for a slightly different magic effect
my @result = ();
foreach my $apply ( @apply ) {
+ # $apply = [ FS::cust_bill_pkg_tax_location record, amount ]
my @sub_lines = $apply->[0]->cust_bill_pkg_tax_Xlocation;
my $amount = $apply->[1];
warn "applying ". $apply->[1]. " to ". $apply->[0]->desc
@@ -346,6 +347,10 @@ sub calculate_applications {
my $owed = $subline->owed;
push @result, [ $apply->[0],
sprintf('%.2f', min($amount, $owed) ),
+ # $subline->primary_key is "billpkgtaxlocationnum"
+ # or "billpkgtaxratelocationnum"
+ # This is the ONLY place either of those fields will
+ # be set.
{ $subline->primary_key => $subline->get($subline->primary_key) },
];
$amount -= $owed;
diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm
index 96fa408a8..b8ae81d86 100644
--- a/FS/FS/cust_bill_pkg.pm
+++ b/FS/FS/cust_bill_pkg.pm
@@ -4,7 +4,7 @@ use base qw( FS::TemplateItem_Mixin FS::cust_main_Mixin FS::Record );
use strict;
use vars qw( @ISA $DEBUG $me );
use Carp;
-use List::Util qw( sum );
+use List::Util qw( sum min );
use Text::CSV_XS;
use FS::Record qw( qsearch qsearchs dbh );
use FS::cust_pkg;
@@ -26,7 +26,6 @@ use FS::cust_bill_pkg_tax_location_void;
use FS::cust_bill_pkg_tax_rate_location_void;
use FS::cust_tax_exempt_pkg_void;
-
$DEBUG = 0;
$me = '[FS::cust_bill_pkg]';
@@ -191,14 +190,12 @@ sub insert {
}
}
- if ( $self->_cust_tax_exempt_pkg ) {
- foreach my $cust_tax_exempt_pkg ( @{$self->_cust_tax_exempt_pkg} ) {
- $cust_tax_exempt_pkg->billpkgnum($self->billpkgnum);
- $error = $cust_tax_exempt_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_tax_exempt_pkg: $error";
- }
+ foreach my $cust_tax_exempt_pkg ( @{$self->cust_tax_exempt_pkg} ) {
+ $cust_tax_exempt_pkg->billpkgnum($self->billpkgnum);
+ $error = $cust_tax_exempt_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error inserting cust_tax_exempt_pkg: $error";
}
}
@@ -787,14 +784,10 @@ sub usage_classes {
}
-# reserving this name for my friends FS::{tax_rate|cust_main_county}::taxline
-# and FS::cust_main::bill
-sub _cust_tax_exempt_pkg {
+sub cust_tax_exempt_pkg {
my ( $self ) = @_;
- $self->{Hash}->{_cust_tax_exempt_pkg} or
- $self->{Hash}->{_cust_tax_exempt_pkg} = [];
-
+ $self->{Hash}->{cust_tax_exempt_pkg} ||= [];
}
=item cust_bill_pkg_tax_Xlocation
@@ -941,6 +934,465 @@ sub credited_sql {
}
+sub upgrade_tax_location {
+ # For taxes that were calculated/invoiced before cust_location refactoring
+ # (May-June 2012), there are no cust_bill_pkg_tax_location records unless
+ # they were calculated on a package-location basis. Create them here,
+ # along with any necessary cust_location records and any tax exemption
+ # records.
+ #
+ # This probably shouldn't run from freeside-upgrade.
+
+ my ($class, %opt) = @_;
+ # %opt may include 's' and 'e': start and end date ranges
+ # and 'X': abort on any error, instead of just rolling back changes to
+ # that invoice
+ my $dbh = dbh;
+ $FS::UID::AutoCommit = 0;
+
+ eval {
+ use FS::h_cust_main;
+ use FS::h_cust_bill;
+ use FS::h_part_pkg;
+ use FS::h_cust_main_exemption;
+ };
+
+ local $FS::cust_location::import = 1;
+
+ my $conf = FS::Conf->new; # h_conf?
+ return if $conf->exists('enable_taxproducts'); #don't touch this case
+ my $use_ship = $conf->exists('tax-ship_address');
+
+ my $date_where = '';
+ if ($opt{s}) {
+ $date_where .= " AND cust_bill._date >= $opt{s}";
+ }
+ if ($opt{e}) {
+ $date_where .= " AND cust_bill._date < $opt{e}";
+ }
+
+ my $commit_each_invoice = 1 unless $opt{X};
+
+ # if an invoice has either of these kinds of objects, then it doesn't
+ # need to be upgraded...probably
+ my $sub_has_tax_link = 'SELECT 1 FROM cust_bill_pkg_tax_location'.
+ ' JOIN cust_bill_pkg USING (billpkgnum)'.
+ ' WHERE cust_bill_pkg.invnum = cust_bill.invnum';
+ my $sub_has_exempt = 'SELECT 1 FROM cust_tax_exempt_pkg'.
+ ' JOIN cust_bill_pkg USING (billpkgnum)'.
+ ' WHERE cust_bill_pkg.invnum = cust_bill.invnum'.
+ ' AND exempt_monthly IS NULL';
+
+ my @invnums = map { $_->invnum } qsearch({
+ select => 'cust_bill.invnum',
+ table => 'cust_bill',
+ hashref => {},
+ extra_sql => "WHERE NOT EXISTS($sub_has_tax_link) ".
+ "AND NOT EXISTS($sub_has_exempt) ".
+ $date_where,
+ });
+
+ print "Processing ".scalar(@invnums)." invoices...\n";
+
+ my $committed;
+ INVOICE:
+ foreach my $invnum (@invnums) {
+ $committed = 0;
+ print STDERR "Invoice #$invnum\n";
+ my $pre = '';
+ my %pkgpart_taxclass; # pkgpart => taxclass
+ my %pkgpart_exempt_setup;
+ my %pkgpart_exempt_recur;
+ my $h_cust_bill = qsearchs('h_cust_bill',
+ { invnum => $invnum,
+ history_action => 'insert' });
+ if (!$h_cust_bill) {
+ warn "no insert record for invoice $invnum; skipped\n";
+ #$date = $cust_bill->_date as a fallback?
+ # We're trying to avoid using non-real dates (-d/-y invoice dates)
+ # when looking up history records in other tables.
+ next INVOICE;
+ }
+ my $custnum = $h_cust_bill->custnum;
+
+ # Determine the address corresponding to this tax region.
+ # It's either the bill or ship address of the customer as of the
+ # invoice date-of-insertion. (Not necessarily the invoice date.)
+ my $date = $h_cust_bill->history_date;
+ my $h_cust_main = qsearchs('h_cust_main',
+ { custnum => $custnum },
+ FS::h_cust_main->sql_h_searchs($date)
+ );
+ if (!$h_cust_main ) {
+ warn "no historical address for cust#".$h_cust_bill->custnum."; skipped\n";
+ next INVOICE;
+ # fallback to current $cust_main? sounds dangerous.
+ }
+
+ # This is a historical customer record, so it has a historical address.
+ # If there's no cust_location matching this custnum and address (there
+ # probably isn't), create one.
+ $pre = 'ship_' if $use_ship and length($h_cust_main->get('ship_last'));
+ my %hash = map { $_ => $h_cust_main->get($pre.$_) }
+ FS::cust_main->location_fields;
+ # not really needed for this, and often result in duplicate locations
+ delete @hash{qw(censustract censusyear latitude longitude coord_auto)};
+
+ $hash{custnum} = $h_cust_main->custnum;
+ my $tax_loc = qsearchs('cust_location', \%hash) # unlikely
+ || FS::cust_location->new({ %hash });
+ if ( !$tax_loc->locationnum ) {
+ $tax_loc->disabled('Y');
+ my $error = $tax_loc->insert;
+ if ( $error ) {
+ warn "couldn't create historical location record for cust#".
+ $h_cust_main->custnum.": $error\n";
+ next INVOICE;
+ }
+ }
+ my $exempt_cust = 1 if $h_cust_main->tax;
+
+ # Get any per-customer taxname exemptions that were in effect.
+ my %exempt_cust_taxname = map {
+ $_->taxname => 1
+ } qsearch('h_cust_main_exemption', { 'custnum' => $custnum },
+ FS::h_cust_main_exemption->sql_h_searchs($date)
+ );
+
+ # classify line items
+ my @tax_items;
+ my %nontax_items; # taxclass => array of cust_bill_pkg
+ foreach my $item ($h_cust_bill->cust_bill_pkg) {
+ my $pkgnum = $item->pkgnum;
+
+ if ( $pkgnum == 0 ) {
+
+ push @tax_items, $item;
+
+ } else {
+ # (pkgparts really shouldn't change, right?)
+ my $h_cust_pkg = qsearchs('h_cust_pkg', { pkgnum => $pkgnum },
+ FS::h_cust_pkg->sql_h_searchs($date)
+ );
+ if ( !$h_cust_pkg ) {
+ warn "no historical package #".$item->pkgpart."; skipped\n";
+ next INVOICE;
+ }
+ my $pkgpart = $h_cust_pkg->pkgpart;
+
+ if (!exists $pkgpart_taxclass{$pkgpart}) {
+ my $h_part_pkg = qsearchs('h_part_pkg', { pkgpart => $pkgpart },
+ FS::h_part_pkg->sql_h_searchs($date)
+ );
+ if ( !$h_part_pkg ) {
+ warn "no historical package def #$pkgpart; skipped\n";
+ next INVOICE;
+ }
+ $pkgpart_taxclass{$pkgpart} = $h_part_pkg->taxclass || '';
+ $pkgpart_exempt_setup{$pkgpart} = 1 if $h_part_pkg->setuptax;
+ $pkgpart_exempt_recur{$pkgpart} = 1 if $h_part_pkg->recurtax;
+ }
+
+ # mark any exemptions that apply
+ if ( $pkgpart_exempt_setup{$pkgpart} ) {
+ $item->set('exempt_setup' => 1);
+ }
+
+ if ( $pkgpart_exempt_recur{$pkgpart} ) {
+ $item->set('exempt_recur' => 1);
+ }
+
+ my $taxclass = $pkgpart_taxclass{ $pkgpart };
+
+ $nontax_items{$taxclass} ||= [];
+ push @{ $nontax_items{$taxclass} }, $item;
+ }
+ }
+ printf("%d tax items: \$%.2f\n", scalar(@tax_items), map {$_->setup} @tax_items);
+
+ # Use a variation on the procedure in
+ # FS::cust_main::Billing::_handle_taxes to identify taxes that apply
+ # to this bill.
+ my @loc_keys = qw( district city county state country );
+ my %taxhash = map { $_ => $h_cust_main->get($pre.$_) } @loc_keys;
+ my %taxdef_by_name; # by name, and then by taxclass
+ my %est_tax; # by name, and then by taxclass
+ my %taxable_items; # by taxnum, and then an array
+
+ foreach my $taxclass (keys %nontax_items) {
+ my %myhash = %taxhash;
+ my @elim = qw( district city county state );
+ my @taxdefs; # because there may be several with different taxnames
+ do {
+ $myhash{taxclass} = $taxclass;
+ @taxdefs = qsearch('cust_main_county', \%myhash);
+ if ( !@taxdefs ) {
+ $myhash{taxclass} = '';
+ @taxdefs = qsearch('cust_main_county', \%myhash);
+ }
+ $myhash{ shift @elim } = '';
+ } while scalar(@elim) and !@taxdefs;
+
+ print "Class '$taxclass': ". scalar(@{ $nontax_items{$taxclass} }).
+ " items, ". scalar(@taxdefs)." tax defs found.\n";
+ foreach my $taxdef (@taxdefs) {
+ next if $taxdef->tax == 0;
+ $taxdef_by_name{$taxdef->taxname}{$taxdef->taxclass} = $taxdef;
+
+ $taxable_items{$taxdef->taxnum} ||= [];
+ foreach my $orig_item (@{ $nontax_items{$taxclass} }) {
+ # clone the item so that taxdef-dependent changes don't
+ # change it for other taxdefs
+ my $item = FS::cust_bill_pkg->new({ $orig_item->hash });
+
+ # these flags are already set if the part_pkg declares itself exempt
+ $item->set('exempt_setup' => 1) if $taxdef->setuptax;
+ $item->set('exempt_recur' => 1) if $taxdef->recurtax;
+
+ my @new_exempt;
+ my $taxable = $item->setup + $item->recur;
+ # credits
+ # h_cust_credit_bill_pkg?
+ # NO. Because if these exemptions HAD been created at the time of
+ # billing, and then a credit applied later, the exemption would
+ # have been adjusted by the amount of the credit. So we adjust
+ # the taxable amount before creating the exemption.
+ # But don't deduct the credit from taxable, because the tax was
+ # calculated before the credit was applied.
+ foreach my $f (qw(setup recur)) {
+ my $credited = FS::Record->scalar_sql(
+ "SELECT SUM(amount) FROM cust_credit_bill_pkg ".
+ "WHERE billpkgnum = ? AND setuprecur = ?",
+ $item->billpkgnum,
+ $f
+ );
+ $item->set($f, $item->get($f) - $credited) if $credited;
+ }
+ my $existing_exempt = FS::Record->scalar_sql(
+ "SELECT SUM(amount) FROM cust_tax_exempt_pkg WHERE ".
+ "billpkgnum = ? AND taxnum = ?",
+ $item->billpkgnum, $taxdef->taxnum
+ ) || 0;
+ $taxable -= $existing_exempt;
+
+ if ( $taxable and $exempt_cust ) {
+ push @new_exempt, { exempt_cust => 'Y', amount => $taxable };
+ $taxable = 0;
+ }
+ if ( $taxable and $exempt_cust_taxname{$taxdef->taxname} ){
+ push @new_exempt, { exempt_cust_taxname => 'Y', amount => $taxable };
+ $taxable = 0;
+ }
+ if ( $taxable and $item->exempt_setup ) {
+ push @new_exempt, { exempt_setup => 'Y', amount => $item->setup };
+ $taxable -= $item->setup;
+ }
+ if ( $taxable and $item->exempt_recur ) {
+ push @new_exempt, { exempt_recur => 'Y', amount => $item->recur };
+ $taxable -= $item->recur;
+ }
+
+ $item->set('taxable' => $taxable);
+ push @{ $taxable_items{$taxdef->taxnum} }, $item
+ if $taxable > 0;
+
+ # estimate the amount of tax (this is necessary because different
+ # taxdefs with the same taxname may have different tax rates)
+ # and sum that for each taxname/taxclass combination
+ # (in cents)
+ $est_tax{$taxdef->taxname} ||= {};
+ $est_tax{$taxdef->taxname}{$taxdef->taxclass} ||= 0;
+ $est_tax{$taxdef->taxname}{$taxdef->taxclass} +=
+ $taxable * $taxdef->tax;
+
+ foreach (@new_exempt) {
+ next if $_->{amount} == 0;
+ my $cust_tax_exempt_pkg = FS::cust_tax_exempt_pkg->new({
+ %$_,
+ billpkgnum => $item->billpkgnum,
+ taxnum => $taxdef->taxnum,
+ });
+ my $error = $cust_tax_exempt_pkg->insert;
+ if ($error) {
+ my $pkgnum = $item->pkgnum;
+ warn "error creating tax exemption for inv$invnum pkg$pkgnum:".
+ "\n$error\n\n";
+ next INVOICE;
+ }
+ } #foreach @new_exempt
+ } #foreach $item
+ } #foreach $taxdef
+ } #foreach $taxclass
+
+ # Now go through the billed taxes and match them up with the line items.
+ TAX_ITEM: foreach my $tax_item ( @tax_items )
+ {
+ my $taxname = $tax_item->itemdesc;
+ $taxname = '' if $taxname eq 'Tax';
+
+ if ( !exists( $taxdef_by_name{$taxname} ) ) {
+ # then we didn't find any applicable taxes with this name
+ warn "no definition found for tax item '$taxname'.\n".
+ '('.join(' ', @hash{qw(country state county city district)}).")\n";
+ # possibly all of these should be "next TAX_ITEM", but whole invoices
+ # are transaction protected and we can go back and retry them.
+ next INVOICE;
+ }
+ # classname => cust_main_county
+ my %taxdef_by_class = %{ $taxdef_by_name{$taxname} };
+
+ # Divide the tax item among taxclasses, if necessary
+ # classname => estimated tax amount
+ my $this_est_tax = $est_tax{$taxname};
+ if (!defined $this_est_tax) {
+ warn "no taxable sales found for inv#$invnum, tax item '$taxname'.\n";
+ next INVOICE;
+ }
+ my $est_total = sum(values %$this_est_tax);
+ if ( $est_total == 0 ) {
+ # shouldn't happen
+ warn "estimated tax on invoice #$invnum is zero.\n";
+ next INVOICE;
+ }
+
+ my $real_tax = $tax_item->setup;
+ printf ("Distributing \$%.2f tax:\n", $real_tax);
+ my $cents_remaining = $real_tax * 100; # for rounding error
+ my @tax_links; # partial CBPTL hashrefs
+ foreach my $taxclass (keys %taxdef_by_class) {
+ my $taxdef = $taxdef_by_class{$taxclass};
+ # these items already have "taxable" set to their charge amount
+ # after applying any credits or exemptions
+ my @items = @{ $taxable_items{$taxdef->taxnum} };
+ my $subtotal = sum(map {$_->get('taxable')} @items);
+ printf("\t$taxclass: %.2f\n", $this_est_tax->{$taxclass}/$est_total);
+
+ foreach my $nontax (@items) {
+ my $part = int($real_tax
+ # class allocation
+ * ($this_est_tax->{$taxclass}/$est_total)
+ # item allocation
+ * ($nontax->get('taxable'))/$subtotal
+ # convert to cents
+ * 100
+ );
+ $cents_remaining -= $part;
+ push @tax_links, {
+ taxnum => $taxdef->taxnum,
+ pkgnum => $nontax->pkgnum,
+ cents => $part,
+ };
+ } #foreach $nontax
+ } #foreach $taxclass
+ # Distribute any leftover tax round-robin style, one cent at a time.
+ my $i = 0;
+ my $nlinks = scalar(@tax_links);
+ if ( $nlinks ) {
+ while (int($cents_remaining) > 0) {
+ $tax_links[$i % $nlinks]->{cents} += 1;
+ $cents_remaining--;
+ $i++;
+ }
+ } else {
+ warn "Can't create tax links--no taxable items found.\n";
+ next INVOICE;
+ }
+
+ # Gather credit/payment applications so that we can link them
+ # appropriately.
+ my @unlinked = (
+ qsearch( 'cust_credit_bill_pkg',
+ { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
+ ),
+ qsearch( 'cust_bill_pay_pkg',
+ { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
+ )
+ );
+
+ # grab the first one
+ my $this_unlinked = shift @unlinked;
+ my $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
+
+ # Create tax links (yay!)
+ printf("Creating %d tax links.\n",scalar(@tax_links));
+ foreach (@tax_links) {
+ my $link = FS::cust_bill_pkg_tax_location->new({
+ billpkgnum => $tax_item->billpkgnum,
+ taxtype => 'FS::cust_main_county',
+ locationnum => $tax_loc->locationnum,
+ taxnum => $_->{taxnum},
+ pkgnum => $_->{pkgnum},
+ amount => sprintf('%.2f', $_->{cents} / 100),
+ });
+ my $error = $link->insert;
+ if ( $error ) {
+ warn "Can't create tax link for inv#$invnum: $error\n";
+ next INVOICE;
+ }
+
+ my $link_cents = $_->{cents};
+ # update/create subitem links
+ #
+ # If $this_unlinked is undef, then we've allocated all of the
+ # credit/payment applications to the tax item. If $link_cents is 0,
+ # then we've applied credits/payments to all of this package fraction,
+ # so go on to the next.
+ while ($this_unlinked and $link_cents) {
+ # apply as much as possible of $link_amount to this credit/payment
+ # link
+ my $apply_cents = min($link_cents, $unlinked_cents);
+ $link_cents -= $apply_cents;
+ $unlinked_cents -= $apply_cents;
+ # $link_cents or $unlinked_cents or both are now zero
+ $this_unlinked->set('amount' => sprintf('%.2f',$apply_cents/100));
+ $this_unlinked->set('billpkgtaxlocationnum' => $link->billpkgtaxlocationnum);
+ my $pkey = $this_unlinked->primary_key; #creditbillpkgnum or billpaypkgnum
+ if ( $this_unlinked->$pkey ) {
+ # then it's an existing link--replace it
+ $error = $this_unlinked->replace;
+ } else {
+ $this_unlinked->insert;
+ }
+ # what do we do with errors at this stage?
+ if ( $error ) {
+ warn "Error creating tax application link: $error\n";
+ next INVOICE; # for lack of a better idea
+ }
+
+ if ( $unlinked_cents == 0 ) {
+ # then we've allocated all of this payment/credit application,
+ # so grab the next one
+ $this_unlinked = shift @unlinked;
+ $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
+ } elsif ( $link_cents == 0 ) {
+ # then we've covered all of this package tax fraction, so split
+ # off a new application from this one
+ $this_unlinked = $this_unlinked->new({
+ $this_unlinked->hash,
+ $pkey => '',
+ });
+ # $unlinked_cents is still what it is
+ }
+
+ } #while $this_unlinked and $link_cents
+ } #foreach (@tax_links)
+ } #foreach $tax_item
+
+ $dbh->commit if $commit_each_invoice;
+ $committed = 1;
+
+ } #foreach $invnum
+ continue {
+ if (!$committed) {
+ $dbh->rollback;
+ die "Upgrade halted.\n" unless $commit_each_invoice;
+ }
+ }
+
+ $dbh->commit unless $commit_each_invoice;
+ '';
+}
+
=back
=head1 BUGS
@@ -958,6 +1410,8 @@ owed_setup and owed_recur could then be repaced by just owed, and
cust_bill::open_cust_bill_pkg and
cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
+The upgrade procedure is pretty sketchy.
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
diff --git a/FS/FS/cust_credit_bill_pkg.pm b/FS/FS/cust_credit_bill_pkg.pm
index 64f1f297e..418900785 100644
--- a/FS/FS/cust_credit_bill_pkg.pm
+++ b/FS/FS/cust_credit_bill_pkg.pm
@@ -103,18 +103,22 @@ sub insert {
return $error;
}
- my $payable = $self->cust_bill_pkg->payable($self->setuprecur);
- my $taxable = $self->_is_taxable ? $payable : 0;
- my $part_pkg = $self->cust_bill_pkg->part_pkg;
- my $freq = $self->cust_bill_pkg->freq;
+ my $cust_bill_pkg = $self->cust_bill_pkg;
+ #'payable' is the amount charged (either setup or recur)
+ # minus any credit applications, including this one
+ my $payable = $cust_bill_pkg->payable($self->setuprecur);
+ my $part_pkg = $cust_bill_pkg->part_pkg;
+ my $freq = $cust_bill_pkg->freq;
unless ($freq) {
$freq = $part_pkg ? ($part_pkg->freq || 1) : 1;#fallback.. assumes unchanged
}
- my $taxable_per_month = sprintf("%.2f", $taxable / $freq );
+ my $taxable_per_month = sprintf("%.2f", $payable / $freq );
my $credit_per_month = sprintf("%.2f", $self->amount / $freq ); #pennies?
if ($taxable_per_month >= 0) { #panic if its subzero?
- my $groupby = 'taxnum,year,month';
+ my $groupby = join(',',
+ qw(taxnum year month exempt_monthly exempt_cust
+ exempt_cust_taxname exempt_setup exempt_recur));
my $sum = 'SUM(amount)';
my @exemptions = qsearch(
{
@@ -124,25 +128,55 @@ sub insert {
'extra_sql' => "GROUP BY $groupby HAVING $sum > 0",
}
);
+ # each $exemption is now the sum of all monthly exemptions applied to
+ # this line item for a particular taxnum and month.
foreach my $exemption ( @exemptions ) {
- next if $taxable_per_month >= $exemption->amount;
- my $amount = $exemption->amount - $taxable_per_month;
- if ($amount > $credit_per_month) {
- "cust_bill_pkg ". $self->billpkgnum. " Reducing.\n";
- $amount = $credit_per_month;
+ my $amount = 0;
+ if ( $exemption->exempt_monthly ) {
+ # finite exemptions
+ # $taxable_per_month is AFTER inserting the credit application, so
+ # if it's still larger than the exemption, we don't need to adjust
+ next if $taxable_per_month >= $exemption->amount;
+ # the amount of 'excess' exemption already in place (above the
+ # remaining charged amount). We'll de-exempt that much, or the
+ # amount of the new credit, whichever is smaller.
+ $amount = $exemption->amount - $taxable_per_month;
+ # $amount is the amount of 'excess' exemption already existing
+ # (above the remaining taxable charge amount). We'll "de-exempt"
+ # that much, or the amount of the new credit, whichever is smaller.
+ if ($amount > $credit_per_month) {
+ "cust_bill_pkg ". $self->billpkgnum. " Reducing.\n";
+ $amount = $credit_per_month;
+ }
+ } elsif ( $exemption->exempt_setup or $exemption->exempt_recur ) {
+ # package defined exemptions: may be setup only, recur only, or both
+ my $method = 'exempt_'.$self->setuprecur;
+ if ( $exemption->$method ) {
+ # then it's exempt from the portion of the charge that this
+ # credit is being applied to
+ $amount = $self->amount;
+ }
+ } else {
+ # other types of exemptions: always equal to the amount of
+ # the charge
+ $amount = $self->amount;
}
+ next if $amount == 0;
+
+ # create a negative exemption
my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg {
+ $exemption->hash, # for exempt_ flags, taxnum, month/year
'billpkgnum' => $self->billpkgnum,
'creditbillpkgnum' => $self->creditbillpkgnum,
'amount' => sprintf('%.2f', 0-$amount),
- map { $_ => $exemption->$_ } split(',', $groupby)
};
+
my $error = $cust_tax_exempt_pkg->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "error inserting cust_tax_exempt_pkg: $error";
}
- }
+ } #foreach $exemption
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -233,7 +267,7 @@ sub delete {
return "error calculating taxes: $hashref_or_error";
}
- push @generated_exemptions, @{ $cust_bill_pkg->_cust_tax_exempt_pkg || [] };
+ push @generated_exemptions, @{ $cust_bill_pkg->cust_tax_exempt_pkg };
}
foreach my $taxnum ( keys %seen ) {
diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm
index 85cafd62c..11247a28f 100644
--- a/FS/FS/cust_main/Billing.pm
+++ b/FS/FS/cust_main/Billing.pm
@@ -735,21 +735,25 @@ sub calculate_taxes {
my @tax_line_items = ();
# keys are tax names (as printed on invoices / itemdesc )
- # values are listrefs of taxlisthash keys (internal identifiers)
+ # values are arrayrefs of taxlisthash keys (internal identifiers)
my %taxname = ();
# keys are taxlisthash keys (internal identifiers)
# values are (cumulative) amounts
- my %tax = ();
+ my %tax_amount = ();
# keys are taxlisthash keys (internal identifiers)
- # values are listrefs of cust_bill_pkg_tax_location hashrefs
+ # values are arrayrefs of cust_bill_pkg_tax_location hashrefs
my %tax_location = ();
# keys are taxlisthash keys (internal identifiers)
- # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
+ # values are arrayrefs of cust_bill_pkg_tax_rate_location hashrefs
my %tax_rate_location = ();
+ # keys are taxnums (not internal identifiers!)
+ # values are arrayrefs of cust_tax_exempt_pkg objects
+ my %tax_exemption;
+
foreach my $tax ( keys %$taxlisthash ) {
# $tax is a tax identifier
my $tax_object = shift @{ $taxlisthash->{$tax} };
@@ -759,14 +763,24 @@ sub calculate_taxes {
warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
# taxline calculates the tax on all cust_bill_pkgs in the
- # first (arrayref) argument
+ # first (arrayref) argument, and returns a hashref of 'name'
+ # (the line item description) and 'amount'.
+ # It also calculates exemptions and attaches them to the cust_bill_pkgs
+ # in the argument.
+ my $taxables = $taxlisthash->{$tax};
+ my $exemptions = $tax_exemption{$tax_object->taxnum} ||= [];
my $hashref_or_error =
- $tax_object->taxline( $taxlisthash->{$tax},
+ $tax_object->taxline( $taxables,
'custnum' => $self->custnum,
- 'invoice_time' => $invoice_time
+ 'invoice_time' => $invoice_time,
+ 'exemptions' => $exemptions,
);
return $hashref_or_error unless ref($hashref_or_error);
+ # then collect any new exemptions generated for this tax
+ push @$exemptions, @{ $_->cust_tax_exempt_pkg }
+ foreach @$taxables;
+
unshift @{ $taxlisthash->{$tax} }, $tax_object;
my $name = $hashref_or_error->{'name'};
@@ -776,7 +790,7 @@ sub calculate_taxes {
$taxname{ $name } ||= [];
push @{ $taxname{ $name } }, $tax;
- $tax{ $tax } += $amount;
+ $tax_amount{ $tax } += $amount;
# link records between cust_main_county/tax_rate and cust_location
$tax_location{ $tax } ||= [];
@@ -809,17 +823,21 @@ sub calculate_taxes {
#move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
foreach my $tax ( keys %$taxlisthash ) {
- foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
- next unless ref($_) eq 'FS::cust_bill_pkg';
-
- my @cust_tax_exempt_pkg = splice( @{ $_->_cust_tax_exempt_pkg } );
+ my $taxables = $taxlisthash->{$tax};
+ my $tax_object = shift @$taxables; # the rest are line items
+ foreach my $cust_bill_pkg ( @$taxables ) {
+ next unless ref($cust_bill_pkg) eq 'FS::cust_bill_pkg';
- next unless @cust_tax_exempt_pkg; #just avoiding the prob when irrelevant?
- die "can't distribute tax exemptions: no line item for ". Dumper($_).
- " in packagemap ". join(',', sort {$a<=>$b} keys %packagemap). "\n"
- unless $packagemap{$_->pkgnum};
+ my @cust_tax_exempt_pkg = splice @{ $cust_bill_pkg->cust_tax_exempt_pkg };
- push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
+ next unless @cust_tax_exempt_pkg;
+ # get the non-disintegrated version
+ my $real_cust_bill_pkg = $packagemap{$cust_bill_pkg->pkgnum}
+ or die "can't distribute tax exemptions: no line item for ".
+ Dumper($_). " in packagemap ".
+ join(',', sort {$a<=>$b} keys %packagemap). "\n";
+
+ push @{ $real_cust_bill_pkg->cust_tax_exempt_pkg },
@cust_tax_exempt_pkg;
}
}
@@ -827,15 +845,15 @@ sub calculate_taxes {
#consolidate and create tax line items
warn "consolidating and generating...\n" if $DEBUG > 2;
foreach my $taxname ( keys %taxname ) {
- my $tax = 0;
+ my $tax_total = 0;
my %seen = ();
my @cust_bill_pkg_tax_location = ();
my @cust_bill_pkg_tax_rate_location = ();
warn "adding $taxname\n" if $DEBUG > 1;
foreach my $taxitem ( @{ $taxname{$taxname} } ) {
next if $seen{$taxitem}++;
- warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
- $tax += $tax{$taxitem};
+ warn "adding $tax_amount{$taxitem}\n" if $DEBUG > 1;
+ $tax_total += $tax_amount{$taxitem};
push @cust_bill_pkg_tax_location,
map { new FS::cust_bill_pkg_tax_location $_ }
@{ $tax_location{ $taxitem } };
@@ -843,9 +861,9 @@ sub calculate_taxes {
map { new FS::cust_bill_pkg_tax_rate_location $_ }
@{ $tax_rate_location{ $taxitem } };
}
- next unless $tax;
+ next unless $tax_total;
- $tax = sprintf('%.2f', $tax );
+ $tax_total = sprintf('%.2f', $tax_total );
my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
'disabled' => '',
@@ -866,7 +884,7 @@ sub calculate_taxes {
push @tax_line_items, new FS::cust_bill_pkg {
'pkgnum' => 0,
- 'setup' => $tax,
+ 'setup' => $tax_total,
'recur' => 0,
'sdate' => '',
'edate' => '',
@@ -1197,8 +1215,11 @@ sub _handle_taxes {
my $exempt = $conf->exists('cust_class-tax_exempt')
? ( $self->cust_class ? $self->cust_class->tax : '' )
: $self->tax;
+ # standardize this just to be sure
+ $exempt = ($exempt eq 'Y') ? 'Y' : '';
- if ( $exempt !~ /Y/i && $self->payby ne 'COMP' ) {
+ #if ( $exempt !~ /Y/i && $self->payby ne 'COMP' ) {
+ if ( $self->payby ne 'COMP' ) {
if ( $conf->exists('enable_taxproducts')
&& ( scalar($part_pkg->part_pkg_taxoverride)
@@ -1207,19 +1228,26 @@ sub _handle_taxes {
)
{
- foreach my $class (@classes) {
- my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg );
- return $err_or_ref unless ref($err_or_ref);
- $taxes{$class} = $err_or_ref;
- }
+ if ( !$exempt ) {
+
+ foreach my $class (@classes) {
+ my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg );
+ return $err_or_ref unless ref($err_or_ref);
+ $taxes{$class} = $err_or_ref;
+ }
+
+ unless (exists $taxes{''}) {
+ my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg );
+ return $err_or_ref unless ref($err_or_ref);
+ $taxes{''} = $err_or_ref;
+ }
- unless (exists $taxes{''}) {
- my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg );
- return $err_or_ref unless ref($err_or_ref);
- $taxes{''} = $err_or_ref;
}
- } else {
+ } else { # cust_main_county tax system
+
+ # We fetch taxes even if the customer is completely exempt,
+ # because we need to record that fact.
my @loc_keys = qw( district city county state country );
my $location = $cust_pkg->tax_location;
@@ -1248,19 +1276,11 @@ sub _handle_taxes {
} while ( !scalar(@taxes) && scalar(@elim) );
- @taxes = grep { ! $_->taxname || ! $self->tax_exemption($_->taxname) }
- @taxes
- if $self->cust_main_exemption; #just to be safe
-
- warn "using taxes:\n". Dumper(@taxes) if $DEBUG > 2;
-
- # all packages now have a locationnum and should get a
- # cust_bill_pkg_tax_location record. The tax_locationnum
- # may be the package's locationnum, or the customer's bill
- # or service location.
foreach (@taxes) {
- $_->set('pkgnum', $cust_pkg->pkgnum);
- $_->set('locationnum', $cust_pkg->tax_locationnum);
+ # These could become cust_bill_pkg_tax_location records,
+ # or cust_tax_exempt_pkg. We'll decide later.
+ $_->set('pkgnum', $cust_pkg->pkgnum);
+ $_->set('locationnum', $cust_pkg->tax_locationnum);
}
$taxes{''} = [ @taxes ];
@@ -1277,7 +1297,7 @@ sub _handle_taxes {
} #if $conf->exists('enable_taxproducts') ...
- }
+ } # if $self->payby eq 'COMP'
#what's this doing in the middle of _handle_taxes? probably should split
#this into three parts above in _make_lines
@@ -1300,14 +1320,15 @@ sub _handle_taxes {
# this is the tax identifier, not the taxname
my $taxname = ref( $tax ). ' '. $tax->taxnum;
-# $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
-# ' locationnum'. $cust_pkg->locationnum
-# if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
+ $taxname .= ' pkgnum'. $cust_pkg->pkgnum;
+ # We need to create a separate $taxlisthash entry for each pkgnum
+ # on the invoice, so that cust_bill_pkg_tax_location records will
+ # be linked correctly.
- # $taxlisthash: keys are "setup", "recur", and usage classes
- # values are arrayrefs, first the tax object (cust_main_county
+ # $taxlisthash: keys are "setup", "recur", and usage classes.
+ # Values are arrayrefs, first the tax object (cust_main_county
# or tax_rate) and then any cust_bill_pkg objects that the
- # tax applies to
+ # tax applies to.
$taxlisthash->{ $taxname } ||= [ $tax ];
push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm
index 6316f239a..143f62ed3 100644
--- a/FS/FS/cust_main_county.pm
+++ b/FS/FS/cust_main_county.pm
@@ -4,7 +4,7 @@ use strict;
use vars qw( @ISA @EXPORT_OK $conf
@cust_main_county %cust_main_county $countyflag ); # $cityflag );
use Exporter;
-use FS::Record qw( qsearch dbh );
+use FS::Record qw( qsearch qsearchs dbh );
use FS::cust_bill_pkg;
use FS::cust_bill;
use FS::cust_pkg;
@@ -164,6 +164,57 @@ sub recurtax {
return '';
}
+=item label OPTIONS
+
+Returns a label looking like "Anytown, Alameda County, CA, US".
+
+If the taxname field is set, it will look like
+"CA Sales Tax (Anytown, Alameda County, CA, US)".
+
+If the taxclass is set, then it will be
+"Anytown, Alameda County, CA, US (International)".
+
+Currently it will not contain the district, even if the city+county+state
+is not unique.
+
+OPTIONS may contain "no_taxclass" (hides taxclass) and/or "no_city"
+(hides city). It may also contain "out", in which case, if this
+region (district+city+county+state+country) contains no non-zero
+taxes, the label will read "Out of taxable region(s)".
+
+=cut
+
+sub label {
+ my ($self, %opt) = @_;
+ if ( $opt{'out'}
+ and $self->tax == 0
+ and !defined(qsearchs('cust_main_county', {
+ 'district' => $self->district,
+ 'city' => $self->city,
+ 'county' => $self->county,
+ 'state' => $self->state,
+ 'country' => $self->country,
+ 'tax' => { op => '>', value => 0 },
+ })) )
+ {
+ return 'Out of taxable region(s)';
+ }
+ my $label = $self->country;
+ $label = $self->state.", $label" if $self->state;
+ $label = $self->county." County, $label" if $self->county;
+ if (!$opt{no_city}) {
+ $label = $self->city.", $label" if $self->city;
+ }
+ # ugly labels when taxclass and taxname are both non-null...
+ # but this is how the tax report does it
+ if (!$opt{no_taxclass}) {
+ $label = "$label (".$self->taxclass.')' if $self->taxclass;
+ }
+ $label = $self->taxname." ($label)" if $self->taxname;
+
+ $label;
+}
+
=item sql_taxclass_sameregion
Returns an SQL WHERE fragment or the empty string to search for entries
@@ -207,21 +258,30 @@ sub _list_sql {
=item taxline TAXABLES_ARRAYREF, [ OPTION => VALUE ... ]
-Returns a listref of a name and an amount of tax calculated for the list of
-packages or amounts referenced by TAXABLES_ARRAYREF. Returns a scalar error
-message on error.
+Returns an hashref of a name and an amount of tax calculated for the
+line items (L<FS::cust_bill_pkg> objects) in TAXABLES_ARRAYREF. The line
+items must come from the same invoice. Returns a scalar error message
+on error.
+
+In addition to calculating the tax for the line items, this will calculate
+any appropriate tax exemptions and attach them to the line items.
-Options include custnum and invoice_date and are hints to this method
+Options may include 'custnum' and 'invoice_date' in case the cust_bill_pkg
+objects belong to an invoice that hasn't been inserted yet.
+
+Options may include 'exemptions', an arrayref of L<FS::cust_tax_exempt_pkg>
+objects belonging to the same customer, to be counted against the monthly
+tax exemption limit if there is one.
=cut
+# XXX this should just return a cust_bill_pkg object for the tax,
+# but that requires changing stuff in tax_rate.pm also.
+
sub taxline {
my( $self, $taxables, %opt ) = @_;
+ return 'taxline called with no line items' unless @$taxables;
- my @exemptions = ();
- push @exemptions, @{ $_->_cust_tax_exempt_pkg }
- for grep { ref($_) } @$taxables;
-
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
@@ -236,29 +296,92 @@ sub taxline {
my $name = $self->taxname || 'Tax';
my $amount = 0;
+ my $cust_bill = $taxables->[0]->cust_bill;
+ my $custnum = $cust_bill ? $cust_bill->custnum : $opt{'custnum'};
+ my $invoice_date = $cust_bill ? $cust_bill->_date : $opt{'invoice_date'};
+ my $cust_main = FS::cust_main->by_key($custnum) if $custnum > 0;
+ if (!$cust_main) {
+ # better way to handle this? should we just assume that it's taxable?
+ die "unable to calculate taxes for an unknown customer\n";
+ }
+
+ # set a flag if the customer is tax-exempt
+ my $exempt_cust;
+ my $conf = FS::Conf->new;
+ if ( $conf->exists('cust_class-tax_exempt') ) {
+ my $cust_class = $cust_main->cust_class;
+ $exempt_cust = $cust_class->tax if $cust_class;
+ } else {
+ $exempt_cust = $cust_main->tax;
+ }
+
+ # set a flag if the customer is exempt from this tax here
+ my $exempt_cust_taxname = $cust_main->tax_exemption($self->taxname)
+ if $self->taxname;
+
+ # Gather any exemptions that are already attached to these cust_bill_pkgs
+ # so that we can deduct them from the customer's monthly limit.
+ my @existing_exemptions = @{ $opt{'exemptions'} };
+ push @existing_exemptions, @{ $_->cust_tax_exempt_pkg }
+ for @$taxables;
+
foreach my $cust_bill_pkg (@$taxables) {
my $cust_pkg = $cust_bill_pkg->cust_pkg;
- my $cust_bill = $cust_pkg->cust_bill if $cust_pkg;
- my $custnum = $cust_pkg ? $cust_pkg->custnum : $opt{custnum};
my $part_pkg = $cust_bill_pkg->part_pkg;
- my $invoice_date = $cust_bill ? $cust_bill->_date : $opt{invoice_date};
-
- my $taxable_charged = 0;
- $taxable_charged += $cust_bill_pkg->setup
- unless $part_pkg->setuptax =~ /^Y$/i
- || $self->setuptax =~ /^Y$/i;
- $taxable_charged += $cust_bill_pkg->recur
- unless $part_pkg->recurtax =~ /^Y$/i
- || $self->recurtax =~ /^Y$/i;
-
- next unless $taxable_charged;
+
+ my @new_exemptions;
+ my $taxable_charged = $cust_bill_pkg->setup + $cust_bill_pkg->recur
+ or next; # don't create zero-amount exemptions
+
+ # XXX the following procedure should probably be in cust_bill_pkg
+
+ if ( $exempt_cust ) {
+
+ push @new_exemptions, FS::cust_tax_exempt_pkg->new({
+ amount => $taxable_charged,
+ exempt_cust => 'Y',
+ });
+ $taxable_charged = 0;
+
+ } elsif ( $exempt_cust_taxname ) {
+
+ push @new_exemptions, FS::cust_tax_exempt_pkg->new({
+ amount => $taxable_charged,
+ exempt_cust_taxname => 'Y',
+ });
+ $taxable_charged = 0;
+
+ }
+
+ if ( ($part_pkg->setuptax eq 'Y' or $self->setuptax eq 'Y')
+ and $cust_bill_pkg->setup > 0 and $taxable_charged > 0 ) {
+
+ push @new_exemptions, FS::cust_tax_exempt_pkg->new({
+ amount => $cust_bill_pkg->setup,
+ exempt_setup => 'Y'
+ });
+ $taxable_charged -= $cust_bill_pkg->setup;
+
+ }
+ if ( ($part_pkg->recurtax eq 'Y' or $self->recurtax eq 'Y')
+ and $cust_bill_pkg->recur > 0 and $taxable_charged > 0 ) {
+
+ push @new_exemptions, FS::cust_tax_exempt_pkg->new({
+ amount => $cust_bill_pkg->recur,
+ exempt_recur => 'Y'
+ });
+ $taxable_charged -= $cust_bill_pkg->recur;
+
+ }
- if ( $self->exempt_amount && $self->exempt_amount > 0 ) {
+ if ( $self->exempt_amount && $self->exempt_amount > 0
+ and $taxable_charged > 0 ) {
#my ($mon,$year) = (localtime($cust_bill_pkg->sdate) )[4,5];
my ($mon,$year) =
(localtime( $cust_bill_pkg->sdate || $invoice_date ) )[4,5];
$mon++;
+ $year += 1900;
my $freq = $cust_bill_pkg->freq;
unless ($freq) {
$freq = $part_pkg->freq || 1; # less trustworthy fallback
@@ -294,6 +417,7 @@ sub taxline {
AND taxnum = ?
AND year = ?
AND month = ?
+ AND exempt_monthly = 'Y'
";
my $sth = dbh->prepare($sql) or do {
$dbh->rollback if $oldAutoCommit;
@@ -302,7 +426,7 @@ sub taxline {
$sth->execute(
$custnum,
$self->taxnum,
- 1900+$year,
+ $year,
$mon,
) or do {
$dbh->rollback if $oldAutoCommit;
@@ -311,9 +435,10 @@ sub taxline {
my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
foreach ( grep { $_->taxnum == $self->taxnum &&
+ $_->exempt_monthly eq 'Y' &&
$_->month == $mon &&
- $_->year == 1900+$year
- } @exemptions
+ $_->year == $year
+ } @existing_exemptions
)
{
$existing_exemption += $_->amount;
@@ -325,42 +450,50 @@ sub taxline {
my $addl = $remaining_exemption > $taxable_per_month
? $taxable_per_month
: $remaining_exemption;
+ push @new_exemptions, FS::cust_tax_exempt_pkg->new({
+ amount => sprintf('%.2f', $addl),
+ exempt_monthly => 'Y',
+ year => $year,
+ month => $mon,
+ });
$taxable_charged -= $addl;
-
- my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
- 'taxnum' => $self->taxnum,
- 'year' => 1900+$year,
- 'month' => $mon,
- 'amount' => sprintf('%.2f', $addl ),
- } );
- if ($cust_bill_pkg->billpkgnum) {
- $cust_tax_exempt_pkg->billpkgnum($cust_bill_pkg->billpkgnum);
- my $error = $cust_tax_exempt_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "fatal: can't insert cust_tax_exempt_pkg: $error";
- }
- }else{
- push @exemptions, $cust_tax_exempt_pkg;
- push @{ $cust_bill_pkg->_cust_tax_exempt_pkg }, $cust_tax_exempt_pkg;
- } # if $cust_bill_pkg->billpkgnum
- } # if $remaining_exemption > 0
-
- #++
+ }
+ last if $taxable_charged < 0.005;
+ # if they're using multiple months of exemption for a multi-month
+ # package, then record the exemptions in separate months
$mon++;
- #until ( $mon < 12 ) { $mon -= 12; $year++; }
- until ( $mon < 13 ) { $mon -= 12; $year++; }
+ if ( $mon > 12 ) {
+ $mon -= 12;
+ $year++;
+ }
} #foreach $which_month
+ } # if exempt_amount
+
+ $_->taxnum($self->taxnum) foreach @new_exemptions;
+
+ if ( $cust_bill_pkg->billpkgnum ) {
+ die "tried to calculate tax exemptions on a previously billed line item\n";
+ # this is unnecessary
+# foreach my $cust_tax_exempt_pkg (@new_exemptions) {
+# my $error = $cust_tax_exempt_pkg->insert;
+# if ( $error ) {
+# $dbh->rollback if $oldAutoCommit;
+# return "can't insert cust_tax_exempt_pkg: $error";
+# }
+# }
+ }
- } #if $tax->exempt_amount
+ # attach them to the line item
+ push @{ $cust_bill_pkg->cust_tax_exempt_pkg }, @new_exemptions;
+ push @existing_exemptions, @new_exemptions;
+ # If we were smart, we'd also generate a cust_bill_pkg_tax_location
+ # record at this point, but that would require redesigning more stuff.
$taxable_charged = sprintf( "%.2f", $taxable_charged);
- $amount += $taxable_charged * $self->tax / 100
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ $amount += $taxable_charged * $self->tax / 100;
+ } #foreach $cust_bill_pkg
return {
'name' => $name,
diff --git a/FS/FS/cust_pkg_discount.pm b/FS/FS/cust_pkg_discount.pm
index a20794027..5f4d0dccf 100644
--- a/FS/FS/cust_pkg_discount.pm
+++ b/FS/FS/cust_pkg_discount.pm
@@ -106,7 +106,8 @@ sub insert {
'amount' => $self->amount,
'percent' => $self->percent,
'months' => $self->months,
- 'setup' => $self->setup,
+ 'setup' => $self->setup,
+ #'linked' => $self->linked,
'disabled' => 'Y',
};
my $error = $discount->insert;
diff --git a/FS/FS/cust_tax_exempt_pkg.pm b/FS/FS/cust_tax_exempt_pkg.pm
index e63b84b30..bbabb5b0a 100644
--- a/FS/FS/cust_tax_exempt_pkg.pm
+++ b/FS/FS/cust_tax_exempt_pkg.pm
@@ -7,6 +7,10 @@ use FS::cust_main_Mixin;
use FS::cust_bill_pkg;
use FS::cust_main_county;
use FS::cust_credit_bill_pkg;
+use FS::UID qw(dbh);
+use FS::upgrade_journal;
+
+# some kind of common ancestor with cust_bill_pkg_tax_location would make sense
@ISA = qw( FS::cust_main_Mixin FS::Record );
@@ -32,22 +36,45 @@ FS::cust_tax_exempt_pkg - Object methods for cust_tax_exempt_pkg records
=head1 DESCRIPTION
An FS::cust_tax_exempt_pkg object represents a record of a customer tax
-exemption. Currently this is only used for "texas tax". FS::cust_tax_exempt
-inherits from FS::Record. The following fields are currently supported:
+exemption. Whenever a package would be taxed (based on its location and
+taxclass), but some or all of it is exempt from taxation, an
+FS::cust_tax_exempt_pkg record is created.
+
+FS::cust_tax_exempt inherits from FS::Record. The following fields are
+currently supported:
=over 4
=item exemptpkgnum - primary key
-=item billpkgnum - invoice line item (see L<FS::cust_bill_pkg>)
+=item billpkgnum - invoice line item (see L<FS::cust_bill_pkg>) that
+was exempted from tax.
=item taxnum - tax rate (see L<FS::cust_main_county>)
-=item year
+=item year - the year in which the exemption occurred. NULL if this
+is a customer or package exemption rather than a monthly exemption.
+
+=item month - the month in which the exemption occurred. NULL if this
+is a customer or package exemption.
+
+=item amount - the amount of revenue exempted. For monthly exemptions
+this may be anything up to the monthly exemption limit defined in
+L<FS::cust_main_county> for this tax. For customer exemptions it is
+always the full price of the line item. For package exemptions it
+may be the setup fee, the recurring fee, or the sum of those.
+
+=item exempt_cust - flag indicating that the customer is tax-exempt
+(cust_main.tax = 'Y').
-=item month
+=item exempt_cust_taxname - flag indicating that the customer is exempt
+from the tax with this name (see L<FS::cust_main_exemption).
-=item amount
+=item exempt_setup, exempt_recur: flag indicating that the package's setup
+or recurring fee is not taxable (part_pkg.setuptax and part_pkg.recurtax).
+
+=item exempt_monthly: flag indicating that this is a monthly per-customer
+exemption (Texas tax).
=back
@@ -109,18 +136,44 @@ and replace methods.
sub check {
my $self = shift;
- $self->ut_numbern('exemptnum')
-# || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
+ my $error = $self->ut_numbern('exemptnum')
|| $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum')
|| $self->ut_foreign_key('taxnum', 'cust_main_county', 'taxnum')
|| $self->ut_foreign_keyn('creditbillpkgnum',
'cust_credit_bill_pkg',
'creditbillpkgnum')
- || $self->ut_number('year') #check better
- || $self->ut_number('month') #check better
+ || $self->ut_numbern('year') #check better
+ || $self->ut_numbern('month') #check better
|| $self->ut_money('amount')
+ || $self->ut_flag('exempt_cust')
+ || $self->ut_flag('exempt_setup')
+ || $self->ut_flag('exempt_recur')
+ || $self->ut_flag('exempt_cust_taxname')
|| $self->SUPER::check
;
+
+ return $error if $error;
+
+ if ( $self->get('exempt_cust') ) {
+ $self->set($_ => '') for qw(
+ exempt_cust_taxname exempt_setup exempt_recur exempt_monthly month year
+ );
+ } elsif ( $self->get('exempt_cust_taxname') ) {
+ $self->set($_ => '') for qw(
+ exempt_setup exempt_recur exempt_monthly month year
+ );
+ } elsif ( $self->get('exempt_setup') || $self->get('exempt_recur') ) {
+ $self->set($_ => '') for qw(exempt_monthly month year);
+ } elsif ( $self->get('exempt_monthly') ) {
+ $self->year =~ /^\d{4}$/
+ or return "illegal exemption year: '".$self->year."'";
+ $self->month >= 1 && $self->month <= 12
+ or return "illegal exemption month: '".$self->month."'";
+ } else {
+ return "no exemption type selected";
+ }
+
+ '';
}
=item cust_main_county
@@ -135,6 +188,18 @@ sub cust_main_county {
qsearchs( 'cust_main_county', { 'taxnum', $self->taxnum } );
}
+sub _upgrade_data {
+ my $class = shift;
+
+ my $journal = 'cust_tax_exempt_pkg_flags';
+ if ( !FS::upgrade_journal->is_done($journal) ) {
+ my $sql = "UPDATE cust_tax_exempt_pkg SET exempt_monthly = 'Y' ".
+ "WHERE month IS NOT NULL";
+ dbh->do($sql) or die dbh->errstr;
+ FS::upgrade_journal->set_done($journal);
+ }
+}
+
=back
=head1 BUGS
diff --git a/FS/FS/cust_tax_exempt_pkg_void.pm b/FS/FS/cust_tax_exempt_pkg_void.pm
index 51c85b463..bfbc8c739 100644
--- a/FS/FS/cust_tax_exempt_pkg_void.pm
+++ b/FS/FS/cust_tax_exempt_pkg_void.pm
@@ -114,10 +114,15 @@ sub check {
$self->ut_number('exemptpkgnum')
|| $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum' )
|| $self->ut_foreign_key('taxnum', 'cust_main_county', 'taxnum')
- || $self->ut_number('year')
- || $self->ut_number('month')
+ || $self->ut_numbern('year')
+ || $self->ut_numbern('month')
|| $self->ut_numbern('creditbillpkgnum') #no FK check, will have been del'ed
|| $self->ut_money('amount')
+ || $self->ut_flag('exempt_cust')
+ || $self->ut_flag('exempt_setup')
+ || $self->ut_flag('exempt_recur')
+ || $self->ut_flag('exempt_cust_taxname')
+ || $self->ut_flag('exempt_monthly')
;
return $error if $error;
diff --git a/FS/FS/discount.pm b/FS/FS/discount.pm
index 88cbdd41c..f6f994599 100644
--- a/FS/FS/discount.pm
+++ b/FS/FS/discount.pm
@@ -136,6 +136,7 @@ sub check {
|| $self->ut_floatn('months') #actually decimal, but this will do
|| $self->ut_enum('disabled', [ '', 'Y' ])
|| $self->ut_enum('setup', [ '', 'Y' ])
+ #|| $self->ut_enum('linked', [ '', 'Y' ])
;
return $error if $error;
diff --git a/FS/FS/h_cust_main_exemption.pm b/FS/FS/h_cust_main_exemption.pm
new file mode 100644
index 000000000..072c4123e
--- /dev/null
+++ b/FS/FS/h_cust_main_exemption.pm
@@ -0,0 +1,19 @@
+package FS::h_cust_main_exemption;
+
+use strict;
+use base qw( FS::h_Common FS::cust_main_exemption );
+
+sub table { 'h_cust_main_exemption' };
+
+=head1 NAME
+
+FS::h_cust_main_exemption - Historical customer tax exemption records.
+
+=head1 SEE ALSO
+
+L<FS::cust_main_exemption>, L<FS::h_Common>, L<FS::Record>.
+
+=cut
+
+1;
+
diff --git a/FS/FS/h_part_pkg.pm b/FS/FS/h_part_pkg.pm
new file mode 100644
index 000000000..2c0e65f22
--- /dev/null
+++ b/FS/FS/h_part_pkg.pm
@@ -0,0 +1,37 @@
+package FS::h_part_pkg;
+
+use strict;
+use vars qw( @ISA );
+use base qw(FS::h_Common FS::part_pkg);
+
+sub table { 'h_part_pkg' };
+
+sub _rebless {}; # don't try to rebless these
+
+=head1 NAME
+
+FS::h_part_pkg - Historical record of package definition.
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+An FS::h_part_pkg object represents historical changes to package
+definitions.
+
+=head1 BUGS
+
+Many important properties of a part_pkg are in other tables, especially
+plan options, service allotments, and link/bundle relationships. The
+methods to access those from the part_pkg will work, but they're
+really accessing current, not historical, data. Be careful.
+
+=head1 SEE ALSO
+
+L<FS::part_pkg>, L<FS::h_Common>, L<FS::Record>, schema.html from the base
+documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/part_event/Action/pkg_agent_credit.pm b/FS/FS/part_event/Action/pkg_agent_credit.pm
index 4bcee983b..e1c77be07 100644
--- a/FS/FS/part_event/Action/pkg_agent_credit.pm
+++ b/FS/FS/part_event/Action/pkg_agent_credit.pm
@@ -18,7 +18,7 @@ sub do_action {
my $agent_cust_main = $agent->agent_cust_main;
#? or return "No customer record for agent ". $agent->agent;
- my $amount = $self->_calc_credit($cust_pkg);
+ my $amount = $self->_calc_credit($cust_pkg);
return '' unless $amount > 0;
my $reasonnum = $self->option('reasonnum');
@@ -29,6 +29,7 @@ sub do_action {
'eventnum' => $cust_event->eventnum,
'addlinfo' => 'for customer #'. $cust_main->display_custnum.
': '.$cust_main->name,
+ #'commission_agentnum' => $agent->agentnum,
);
die "Error crediting customer ". $agent_cust_main->custnum.
" for agent commission: $error"
diff --git a/FS/FS/part_export/dma_radiusmanager.pm b/FS/FS/part_export/dma_radiusmanager.pm
new file mode 100644
index 000000000..ab77c4645
--- /dev/null
+++ b/FS/FS/part_export/dma_radiusmanager.pm
@@ -0,0 +1,336 @@
+package FS::part_export::dma_radiusmanager;
+
+use strict;
+use vars qw($DEBUG %info %options);
+use base 'FS::part_export';
+use FS::part_svc;
+use FS::svc_acct;
+use FS::radius_group;
+use Tie::IxHash;
+use Digest::MD5 'md5_hex';
+
+tie %options, 'Tie::IxHash',
+ 'dbname' => { label=>'Database name', default=>'radius' },
+ 'username' => { label=>'Database username' },
+ 'password' => { label=>'Database password' },
+ 'manager' => { label=>'Manager name' },
+ 'groupid' => { label=>'Group ID', default=>'1' },
+ 'service_prefix' => { label=>'Service name prefix' },
+ 'nasnames' => { label=>'NAS IDs/addresses' },
+ 'debug' => { label=>'Enable debugging', type=>'checkbox' },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Export to DMA Radius Manager',
+ 'options' => \%options,
+ 'nodomain' => 'Y',
+ 'notes' => '', #XXX
+);
+
+$DEBUG = 0;
+
+sub connect {
+ my $self = shift;
+ my $datasrc = 'dbi:mysql:host='.$self->machine.
+ ':database='.$self->option('dbname');
+ DBI->connect(
+ $datasrc,
+ $self->option('username'),
+ $self->option('password'),
+ { AutoCommit => 0 }
+ ) or die $DBI::errstr;
+}
+
+sub export_insert { my $self = shift; $self->dma_rm_queue('insert', @_) }
+sub export_delete { my $self = shift; $self->dma_rm_queue('delete', @_) }
+sub export_replace { my $self = shift; $self->dma_rm_queue('replace', @_) }
+sub export_suspend { my $self = shift; $self->dma_rm_queue('suspend', @_) }
+sub export_unsuspend { my $self = shift; $self->dma_rm_queue('unsuspend', @_) }
+
+sub dma_rm_queue {
+ my ($self, $action, $svc_acct, $old) = @_;
+
+ my $svcnum = $svc_acct->svcnum;
+
+ my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
+ my $cust_main = $cust_pkg->cust_main;
+ my $location = $cust_pkg->cust_location;
+
+ my %params = (
+ # for the remote side
+ username => $svc_acct->username,
+ password => md5_hex($svc_acct->_password),
+ groupid => $self->option('groupid'),
+ enableuser => 1,
+ firstname => $cust_main->first,
+ lastname => $cust_main->last,
+ company => $cust_main->company,
+ phone => ($cust_main->daytime || $cust_main->night),
+ mobile => $cust_main->mobile,
+ address => $location->address1, # address2?
+ city => $location->city,
+ state => $location->state,
+ zip => $location->zip,
+ country => $location->country,
+ gpslat => $location->latitude,
+ gpslong => $location->longitude,
+ comment => 'svcnum'.$svcnum,
+ createdby => $self->option('manager'),
+ owner => $self->option('manager'),
+ email => $cust_main->invoicing_list_emailonly_scalar,
+
+ # used internally by the export
+ exportnum => $self->exportnum,
+ svcnum => $svcnum,
+ action => $action,
+ svcpart => $svc_acct->cust_svc->svcpart,
+ _password => $svc_acct->_password,
+ );
+ if ( $action eq 'replace' ) {
+ $params{'old_username'} = $old->username;
+ $params{'old_password'} = $old->_password;
+ }
+ my $queue = FS::queue->new({
+ 'svcnum' => $svcnum,
+ 'job' => "FS::part_export::dma_radiusmanager::dma_rm_action",
+ });
+ $queue->insert(%params);
+}
+
+sub dma_rm_action {
+ my %params = @_;
+ my $svcnum = delete $params{svcnum};
+ my $action = delete $params{action};
+ my $svcpart = delete $params{svcpart};
+ my $exportnum = delete $params{exportnum};
+
+ my $username = $params{username};
+ my $password = delete $params{_password};
+
+ my $self = FS::part_export->by_key($exportnum);
+ my $dbh = $self->connect;
+ local $DEBUG = 1 if $self->option('debug');
+
+ # export the part_svc if needed, and get its srvid
+ my $part_svc = FS::part_svc->by_key($svcpart);
+ my $srvid = $self->export_part_svc($part_svc, $dbh); # dies on error
+ $params{srvid} = $srvid;
+
+ if ( $action eq 'insert' ) {
+ warn "rm_users: inserting svcnum$svcnum\n" if $DEBUG;
+ my $sth = $dbh->prepare( 'INSERT INTO rm_users ( '.
+ join(', ', keys(%params)).
+ ') VALUES ('.
+ join(', ', ('?') x keys(%params)).
+ ')'
+ );
+ $sth->execute(values(%params)) or die $dbh->errstr;
+
+ # minor false laziness w/ sqlradius_insert
+ warn "radcheck: inserting $username\n" if $DEBUG;
+ $sth = $dbh->prepare( 'INSERT INTO radcheck (
+ username, attribute, op, value
+ ) VALUES (?, ?, ?, ?)' );
+ $sth->execute(
+ $username,
+ 'Cleartext-Password',
+ ':=', # :=(
+ $password,
+ ) or die $dbh->errstr;
+
+ $sth->execute(
+ $username,
+ 'Simultaneous-Use',
+ ':=',
+ 1, # should this be an option?
+ ) or die $dbh->errstr;
+ # also, we don't support exporting any other radius attrs...
+ # those should go in 'custattr' if we need them
+ } elsif ( $action eq 'replace' ) {
+
+ my $old_username = delete $params{old_username};
+ my $old_password = delete $params{old_password};
+ # svcnum is invariant and on the remote side, so we don't need any
+ # of the old fields to do this
+ warn "rm_users: updating svcnum$svcnum\n" if $DEBUG;
+ my $sth = $dbh->prepare( 'UPDATE rm_users SET '.
+ join(', ', map { "$_ = ?" } keys(%params)).
+ ' WHERE comment = ?'
+ );
+ $sth->execute(values(%params), $params{comment}) or die $dbh->errstr;
+ # except for username/password changes
+ if ( $old_password ne $password ) {
+ warn "radcheck: changing password for $old_username\n" if $DEBUG;
+ $sth = $dbh->prepare( 'UPDATE radcheck SET value = ? '.
+ 'WHERE username = ? and attribute = \'Cleartext-Password\''
+ );
+ $sth->execute($password, $old_username) or die $dbh->errstr;
+ }
+ if ( $old_username ne $username ) {
+ warn "radcheck: changing username $old_username to $username\n"
+ if $DEBUG;
+ $sth = $dbh->prepare( 'UPDATE radcheck SET username = ? '.
+ 'WHERE username = ?'
+ );
+ $sth->execute($username, $old_username) or die $dbh->errstr;
+ }
+
+ } elsif ( $action eq 'suspend' ) {
+
+ # this is sufficient
+ warn "rm_users: disabling svcnum#$svcnum\n" if $DEBUG;
+ my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 0 '.
+ 'WHERE comment = ?'
+ );
+ $sth->execute($params{comment}) or die $dbh->errstr;
+
+ } elsif ( $action eq 'unsuspend' ) {
+
+ warn "rm_users: enabling svcnum#$svcnum\n" if $DEBUG;
+ my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 1 '.
+ 'WHERE comment = ?'
+ );
+ $sth->execute($params{comment}) or die $dbh->errstr;
+
+ } elsif ( $action eq 'delete' ) {
+
+ warn "rm_users: deleting svcnum#$svcnum\n" if $DEBUG;
+ my $sth = $dbh->prepare( 'DELETE FROM rm_users WHERE comment = ?' );
+ $sth->execute($params{comment}) or die $dbh->errstr;
+
+ warn "radcheck: deleting $username\n" if $DEBUG;
+ $sth = $dbh->prepare( 'DELETE FROM radcheck WHERE username = ?' );
+ $sth->execute($username) or die $dbh->errstr;
+
+ # if this were smarter it would also delete the rm_services record
+ # if it was no longer in use, but that's not really necessary
+ }
+
+ $dbh->commit;
+ '';
+}
+
+=item export_part_svc PART_SVC DBH
+
+Query Radius Manager for a service definition matching the name of
+PART_SVC (optionally with a prefix defined in the export options).
+If there is one, update it to match the attributes of PART_SVC; if
+not, create one. Then return its srvid.
+
+=cut
+
+sub export_part_svc {
+ my ($self, $part_svc, $dbh) = @_;
+
+ my $name = $self->option('service_prefix').$part_svc->svc;
+
+ my %params = (
+ 'srvname' => $name,
+ 'enableservice' => 1,
+ 'nextsrvid' => -1,
+ 'dailynextsrvid' => -1,
+ );
+ my @fixed_groups;
+ # use speed settings from fixed usergroups configured on this part_svc
+ if ( my $psc = $part_svc->part_svc_column('usergroup') ) {
+ if ( $psc->columnflag eq 'F' ) {
+ # each part_svc really should only have one fixed group with non-null
+ # speed settings, but go by priority order for consistency
+ @fixed_groups =
+ sort { $a->priority <=> $b->priority }
+ grep { $_ }
+ map { FS::radius_group->by_key($_) }
+ split(/\s*,\s*/, $psc->columnvalue);
+ }
+ } # otherwise there are no fixed groups, so leave speed empty
+
+ foreach (qw(down up)) {
+ my $speed = "speed_$_";
+ foreach my $group (@fixed_groups) {
+ if ( ($group->$speed || 0) > 0 ) {
+ $params{$_.'rate'} = $group->$speed;
+ last;
+ }
+ }
+ }
+ # anything else we need here? poolname, maybe?
+
+ warn "rm_services: looking for '$name'\n" if $DEBUG;
+ my $sth = $dbh->prepare(
+ 'SELECT srvid FROM rm_services WHERE srvname = ? AND enableservice = 1'
+ );
+ $sth->execute($name) or die $dbh->errstr;
+ if ( $sth->rows > 1 ) {
+ die "Multiple services with name '$name' found in Radius Manager.\n";
+ } elsif ( $sth->rows == 1 ) {
+ my $row = $sth->fetchrow_arrayref;
+ my $srvid = $row->[0];
+ warn "rm_services: updating srvid#$srvid\n" if $DEBUG;
+ $sth = $dbh->prepare(
+ 'UPDATE rm_services SET '.join(', ', map {"$_ = ?"} keys %params) .
+ ' WHERE srvid = ?'
+ );
+ $sth->execute(values(%params), $srvid) or die $dbh->errstr;
+ return $srvid;
+ } else { # $sth->rows == 0
+ # create a new one
+ # but first... get the next available srvid
+ $sth = $dbh->prepare('SELECT MAX(srvid) FROM rm_services');
+ $sth->execute or die $dbh->errstr;
+ my $srvid = 1; # just in case you somehow have nothing in your database
+ if ( $sth->rows ) {
+ $srvid = $sth->fetchrow_arrayref->[0] + 1;
+ }
+ $params{'srvid'} = $srvid;
+ # NOW create a new one
+ warn "rm_services: inserting '$name' as srvid#$srvid\n" if $DEBUG;
+ $sth = $dbh->prepare(
+ 'INSERT INTO rm_services ('.join(', ', keys %params).
+ ') VALUES ('.join(', ', map {'?'} keys %params).')'
+ );
+ $sth->execute(values(%params)) or die $dbh->errstr;
+ # also link it to our manager name
+ warn "rm_services: linking to manager\n" if $DEBUG;
+ $sth = $dbh->prepare(
+ 'INSERT INTO rm_allowedmanagers (srvid, managername) VALUES (?, ?)'
+ );
+ $sth->execute($srvid, $self->option('manager')) or die $dbh->errstr;
+ # and allow it on our NAS
+ $sth = $dbh->prepare(
+ 'INSERT INTO rm_allowednases (srvid, nasid) VALUES (?, ?)'
+ );
+ foreach my $nasid ($self->nas_ids($dbh)) {
+ warn "rm_services: linking to nasid#$nasid\n" if $DEBUG;
+ $sth->execute($srvid, $nasid) or die $dbh->errstr;
+ }
+ return $srvid;
+ }
+}
+
+=item nas_ids DBH
+
+Convert the 'nasnames option into a list of real NAS ids.
+
+=cut
+
+sub nas_ids {
+ my $self = shift;
+ my $dbh = shift;
+
+ my @nasnames = split(/\s*,\s*/, $self->option('nasnames'));
+ return unless @nasnames;
+ # pass these through unchanged
+ my @ids = grep { /^\d+$/ } @nasnames;
+ @nasnames = grep { not /^\d+$/ } @nasnames;
+ my $in_nasnames = join(',', map {$dbh->quote($_)} @nasnames);
+
+ my $sth = $dbh->prepare("SELECT id FROM nas WHERE nasname IN ($in_nasnames)");
+ $sth->execute or die $dbh->errstr;
+ my $rows = $sth->fetchall_arrayref;
+ push @ids, $_->[0] foreach @$rows;
+
+ return @ids;
+}
+
+1;
diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm
index ca4e52420..f964af31c 100644
--- a/FS/FS/part_export/shellcommands.pm
+++ b/FS/FS/part_export/shellcommands.pm
@@ -490,7 +490,7 @@ sub ssh_cmd { #subroutine, not method
my ($output, $errput) = $ssh->capture2($ssh_opt, $opt->{'command'});
return if $opt->{'ignore_all_errors'};
- die "Error running SSH command: ". $ssh->error if $ssh->error;
+ #die "Error running SSH command: ". $ssh->error if $ssh->error;
if ( ($output || $errput)
&& $opt->{'ignored_errors'} && length($opt->{'ignored_errors'})
@@ -504,7 +504,9 @@ sub ssh_cmd { #subroutine, not method
$errput =~ s/[\s\n]//g;
}
- die "$errput\n" if $errput;
+ die (($errput || $ssh->error). "\n") if $errput || $ssh->error;
+ #die "$errput\n" if $errput;
+
die "$output\n" if $output and $opt->{'fail_on_output'};
'';
}
diff --git a/FS/FS/radius_group.pm b/FS/FS/radius_group.pm
index 37aa0f37b..f1a4efe7f 100644
--- a/FS/FS/radius_group.pm
+++ b/FS/FS/radius_group.pm
@@ -47,6 +47,8 @@ description
priority - for export
+=item speed_up, speed_down - connection speeds in bits per second. Some
+exports may use this to generate appropriate RADIUS attributes.
=back
@@ -176,6 +178,8 @@ sub check {
|| $self->ut_text('groupname')
|| $self->ut_textn('description')
|| $self->ut_numbern('priority')
+ || $self->ut_numbern('speed_up')
+ || $self->ut_numbern('speed_down')
;
return $error if $error;
diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm
index 02d8250eb..a2511cf99 100644
--- a/FS/FS/rate.pm
+++ b/FS/FS/rate.pm
@@ -387,7 +387,7 @@ sub rate_detail {
=item process
-Experimental job-queue processor for web interface adds/edits
+Job-queue processor for web interface adds/edits
=cut
diff --git a/FS/FS/svc_Tower_Mixin.pm b/FS/FS/svc_Tower_Mixin.pm
index 0b5588466..6adbc6f5e 100644
--- a/FS/FS/svc_Tower_Mixin.pm
+++ b/FS/FS/svc_Tower_Mixin.pm
@@ -52,5 +52,4 @@ sub tower_sector_sql {
@where;
}
-
1;
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 479dcad60..b5ee87e93 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -94,6 +94,7 @@ FS/h_cust_pkg_reason.pm
FS/h_cust_svc.pm
FS/h_cust_tax_exempt.pm
FS/h_domain_record.pm
+FS/h_part_pkg.pm
FS/h_svc_acct.pm
FS/h_svc_broadband.pm
FS/h_svc_domain.pm
generated by cgit v1.2.1 (git 2.18.0) at 2025-08-09 23:16:28 +0000