From f2e2f27be8635833c9b7378cdef1b4b206a17955 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 23 Jul 2012 16:47:39 -0700 Subject: don't enumerate the whole subnet when looking for a free address, #18556 --- FS/FS/addr_block.pm | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) (limited to 'FS') diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm index e00f587c6..686bdbd18 100755 --- a/FS/FS/addr_block.pm +++ b/FS/FS/addr_block.pm @@ -223,43 +223,45 @@ sub cidr { $self->NetAddr->cidr; } -=item free_addrs +=item next_free_addr Returns a NetAddr::IP object corresponding to the first unassigned address in the block (other than the network, broadcast, or gateway address). If there are no free addresses, returns nothing. There are never free addresses when manual_flag is true. -=item next_free_addr - -Returns a NetAddr::IP object for the first unassigned address in the block, -or '' if there are none. +There is no longer a method to return all free addresses in a block. =cut -sub free_addrs { +sub next_free_addr { my $self = shift; + my $selfaddr = $self->NetAddr; return if $self->manual_flag; my $conf = new FS::Conf; my @excludeaddr = $conf->config('exclude_ip_addr'); - + my %used = map { $_ => 1 } ( + @excludeaddr, + $selfaddr->addr, + $selfaddr->network->addr, + $selfaddr->broadcast->addr, (map { $_->NetAddr->addr } - ($self, - qsearch('svc_broadband', { blocknum => $self->blocknum })) + qsearch('svc_broadband', { blocknum => $self->blocknum }) ), @excludeaddr ); - grep { !$used{$_->addr} } $self->NetAddr->hostenum; - -} + # just do a linear search of the block + my $freeaddr = $selfaddr->network + 1; + while ( $freeaddr < $selfaddr->broadcast ) { + return $freeaddr unless $used{ $freeaddr->addr }; + $freeaddr++; + } + return; -sub next_free_addr { - my $self = shift; - ($self->free_addrs, '')[0] } =item allocate -- deprecated -- cgit v1.2.1 From 217b71622d3898e6df98832d378312aa70d6ae7e Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 25 Jul 2012 16:15:40 -0700 Subject: typo --- FS/FS/part_pkg/prepaid.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_pkg/prepaid.pm b/FS/FS/part_pkg/prepaid.pm index 407343bc8..50f908c6d 100644 --- a/FS/FS/part_pkg/prepaid.pm +++ b/FS/FS/part_pkg/prepaid.pm @@ -23,7 +23,7 @@ tie my %overlimit_action, 'Tie::IxHash', 'shortname' => 'Prepaid, no automatic cycle', 'inherit_fields' => [ 'usage_Mixin', 'global_Mixin' ], 'fields' => { - 'recur_action' => { 'name' => 'Action to take upon reaching end of prepaid preiod', + 'recur_action' => { 'name' => 'Action to take upon reaching end of prepaid period', 'type' => 'select', 'select_options' => \%recur_action, }, -- cgit v1.2.1 From bd647f16de5352722baed016b45baa4e7c695278 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 25 Jul 2012 16:16:57 -0700 Subject: EZ-Prepaid PIN export, #16172 --- FS/FS/part_export/ez_prepaid.pm | 183 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 183 insertions(+) create mode 100644 FS/FS/part_export/ez_prepaid.pm (limited to 'FS') diff --git a/FS/FS/part_export/ez_prepaid.pm b/FS/FS/part_export/ez_prepaid.pm new file mode 100644 index 000000000..d171eb135 --- /dev/null +++ b/FS/FS/part_export/ez_prepaid.pm @@ -0,0 +1,183 @@ +package FS::part_export::ez_prepaid; + +use base qw( FS::part_export ); + +use strict; +use vars qw(@ISA %info $version $replace_ok_kludge $product_info); +use Tie::IxHash; +use FS::Record qw( qsearchs ); +use FS::svc_external; +use SOAP::Lite; +use XML::Simple qw( xml_in ); +use Data::Dumper; + +$version = '01'; + +my $product_info; +my %language_id = ( English => 1, Spanish => 2 ); + +tie my %options, 'Tie::IxHash', + 'site_id' => { label => 'Site ID' }, + 'clerk_id' => { label => 'Clerk ID' }, +# 'product_id' => { label => 'Product ID' }, use the 'title' field +# 'amount' => { label => 'Purchase amount' }, + 'language' => { label => 'Language', + type => 'select', + options => [ 'English', 'Spanish' ], + }, + + 'debug' => { label => 'Debug level', + type => 'select', options => [0, 1, 2 ] }, +; + +%info = ( + 'svc' => 'svc_external', + 'desc' => 'Purchase EZ-Prepaid PIN', + 'options' => \%options, + 'notes' => <<'END' +

Export to the EZ-Prepaid PIN purchase service. If the purchase is allowed, +the PIN will be stored as svc_external.id.

+

svc_external.title must contain the product ID, and should be set as a fixed +field in the service definition. For a list of product IDs, see the +"Merchant Info" tab in the EZ Prepaid reseller portal.

+END + ); + +$replace_ok_kludge = 0; + +sub _export_insert { + my ($self, $svc_external) = @_; + + # the name on the certificate is 'debisys.com', for some reason + local $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}=0; + + my $pin = eval { $self->ez_prepaid_PinDistSale( $svc_external->title ) }; + return $@ if $@; + + local($replace_ok_kludge) = 1; + $svc_external->set('id', $pin); + $svc_external->replace; +} + +sub _export_replace { + $replace_ok_kludge ? '' : "can't change PIN after purchase"; +} + +sub _export_delete { + "can't delete PIN after purchase"; +} + +# possibly options at some point to relate these to agentnum/usernum +sub site_id { $_[0]->option('site_id') } + +sub clerk_id { $_[0]->option('clerk_id') } + +sub ez_prepaid_PinDistSale { + my $self = shift; + my $product_id = shift; + $self->ez_prepaid_init; # populate product ID cache + my $info = $product_info->{$product_id}; + if ( $info ) { + if ( $self->option('debug') ) { + warn "Purchasing PIN product #$product_id:\n" . + $info->{Description}."\n". + $info->{CurrencyCode} . ' ' .$info->{Amount}."\n"; + } + } else { #no $info + die "Unknown PIN product #$product_id.\n"; + } + + my $response = $self->ez_prepaid_request( + 'PinDistSale', + $version, + $self->site_id, + $self->clerk_id, + $product_id, + '', # AccountID, not used for PIN sale + $product_info->{$product_id}->{Amount}, + $self->svcnum, + ($language_id{ $self->option('language') } || 1), + ); + if ( $self->option('debug') ) { + warn Dumper($response); + # includes serial number and transaction ID, possibly useful + # (but we don't have a structured place to store it--maybe in + # a customer note?) + } + $response->{Pin}; +} + +sub ez_prepaid_init { + # returns the SOAP client object + my $self = shift; + my $wsdl = 'https://webservice.ez-prepaid.com/soap/webServices.wsdl'; + + if ( $self->option('debug') >= 2 ) { + SOAP::Lite->import(+trace => [transport => \&log_transport ]); + } + + if ( !$self->client ) { + $self->set(client => SOAP::Lite->new->service($wsdl)); + # I don't know if this can happen, but better to bail out here + # than go into recursion. + die "Error creating SOAP client\n" if !$self->client; + } + + if ( !defined($product_info) ) { + # for now we only support the 'PIN' type + my $response = $self->ez_prepaid_request( + 'GetTransTypeList', $version, $self->site_id, '', '', '', '' + ); + my %transtype = map { $_->{Description} => $_->{TransTypeId} } + @{ $response->{TransType} }; + + if ( !exists $transtype{PIN} ) { + warn "'PIN' transaction type not available.\n"; + # or else your site ID is wrong + return; + } + + $response = $self->ez_prepaid_request( + 'GetProductList', + $version, + $self->option('site_id'), + $transtype{PIN}, + '', #CarrierId + '', #CategoryId + '', #ProductId + ); + $product_info = +{ + map { $_->{ProductId} => $_ } + @{ $response->{Product} } + }; + } #!defined $product_info +} + +sub log_transport { + my $in = shift; + if ( UNIVERSAL::can($in, 'content') ) { + warn $in->content."\n"; + } +} + +my @ForceArray = qw(TransType Product); # add others as needed +sub ez_prepaid_request { + my $self = shift; + # takes a method name and param list, + # returns a hashref containing the unpacked response + # or dies on error + + $self->ez_prepaid_init if !$self->client; + + my $method = shift; + my $xml = $self->client->$method(@_); + # All of their response data types are one part, a string, containing + # an encoded XML structure, containing the fields described in the docs. + my $response = xml_in($xml, ForceArray => \@ForceArray); + if ( exists($response->{ResponseCode}) && $response->{ResponseCode} > 0 ) { + die "[$method] ".$response->{ResponseMessage}; + } + $response; +} + +1; -- cgit v1.2.1 From c1cabbc4cea2e0cfd9e1db668100b97069140cf5 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 26 Jul 2012 14:02:36 -0700 Subject: add anniversary date, RT#18631 --- FS/FS/Conf.pm | 7 +++++++ FS/FS/Schema.pm | 1 + FS/FS/cust_main.pm | 4 +++- FS/FS/cust_main/Import.pm | 3 ++- FS/FS/cust_main/Search.pm | 6 +++++- 5 files changed, 18 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 7e641308b..043594536 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3652,6 +3652,13 @@ and customer address. Include units.', 'type' => 'checkbox', }, + { + 'key' => 'cust_main-enable_anniversary_date', + 'section' => 'UI', + 'description' => 'Enable tracking of an anniversary date with each customer record', + 'type' => 'checkbox', + }, + { 'key' => 'cust_main-edit_calling_list_exempt', 'section' => 'UI', diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 797b70549..3fc26b071 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -858,6 +858,7 @@ sub tables_hashref { 'stateid_state', 'varchar', 'NULL', $char_d, '', '', 'birthdate' ,@date_type, '', '', 'spouse_birthdate' ,@date_type, '', '', + 'anniversary_date' ,@date_type, '', '', 'signupdate',@date_type, '', '', 'dundate', @date_type, '', '', 'company', 'varchar', 'NULL', $char_d, '', '', diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 82b09b61f..78791dd57 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1779,8 +1779,10 @@ sub check { || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') - || $self->ut_snumbern('birthdate') || $self->ut_snumbern('signupdate') + || $self->ut_snumbern('birthdate') + || $self->ut_snumbern('spouse_birthdate') + || $self->ut_snumbern('anniversary_date') || $self->ut_textn('company') || $self->ut_anything('comments') || $self->ut_numbern('referral_custnum') diff --git a/FS/FS/cust_main/Import.pm b/FS/FS/cust_main/Import.pm index 6681f9ec2..ee14cbaed 100644 --- a/FS/FS/cust_main/Import.pm +++ b/FS/FS/cust_main/Import.pm @@ -375,7 +375,8 @@ sub batch_import { } $cust_main{$_} = parse_datetime($cust_main{$_}) - foreach grep $cust_main{$_}, qw( birthdate spouse_birthdate ); + foreach grep $cust_main{$_}, + qw( birthdate spouse_birthdate anniversary_date ); my $invoicing_list = $cust_main{'invoicing_list'} ? [ delete $cust_main{'invoicing_list'} ] diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm index b528a689c..b213bbcbe 100644 --- a/FS/FS/cust_main/Search.pm +++ b/FS/FS/cust_main/Search.pm @@ -475,6 +475,10 @@ listref of start date, end date listref of start date, end date +=item anniversary_date + +listref of start date, end date + =item payby listref @@ -617,7 +621,7 @@ sub search { # dates ## - foreach my $field (qw( signupdate birthdate spouse_birthdate )) { + foreach my $field (qw( signupdate birthdate spouse_birthdate anniversary_date )) { next unless exists($params->{$field}); -- cgit v1.2.1 From b0651fcfbe21c6f97c164ce0996fa281db5100b0 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 26 Jul 2012 18:18:04 -0700 Subject: when Email invoices is set to no, don't send payment receipt Statement invoice either, RT#17676 --- FS/FS/cust_pay.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index c11738665..d28997ccd 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -662,7 +662,7 @@ sub send_receipt { } - } else { #not manual + } elsif ( ! $cust_main->invoice_noemail ) { #not manual my $queue = new FS::queue { 'paynum' => $self->paynum, -- cgit v1.2.1 From f578e57b593adb9254b2e465c73116a0e0e617b5 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sun, 29 Jul 2012 17:57:24 -0700 Subject: update customer list and zip code report to use cust_location, #940 --- FS/FS/cust_main/Search.pm | 15 +++++++++++++++ 1 file changed, 15 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm index b213bbcbe..2d347e140 100644 --- a/FS/FS/cust_main/Search.pm +++ b/FS/FS/cust_main/Search.pm @@ -457,6 +457,8 @@ HASHREF. Valid parameters are =item address +=item zip + =item refnum =item cancelled_pkgs @@ -516,6 +518,7 @@ sub search { 'usernum' => '', 'status' => '', 'address' => '', + 'zip' => '', 'paydate_year' => '', 'invoice_terms' => '', 'custbatch' => '', @@ -578,6 +581,18 @@ sub search { )"; } + ## + # zipcode + ## + if ( $params->{'zip'} =~ /\S/ ) { + my $zip = dbh->quote($params->{'zip'} . '%'); + push @where, "EXISTS( + SELECT 1 FROM cust_location + WHERE cust_location.custnum = cust_main.custnum + AND cust_location.zip LIKE $zip + )"; + } + ### # refnum ### -- cgit v1.2.1 From 98a2c1d79af4c475e8245651a79ded35ce3391dd Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 30 Jul 2012 14:50:23 -0700 Subject: fix package changes/cancels with credits turned on, for delayed packages, RT#18576 --- FS/FS/part_pkg/delayed_Mixin.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_pkg/delayed_Mixin.pm b/FS/FS/part_pkg/delayed_Mixin.pm index d28480db2..83e543a4f 100644 --- a/FS/FS/part_pkg/delayed_Mixin.pm +++ b/FS/FS/part_pkg/delayed_Mixin.pm @@ -2,6 +2,7 @@ package FS::part_pkg::delayed_Mixin; use strict; use vars qw(%info); +use NEXT; %info = ( 'disabled' => 1, @@ -45,7 +46,7 @@ sub calc_remain { && $last_bill == $cust_pkg->setup; } - return $self->SUPER::calc_remain($cust_pkg, %options); + return $self->NEXT::calc_remain($cust_pkg, %options); } sub can_start_date { ! shift->option('delay_setup', 1) } -- cgit v1.2.1 From dddedb2754d6cd24edfde9a6d25bc687f488e5ec Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 30 Jul 2012 16:33:32 -0700 Subject: fix multiple RADIUS group attributes with same name, RT#18580 --- FS/FS/Schema.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index ff40cd673..cfb806007 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2518,8 +2518,8 @@ sub tables_hashref { 'op', 'char', '', 2, '', '', ], 'primary_key' => 'attrnum', - 'unique' => [ ['groupnum','attrname'] ], #? - 'index' => [], + 'unique' => [], + 'index' => [ ['groupnum'], ], }, 'msgcat' => { -- cgit v1.2.1 From ee8a023fff0a259b0c62b46b260a396805ad2f00 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 30 Jul 2012 21:08:02 -0700 Subject: correctly export RADIUS attributes with the same name, #18695 --- FS/FS/part_export/sqlradius.pm | 103 ++++++++++++++++------------------------- 1 file changed, 39 insertions(+), 64 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index c360c9ef0..d7cd459d8 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -347,6 +347,7 @@ sub _export_delete { sub sqlradius_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); + my %args = @_; my $queue = new FS::queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::sqlradius::sqlradius_$method", @@ -966,8 +967,7 @@ are identified by the combination of group name and attribute name. In the special case where attributes are being replaced because a group name (L->groupname) is changing, the pseudo-field -'groupname' must be set in OLD_RADIUS_ATTR. It's probably best to do this - +'groupname' must be set in OLD_RADIUS_ATTR. =cut @@ -982,41 +982,43 @@ sub export_attr_replace { shift->export_attr_action('replace', @_); } sub export_attr_action { my $self = shift; my ($action, $new, $old) = @_; - my ($attrname, $attrtype, $groupname) = - ($new->attrname, $new->attrtype, $new->radius_group->groupname); - if ( $action eq 'replace' ) { - - if ( $new->attrtype ne $old->attrtype ) { - # they're in separate tables in the target - return $self->export_attr_action('delete', $old) - || $self->export_attr_action('insert', $new) - ; - } + my $err_or_queue; - # otherwise, just make sure we know the old attribute/group names - # so we can find the existing record - $attrname = $old->attrname; - $groupname = $old->groupname || $old->radius_group->groupname; - # maybe this should be enforced more strictly - warn "WARNING: attribute replace without 'groupname' set; assuming '$groupname'\n" - if !defined($old->groupname); + if ( $action eq 'delete' ) { + $old = $new; + } + if ( $action eq 'delete' or $action eq 'replace' ) { + # delete based on an exact match + my %opt = ( + attrname => $old->attrname, + attrtype => $old->attrtype, + groupname => $old->groupname || $old->radius_group->groupname, + op => $old->op, + value => $old->value, + ); + $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt); + return $err_or_queue unless ref $err_or_queue; + } + # this probably doesn't matter, but just to be safe... + my $jobnum = $err_or_queue->jobnum if $action eq 'replace'; + if ( $action eq 'replace' or $action eq 'insert' ) { + my %opt = ( + attrname => $new->attrname, + attrtype => $new->attrtype, + groupname => $new->radius_group->groupname, + op => $new->op, + value => $new->value, + ); + $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt); + $err_or_queue->depend_insert($jobnum) if $jobnum; + return $err_or_queue unless ref $err_or_queue; } - - my $err_or_queue = $self->sqlradius_queue('', "attr_$action", - attrnum => $new->attrnum, - attrname => $attrname, - attrtype => $attrtype, - groupname => $groupname, - ); - return $err_or_queue unless ref $err_or_queue; ''; } sub sqlradius_attr_insert { my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; - my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} }) - or die 'attrnum '.$opt{'attrnum'}.' not found'; my $table; # make sure $table is completely safe @@ -1027,12 +1029,10 @@ sub sqlradius_attr_insert { $table = 'radgroupreply'; } else { - die "unknown attribute type '".$radius_attr->attrtype."'"; + die "unknown attribute type '$opt{attrtype}'"; } - my @values = ( - $opt{'groupname'}, map { $radius_attr->$_ } qw(attrname op value) - ); + my @values = @opt{ qw(groupname attrname op value) }; my $sth = $dbh->prepare( 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)' ); @@ -1054,41 +1054,16 @@ sub sqlradius_attr_delete { die "unknown attribute type '".$opt{'attrtype'}."'"; } + my @values = @opt{ qw(groupname attrname op value) }; my $sth = $dbh->prepare( - 'DELETE FROM '.$table.' WHERE groupname = ? AND attribute = ?' + 'DELETE FROM '.$table. + ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'. + ' LIMIT 1' ); - $sth->execute( @opt{'groupname', 'attrname'} ) or die $dbh->errstr; + $sth->execute(@values) or die $dbh->errstr; } -sub sqlradius_attr_replace { - my $dbh = sqlradius_connect(shift, shift, shift); - my %opt = @_; - my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} }) - or die 'attrnum '.$opt{'attrnum'}.' not found'; - - my $table; - if ( $opt{'attrtype'} eq 'C' ) { - $table = 'radgroupcheck'; - } - elsif ( $opt{'attrtype'} eq 'R' ) { - $table = 'radgroupreply'; - } - else { - die "unknown attribute type '".$opt{'attrtype'}."'"; - } - - my $sth = $dbh->prepare( - 'UPDATE '.$table.' SET groupname = ?, attribute = ?, op = ?, value = ? - WHERE groupname = ? AND attribute = ?' - ); - - my $new_groupname = $radius_attr->radius_group->groupname; - my @new_values = ( - $new_groupname, map { $radius_attr->$_ } qw(attrname op value) - ); - $sth->execute( @new_values, @opt{'groupname', 'attrname'} ) - or die $dbh->errstr; -} +#sub sqlradius_attr_replace { no longer needed =item export_group_replace NEW OLD -- cgit v1.2.1 From 6cce5ada4fbf1e9ad7debd0451336e8005c12195 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 31 Jul 2012 14:00:14 -0700 Subject: add strip_tld option to sqlradius_withdomain export, RT#18718 --- FS/FS/part_export/sqlradius_withdomain.pm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm index e5a7151a2..2af9e8d76 100644 --- a/FS/FS/part_export/sqlradius_withdomain.pm +++ b/FS/FS/part_export/sqlradius_withdomain.pm @@ -6,11 +6,16 @@ use FS::part_export::sqlradius; tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; +$options{'strip_tld'} = { type => 'checkbox', + label => 'Strip TLD from realm names', + }; + %info = ( 'svc' => 'svc_acct', 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) with realms', 'options' => \%options, 'nodomain' => '', + 'default_svc_class' => 'Internet', 'notes' => $FS::part_export::sqlradius::notes1. 'This export exports domains to RADIUS realms (see also '. 'sqlradius). '. @@ -21,7 +26,11 @@ tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; sub export_username { my($self, $svc_acct) = (shift, shift); - $svc_acct->email; + my $email = $svc_acct->email; + if ( $self->option('strip_tld') ) { + $email =~ s/\.\w+$//; + } + $email; } 1; -- cgit v1.2.1 From f24c4bebce257bfcc61ba07fd3d16c5c0d730071 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 31 Jul 2012 23:02:14 -0700 Subject: invoice voiding, RT#18677 --- FS/FS/AccessRight.pm | 3 +- FS/FS/Schema.pm | 159 ++++++++++++++++++- FS/FS/access_right.pm | 1 + FS/FS/cust_bill.pm | 59 ++++++- FS/FS/cust_bill_pkg.pm | 77 ++++++++- FS/FS/cust_bill_pkg_detail_void.pm | 168 ++++++++++++++++++++ FS/FS/cust_bill_pkg_display_void.pm | 132 ++++++++++++++++ FS/FS/cust_bill_pkg_tax_location_void.pm | 139 +++++++++++++++++ FS/FS/cust_bill_pkg_tax_rate_location_void.pm | 139 +++++++++++++++++ FS/FS/cust_bill_pkg_void.pm | 181 +++++++++++++++++++++ FS/FS/cust_bill_void.pm | 217 ++++++++++++++++++++++++++ FS/FS/cust_main.pm | 18 ++- FS/FS/cust_tax_exempt_pkg_void.pm | 138 ++++++++++++++++ 13 files changed, 1421 insertions(+), 10 deletions(-) create mode 100644 FS/FS/cust_bill_pkg_detail_void.pm create mode 100644 FS/FS/cust_bill_pkg_display_void.pm create mode 100644 FS/FS/cust_bill_pkg_tax_location_void.pm create mode 100644 FS/FS/cust_bill_pkg_tax_rate_location_void.pm create mode 100644 FS/FS/cust_bill_pkg_void.pm create mode 100644 FS/FS/cust_bill_void.pm create mode 100644 FS/FS/cust_tax_exempt_pkg_void.pm (limited to 'FS') diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 4de29481d..ebf66e64c 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -177,7 +177,8 @@ tie my %rights, 'Tie::IxHash', 'Customer invoice / financial info rights' => [ 'View invoices', 'Resend invoices', #NEWNEW - 'Delete invoices', #new, but no need to phase in + 'Void invoices', + 'Delete invoices', 'View customer tax exemptions', #yow 'Add customer tax adjustment', #new, but no need to phase in 'View customer batched payments', #NEW diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index cfb806007..e59268b2a 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -551,6 +551,35 @@ sub tables_hashref { 'index' => [ ['custnum'], ['_date'], ['statementnum'], ['agent_invid'] ], }, + 'cust_bill_void' => { + 'columns' => [ + #regular fields + 'invnum', 'int', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'charged', @money_type, '', '', + 'invoice_terms', 'varchar', 'NULL', $char_d, '', '', + + #customer balance info at invoice generation time + 'previous_balance', @money_typen, '', '', #eventually not nullable + 'billing_balance', @money_typen, '', '', #eventually not nullable + + #specific use cases + 'closed', 'char', 'NULL', 1, '', '', #not yet used much + 'statementnum', 'int', 'NULL', '', '', '', #invoice aggregate statements + 'agent_invid', 'int', 'NULL', '', '', '', #(varchar?) importing legacy + 'promised_date', @date_type, '', '', + + #void fields + 'void_date', @date_type, '', '', + 'reason', 'varchar', 'NULL', $char_d, '', '', + 'void_usernum', 'int', 'NULL', '', '', '', + ], + 'primary_key' => 'invnum', + 'unique' => [ [ 'custnum', 'agent_invid' ] ], #agentnum? huh + 'index' => [ ['custnum'], ['_date'], ['statementnum'], ['agent_invid'], [ 'void_usernum' ] ], + }, + #for importing invoices from a legacy system for display purposes only # no effect upon balance 'legacy_cust_bill' => { @@ -787,6 +816,101 @@ sub tables_hashref { 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'taxratelocationnum' ] ], }, + 'cust_bill_pkg_void' => { + 'columns' => [ + 'billpkgnum', 'int', '', '', '', '', + 'invnum', 'int', '', '', '', '', + 'pkgnum', 'int', '', '', '', '', + 'pkgpart_override', 'int', 'NULL', '', '', '', + 'setup', @money_type, '', '', + 'recur', @money_type, '', '', + 'sdate', @date_type, '', '', + 'edate', @date_type, '', '', + 'itemdesc', 'varchar', 'NULL', $char_d, '', '', + 'itemcomment', 'varchar', 'NULL', $char_d, '', '', + 'section', 'varchar', 'NULL', $char_d, '', '', + 'freq', 'varchar', 'NULL', $char_d, '', '', + 'quantity', 'int', 'NULL', '', '', '', + 'unitsetup', @money_typen, '', '', + 'unitrecur', @money_typen, '', '', + 'hidden', 'char', 'NULL', 1, '', '', + #void fields + 'void_date', @date_type, '', '', + 'reason', 'varchar', 'NULL', $char_d, '', '', + 'void_usernum', 'int', 'NULL', '', '', '', + ], + 'primary_key' => 'billpkgnum', + 'unique' => [], + 'index' => [ ['invnum'], [ 'pkgnum' ], [ 'itemdesc' ], [ 'void_usernum' ], ], + }, + + 'cust_bill_pkg_detail_void' => { + 'columns' => [ + 'detailnum', 'int', '', '', '', '', + 'billpkgnum', 'int', 'NULL', '', '', '', # should not be nullable + 'pkgnum', 'int', 'NULL', '', '', '', # deprecated + 'invnum', 'int', 'NULL', '', '', '', # deprecated + 'amount', 'decimal', 'NULL', '10,4', '', '', + 'format', 'char', 'NULL', 1, '', '', + 'classnum', 'int', 'NULL', '', '', '', + 'duration', 'int', 'NULL', '', 0, '', + 'phonenum', 'varchar', 'NULL', 15, '', '', + 'accountcode', 'varchar', 'NULL', 20, '', '', + 'startdate', @date_type, '', '', + 'regionname', 'varchar', 'NULL', $char_d, '', '', + 'detail', 'varchar', '', 255, '', '', + ], + 'primary_key' => 'detailnum', + 'unique' => [], + 'index' => [ [ 'billpkgnum' ], [ 'classnum' ], [ 'pkgnum', 'invnum' ] ], + }, + + 'cust_bill_pkg_display_void' => { + 'columns' => [ + 'billpkgdisplaynum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'section', 'varchar', 'NULL', $char_d, '', '', + #'unitsetup', @money_typen, '', '', #override the linked real one? + #'unitrecur', @money_typen, '', '', #this too? + 'post_total', 'char', 'NULL', 1, '', '', + 'type', 'char', 'NULL', 1, '', '', + 'summary', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'billpkgdisplaynum', + 'unique' => [], + 'index' => [ ['billpkgnum'], ], + }, + + 'cust_bill_pkg_tax_location_void' => { + 'columns' => [ + 'billpkgtaxlocationnum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'taxtype', 'varchar', '', $char_d, '', '', + 'pkgnum', 'int', '', '', '', '', + 'locationnum', 'int', '', '', '', '', #redundant? + 'amount', @money_type, '', '', + ], + 'primary_key' => 'billpkgtaxlocationnum', + 'unique' => [], + 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'pkgnum' ], [ 'locationnum' ] ], + }, + + 'cust_bill_pkg_tax_rate_location_void' => { + 'columns' => [ + 'billpkgtaxratelocationnum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'taxtype', 'varchar', '', $char_d, '', '', + 'locationtaxid', 'varchar', 'NULL', $char_d, '', '', + 'taxratelocationnum', 'int', '', '', '', '', + 'amount', @money_type, '', '', + ], + 'primary_key' => 'billpkgtaxratelocationnum', + 'unique' => [], + 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'taxratelocationnum' ] ], + }, + 'cust_credit' => { 'columns' => [ 'crednum', 'serial', '', '', '', '', @@ -1419,20 +1543,29 @@ sub tables_hashref { 'columns' => [ 'paynum', 'int', '', '', '', '', 'custnum', 'int', '', '', '', '', - 'paid', @money_type, '', '', '_date', @date_type, '', '', + 'paid', @money_type, '', '', + 'otaker', 'varchar', 'NULL', 32, '', '', + 'usernum', 'int', 'NULL', '', '', '', 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be # index into payby table # eventually 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above 'paymask', 'varchar', 'NULL', $char_d, '', '', + #'paydate' ? 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. 'closed', 'char', 'NULL', 1, '', '', 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances + # cash/check deposit info fields + 'bank', 'varchar', 'NULL', $char_d, '', '', + 'depositor', 'varchar', 'NULL', $char_d, '', '', + 'account', 'varchar', 'NULL', 20, '', '', + 'teller', 'varchar', 'NULL', 20, '', '', + 'batchnum', 'int', 'NULL', '', '', '', #pay_batch foreign key + + #void fields 'void_date', @date_type, '', '', 'reason', 'varchar', 'NULL', $char_d, '', '', - 'otaker', 'varchar', 'NULL', 32, '', '', - 'usernum', 'int', 'NULL', '', '', '', 'void_usernum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'paynum', @@ -2568,6 +2701,26 @@ sub tables_hashref { ], }, + 'cust_tax_exempt_pkg_void' => { + 'columns' => [ + 'exemptpkgnum', 'int', '', '', '', '', + #'custnum', 'int', '', '', '', '' + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'year', 'int', '', '', '', '', + 'month', 'int', '', '', '', '', + 'creditbillpkgnum', 'int', 'NULL', '', '', '', + 'amount', @money_type, '', '', + ], + 'primary_key' => 'exemptpkgnum', + 'unique' => [], + 'index' => [ [ 'taxnum', 'year', 'month' ], + [ 'billpkgnum' ], + [ 'taxnum' ], + [ 'creditbillpkgnum' ], + ], + }, + 'router' => { 'columns' => [ 'routernum', 'serial', '', '', '', '', diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index e6266b49b..bc57364d2 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -193,6 +193,7 @@ sub _upgrade_data { # class method 'Suspend customer package' => 'Suspend customer', 'Unsuspend customer package' => 'Unsuspend customer', 'New prospect' => 'Generate quotation', + 'Delete invoices' => 'Void invoices', 'List services' => [ 'Services: Accounts', 'Services: Domains', diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index c3d48a61c..c5b707bb1 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -38,6 +38,7 @@ use FS::cust_bill_batch; use FS::cust_bill_pay_pkg; use FS::cust_credit_bill_pkg; use FS::discount_plan; +use FS::cust_bill_void; use FS::L10N; $DEBUG = 0; @@ -203,10 +204,63 @@ sub insert { } +=item void + +Voids this invoice: deletes the invoice and adds a record of the voided invoice +to the FS::cust_bill_void table (and related tables starting from +FS::cust_bill_pkg_void). + +=cut + +sub void { + my $self = shift; + my $reason = scalar(@_) ? shift : ''; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $cust_bill_void = new FS::cust_bill_void ( { + map { $_ => $self->get($_) } $self->fields + } ); + $cust_bill_void->reason($reason); + my $error = $cust_bill_void->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { + my $error = $cust_bill_pkg->void($reason); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item delete This method now works but you probably shouldn't use it. Instead, apply a -credit against the invoice. +credit against the invoice, or use the new void method. Using this method to delete invoices outright is really, really bad. There would be no record you ever posted this invoice, and there are no check to @@ -236,11 +290,10 @@ sub delete { cust_event cust_credit_bill cust_bill_pay - cust_credit_bill cust_pay_batch cust_bill_pay_batch - cust_bill_pkg cust_bill_batch + cust_bill_pkg )) { foreach my $linked ( $self->$table() ) { diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 4220d3c06..2ceef0474 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -3,6 +3,7 @@ package FS::cust_bill_pkg; use strict; use vars qw( @ISA $DEBUG $me ); use Carp; +use List::Util qw( sum ); use Text::CSV_XS; use FS::Record qw( qsearch qsearchs dbdef dbh ); use FS::cust_main_Mixin; @@ -18,8 +19,12 @@ use FS::cust_tax_exempt_pkg; use FS::cust_bill_pkg_tax_location; use FS::cust_bill_pkg_tax_rate_location; use FS::cust_tax_adjustment; - -use List::Util qw(sum); +use FS::cust_bill_pkg_void; +use FS::cust_bill_pkg_detail_void; +use FS::cust_bill_pkg_display_void; +use FS::cust_bill_pkg_tax_location_void; +use FS::cust_bill_pkg_tax_rate_location_void; +use FS::cust_tax_exempt_pkg_void; @ISA = qw( FS::cust_main_Mixin FS::Record ); @@ -230,6 +235,74 @@ sub insert { } +=item void + +Voids this line item: deletes the line item and adds a record of the voided +line item to the FS::cust_bill_pkg_void table (and related tables). + +=cut + +sub void { + my $self = shift; + my $reason = scalar(@_) ? shift : ''; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $cust_bill_pkg_void = new FS::cust_bill_pkg_void ( { + map { $_ => $self->get($_) } $self->fields + } ); + $cust_bill_pkg_void->reason($reason); + my $error = $cust_bill_pkg_void->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $table (qw( + cust_bill_pkg_detail + cust_bill_pkg_display + cust_bill_pkg_tax_location + cust_bill_pkg_tax_rate_location + cust_tax_exempt_pkg + )) { + + foreach my $linked ( qsearch($table, { billpkgnum=>$self->billpkgnum }) ) { + + my $vclass = 'FS::'.$table.'_void'; + my $void = $vclass->new( { + map { $_ => $linked->get($_) } $linked->fields + }); + my $error = $void->insert || $linked->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + } + + $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item delete Not recommended. diff --git a/FS/FS/cust_bill_pkg_detail_void.pm b/FS/FS/cust_bill_pkg_detail_void.pm new file mode 100644 index 000000000..cebe7c1f8 --- /dev/null +++ b/FS/FS/cust_bill_pkg_detail_void.pm @@ -0,0 +1,168 @@ +package FS::cust_bill_pkg_detail_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::usage_class; + +=head1 NAME + +FS::cust_bill_pkg_detail_void - Object methods for cust_bill_pkg_detail_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_detail_void; + + $record = new FS::cust_bill_pkg_detail_void \%hash; + $record = new FS::cust_bill_pkg_detail_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_detail_void object represents additional detail +information for a voided invoice line item. FS::cust_bill_pkg_detail_void +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item detailnum + +primary key + +=item billpkgnum + +billpkgnum + +=item pkgnum + +pkgnum + +=item invnum + +invnum + +=item amount + +amount + +=item format + +format + +=item classnum + +classnum + +=item duration + +duration + +=item phonenum + +phonenum + +=item accountcode + +accountcode + +=item startdate + +startdate + +=item regionname + +regionname + +=item detail + +detail + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_bill_pkg_detail_void'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('detailnum') + || $self->ut_foreign_keyn('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum') + || $self->ut_numbern('pkgnum') + || $self->ut_numbern('invnum') + || $self->ut_floatn('amount') + || $self->ut_enum('format', [ '', 'C' ] ) + || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum') + || $self->ut_numbern('duration') + || $self->ut_textn('phonenum') + || $self->ut_textn('accountcode') + || $self->ut_numbern('startdate') + || $self->ut_textn('regionname') + || $self->ut_text('detail') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill_pkg_display_void.pm b/FS/FS/cust_bill_pkg_display_void.pm new file mode 100644 index 000000000..e78801a36 --- /dev/null +++ b/FS/FS/cust_bill_pkg_display_void.pm @@ -0,0 +1,132 @@ +package FS::cust_bill_pkg_display_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; + +=head1 NAME + +FS::cust_bill_pkg_display_void - Object methods for cust_bill_pkg_display_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_display_void; + + $record = new FS::cust_bill_pkg_display_void \%hash; + $record = new FS::cust_bill_pkg_display_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_display_void object represents voided line item display +information. FS::cust_bill_pkg_display_void inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item billpkgdisplaynum + +primary key + +=item billpkgnum + +billpkgnum + +=item section + +section + +=item post_total + +post_total + +=item type + +type + +=item summary + +summary + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_bill_pkg_display_void'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('billpkgdisplaynum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum') + || $self->ut_textn('section') + || $self->ut_enum('post_total', [ '', 'Y' ]) + || $self->ut_enum('type', [ '', 'S', 'R', 'U' ]) + || $self->ut_enum('summary', [ '', 'Y' ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill_pkg_tax_location_void.pm b/FS/FS/cust_bill_pkg_tax_location_void.pm new file mode 100644 index 000000000..9e0794bad --- /dev/null +++ b/FS/FS/cust_bill_pkg_tax_location_void.pm @@ -0,0 +1,139 @@ +package FS::cust_bill_pkg_tax_location_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::cust_pkg; +use FS::cust_location; + +=head1 NAME + +FS::cust_bill_pkg_tax_location_void - Object methods for cust_bill_pkg_tax_location_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_tax_location_void; + + $record = new FS::cust_bill_pkg_tax_location_void \%hash; + $record = new FS::cust_bill_pkg_tax_location_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_tax_location_void object represents a voided record +of taxation based on package location. FS::cust_bill_pkg_tax_location_void +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item billpkgtaxlocationnum + +primary key + +=item billpkgnum + +billpkgnum + +=item taxnum + +taxnum + +=item taxtype + +taxtype + +=item pkgnum + +pkgnum + +=item locationnum + +locationnum + +=item amount + +amount + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_bill_pkg_tax_location_void'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('billpkgtaxlocationnum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum' ) + || $self->ut_number('taxnum') #cust_bill_pkg/tax_rate key, based on taxtype + || $self->ut_enum('taxtype', [ qw( FS::cust_main_county FS::tax_rate ) ] ) + || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum' ) + || $self->ut_foreign_key('locationnum', 'cust_location', 'locationnum' ) + || $self->ut_money('amount') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill_pkg_tax_rate_location_void.pm b/FS/FS/cust_bill_pkg_tax_rate_location_void.pm new file mode 100644 index 000000000..f2e85c085 --- /dev/null +++ b/FS/FS/cust_bill_pkg_tax_rate_location_void.pm @@ -0,0 +1,139 @@ +package FS::cust_bill_pkg_tax_rate_location_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::tax_rate_location; + +=head1 NAME + +FS::cust_bill_pkg_tax_rate_location_void - Object methods for cust_bill_pkg_tax_rate_location_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_tax_rate_location_void; + + $record = new FS::cust_bill_pkg_tax_rate_location_void \%hash; + $record = new FS::cust_bill_pkg_tax_rate_location_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_tax_rate_location_void object represents a voided record +of taxation based on package location. +FS::cust_bill_pkg_tax_rate_location_void inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item billpkgtaxratelocationnum + +primary key + +=item billpkgnum + +billpkgnum + +=item taxnum + +taxnum + +=item taxtype + +taxtype + +=item locationtaxid + +locationtaxid + +=item taxratelocationnum + +taxratelocationnum + +=item amount + +amount + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_bill_pkg_tax_rate_location_void'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('billpkgtaxratelocationnum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum' ) + || $self->ut_number('taxnum') #cust_bill_pkg/tax_rate key, based on taxtype + || $self->ut_text('taxtype', [ qw( FS::cust_main_county FS::tax_rate ) ] ) + || $self->ut_textn('locationtaxid') + || $self->ut_foreign_key('taxratelocationnum', 'tax_rate_location', 'taxratelocationnum' ) + || $self->ut_money('amount') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill_pkg_void.pm b/FS/FS/cust_bill_pkg_void.pm new file mode 100644 index 000000000..198283955 --- /dev/null +++ b/FS/FS/cust_bill_pkg_void.pm @@ -0,0 +1,181 @@ +package FS::cust_bill_pkg_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); + +=head1 NAME + +FS::cust_bill_pkg_void - Object methods for cust_bill_pkg_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_void; + + $record = new FS::cust_bill_pkg_void \%hash; + $record = new FS::cust_bill_pkg_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_void object represents a voided invoice line item. +FS::cust_bill_pkg_void inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item billpkgnum + +primary key + +=item invnum + +invnum + +=item pkgnum + +pkgnum + +=item pkgpart_override + +pkgpart_override + +=item setup + +setup + +=item recur + +recur + +=item sdate + +sdate + +=item edate + +edate + +=item itemdesc + +itemdesc + +=item itemcomment + +itemcomment + +=item section + +section + +=item freq + +freq + +=item quantity + +quantity + +=item unitsetup + +unitsetup + +=item unitrecur + +unitrecur + +=item hidden + +hidden + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_bill_pkg_void'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('billpkgnum') + || $self->ut_snumber('pkgnum') + || $self->ut_number('invnum') #cust_bill or cust_bill_void ? + || $self->ut_numbern('pkgpart_override') + || $self->ut_money('setup') + || $self->ut_money('recur') + || $self->ut_numbern('sdate') + || $self->ut_numbern('edate') + || $self->ut_textn('itemdesc') + || $self->ut_textn('itemcomment') + || $self->ut_textn('section') + || $self->ut_textn('freq') + || $self->ut_numbern('quantity') + || $self->ut_moneyn('unitsetup') + || $self->ut_moneyn('unitrecur') + || $self->ut_enum('hidden', [ '', 'Y' ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill_void.pm b/FS/FS/cust_bill_void.pm new file mode 100644 index 000000000..c782172b5 --- /dev/null +++ b/FS/FS/cust_bill_void.pm @@ -0,0 +1,217 @@ +package FS::cust_bill_void; +use base qw( FS::Template_Mixin FS::cust_main_Mixin FS::otaker_Mixin FS::Record ); + +use strict; +use FS::Record qw( qsearchs ); #qsearch ); +use FS::cust_main; +use FS::cust_statement; +use FS::access_user; + +=head1 NAME + +FS::cust_bill_void - Object methods for cust_bill_void records + +=head1 SYNOPSIS + + use FS::cust_bill_void; + + $record = new FS::cust_bill_void \%hash; + $record = new FS::cust_bill_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_void object represents a voided invoice. FS::cust_bill_void +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item invnum + +primary key + +=item custnum + +custnum + +=item _date + +_date + +=item charged + +charged + +=item invoice_terms + +invoice_terms + +=item previous_balance + +previous_balance + +=item billing_balance + +billing_balance + +=item closed + +closed + +=item statementnum + +statementnum + +=item agent_invid + +agent_invid + +=item promised_date + +promised_date + +=item void_date + +void_date + +=item reason + +reason + +=item void_usernum + +void_usernum + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new voided invoice. To add the voided invoice to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_bill_void'; } +sub notice_name { 'VOIDED Invoice'; } +#XXXsub template_conf { 'quotation_'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid voided invoice. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_number('invnum') + || $self->ut_foreign_key('custnum', 'cust_main', 'custnum' ) + || $self->ut_numbern('_date') + || $self->ut_money('charged') + || $self->ut_textn('invoice_terms') + || $self->ut_moneyn('previous_balance') + || $self->ut_moneyn('billing_balance') + || $self->ut_enum('closed', [ '', 'Y' ]) + || $self->ut_foreign_keyn('statementnum', 'cust_statement', 'statementnum') + || $self->ut_numbern('agent_invid') + || $self->ut_numbern('promised_date') + || $self->ut_numbern('void_date') + || $self->ut_textn('reason') + || $self->ut_numbern('void_usernum') + ; + return $error if $error; + + $self->void_date(time) unless $self->void_date; + + $self->void_usernum($FS::CurrentUser::CurrentUser->usernum) + unless $self->void_usernum; + + $self->SUPER::check; +} + +=item display_invnum + +Returns the displayed invoice number for this invoice: agent_invid if +cust_bill-default_agent_invid is set and it has a value, invnum otherwise. + +=cut + +sub display_invnum { + my $self = shift; + my $conf = $self->conf; + if ( $conf->exists('cust_bill-default_agent_invid') && $self->agent_invid ){ + return $self->agent_invid; + } else { + return $self->invnum; + } +} + +=item void_access_user + +Returns the voiding employee object (see L). + +=cut + +sub void_access_user { + my $self = shift; + qsearchs('access_user', { 'usernum' => $self->void_usernum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 96029415a..36c62808c 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -42,6 +42,7 @@ use FS::payby; use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; +use FS::cust_bill_void; use FS::legacy_cust_bill; use FS::cust_pay; use FS::cust_pay_pending; @@ -1279,6 +1280,7 @@ sub merge { tie my %financial_tables, 'Tie::IxHash', 'cust_bill' => 'invoices', + 'cust_bill_void' => 'voided invoices', 'cust_statement' => 'statements', 'cust_credit' => 'credits', 'cust_pay' => 'payments', @@ -3646,6 +3648,20 @@ be passed. =cut +=item cust_bill_void + +Returns all the voided invoices (see L) for this customer. + +=cut + +sub cust_bill_void { + my $self = shift; + + map { $_ } #return $self->num_cust_bill_void unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } ) +} + sub cust_statement { my $self = shift; my $opt = ref($_[0]) ? shift : { @_ }; @@ -3802,7 +3818,7 @@ sub cust_pay_void { =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] -Returns all batched payments (see L) for this customer. +Returns all batched payments (see L) for this customer. Optionally, a list or hashref of additional arguments to the qsearch call can be passed. diff --git a/FS/FS/cust_tax_exempt_pkg_void.pm b/FS/FS/cust_tax_exempt_pkg_void.pm new file mode 100644 index 000000000..51c85b463 --- /dev/null +++ b/FS/FS/cust_tax_exempt_pkg_void.pm @@ -0,0 +1,138 @@ +package FS::cust_tax_exempt_pkg_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::cust_main_county; + +=head1 NAME + +FS::cust_tax_exempt_pkg_void - Object methods for cust_tax_exempt_pkg_void records + +=head1 SYNOPSIS + + use FS::cust_tax_exempt_pkg_void; + + $record = new FS::cust_tax_exempt_pkg_void \%hash; + $record = new FS::cust_tax_exempt_pkg_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_tax_exempt_pkg_void object represents a voided record of a customer +tax exemption. FS::cust_tax_exempt_pkg_void inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item exemptpkgnum + +primary key + +=item billpkgnum + +billpkgnum + +=item taxnum + +taxnum + +=item year + +year + +=item month + +month + +=item creditbillpkgnum + +creditbillpkgnum + +=item amount + +amount + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_tax_exempt_pkg_void'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $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('creditbillpkgnum') #no FK check, will have been del'ed + || $self->ut_money('amount') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + -- cgit v1.2.1 From 5c48396fab6b19e33dbeac6f807860441465fa3b Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 31 Jul 2012 23:05:06 -0700 Subject: invoice voiding, RT#18677 --- FS/FS/Mason.pm | 7 +++++++ FS/MANIFEST | 14 ++++++++++++++ 2 files changed, 21 insertions(+) (limited to 'FS') diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 51edd97cc..c45e783db 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -315,6 +315,13 @@ if ( -e $addl_handler_use_file ) { use FS::quotation; use FS::quotation_pkg; use FS::quotation_pkg_discount; + use FS::cust_bill_void; + use FS::cust_bill_pkg_void; + use FS::cust_bill_pkg_detail_void; + use FS::cust_bill_pkg_display_void; + use FS::cust_bill_pkg_tax_location_void; + use FS::cust_bill_pkg_tax_rate_location_void; + use FS::cust_tax_exempt_pkg_void; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/MANIFEST b/FS/MANIFEST index 590874d46..01dab2092 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -649,3 +649,17 @@ FS/quotation_pkg_discount.pm t/quotation_pkg_discount.t FS/Quotable_Mixin.pm t/Quotable_Mixin.t +FS/cust_bill_void.pm +t/cust_bill_void.t +FS/cust_bill_pkg_void.pm +t/cust_bill_pkg_void.t +FS/cust_bill_pkg_detail_void.pm +t/cust_bill_pkg_detail_void.t +FS/cust_bill_pkg_display_void.pm +t/cust_bill_pkg_display_void.t +FS/cust_bill_pkg_tax_location_void.pm +t/cust_bill_pkg_tax_location_void.t +FS/cust_bill_pkg_tax_rate_location_void.pm +t/cust_bill_pkg_tax_rate_location_void.t +FS/cust_tax_exempt_pkg_void.pm +t/cust_tax_exempt_pkg_void.t -- cgit v1.2.1 From 338eca0837fdaddbda2a34ddf8af3f815de13d26 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 31 Jul 2012 23:05:22 -0700 Subject: invoice voiding, RT#18677 --- FS/t/cust_bill_pkg_detail_void.t | 5 +++++ FS/t/cust_bill_pkg_display_void.t | 5 +++++ FS/t/cust_bill_pkg_tax_location_void.t | 5 +++++ FS/t/cust_bill_pkg_tax_rate_location_void.t | 5 +++++ FS/t/cust_bill_pkg_void.t | 5 +++++ FS/t/cust_bill_void.t | 5 +++++ 6 files changed, 30 insertions(+) create mode 100644 FS/t/cust_bill_pkg_detail_void.t create mode 100644 FS/t/cust_bill_pkg_display_void.t create mode 100644 FS/t/cust_bill_pkg_tax_location_void.t create mode 100644 FS/t/cust_bill_pkg_tax_rate_location_void.t create mode 100644 FS/t/cust_bill_pkg_void.t create mode 100644 FS/t/cust_bill_void.t (limited to 'FS') diff --git a/FS/t/cust_bill_pkg_detail_void.t b/FS/t/cust_bill_pkg_detail_void.t new file mode 100644 index 000000000..bd58c4eab --- /dev/null +++ b/FS/t/cust_bill_pkg_detail_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_detail_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_display_void.t b/FS/t/cust_bill_pkg_display_void.t new file mode 100644 index 000000000..87403e12e --- /dev/null +++ b/FS/t/cust_bill_pkg_display_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_display_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_tax_location_void.t b/FS/t/cust_bill_pkg_tax_location_void.t new file mode 100644 index 000000000..dbfea5131 --- /dev/null +++ b/FS/t/cust_bill_pkg_tax_location_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_tax_location_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_tax_rate_location_void.t b/FS/t/cust_bill_pkg_tax_rate_location_void.t new file mode 100644 index 000000000..8ebda6528 --- /dev/null +++ b/FS/t/cust_bill_pkg_tax_rate_location_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_tax_rate_location_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_void.t b/FS/t/cust_bill_pkg_void.t new file mode 100644 index 000000000..9256b469f --- /dev/null +++ b/FS/t/cust_bill_pkg_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_void.t b/FS/t/cust_bill_void.t new file mode 100644 index 000000000..95ff4a45c --- /dev/null +++ b/FS/t/cust_bill_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_void; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 55675d6cdd93f00b7c0ac93403e8c4d66567a729 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 1 Aug 2012 13:16:42 -0700 Subject: invoice voiding, RT#18677 --- FS/FS/TemplateItem_Mixin.pm | 317 +++++++++++++++++++++++++++++++++++ FS/FS/cust_bill_pkg.pm | 317 ++--------------------------------- FS/FS/cust_bill_pkg_discount_void.pm | 129 ++++++++++++++ FS/FS/cust_bill_pkg_void.pm | 30 +++- FS/FS/cust_bill_void.pm | 30 +++- FS/t/cust_bill_pkg_discount_void.t | 5 + 6 files changed, 518 insertions(+), 310 deletions(-) create mode 100644 FS/FS/TemplateItem_Mixin.pm create mode 100644 FS/FS/cust_bill_pkg_discount_void.pm create mode 100644 FS/t/cust_bill_pkg_discount_void.t (limited to 'FS') diff --git a/FS/FS/TemplateItem_Mixin.pm b/FS/FS/TemplateItem_Mixin.pm new file mode 100644 index 000000000..6d7ea26bc --- /dev/null +++ b/FS/FS/TemplateItem_Mixin.pm @@ -0,0 +1,317 @@ +package FS::TemplateItem_Mixin; + +use strict; +use vars qw( $DEBUG $me ); # but NOT $conf +use Carp; +use FS::UID; +use FS::Record qw( qsearch qsearchs dbh ); +use FS::part_pkg; +use FS::cust_pkg; + +$DEBUG = 0; +$me = '[FS::TemplateItem_Mixin]'; + +=item cust_pkg + +Returns the package (see L) for this invoice line item. + +=cut + +sub cust_pkg { + my $self = shift; + carp "$me $self -> cust_pkg" if $DEBUG; + qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); +} + +=item part_pkg + +Returns the package definition for this invoice line item. + +=cut + +sub part_pkg { + my $self = shift; + if ( $self->pkgpart_override ) { + qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } ); + } else { + my $part_pkg; + my $cust_pkg = $self->cust_pkg; + $part_pkg = $cust_pkg->part_pkg if $cust_pkg; + $part_pkg; + } + +} + +=item desc + +Returns a description for this line item. For typical line items, this is the +I field of the corresponding B object (see L). +For one-shot line items and named taxes, it is the I field of this +line item, and for generic taxes, simply returns "Tax". + +=cut + +sub desc { + my $self = shift; + + if ( $self->pkgnum > 0 ) { + $self->itemdesc || $self->part_pkg->pkg; + } else { + my $desc = $self->itemdesc || 'Tax'; + $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/; + $desc; + } +} + +=item details [ OPTION => VALUE ... ] + +Returns an array of detail information for the invoice line item. + +Currently available options are: I, I and +I. + +If I is set to html or latex then the array members are improved +for tabular appearance in those environments if possible. + +If I is set then the array members are processed by this +function before being returned. + +I overrides the normal HTML or LaTeX function for returning +formatted CDRs. It can be set to a subroutine which returns an empty list +to skip usage detail: + + 'format_function' => sub { () }, + +=cut + +sub details { + my ( $self, %opt ) = @_; + my $escape_function = $opt{escape_function} || sub { shift }; + + my $csv = new Text::CSV_XS; + + if ( $opt{format_function} ) { + + #this still expects to be passed a cust_bill_pkg_detail object as the + #second argument, which is expensive + carp "deprecated format_function passed to cust_bill_pkg->details"; + my $format_sub = $opt{format_function} if $opt{format_function}; + + map { ( $_->format eq 'C' + ? &{$format_sub}( $_->detail, $_ ) + : &{$escape_function}( $_->detail ) + ) + } + qsearch ({ 'table' => $self->detail_table, + 'hashref' => { 'billpkgnum' => $self->billpkgnum }, + 'order_by' => 'ORDER BY detailnum', + }); + + } elsif ( $opt{'no_usage'} ) { + + my $sql = "SELECT detail FROM ". $self->detail_table. + " WHERE billpkgnum = ". $self->billpkgnum. + " AND ( format IS NULL OR format != 'C' ) ". + " ORDER BY detailnum"; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + + map &{$escape_function}( $_->[0] ), @{ $sth->fetchall_arrayref }; + + } else { + + my $format_sub; + my $format = $opt{format} || ''; + if ( $format eq 'html' ) { + + $format_sub = sub { my $detail = shift; + $csv->parse($detail) or return "can't parse $detail"; + join('', map { &$escape_function($_) } + $csv->fields + ); + }; + + } elsif ( $format eq 'latex' ) { + + $format_sub = sub { + my $detail = shift; + $csv->parse($detail) or return "can't parse $detail"; + #join(' & ', map { '\small{'. &$escape_function($_). '}' } + # $csv->fields ); + my $result = ''; + my $column = 1; + foreach ($csv->fields) { + $result .= ' & ' if $column > 1; + if ($column > 6) { # KLUDGE ALERT! + $result .= '\multicolumn{1}{l}{\scriptsize{'. + &$escape_function($_). '}}'; + }else{ + $result .= '\scriptsize{'. &$escape_function($_). '}'; + } + $column++; + } + $result; + }; + + } else { + + $format_sub = sub { my $detail = shift; + $csv->parse($detail) or return "can't parse $detail"; + join(' - ', map { &$escape_function($_) } + $csv->fields + ); + }; + + } + + my $sql = "SELECT format, detail FROM ". $self->detail_table. + " WHERE billpkgnum = ". $self->billpkgnum. + " ORDER BY detailnum"; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + + #avoid the fetchall_arrayref and loop for less memory usage? + + map { (defined($_->[0]) && $_->[0] eq 'C') + ? &{$format_sub}( $_->[1] ) + : &{$escape_function}( $_->[1] ); + } + @{ $sth->fetchall_arrayref }; + + } + +} + +=item details_header [ OPTION => VALUE ... ] + +Returns a list representing an invoice line item detail header, if any. +This relies on the behavior of voip_cdr in that it expects the header +to be the first CSV formatted detail (as is expected by invoice generation +routines). Returns the empty list otherwise. + +=cut + +sub details_header { + my $self = shift; + + my $csv = new Text::CSV_XS; + + my @detail = + qsearch ({ 'table' => $self->detail_table, + 'hashref' => { 'billpkgnum' => $self->billpkgnum, + 'format' => 'C', + }, + 'order_by' => 'ORDER BY detailnum LIMIT 1', + }); + return() unless scalar(@detail); + $csv->parse($detail[0]->detail) or return (); + $csv->fields; +} + +=item quantity + +=cut + +sub quantity { + my( $self, $value ) = @_; + if ( defined($value) ) { + $self->setfield('quantity', $value); + } + $self->getfield('quantity') || 1; +} + +=item unitsetup + +=cut + +sub unitsetup { + my( $self, $value ) = @_; + if ( defined($value) ) { + $self->setfield('unitsetup', $value); + } + $self->getfield('unitsetup') eq '' + ? $self->getfield('setup') + : $self->getfield('unitsetup'); +} + +=item unitrecur + +=cut + +sub unitrecur { + my( $self, $value ) = @_; + if ( defined($value) ) { + $self->setfield('unitrecur', $value); + } + $self->getfield('unitrecur') eq '' + ? $self->getfield('recur') + : $self->getfield('unitrecur'); +} + +=item cust_bill_pkg_display [ type => TYPE ] + +Returns an array of display information for the invoice line item optionally +limited to 'TYPE'. + +=cut + +sub cust_bill_pkg_display { + my ( $self, %opt ) = @_; + + my $class = 'FS::'. $self->display_table; + + my $default = $class->new( { billpkgnum =>$self->billpkgnum } ); + + my $type = $opt{type} if exists $opt{type}; + my @result; + + if ( $self->get('display') ) { + @result = grep { defined($type) ? ($type eq $_->type) : 1 } + @{ $self->get('display') }; + } else { + my $hashref = { 'billpkgnum' => $self->billpkgnum }; + $hashref->{type} = $type if defined($type); + + @result = qsearch ({ 'table' => $self->display_table, + 'hashref' => { 'billpkgnum' => $self->billpkgnum }, + 'order_by' => 'ORDER BY billpkgdisplaynum', + }); + } + + push @result, $default unless ( scalar(@result) || $type ); + + @result; + +} + +=item cust_bill_pkg_detail [ CLASSNUM ] + +Returns the list of associated cust_bill_pkg_detail objects +The optional CLASSNUM argument will limit the details to the specified usage +class. + +=cut + +sub cust_bill_pkg_detail { + my $self = shift; + my $classnum = shift || ''; + + my %hash = ( 'billpkgnum' => $self->billpkgnum ); + $hash{classnum} = $classnum if $classnum; + + qsearch( $self->detail_table, \%hash ), + +} + +=item cust_bill_pkg_discount + +Returns the list of associated cust_bill_pkg_discount objects. + +=cut + +sub cust_bill_pkg_discount { + my $self = shift; + qsearch( $self->discount_table, { 'billpkgnum' => $self->billpkgnum } ); +} + +1; diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 2ceef0474..304d51d6a 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -1,14 +1,13 @@ package FS::cust_bill_pkg; +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 Text::CSV_XS; -use FS::Record qw( qsearch qsearchs dbdef dbh ); -use FS::cust_main_Mixin; +use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_pkg; -use FS::part_pkg; use FS::cust_bill; use FS::cust_bill_pkg_detail; use FS::cust_bill_pkg_display; @@ -26,7 +25,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; -@ISA = qw( FS::cust_main_Mixin FS::Record ); $DEBUG = 0; $me = '[FS::cust_bill_pkg]'; @@ -125,6 +123,13 @@ customer object (see L). sub table { 'cust_bill_pkg'; } +sub detail_table { 'cust_bill_pkg_detail'; } +sub display_table { 'cust_bill_pkg_display'; } +sub discount_table { 'cust_bill_pkg_discount'; } +#sub tax_location_table { 'cust_bill_pkg_tax_location'; } +#sub tax_rate_location_table { 'cust_bill_pkg_tax_rate_location'; } +#sub tax_exempt_pkg_table { 'cust_tax_exempt_pkg'; } + =item insert Adds this line item to the database. If there is an error, returns the error, @@ -270,6 +275,7 @@ sub void { foreach my $table (qw( cust_bill_pkg_detail cust_bill_pkg_display + cust_bill_pkg_discount cust_bill_pkg_tax_location cust_bill_pkg_tax_rate_location cust_tax_exempt_pkg @@ -326,6 +332,7 @@ sub delete { foreach my $table (qw( cust_bill_pkg_detail cust_bill_pkg_display + cust_bill_pkg_discount cust_bill_pkg_tax_location cust_bill_pkg_tax_rate_location cust_tax_exempt_pkg @@ -462,36 +469,6 @@ sub regularize_details { return; } -=item cust_pkg - -Returns the package (see L) for this invoice line item. - -=cut - -sub cust_pkg { - my $self = shift; - carp "$me $self -> cust_pkg" if $DEBUG; - qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); -} - -=item part_pkg - -Returns the package definition for this invoice line item. - -=cut - -sub part_pkg { - my $self = shift; - if ( $self->pkgpart_override ) { - qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } ); - } else { - my $part_pkg; - my $cust_pkg = $self->cust_pkg; - $part_pkg = $cust_pkg->part_pkg if $cust_pkg; - $part_pkg; - } -} - =item cust_bill Returns the invoice (see L) for this invoice line item. @@ -521,173 +498,6 @@ sub previous_cust_bill_pkg { }); } -=item details [ OPTION => VALUE ... ] - -Returns an array of detail information for the invoice line item. - -Currently available options are: I, I and -I. - -If I is set to html or latex then the array members are improved -for tabular appearance in those environments if possible. - -If I is set then the array members are processed by this -function before being returned. - -I overrides the normal HTML or LaTeX function for returning -formatted CDRs. It can be set to a subroutine which returns an empty list -to skip usage detail: - - 'format_function' => sub { () }, - -=cut - -sub details { - my ( $self, %opt ) = @_; - my $escape_function = $opt{escape_function} || sub { shift }; - - my $csv = new Text::CSV_XS; - - if ( $opt{format_function} ) { - - #this still expects to be passed a cust_bill_pkg_detail object as the - #second argument, which is expensive - carp "deprecated format_function passed to cust_bill_pkg->details"; - my $format_sub = $opt{format_function} if $opt{format_function}; - - map { ( $_->format eq 'C' - ? &{$format_sub}( $_->detail, $_ ) - : &{$escape_function}( $_->detail ) - ) - } - qsearch ({ 'table' => 'cust_bill_pkg_detail', - 'hashref' => { 'billpkgnum' => $self->billpkgnum }, - 'order_by' => 'ORDER BY detailnum', - }); - - } elsif ( $opt{'no_usage'} ) { - - my $sql = "SELECT detail FROM cust_bill_pkg_detail ". - " WHERE billpkgnum = ". $self->billpkgnum. - " AND ( format IS NULL OR format != 'C' ) ". - " ORDER BY detailnum"; - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute or die $sth->errstr; - - map &{$escape_function}( $_->[0] ), @{ $sth->fetchall_arrayref }; - - } else { - - my $format_sub; - my $format = $opt{format} || ''; - if ( $format eq 'html' ) { - - $format_sub = sub { my $detail = shift; - $csv->parse($detail) or return "can't parse $detail"; - join('', map { &$escape_function($_) } - $csv->fields - ); - }; - - } elsif ( $format eq 'latex' ) { - - $format_sub = sub { - my $detail = shift; - $csv->parse($detail) or return "can't parse $detail"; - #join(' & ', map { '\small{'. &$escape_function($_). '}' } - # $csv->fields ); - my $result = ''; - my $column = 1; - foreach ($csv->fields) { - $result .= ' & ' if $column > 1; - if ($column > 6) { # KLUDGE ALERT! - $result .= '\multicolumn{1}{l}{\scriptsize{'. - &$escape_function($_). '}}'; - }else{ - $result .= '\scriptsize{'. &$escape_function($_). '}'; - } - $column++; - } - $result; - }; - - } else { - - $format_sub = sub { my $detail = shift; - $csv->parse($detail) or return "can't parse $detail"; - join(' - ', map { &$escape_function($_) } - $csv->fields - ); - }; - - } - - my $sql = "SELECT format, detail FROM cust_bill_pkg_detail ". - " WHERE billpkgnum = ". $self->billpkgnum. - " ORDER BY detailnum"; - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute or die $sth->errstr; - - #avoid the fetchall_arrayref and loop for less memory usage? - - map { (defined($_->[0]) && $_->[0] eq 'C') - ? &{$format_sub}( $_->[1] ) - : &{$escape_function}( $_->[1] ); - } - @{ $sth->fetchall_arrayref }; - - } - -} - -=item details_header [ OPTION => VALUE ... ] - -Returns a list representing an invoice line item detail header, if any. -This relies on the behavior of voip_cdr in that it expects the header -to be the first CSV formatted detail (as is expected by invoice generation -routines). Returns the empty list otherwise. - -=cut - -sub details_header { - my $self = shift; - return '' unless defined dbdef->table('cust_bill_pkg_detail'); - - my $csv = new Text::CSV_XS; - - my @detail = - qsearch ({ 'table' => 'cust_bill_pkg_detail', - 'hashref' => { 'billpkgnum' => $self->billpkgnum, - 'format' => 'C', - }, - 'order_by' => 'ORDER BY detailnum LIMIT 1', - }); - return() unless scalar(@detail); - $csv->parse($detail[0]->detail) or return (); - $csv->fields; -} - -=item desc - -Returns a description for this line item. For typical line items, this is the -I field of the corresponding B object (see L). -For one-shot line items and named taxes, it is the I field of this -line item, and for generic taxes, simply returns "Tax". - -=cut - -sub desc { - my $self = shift; - - if ( $self->pkgnum > 0 ) { - $self->itemdesc || $self->part_pkg->pkg; - } else { - my $desc = $self->itemdesc || 'Tax'; - $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/; - $desc; - } -} - =item owed_setup Returns the amount owed (still outstanding) on this line item's setup fee, @@ -765,45 +575,6 @@ sub units { $self->pkgnum ? $self->part_pkg->calc_units($self->cust_pkg) : 0; # 1? } -=item quantity - -=cut - -sub quantity { - my( $self, $value ) = @_; - if ( defined($value) ) { - $self->setfield('quantity', $value); - } - $self->getfield('quantity') || 1; -} - -=item unitsetup - -=cut - -sub unitsetup { - my( $self, $value ) = @_; - if ( defined($value) ) { - $self->setfield('unitsetup', $value); - } - $self->getfield('unitsetup') eq '' - ? $self->getfield('setup') - : $self->getfield('unitsetup'); -} - -=item unitrecur - -=cut - -sub unitrecur { - my( $self, $value ) = @_; - if ( defined($value) ) { - $self->setfield('unitrecur', $value); - } - $self->getfield('unitrecur') eq '' - ? $self->getfield('recur') - : $self->getfield('unitrecur'); -} =item set_display OPTION => VALUE ... @@ -1015,44 +786,8 @@ sub usage_classes { } -=item cust_bill_pkg_display [ type => TYPE ] - -Returns an array of display information for the invoice line item optionally -limited to 'TYPE'. - -=cut - -sub cust_bill_pkg_display { - my ( $self, %opt ) = @_; - - my $default = - new FS::cust_bill_pkg_display { billpkgnum =>$self->billpkgnum }; - - my $type = $opt{type} if exists $opt{type}; - my @result; - - if ( $self->get('display') ) { - @result = grep { defined($type) ? ($type eq $_->type) : 1 } - @{ $self->get('display') }; - } else { - my $hashref = { 'billpkgnum' => $self->billpkgnum }; - $hashref->{type} = $type if defined($type); - - @result = qsearch ({ 'table' => 'cust_bill_pkg_display', - 'hashref' => { 'billpkgnum' => $self->billpkgnum }, - 'order_by' => 'ORDER BY billpkgdisplaynum', - }); - } - - push @result, $default unless ( scalar(@result) || $type ); - - @result; - -} - # reserving this name for my friends FS::{tax_rate|cust_main_county}::taxline # and FS::cust_main::bill - sub _cust_tax_exempt_pkg { my ( $self ) = @_; @@ -1080,36 +815,6 @@ sub cust_bill_pkg_tax_Xlocation { } -=item cust_bill_pkg_detail [ CLASSNUM ] - -Returns the list of associated cust_bill_pkg_detail objects -The optional CLASSNUM argument will limit the details to the specified usage -class. - -=cut - -sub cust_bill_pkg_detail { - my $self = shift; - my $classnum = shift || ''; - - my %hash = ( 'billpkgnum' => $self->billpkgnum ); - $hash{classnum} = $classnum if $classnum; - - qsearch( 'cust_bill_pkg_detail', \%hash ), - -} - -=item cust_bill_pkg_discount - -Returns the list of associated cust_bill_pkg_discount objects. - -=cut - -sub cust_bill_pkg_discount { - my $self = shift; - qsearch( 'cust_bill_pkg_discount', { 'billpkgnum' => $self->billpkgnum } ); -} - =item recur_show_zero =cut diff --git a/FS/FS/cust_bill_pkg_discount_void.pm b/FS/FS/cust_bill_pkg_discount_void.pm new file mode 100644 index 000000000..859ef3cf2 --- /dev/null +++ b/FS/FS/cust_bill_pkg_discount_void.pm @@ -0,0 +1,129 @@ +package FS::cust_bill_pkg_discount_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::cust_pkg_discount; + +=head1 NAME + +FS::cust_bill_pkg_discount_void - Object methods for cust_bill_pkg_discount_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_discount_void; + + $record = new FS::cust_bill_pkg_discount_void \%hash; + $record = new FS::cust_bill_pkg_discount_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_discount_void object represents the slice of a customer +discount applied to a specific voided line item. +FS::cust_bill_pkg_discount_void inherits from FS::Record. The following fields +are currently supported: + +=over 4 + +=item billpkgdiscountnum + +primary key + +=item billpkgnum + +billpkgnum + +=item pkgdiscountnum + +pkgdiscountnum + +=item amount + +amount + +=item months + +months + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_bill_pkg_discount_void'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('billpkgdiscountnum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum' ) + || $self->ut_foreign_key('pkgdiscountnum', 'cust_pkg_discount', 'pkgdiscountnum' ) + || $self->ut_money('amount') + || $self->ut_float('months') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill_pkg_void.pm b/FS/FS/cust_bill_pkg_void.pm index 198283955..7855d58c6 100644 --- a/FS/FS/cust_bill_pkg_void.pm +++ b/FS/FS/cust_bill_pkg_void.pm @@ -1,8 +1,12 @@ package FS::cust_bill_pkg_void; +use base qw( FS::TemplateItem_Mixin FS::Record ); use strict; -use base qw( FS::Record ); -use FS::Record; # qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_bill_void; +use FS::cust_bill_pkg_detail_void; +use FS::cust_bill_pkg_display_void; +use FS::cust_bill_pkg_discount_void; =head1 NAME @@ -113,6 +117,13 @@ points to. You can ask the object for a copy with the I method. sub table { 'cust_bill_pkg_void'; } +sub detail_table { 'cust_bill_pkg_detail_void'; } +sub display_table { 'cust_bill_pkg_display_void'; } +sub discount_table { 'cust_bill_pkg_discount_void'; } +#sub tax_location_table { 'cust_bill_pkg_tax_location'; } +#sub tax_rate_location_table { 'cust_bill_pkg_tax_rate_location'; } +#sub tax_exempt_pkg_table { 'cust_tax_exempt_pkg'; } + =item insert Adds this record to the database. If there is an error, returns the error, @@ -147,7 +158,7 @@ sub check { my $error = $self->ut_number('billpkgnum') || $self->ut_snumber('pkgnum') - || $self->ut_number('invnum') #cust_bill or cust_bill_void ? + || $self->ut_number('invnum') #cust_bill or cust_bill_void, if we ever support line item voiding || $self->ut_numbern('pkgpart_override') || $self->ut_money('setup') || $self->ut_money('recur') @@ -167,6 +178,19 @@ sub check { $self->SUPER::check; } +=item cust_bill + +Returns the voided invoice (see L) for this voided line +item. + +=cut + +sub cust_bill { + my $self = shift; + #cust_bill or cust_bill_void, if we ever support line item voiding + qsearchs( 'cust_bill_void', { 'invnum' => $self->invnum } ); +} + =back =head1 BUGS diff --git a/FS/FS/cust_bill_void.pm b/FS/FS/cust_bill_void.pm index c782172b5..cd6a9e13b 100644 --- a/FS/FS/cust_bill_void.pm +++ b/FS/FS/cust_bill_void.pm @@ -2,10 +2,11 @@ package FS::cust_bill_void; use base qw( FS::Template_Mixin FS::cust_main_Mixin FS::otaker_Mixin FS::Record ); use strict; -use FS::Record qw( qsearchs ); #qsearch ); +use FS::Record qw( qsearch qsearchs ); use FS::cust_main; use FS::cust_statement; use FS::access_user; +use FS::cust_bill_pkg_void; =head1 NAME @@ -203,6 +204,33 @@ sub void_access_user { qsearchs('access_user', { 'usernum' => $self->void_usernum } ); } +=item cust_main + +=cut + +sub cust_main { + my $self = shift; + qsearchs('cust_main', { 'custnum' => $self->custnum } ); +} + +=item cust_bill_pkg + +=cut + +sub cust_bill_pkg { #actually cust_bill_pkg_void objects + my $self = shift; + qsearch('cust_bill_pkg_void', { invnum=>$self->invnum }); +} + +=back + +=item enable_previous + +=cut + +sub enable_previous { 0 } + + =back =head1 BUGS diff --git a/FS/t/cust_bill_pkg_discount_void.t b/FS/t/cust_bill_pkg_discount_void.t new file mode 100644 index 000000000..e591eb03d --- /dev/null +++ b/FS/t/cust_bill_pkg_discount_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_discount_void; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From bec3b6c2bf97d66b992866d7ee7295f1f05452e6 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 1 Aug 2012 14:01:14 -0700 Subject: invoice voiding, RT#18677 --- FS/FS/AccessRight.pm | 7 +++-- FS/FS/access_right.pm | 9 ++++-- FS/FS/cust_bill_pkg_void.pm | 74 ++++++++++++++++++++++++++++++++++++++++++--- FS/FS/cust_bill_void.pm | 61 +++++++++++++++++++++++++++++++------ 4 files changed, 130 insertions(+), 21 deletions(-) (limited to 'FS') diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index ebf66e64c..b41ec2fe2 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -178,6 +178,7 @@ tie my %rights, 'Tie::IxHash', 'View invoices', 'Resend invoices', #NEWNEW 'Void invoices', + 'Unvoid invoices', 'Delete invoices', 'View customer tax exemptions', #yow 'Add customer tax adjustment', #new, but no need to phase in @@ -228,11 +229,11 @@ tie my %rights, 'Tie::IxHash', ### # customer voiding rights.. ### - 'Customer void rights' => [ + 'Customer payment void rights' => [ { rightname=>'Credit card void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. cc-void { rightname=>'Echeck void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. echeck-void - 'Regular void', - { rightname=>'Unvoid', desc=>'Enable unvoiding of voided payments' }, #aka. unvoid + 'Void payments', + { rightname=>'Unvoid payments', desc=>'Enable unvoiding of voided payments' }, #aka. unvoid ], diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index bc57364d2..dc9f9978d 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -152,6 +152,8 @@ sub _upgrade_data { # class method 'Process payment' => [ 'Process credit card payment', 'Process Echeck payment' ], 'Post refund' => [ 'Post check refund', 'Post cash refund' ], 'Refund payment' => [ 'Refund credit card payment', 'Refund Echeck payment' ], + 'Regular void' => [ 'Void payments' ], + 'Unvoid' => [ 'Unvoid payments', 'Unvoid invoices' ], ); foreach my $oldright (keys %migrate) { @@ -174,9 +176,10 @@ sub _upgrade_data { # class method die $error if $error; } - #after the WEST stuff is sorted, etc. - #my $error = $old->delete; - #die $error if $error; + unless ( $oldright =~ / (payment|refund)$/ ) { #after the WEST stuff is sorted + my $error = $old->delete; + die $error if $error; + } } diff --git a/FS/FS/cust_bill_pkg_void.pm b/FS/FS/cust_bill_pkg_void.pm index 7855d58c6..b7c6feed5 100644 --- a/FS/FS/cust_bill_pkg_void.pm +++ b/FS/FS/cust_bill_pkg_void.pm @@ -2,11 +2,12 @@ package FS::cust_bill_pkg_void; use base qw( FS::TemplateItem_Mixin FS::Record ); use strict; -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs dbh fields ); use FS::cust_bill_void; use FS::cust_bill_pkg_detail_void; use FS::cust_bill_pkg_display_void; use FS::cust_bill_pkg_discount_void; +use FS::cust_bill_pkg; =head1 NAME @@ -129,21 +130,84 @@ sub discount_table { 'cust_bill_pkg_discount_void'; } Adds this record to the database. If there is an error, returns the error, otherwise returns false. +=item unvoid + +"Un-void"s this line item: Deletes the voided line item from the database and +adds back a normal line item (and related tables). + =cut +sub unvoid { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $cust_bill_pkg = new FS::cust_bill_pkg ( { + map { $_ => $self->get($_) } fields('cust_bill_pkg') + } ); + my $error = $cust_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $table (qw( + cust_bill_pkg_detail + cust_bill_pkg_display + cust_bill_pkg_discount + cust_bill_pkg_tax_location + cust_bill_pkg_tax_rate_location + cust_tax_exempt_pkg + )) { + + foreach my $voided ( + qsearch($table.'_void', { billpkgnum=>$self->billpkgnum }) + ) { + + my $class = 'FS::'.$table; + my $unvoid = $class->new( { + map { $_ => $voided->get($_) } fields($table) + }); + my $error = $unvoid->insert || $voided->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + } + + $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item delete Delete this record from the database. -=cut - =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -=cut - =item check Checks all fields to make sure this is a valid record. If there is diff --git a/FS/FS/cust_bill_void.pm b/FS/FS/cust_bill_void.pm index cd6a9e13b..cce77b3aa 100644 --- a/FS/FS/cust_bill_void.pm +++ b/FS/FS/cust_bill_void.pm @@ -2,11 +2,12 @@ package FS::cust_bill_void; use base qw( FS::Template_Mixin FS::cust_main_Mixin FS::otaker_Mixin FS::Record ); use strict; -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs dbh fields ); use FS::cust_main; use FS::cust_statement; use FS::access_user; use FS::cust_bill_pkg_void; +use FS::cust_bill; =head1 NAME @@ -117,7 +118,55 @@ otherwise returns false. =cut -# the insert method can be inherited from FS::Record +=item unvoid + +"Un-void"s this invoice: Deletes the voided invoice from the database and adds +back a normal invoice (and related tables). + +=cut + +sub unvoid { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $cust_bill = new FS::cust_bill ( { + map { $_ => $self->get($_) } fields('cust_bill') + } ); + my $error = $cust_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $cust_bill_pkg_void ( $self->cust_bill_pkg ) { + my $error = $cust_bill_pkg_void->unvoid; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} =item delete @@ -125,8 +174,6 @@ Delete this record from the database. =cut -# the delete method can be inherited from FS::Record - =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, @@ -134,8 +181,6 @@ returns the error, otherwise returns false. =cut -# the replace method can be inherited from FS::Record - =item check Checks all fields to make sure this is a valid voided invoice. If there is @@ -144,9 +189,6 @@ and replace methods. =cut -# the check method should currently be supplied - FS::Record contains some -# data checking routines - sub check { my $self = shift; @@ -230,7 +272,6 @@ sub cust_bill_pkg { #actually cust_bill_pkg_void objects sub enable_previous { 0 } - =back =head1 BUGS -- cgit v1.2.1 From 4d6c465f4b32a49f8bce091f6cb5abb209123ec2 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 1 Aug 2012 14:04:50 -0700 Subject: invoice voiding, RT#18677 --- FS/FS/Mason.pm | 1 + FS/FS/Schema.pm | 13 +++++++++++++ FS/FS/cust_bill_pkg_discount.pm | 4 ++-- FS/FS/quotation.pm | 3 +-- FS/MANIFEST | 2 ++ 5 files changed, 19 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index c45e783db..663a48e72 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -322,6 +322,7 @@ if ( -e $addl_handler_use_file ) { use FS::cust_bill_pkg_tax_location_void; use FS::cust_bill_pkg_tax_rate_location_void; use FS::cust_tax_exempt_pkg_void; + use FS::cust_bill_pkg_discount_void; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index e59268b2a..cff0afd6c 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1784,6 +1784,19 @@ sub tables_hashref { 'index' => [ [ 'billpkgnum' ], [ 'pkgdiscountnum' ] ], }, + 'cust_bill_pkg_discount_void' => { + 'columns' => [ + 'billpkgdiscountnum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'pkgdiscountnum', 'int', '', '', '', '', + 'amount', @money_type, '', '', + 'months', 'decimal', 'NULL', '7,4', '', '', + ], + 'primary_key' => 'billpkgdiscountnum', + 'unique' => [], + 'index' => [ [ 'billpkgnum' ], [ 'pkgdiscountnum' ] ], + }, + 'discount' => { 'columns' => [ 'discountnum', 'serial', '', '', '', '', diff --git a/FS/FS/cust_bill_pkg_discount.pm b/FS/FS/cust_bill_pkg_discount.pm index e7dd5f22f..dfa83d393 100644 --- a/FS/FS/cust_bill_pkg_discount.pm +++ b/FS/FS/cust_bill_pkg_discount.pm @@ -28,8 +28,8 @@ FS::cust_bill_pkg_discount - Object methods for cust_bill_pkg_discount records =head1 DESCRIPTION An FS::cust_bill_pkg_discount object represents the slice of a customer -applied to a line item. FS::cust_bill_pkg_discount inherits from -FS::Record. The following fields are currently supported: +discount applied to a specific line item. FS::cust_bill_pkg_discount inherits +from FS::Record. The following fields are currently supported: =over 4 diff --git a/FS/FS/quotation.pm b/FS/FS/quotation.pm index ccaa1c34b..9e7723c77 100644 --- a/FS/FS/quotation.pm +++ b/FS/FS/quotation.pm @@ -142,9 +142,8 @@ sub cust_main { =cut -sub cust_bill_pkg { +sub cust_bill_pkg { #actually quotation_pkg objects my $self = shift; - #actually quotation_pkg objects qsearch('quotation_pkg', { quotationnum=>$self->quotationnum }); } diff --git a/FS/MANIFEST b/FS/MANIFEST index 01dab2092..2163a2324 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -663,3 +663,5 @@ FS/cust_bill_pkg_tax_rate_location_void.pm t/cust_bill_pkg_tax_rate_location_void.t FS/cust_tax_exempt_pkg_void.pm t/cust_tax_exempt_pkg_void.t +FS/cust_bill_pkg_discount_void.pm +t/cust_bill_pkg_discount_void.t -- cgit v1.2.1 From 7404ff9d5df7679054dd73f17b3737f5474e5512 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 2 Aug 2012 14:59:53 -0700 Subject: fix some illegal RADIUS attributes during import, #18751 --- FS/FS/part_export/sqlradius.pm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index d7cd459d8..721396671 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -1160,6 +1160,7 @@ sub import_attrs { SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck UNION SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply'; + my @fixes; # things that need to be changed on the radius db foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) { my ($groupname, $attrname, $op, $value, $attrtype) = @$row; warn "$groupname.$attrname\n"; @@ -1181,6 +1182,20 @@ SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply'; my $old = $a->{$attrname}; my $new; + if ( $attrtype eq 'R' ) { + # Freeradius tolerates illegal operators in reply attributes. We don't. + if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) { + warn "$groupname.$attrname: changing $op to +=\n"; + # Make a note to change it in the db + push @fixes, [ + 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?', + $groupname, $attrname, $op, $value + ]; + # and import it correctly. + $op = '+='; + } + } + if ( defined $old ) { # replace $new = new FS::radius_attr { @@ -1210,6 +1225,13 @@ SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply'; } $attrs_of{$groupname}->{$attrname} = $new; } #foreach $row + + foreach (@fixes) { + my ($sql, @args) = @$_; + my $sth = $dbh->prepare($sql); + $sth->execute(@args) or warn $sth->errstr; + } + return; } -- cgit v1.2.1 From e881063d6e46d991003cf8fae96d8d36780fedcd Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 2 Aug 2012 19:39:20 -0700 Subject: per-customer prorate day, RT#17891 --- FS/FS/Conf.pm | 7 +++++++ FS/FS/Schema.pm | 1 + FS/FS/cust_main.pm | 1 + FS/FS/part_pkg/prorate.pm | 10 +++++++--- FS/FS/part_pkg/recur_Common.pm | 15 ++++++++------- 5 files changed, 24 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 37bbf6e17..8069fb41f 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -838,6 +838,13 @@ sub reason_type_options { 'type' => 'checkbox', }, + { + 'key' => 'cust_main-select-prorate_day', + 'section' => 'billing', + 'description' => 'When used with prorate or anniversary packages, allows the selection of the prorate day of month, on a per-customer basis', + 'type' => 'checkbox', + }, + { 'key' => 'encryption', 'section' => 'billing', diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index cff0afd6c..a55e0f9d2 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1050,6 +1050,7 @@ sub tables_hashref { 'email_csv_cdr', 'char', 'NULL', 1, '', '', 'accountcode_cdr', 'char', 'NULL', 1, '', '', 'billday', 'int', 'NULL', '', '', '', + 'prorate_day', 'int', 'NULL', '', '', '', 'edit_subject', 'char', 'NULL', 1, '', '', 'locale', 'varchar', 'NULL', 16, '', '', 'calling_list_exempt', 'char', 'NULL', 1, '', '', diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 36c62808c..1da1f0ffd 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1794,6 +1794,7 @@ sub check { || $self->ut_floatn('cdr_termination_percentage') || $self->ut_floatn('credit_limit') || $self->ut_numbern('billday') + || $self->ut_numbern('prorate_day') || $self->ut_enum('edit_subject', [ '', 'Y' ] ) || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] ) || $self->ut_enum('invoice_noemail', [ '', 'Y' ] ) diff --git a/FS/FS/part_pkg/prorate.pm b/FS/FS/part_pkg/prorate.pm index f8d03dcb5..ac86f3918 100644 --- a/FS/FS/part_pkg/prorate.pm +++ b/FS/FS/part_pkg/prorate.pm @@ -44,12 +44,16 @@ use FS::part_pkg::flat; sub calc_recur { my $self = shift; - return $self->calc_prorate(@_, $self->cutoff_day) - $self->calc_discount(@_); + my $cust_pkg = $_[0]; + $self->calc_prorate(@_, $self->cutoff_day($cust_pkg)) + - $self->calc_discount(@_); } sub cutoff_day { - my $self = shift; - split(/\s*,\s*/, $self->option('cutoff_day', 1) || '1'); + my( $self, $cust_pkg ) = @_; + my $prorate_day = $cust_pkg->cust_main->prorate_day; + $prorate_day ? ( $prorate_day ) + : split(/\s*,\s*/, $self->option('cutoff_day', 1) || '1'); } 1; diff --git a/FS/FS/part_pkg/recur_Common.pm b/FS/FS/part_pkg/recur_Common.pm index 9d7341b76..03d5c2cb2 100644 --- a/FS/FS/part_pkg/recur_Common.pm +++ b/FS/FS/part_pkg/recur_Common.pm @@ -39,14 +39,15 @@ sub calc_setup { sub cutoff_day { # prorate/subscription only; we don't support sync_bill_date here - my $self = shift; - my $cust_pkg = shift; + my( $self, $cust_pkg ) = @_; my $recur_method = $self->option('recur_method',1) || 'anniversary'; - if ( $recur_method eq 'prorate' or $recur_method eq 'subscription' ) { - return $self->option('cutoff_day',1) || 1; - } else { - return (); - } + return () unless $recur_method eq 'prorate' + || $recur_method eq 'subscription'; + + #false laziness w/prorate.pm::cutoff_day + my $prorate_day = $cust_pkg->cust_main->prorate_day; + $prorate_day ? ( $prorate_day ) + : split(/\s*,\s*/, $self->option('cutoff_day', 1) || '1'); } sub calc_recur_Common { -- cgit v1.2.1 From 07d63243b070962b8fcf8e6b59128ccf1305f8f8 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 2 Aug 2012 20:53:04 -0700 Subject: FS/FS/Trace.pm --- FS/FS/Mason/Request.pm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'FS') diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm index 0d21df4ca..36c46dc41 100644 --- a/FS/FS/Mason/Request.pm +++ b/FS/FS/Mason/Request.pm @@ -4,6 +4,7 @@ use strict; use warnings; use vars qw( $FSURL $QUERY_STRING ); use base 'HTML::Mason::Request'; +use FS::Trace; $FSURL = 'http://Set/FS_Mason_Request_FSURL/in_standalone_mode/'; $QUERY_STRING = ''; @@ -11,21 +12,27 @@ $QUERY_STRING = ''; sub new { my $class = shift; + FS::Trace->log('creating new FS::Mason::Request object'); + my $superclass = $HTML::Mason::ApacheHandler::VERSION ? 'HTML::Mason::Request::ApacheHandler' : $HTML::Mason::CGIHandler::VERSION ? 'HTML::Mason::Request::CGI' : 'HTML::Mason::Request'; + FS::Trace->log(' altering superclass'); $class->alter_superclass( $superclass ); + FS::Trace->log(' setting valid params'); #huh... shouldn't alter_superclass take care of this for us? __PACKAGE__->valid_params( %{ $superclass->valid_params() } ); + FS::Trace->log(' freeside_setup'); my %opt = @_; my $mode = $superclass =~ /Apache/i ? 'apache' : 'standalone'; $class->freeside_setup($opt{'comp'}, $mode); + FS::Trace->log(' SUPER::new'); $class->SUPER::new(@_); } @@ -38,6 +45,8 @@ my $protect_fds; sub freeside_setup { my( $class, $filename, $mode ) = @_; + FS::Trace->log(' protecting fds'); + #from rt/bin/webmux.pl(.in) if ( !$protect_fds && $ENV{'MOD_PERL'} && exists $ENV{'MOD_PERL_API_VERSION'} && $ENV{'MOD_PERL_API_VERSION'} >= 2 @@ -57,6 +66,8 @@ sub freeside_setup { if ( $filename =~ qr(/REST/\d+\.\d+/NoAuth/) ) { + FS::Trace->log(' handling RT REST/NoAuth file'); + package HTML::Mason::Commands; #? use FS::UID qw( adminsuidsetup ); @@ -65,10 +76,13 @@ sub freeside_setup { ##old installs w/fs_selfs or selfserv?? #&adminsuidsetup('fs_selfservice'); + FS::Trace->log(' adminsuidsetup fs_queue'); &adminsuidsetup('fs_queue'); } else { + FS::Trace->log(' handling regular file'); + package HTML::Mason::Commands; use vars qw( $cgi $p $fsurl ); # $lh ); #not using /mt use Encode; @@ -77,6 +91,7 @@ sub freeside_setup { if ( $mode eq 'apache' ) { $cgi = new CGI; + FS::Trace->log(' cgisuidsetup'); &cgisuidsetup($cgi); #&cgisuidsetup($r); $fsurl = rooturl(); @@ -91,6 +106,7 @@ sub freeside_setup { die "unknown mode $mode"; } + FS::Trace->log(' UTF-8-decoding form data'); # foreach my $param ( $cgi->param ) { my @values = $cgi->param($param); @@ -102,6 +118,8 @@ sub freeside_setup { } + FS::Trace->log(' done'); + } sub callback { -- cgit v1.2.1 From aa59ea407bdb0368f0dcb36d48b69cdabf44da41 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 2 Aug 2012 20:53:12 -0700 Subject: request tracing, RT#18719 --- FS/MANIFEST | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 2163a2324..e8b676028 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -665,3 +665,4 @@ FS/cust_tax_exempt_pkg_void.pm t/cust_tax_exempt_pkg_void.t FS/cust_bill_pkg_discount_void.pm t/cust_bill_pkg_discount_void.t +FS/Trace.pm -- cgit v1.2.1 From c573de444fba4ff9a42127b4cfe97b85d1f89b70 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Fri, 3 Aug 2012 10:51:55 -0700 Subject: request tracing, RT#18719 --- FS/FS/Trace.pm | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 FS/FS/Trace.pm (limited to 'FS') diff --git a/FS/FS/Trace.pm b/FS/FS/Trace.pm new file mode 100644 index 000000000..9ff39dd26 --- /dev/null +++ b/FS/FS/Trace.pm @@ -0,0 +1,35 @@ +package FS::Trace; + +use strict; +use Date::Format; +use File::Slurp; + +my @trace = (); + +sub log { + my( $class, $msg ) = @_; + push @trace, [ time, "[$$][". time2str('%r', time). "] $msg" ]; +} + +sub total { + $trace[-1]->[0] - $trace[0]->[0]; +} + +sub reset { + @trace = (); +} + +sub dump_ary { + map $_->[1], @trace; +} + +sub dump { + join("\n", map $_->[1], @trace). "\n"; +} + +sub dumpfile { + my( $class, $filename, $header ) = @_; + write_file( $filename, "$header\n". $class->dump ); +} + +1; -- cgit v1.2.1 From 45346fd655ba53b82c80b920da945cc0b87ece01 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Fri, 3 Aug 2012 13:09:05 -0700 Subject: selfservice payment fees, RT#18345 --- FS/FS/ClientAPI/MasonComponent.pm | 23 +++++++++++++++++++++ FS/FS/ClientAPI/MyAccount.pm | 29 +++++++++++++++++++++++++++ FS/FS/Conf.pm | 42 +++++++++++++++++++-------------------- 3 files changed, 73 insertions(+), 21 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MasonComponent.pm b/FS/FS/ClientAPI/MasonComponent.pm index 534b48a76..c72d26879 100644 --- a/FS/FS/ClientAPI/MasonComponent.pm +++ b/FS/FS/ClientAPI/MasonComponent.pm @@ -26,6 +26,7 @@ my %allowed_comps = map { $_=>1 } qw( my %session_comps = map { $_=>1 } qw( /elements/location.html + /elements/tr-amount_fee.html /edit/cust_main/first_pkg/select-part_pkg.html ); @@ -41,6 +42,28 @@ my %session_callbacks = ( return ''; #no error }, + '/elements/tr-amount_fee.html' => sub { + my( $custnum, $argsref ) = @_; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return "unknown custnum $custnum"; + + my $conf = new FS::Conf; + + my %args = @$argsref; + %args = ( + %args, + 'process-pkgpart' => scalar($conf->config('selfservice_process-pkgpart')), + 'process-display' => scalar($conf->config('selfservice_process-display')), + 'process-skip-first' => $conf->exists('selfservice_process-skip_first'), + 'num_payments' => scalar($cust_main->cust_pay), + 'surcharge_percentage' => scalar($conf->config('credit-card-surcharge-percentage')), + ); + @$argsref = ( %args ); + + return ''; #no error + }, + '/edit/cust_main/first_pkg/select-part_pkg.html' => sub { my( $custnum, $argsref ) = @_; my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 54799b817..151a2ed67 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -38,6 +38,7 @@ use FS::cust_main; use FS::cust_bill; use FS::legacy_cust_bill; use FS::cust_main_county; +use FS::part_pkg; use FS::cust_pkg; use FS::payby; use FS::acct_rt_transaction; @@ -926,6 +927,16 @@ sub validate_payment { my $amount = $1; return { error => 'Amount must be greater than 0' } unless $amount > 0; + #false laziness w/tr-amount_fee.html, but we don't want selfservice users + #changing the hidden form values + my $conf = new FS::Conf; + my $fee_display = $conf->config('selfservice_process-display') || 'add'; + my $fee_pkgpart = $conf->config('selfservice_process-pkgpart'); + if ( $fee_display eq 'add' && $fee_pkgpart ) { + my $fee_pkg = qsearchs('part_pkg', { pkgpart=>$fee_pkgpart } ); + $amount = sprintf('%.2f', $amount + $fee_pkg->option('setup_fee') ); + } + $p->{'discount_term'} =~ /^\s*(\d*)\s*$/ or return { 'error' => gettext('illegal_discount_term'). ': '. $p->{'discount_term'} }; my $discount_term = $1; @@ -1085,6 +1096,24 @@ sub do_process_payment { ); return { 'error' => $error } if $error; + #no error, so order the fee package if applicable... + my $conf = new FS::Conf; + my $fee_pkgpart = $conf->config('selfservice_process-pkgpart'); + if ( $fee_pkgpart ) { + + my $cust_pkg = new FS::cust_pkg { 'pkgpart' => $fee_pkgpart }; + + $error = $cust_main->order_pkg( 'cust_pkg' => $cust_pkg ); + return { 'error' => "payment processed successfully, but error ordering fee: $error" } + if $error; + + #and generate an invoice for it now too + $error = $cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); + return { 'error' => "payment processed and fee ordered sucessfully, but error billing fee: $error" } + if $error; + + } + $cust_main->apply_payments; if ( $validate->{'save'} ) { diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 8069fb41f..39b59cf37 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -2592,30 +2592,30 @@ and customer address. Include units.', 'type' => 'checkbox', }, - { - 'key' => 'suto_process-pkgpart', - 'section' => 'billing', - 'description' => 'Package to add to each automatic credit card and ACH payment processed by billing events. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option.', - 'type' => 'select-part_pkg', - }, - # { -# 'key' => 'auto_process-display', +# 'key' => 'auto_process-pkgpart', # 'section' => 'billing', -# 'description' => 'When using auto_process-pkgpart, add the fee to the amount entered (default), or subtract the fee from the amount entered.', -# 'type' => 'select', -# 'select_hash' => [ -# 'add' => 'Add fee to amount entered', -# 'subtract' => 'Subtract fee from amount entered', -# ], +# 'description' => 'Package to add to each automatic credit card and ACH payment processed by billing events. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option.', +# 'type' => 'select-part_pkg', +# }, +# +## { +## 'key' => 'auto_process-display', +## 'section' => 'billing', +## 'description' => 'When using auto_process-pkgpart, add the fee to the amount entered (default), or subtract the fee from the amount entered.', +## 'type' => 'select', +## 'select_hash' => [ +## 'add' => 'Add fee to amount entered', +## 'subtract' => 'Subtract fee from amount entered', +## ], +## }, +# +# { +# 'key' => 'auto_process-skip_first', +# 'section' => 'billing', +# 'description' => "When using auto_process-pkgpart, omit the fee if it is the customer's first payment.", +# 'type' => 'checkbox', # }, - - { - 'key' => 'auto_process-skip_first', - 'section' => 'billing', - 'description' => "When using auto_process-pkgpart, omit the fee if it is the customer's first payment.", - 'type' => 'checkbox', - }, { 'key' => 'allow_negative_charges', -- cgit v1.2.1 From 72f0bcbaece30fed81dd101cca1685b2c69013ec Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Fri, 3 Aug 2012 13:11:36 -0700 Subject: remove inadvertant debugging --- FS/FS/ClientAPI/MyAccount.pm | 2 -- 1 file changed, 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 151a2ed67..3fd621493 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -196,8 +196,6 @@ sub login { } else { -warn Dumper($p); - my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } ) or return { error => 'Domain '. $p->{'domain'}. ' not found' }; -- cgit v1.2.1 From 2d7ff76b7fc593f420421c5d3e9c561eb67fd368 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Fri, 3 Aug 2012 15:26:01 -0700 Subject: nvoice voiding, RT#18677 --- FS/FS/cust_bill_pkg_void.pm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill_pkg_void.pm b/FS/FS/cust_bill_pkg_void.pm index b7c6feed5..8949ba7a3 100644 --- a/FS/FS/cust_bill_pkg_void.pm +++ b/FS/FS/cust_bill_pkg_void.pm @@ -4,10 +4,13 @@ use base qw( FS::TemplateItem_Mixin FS::Record ); use strict; use FS::Record qw( qsearch qsearchs dbh fields ); use FS::cust_bill_void; -use FS::cust_bill_pkg_detail_void; -use FS::cust_bill_pkg_display_void; -use FS::cust_bill_pkg_discount_void; +use FS::cust_bill_pkg_detail; +use FS::cust_bill_pkg_display; +use FS::cust_bill_pkg_discount; use FS::cust_bill_pkg; +use FS::cust_bill_pkg_tax_location; +use FS::cust_bill_pkg_tax_rate_location; +use FS::cust_tax_exempt_pkg; =head1 NAME -- cgit v1.2.1 From bb1b909a073b9cc318291aefa0ed0f3743616642 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Fri, 3 Aug 2012 15:26:25 -0700 Subject: nvoice voiding, RT#18677 --- FS/FS/cust_bill_pkg.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 304d51d6a..96fa408a8 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -21,6 +21,7 @@ use FS::cust_tax_adjustment; use FS::cust_bill_pkg_void; use FS::cust_bill_pkg_detail_void; use FS::cust_bill_pkg_display_void; +use FS::cust_bill_pkg_discount_void; use FS::cust_bill_pkg_tax_location_void; use FS::cust_bill_pkg_tax_rate_location_void; use FS::cust_tax_exempt_pkg_void; -- cgit v1.2.1 From 0d8eb2d4d4a372680d0fa564fbfcba0d6674b259 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Sat, 4 Aug 2012 09:26:23 -0700 Subject: fix skipping processing fee for first payment, RT#18345 --- FS/FS/ClientAPI/MasonComponent.pm | 2 +- FS/FS/ClientAPI/MyAccount.pm | 11 +++++++++-- 2 files changed, 10 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MasonComponent.pm b/FS/FS/ClientAPI/MasonComponent.pm index c72d26879..61208c129 100644 --- a/FS/FS/ClientAPI/MasonComponent.pm +++ b/FS/FS/ClientAPI/MasonComponent.pm @@ -55,7 +55,7 @@ my %session_callbacks = ( %args, 'process-pkgpart' => scalar($conf->config('selfservice_process-pkgpart')), 'process-display' => scalar($conf->config('selfservice_process-display')), - 'process-skip-first' => $conf->exists('selfservice_process-skip_first'), + 'process-skip_first' => $conf->exists('selfservice_process-skip_first'), 'num_payments' => scalar($cust_main->cust_pay), 'surcharge_percentage' => scalar($conf->config('credit-card-surcharge-percentage')), ); diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 3fd621493..eddb16456 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -930,7 +930,12 @@ sub validate_payment { my $conf = new FS::Conf; my $fee_display = $conf->config('selfservice_process-display') || 'add'; my $fee_pkgpart = $conf->config('selfservice_process-pkgpart'); - if ( $fee_display eq 'add' && $fee_pkgpart ) { + my $fee_skip_first = $conf->exists('selfservice_process-skip_first'); + if ( $fee_display eq 'add' + and $fee_pkgpart + and ! $fee_skip_first || scalar($cust_main->cust_pay) + ) + { my $fee_pkg = qsearchs('part_pkg', { pkgpart=>$fee_pkgpart } ); $amount = sprintf('%.2f', $amount + $fee_pkg->option('setup_fee') ); } @@ -1097,7 +1102,9 @@ sub do_process_payment { #no error, so order the fee package if applicable... my $conf = new FS::Conf; my $fee_pkgpart = $conf->config('selfservice_process-pkgpart'); - if ( $fee_pkgpart ) { + my $fee_skip_first = $conf->exists('selfservice_process-skip_first'); + + if ( $fee_pkgpart and ! $fee_skip_first || scalar($cust_main->cust_pay) ) { my $cust_pkg = new FS::cust_pkg { 'pkgpart' => $fee_pkgpart }; -- cgit v1.2.1 From f5a3626fdc2ff793648cebc86f96bf3eac08cc65 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 6 Aug 2012 17:00:55 -0700 Subject: eliminate warnings --- FS/FS/cust_main.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 1da1f0ffd..3742bfdad 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -454,8 +454,10 @@ sub insert { warn " setting $l.custnum\n" if $DEBUG > 1; my $loc = $self->$l; - $loc->set(custnum => $self->custnum); - $error ||= $loc->replace; + unless ( $loc->custnum ) { + $loc->set(custnum => $self->custnum); + $error ||= $loc->replace; + } if ( $error ) { $dbh->rollback if $oldAutoCommit; -- cgit v1.2.1 From cd6bb5eafb6c7df7ea3eb7b78226a0d9c4b572ed Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 7 Aug 2012 15:43:07 -0700 Subject: cust_svc::ignore_quantity hack applies to services not in package too --- FS/FS/cust_svc.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 2ec8f12c2..acd2fcdb7 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -335,10 +335,10 @@ sub check { ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc; return "No svcpart ". $self->svcpart. " services in pkgpart ". $cust_pkg->pkgpart - unless $part_svc; + unless $part_svc || $ignore_quantity; return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum - if $part_svc->get('num_avail') == 0 and !$ignore_quantity; + if $part_svc->get('num_avail') <= 0 and !$ignore_quantity; } $self->SUPER::check; -- cgit v1.2.1 From 2ec6f6df3efd366cb3c3532714dfc93bfa6dcef9 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 7 Aug 2012 16:07:51 -0700 Subject: cust_svc::ignore_quantity hack applies to services not in package too --- FS/FS/cust_svc.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index acd2fcdb7..52069316d 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -338,7 +338,7 @@ sub check { unless $part_svc || $ignore_quantity; return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum - if $part_svc->get('num_avail') <= 0 and !$ignore_quantity; + if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ; } $self->SUPER::check; -- cgit v1.2.1 From 7792fb0d3dfa4e77f41b8055e96a8938153a7677 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 7 Aug 2012 17:12:18 -0700 Subject: better debugging for CCH import failure, RT#18817 --- FS/FS/cust_tax_location.pm | 2 +- FS/FS/part_pkg_taxrate.pm | 2 +- FS/FS/tax_class.pm | 2 +- FS/FS/tax_rate.pm | 2 +- FS/FS/tax_rate_location.pm | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_tax_location.pm b/FS/FS/cust_tax_location.pm index 161a6547b..1a9bf5a41 100644 --- a/FS/FS/cust_tax_location.pm +++ b/FS/FS/cust_tax_location.pm @@ -298,7 +298,7 @@ sub batch_import { } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing cust_tax_location: $line"; } my $error = &{$hook}(\%cust_tax_location); diff --git a/FS/FS/part_pkg_taxrate.pm b/FS/FS/part_pkg_taxrate.pm index e29c3d0b4..c83f700d9 100644 --- a/FS/FS/part_pkg_taxrate.pm +++ b/FS/FS/part_pkg_taxrate.pm @@ -384,7 +384,7 @@ sub batch_import { } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing part_pkg_taxrate: $line"; } my $error = &{$hook}(\%part_pkg_taxrate); diff --git a/FS/FS/tax_class.pm b/FS/FS/tax_class.pm index 4f0396982..bfec2c06c 100644 --- a/FS/FS/tax_class.pm +++ b/FS/FS/tax_class.pm @@ -339,7 +339,7 @@ sub batch_import { } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing tax_class: $line"; } my $error = &{$hook}(\%tax_class); diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index e9496e4f5..77cd5cb52 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -760,7 +760,7 @@ sub batch_import { } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line"; } my $error = &{$hook}(\%tax_rate); diff --git a/FS/FS/tax_rate_location.pm b/FS/FS/tax_rate_location.pm index 1a6c47dcf..b4be8b90e 100644 --- a/FS/FS/tax_rate_location.pm +++ b/FS/FS/tax_rate_location.pm @@ -301,7 +301,7 @@ sub batch_import { } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing tax-rate_location: $line"; } my $error = &{$hook}(\%tax_rate_location); -- cgit v1.2.1 From 21891ab9181cb54c36d78d6aacccadc1aaf910d7 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 7 Aug 2012 17:45:24 -0700 Subject: ignore extra columns in CCH diff (bad data from last update?) --- FS/FS/tax_rate.pm | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 77cd5cb52..3fdaa1efe 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -758,10 +758,13 @@ sub batch_import { foreach my $field ( @fields ) { $tax_rate{$field} = shift @columns; } - if ( scalar( @columns ) ) { - $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line"; - } + + #ignoring extra columns (bad data from last update?) and seeing if that + # allows the upgrade to proceed + #if ( scalar( @columns ) ) { + # $dbh->rollback if $oldAutoCommit; + # return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line"; + #} my $error = &{$hook}(\%tax_rate); if ( $error ) { @@ -1635,16 +1638,16 @@ sub process_download_and_update { if (-d $dir) { - if (-d "$dir.4") { - opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n"; + if (-d "$dir.9") { + opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n"; foreach my $file (readdir($dirh)) { - unlink "$dir.4/$file" if (-f "$dir.4/$file"); + unlink "$dir.9/$file" if (-f "$dir.9/$file"); } closedir($dirh); - rmdir "$dir.4"; + rmdir "$dir.9"; } - for (3, 2, 1) { + for (8, 7, 6, 5, 4, 3, 2, 1) { if ( -e "$dir.$_" ) { rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n"; } -- cgit v1.2.1 From 21254f0e0062b92c19530c49c6eacc9ce3e93827 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Tue, 7 Aug 2012 18:39:05 -0700 Subject: Business::BatchPayment fixes for TD EFT format, #17878 --- FS/FS/Cron/pay_batch.pm | 2 +- FS/FS/pay_batch.pm | 11 +++++++---- FS/FS/pay_batch/td_eft1464.pm | 9 +++++++++ 3 files changed, 17 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/Cron/pay_batch.pm b/FS/FS/Cron/pay_batch.pm index c7cedafb9..0ab37dd13 100644 --- a/FS/FS/Cron/pay_batch.pm +++ b/FS/FS/Cron/pay_batch.pm @@ -103,7 +103,7 @@ sub batch_receive { if ( $gateway->batch_processor->can('default_transport') ) { warn "Importing results from '".$gateway->label."'\n" if $DEBUG; $error = eval { - FS::pay_batch->import_from_gateway( $gateway, debug => $DEBUG ) + FS::pay_batch->import_from_gateway( gateway =>$gateway, debug => $DEBUG ) } || $@; if ( $error ) { # this we can roll back diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index 813d096b4..e98cf5aeb 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -807,8 +807,8 @@ sub try_to_resolve { } ); - if ( @unresolved ) { - my $days = $conf->config('batch-auto_resolve_days') || ''; + if ( @unresolved and $conf->exists('batch-auto_resolve_days') ) { + my $days = $conf->config('batch-auto_resolve_days'); # can be zero # either 'approve' or 'decline' my $action = $conf->config('batch-auto_resolve_status') || ''; return unless @@ -861,6 +861,9 @@ sub prepare_for_export { return "error updating pay_batch status: $error\n" if $error; } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) { $first_download = 0; + } elsif ($status eq 'R' && + $curuser->access_right('Redownload resolved batches')) { + $first_download = 0; } else { die "No pending batch.\n"; } @@ -1080,7 +1083,7 @@ sub _upgrade_data { for my $format (keys %export_info) { my $mod = "FS::pay_batch::$format"; if ( $mod->can('_upgrade_gateway') - and length( $conf->config("batchconfig-$format") ) ) { + and exists( $conf->config("batchconfig-$format") ) ) { local $@; my ($module, %gw_options) = $mod->_upgrade_gateway; @@ -1109,7 +1112,7 @@ sub _upgrade_data { # and if appropriate, make it the system default for my $payby (qw(CARD CHEK)) { - if ( $conf->config("batch-fixed_format-$payby") eq $format ) { + if ( ($conf->config("batch-fixed_format-$payby") || '') eq $format ) { warn "Setting as default for $payby.\n"; $conf->set("batch-gateway-$payby", $gateway->gatewaynum); $conf->delete("batch-fixed_format-$payby"); diff --git a/FS/FS/pay_batch/td_eft1464.pm b/FS/FS/pay_batch/td_eft1464.pm index 3a6befef5..93612f1ea 100644 --- a/FS/FS/pay_batch/td_eft1464.pm +++ b/FS/FS/pay_batch/td_eft1464.pm @@ -154,5 +154,14 @@ $name = 'td_eft1464'; }, ); +sub _upgrade_gateway { + my $conf = FS::Conf->new; + my @batchconfig = $conf->config('batchconfig-td_eft1464'); + my %options; + @options{ qw(originator datacentre short_name long_name return_branch + return_account cpa_code) } = @batchconfig; + ( 'TD_EFT', %options ); +} + 1; -- cgit v1.2.1 From 94c1d035193d1eabb1820e62bce96438f11f870a Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 7 Aug 2012 23:08:53 -0700 Subject: ignore extra columns in CCH diff (bad data from last update?), RT#18817 --- FS/FS/tax_rate.pm | 40 ++++++++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 14 deletions(-) (limited to 'FS') diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 3fdaa1efe..a5a623d94 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -10,6 +10,7 @@ use DateTime::Format::Strptime; use Storable qw( thaw nfreeze ); use IO::File; use File::Temp; +use Text::CSV_XS; use LWP::UserAgent; use HTTP::Request; use HTTP::Response; @@ -637,6 +638,7 @@ sub batch_import { $count *=2; if ( $format eq 'cch' || $format eq 'cch-update' ) { + #false laziness w/below (sub _perform_cch_diff) @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax excessrate effective_date taxauth taxtype taxcat taxname usetax useexcessrate fee unittype feemax maxtype passflag @@ -715,9 +717,6 @@ sub batch_import { die "unknown format $format"; } - eval "use Text::CSV_XS;"; - die $@ if $@; - my $csv = new Text::CSV_XS; my $imported = 0; @@ -759,12 +758,10 @@ sub batch_import { $tax_rate{$field} = shift @columns; } - #ignoring extra columns (bad data from last update?) and seeing if that - # allows the upgrade to proceed - #if ( scalar( @columns ) ) { - # $dbh->rollback if $oldAutoCommit; - # return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line"; - #} + if ( scalar( @columns ) ) { + $dbh->rollback if $oldAutoCommit; + return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line"; + } my $error = &{$hook}(\%tax_rate); if ( $error ) { @@ -1118,8 +1115,26 @@ sub _perform_cch_diff { } close $newcsvfh; - for (keys %oldlines) { - print $dfh $_, ',"D"', "\n" if $oldlines{$_}; + #false laziness w/above (sub batch_import) + my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax + excessrate effective_date taxauth taxtype taxcat taxname + usetax useexcessrate fee unittype feemax maxtype passflag + passtype basetype ); + my $numfields = scalar(@fields); + + my $csv = new Text::CSV_XS { 'always_quote' => 1 }; + + for my $line (grep $oldlines{$_}, keys %oldlines) { + + $csv->parse($line) or do { + #$dbh->rollback if $oldAutoCommit; + die "can't parse: ". $csv->error_input(); + }; + my @columns = $csv->fields(); + + $csv->combine( splice(@columns, 0, $numfields) ); + + print $dfh $csv->string, ',"D"', "\n"; } close $dfh; @@ -1173,9 +1188,6 @@ sub _cch_fetch_and_unzip { sub _cch_extract_csv_from_dbf { my ( $job, $dir, $name ) = @_; - eval "use Text::CSV_XS;"; - die $@ if $@; - eval "use XBase;"; die $@ if $@; -- cgit v1.2.1 From ce1554c9cbd7d97adeb8d55f23cdd18e12e6a623 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 7 Aug 2012 23:56:06 -0700 Subject: fix compilation error --- FS/FS/pay_batch.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index e98cf5aeb..b8da9b49b 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -1083,7 +1083,7 @@ sub _upgrade_data { for my $format (keys %export_info) { my $mod = "FS::pay_batch::$format"; if ( $mod->can('_upgrade_gateway') - and exists( $conf->config("batchconfig-$format") ) ) { + and $conf->exists("batchconfig-$format") ) { local $@; my ($module, %gw_options) = $mod->_upgrade_gateway; -- cgit v1.2.1 From c1a8a9a97ee439036f9f3da5ff222fe3612fc4be Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 8 Aug 2012 00:38:33 -0700 Subject: remove old tax_rate records even if .tax does not match geocode/taxclassnum/taxname/etc. should be enough(bad data from last update?), RT#18817 --- FS/FS/tax_rate.pm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'FS') diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index a5a623d94..6c65bd4c5 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -826,6 +826,9 @@ sub batch_import { } } + #remove even if the rate doesn't match, + # geocode/taxclassnum/taxname/etc. should be enough + delete $delete{$_}->{tax}; my $old = qsearchs( 'tax_rate', $delete{$_} ); unless ($old) { $dbh->rollback if $oldAutoCommit; -- cgit v1.2.1 From ac0162d1dbc26e0c553726ff010b7c5346253e13 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 8 Aug 2012 01:28:08 -0700 Subject: longer username --- FS/FS/Schema.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index a55e0f9d2..72f8c3027 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -445,7 +445,7 @@ sub tables_hashref { my @taxrate_type = ( 'decimal', '', '14,8' ); # requires pg 8 for my @taxrate_typen = ( 'decimal', 'NULL', '14,8' ); # fs-upgrade to work - my $username_len = 32; #usernamemax config file + my $username_len = 64; #usernamemax config file # name type nullability length default local -- cgit v1.2.1 From 31aae8ccdeb214609f96b31a6d8f6dc4614a93b7 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 8 Aug 2012 01:30:22 -0700 Subject: dunno how this happened, but this shouldn't be fatal --- FS/FS/access_right.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index dc9f9978d..22fe94da8 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -265,7 +265,7 @@ sub _upgrade_data { # class method 'rightname' => 'Download report data', } ); my $error = $access_right->insert; - die $error if $error; + warn $error if $error; } FS::upgrade_journal->set_done('ACL_download_report_data'); -- cgit v1.2.1 From 7d4cd63e56dbfcb5020faba2c9a274e3afd6d417 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 8 Aug 2012 01:38:35 -0700 Subject: avoid RT __WARN__ handler harder --- FS/FS/TicketSystem/RT_Internal.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm index e2dfce373..939aa4017 100644 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ b/FS/FS/TicketSystem/RT_Internal.pm @@ -92,6 +92,7 @@ sub init { # this needs to be done on each fork warn "$me init: initializing RT\n" if $DEBUG; { + local $SIG{__WARN}; local $SIG{__DIE__}; eval 'RT::Init("NoSignalHandlers"=>1);'; } -- cgit v1.2.1 From d32459cf059ff29a5ddc4b83ca2bf50a7828454b Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 8 Aug 2012 01:39:25 -0700 Subject: avoid RT __WARN__ handler harder --- FS/FS/TicketSystem/RT_Internal.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm index 939aa4017..b09647e18 100644 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ b/FS/FS/TicketSystem/RT_Internal.pm @@ -92,7 +92,7 @@ sub init { # this needs to be done on each fork warn "$me init: initializing RT\n" if $DEBUG; { - local $SIG{__WARN}; + local $SIG{__WARN__}; local $SIG{__DIE__}; eval 'RT::Init("NoSignalHandlers"=>1);'; } -- cgit v1.2.1 From 5a204201503f8e0db6087db6e53b84297cbc739a Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Fri, 10 Aug 2012 13:54:14 -0700 Subject: add national id # handling for my, RT#18543 --- FS/FS/Conf.pm | 8 ++++++++ FS/FS/Schema.pm | 1 + 2 files changed, 9 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 39b59cf37..43d561168 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1984,6 +1984,14 @@ and customer address. Include units.', 'type' => 'checkbox', }, + { + 'key' => 'national_id-country', + 'section' => 'UI', + 'description' => 'Track a national identification number, for specific countries.', + 'type' => 'select', + 'select_enum' => [ '', 'MY' ], + }, + { 'key' => 'show_bankstate', 'section' => 'UI', diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 72f8c3027..6b32d7153 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -980,6 +980,7 @@ sub tables_hashref { 'ss', 'varchar', 'NULL', 11, '', '', 'stateid', 'varchar', 'NULL', $char_d, '', '', 'stateid_state', 'varchar', 'NULL', $char_d, '', '', + 'national_id', 'varchar', 'NULL', $char_d, '', '', 'birthdate' ,@date_type, '', '', 'spouse_birthdate' ,@date_type, '', '', 'anniversary_date' ,@date_type, '', '', -- cgit v1.2.1 From 45c427d4ceae52aac774702e13290144862e9ab8 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 13 Aug 2012 22:15:24 -0700 Subject: revert: remove old tax_rate records even if .tax does not match geocode/taxclassnum/taxname/etc. should be enough(bad data from last update?), RT#18817 --- FS/FS/tax_rate.pm | 3 --- 1 file changed, 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 6c65bd4c5..a5a623d94 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -826,9 +826,6 @@ sub batch_import { } } - #remove even if the rate doesn't match, - # geocode/taxclassnum/taxname/etc. should be enough - delete $delete{$_}->{tax}; my $old = qsearchs( 'tax_rate', $delete{$_} ); unless ($old) { $dbh->rollback if $oldAutoCommit; -- cgit v1.2.1 From 8d5b8d5d0d0ce1e238cca778e4b342e950ea1574 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 13 Aug 2012 22:25:17 -0700 Subject: don't suck so much CPU with freeside-cdrd --- FS/bin/freeside-cdrd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-cdrd b/FS/bin/freeside-cdrd index 2cf75f31c..b21bd5b07 100644 --- a/FS/bin/freeside-cdrd +++ b/FS/bin/freeside-cdrd @@ -108,7 +108,7 @@ while (1) { } myexit() if sigterm() || sigint(); - sleep 1 unless $found; + sleep 5 unless $found; } -- cgit v1.2.1 From 00938b30a69411a743aa01db5e27100818a3c82b Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Tue, 14 Aug 2012 17:02:47 -0700 Subject: unsuspend fees, #6587 --- FS/FS/Schema.pm | 2 ++ FS/FS/cust_pkg.pm | 37 ++++++++++++++++++++++++++++++++++++- FS/FS/reason.pm | 27 +++++++++++++++++++++++++-- 3 files changed, 63 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 6b32d7153..0f1d1513a 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -3671,6 +3671,8 @@ sub tables_hashref { 'reason_type', 'int', '', '', '', '', 'reason', 'text', '', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', + 'unsuspend_pkgpart', 'int', 'NULL', '', '', '', + 'unsuspend_hold','char', 'NULL', 1, '', '', ], 'primary_key' => 'reasonnum', 'unique' => [], diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index aed99e51d..f56e1f0ed 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1319,7 +1319,8 @@ sub credit_remaining { Unsuspends all services (see L and L) in this package, then unsuspends the package itself (clears the susp field and the -adjourn field if it is in the past). +adjourn field if it is in the past). If the suspend reason includes an +unsuspension package, that package will be ordered. Available options are: @@ -1423,6 +1424,8 @@ sub unsuspend { } + my $reason = $self->last_cust_pkg_reason('susp')->reason; + my %hash = $self->hash; my $inactive = time - $hash{'susp'}; @@ -1449,6 +1452,33 @@ sub unsuspend { return $error; } + my $unsusp_pkg; + + if ( $reason->unsuspend_pkgpart ) { + my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart) + or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart. + " not found."; + my $start_date = $self->cust_main->next_bill_date + if $reason->unsuspend_hold; + + if ( $part_pkg ) { + $unsusp_pkg = FS::cust_pkg->new({ + 'custnum' => $self->custnum, + 'pkgpart' => $reason->unsuspend_pkgpart, + 'start_date' => $start_date, + 'locationnum' => $self->locationnum, + # discount? probably not... + }); + + $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg ); + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + if ( $conf->config('unsuspend_email_admin') ) { my $error = send_email( @@ -1462,6 +1492,11 @@ sub unsuspend { 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n", 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n", ( map { "Service : $_\n" } @labels ), + ($unsusp_pkg ? + "An unsuspension fee was charged: Package #".$unsusp_pkg->pkgnum. + " (.".$unsusp_pkg->pkg_comment.")\n" + : '' + ), ], ); diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index 377da4985..a9a7d745d 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -46,6 +46,15 @@ FS::Record. The following fields are currently supported: =item disabled - 'Y' or '' +=item unsuspend_pkgpart - for suspension reasons only, the pkgpart (see +L) of a package to be ordered when the package is unsuspended. +Typically this will be some kind of reactivation fee. Attaching it to +a suspension reason allows the reactivation fee to be charged for some +suspensions but not others. + +=item unsuspend_hold - 'Y' or ''. If unsuspend_pkgpart is set, this tells +whether to bill the unsuspend package immediately ('') or to wait until +the customer's next invoice ('Y'). =back @@ -97,16 +106,30 @@ sub check { my $error = $self->ut_numbern('reasonnum') + || $self->ut_number('reason_type') + || $self->ut_foreign_key('reason_type', 'reason_type', 'typenum') || $self->ut_text('reason') + || $self->ut_flag('disabled') ; return $error if $error; + if ( $self->reasontype->class eq 'S' ) { + $error = $self->ut_numbern('unsuspend_pkgpart') + || $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart') + || $self->ut_flag('unsuspend_hold') + ; + return $error if $error; + } else { + $self->set('unsuspend_pkgpart' => ''); + $self->set('unsuspend_hold' => ''); + } + $self->SUPER::check; } =item reasontype -Returns the reason_type (see FS::reason_type) associated with this reason. +Returns the reason_type (see L) associated with this reason. =cut @@ -118,7 +141,7 @@ sub reasontype { =head1 BUGS -Here be termintes. Don't use on wooden computers. +Here by termintes. Don't use on wooden computers. =head1 SEE ALSO -- cgit v1.2.1 From 8728da844700ef4a10b05195f901d25630c416d8 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Tue, 14 Aug 2012 17:11:40 -0700 Subject: fix typo --- FS/FS/cust_pkg.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index f56e1f0ed..ba6120b8a 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1493,8 +1493,8 @@ sub unsuspend { 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n", ( map { "Service : $_\n" } @labels ), ($unsusp_pkg ? - "An unsuspension fee was charged: Package #".$unsusp_pkg->pkgnum. - " (.".$unsusp_pkg->pkg_comment.")\n" + "An unsuspension fee was charged: ". + $unsusp_pkg->part_pkg->pkg_comment."\n" : '' ), ], -- cgit v1.2.1 From 947347097f67c615d2306e34772535f312e2fb2d Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 15 Aug 2012 13:58:06 -0700 Subject: ticket system init note --- FS/FS/cust_pkg.pm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index aed99e51d..721c9dbed 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -338,6 +338,9 @@ sub insert { if ( $conf->config('ticket_system') && $options{ticket_subject} ) { + #this init stuff is still inefficient, but at least its limited to + # the small number (any?) folks using ticket emailing on pkg order + #eval ' # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); # use RT; -- cgit v1.2.1 From 66b55857d43110136cf85d57dbda0960cad29b32 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 15 Aug 2012 23:12:58 -0700 Subject: separate ACL for merging customers across agents, RT#18939 --- FS/FS/AccessRight.pm | 1 + FS/FS/cust_main.pm | 9 ++++++--- 2 files changed, 7 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index b41ec2fe2..e730bde82 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -117,6 +117,7 @@ tie my %rights, 'Tie::IxHash', 'Cancel customer', 'Complimentary customer', #aka users-allow_comp 'Merge customer', + 'Merge customer across agents', { rightname=>'Delete customer', desc=>"Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customer's packages if they cancel service." }, #aka. deletecustomers 'Bill customer now', #NEW 'Bulk send customer notices', #NEW diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 3742bfdad..fda82e45b 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1245,9 +1245,12 @@ sub merge { return "Can't merge a customer into self" if $self->custnum == $new_custnum; - unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { - return "Invalid new customer number: $new_custnum"; - } + my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) + or return "Invalid new customer number: $new_custnum"; + + return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent' + if $self->agentnum != $new_cust_main->agentnum + && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents'); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; -- cgit v1.2.1 From 022c84a3d9c8a946d5e0b3f0fff73aa771461bc5 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 16 Aug 2012 01:27:03 -0700 Subject: FS/FS/cust_main/NationalID.pm --- FS/FS/cust_main.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index fda82e45b..9e39b3006 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4,6 +4,7 @@ require 5.006; use strict; #FS::cust_main:_Marketgear when they're ready to move to 2.1 use base qw( FS::cust_main::Packages FS::cust_main::Status + FS::cust_main::NationalID FS::cust_main::Billing FS::cust_main::Billing_Realtime FS::cust_main::Billing_Discount FS::cust_main::Location -- cgit v1.2.1 From 582189e6a07bf401385e220bb554ddbf0441b9fb Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 16 Aug 2012 01:31:15 -0700 Subject: national IDs, RT#18543 --- FS/FS/cust_main/NationalID.pm | 60 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 FS/FS/cust_main/NationalID.pm (limited to 'FS') diff --git a/FS/FS/cust_main/NationalID.pm b/FS/FS/cust_main/NationalID.pm new file mode 100644 index 000000000..cc8d55685 --- /dev/null +++ b/FS/FS/cust_main/NationalID.pm @@ -0,0 +1,60 @@ +package FS::cust_main::NationalID; + +use strict; +use vars qw( $conf ); +use Date::Simple qw( days_in_month ); +use FS::UID; + +install_callback FS::UID sub { + $conf = new FS::Conf; +}; + +sub set_national_id_from_cgi { + my( $self, $cgi ) = @_; + + my $error = ''; + + if ( my $id_country = $conf->config('national_id-country') ) { + if ( $id_country eq 'MY' ) { + + if ( $cgi->param('national_id1') =~ /\S/ ) { + my $nric = $cgi->param('national_id1'); + $nric =~ s/\s//g; + if ( $nric =~ /^(\d{2})(\d{2})(\d{2})\-?(\d{2})\-?(\d{4})$/ ) { + my( $y, $m, $d, $bp, $n ) = ( $1, $2, $3, $4, $5 ); + $self->national_id( "$y$m$d-$bp-$n" ); + + my @lt = localtime(time); + my $year = ( $y <= substr( $lt[5]+1900, -2) ) ? 2000 + $y + : 1900 + $y; + $error ||= "Illegal NRIC: ". $cgi->param('national_id1') + if $m < 1 || $m > 12 || $d < 1 || $d > days_in_month($year, $m); + #$bp validation per http://en.wikipedia.org/wiki/National_Registration_Identity_Card_Number_%28Malaysia%29#Second_section:_Birthplace ? seems like a bad idea, some could be missing or get added + } else { + $error ||= "Illegal NRIC: ". $cgi->param('national_id1'); + } + } elsif ( $cgi->param('national_id2') =~ /\S/ ) { + my $oldic = $cgi->param('national_id2'); + $oldic =~ s/\s//g; + if ( $oldic =~ /^\w\d{9}$/ ) { + $self->national_id($oldic); + } else { + $error ||= "Illegal Old IC/Passport: ". $cgi->param('national_id2'); + } + } else { + $error ||= 'Either NRIC or Old IC/Passport is required'; + } + + } else { + warn "unknown national_id-country $id_country"; + } + } elsif ( $cgi->param('national_id0') ) { + $self->national_id( $cgi->param('national_id0') ); + } + + $error; + +} + +1; + -- cgit v1.2.1 From fb40033fc45f6edce5088e7b29840b58df7b0690 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 16 Aug 2012 10:59:48 -0700 Subject: slightly better description --- FS/FS/Conf.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 43d561168..d152a0145 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3438,7 +3438,7 @@ and customer address. Include units.', { 'key' => 'invoice-unitprice', 'section' => 'invoicing', - 'description' => 'Enable unit pricing on invoices.', + 'description' => 'Enable unit pricing on invoices and quantities on packages.', 'type' => 'checkbox', }, -- cgit v1.2.1 From ec1c141729f9c3004cd0c633f2e4c7ed8bdaa418 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 16 Aug 2012 11:10:02 -0700 Subject: fix unit_recur 0.0 on existing line items, RT#13136 --- FS/FS/Template_Mixin.pm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 61cfccba8..8277c0046 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -2411,6 +2411,10 @@ sub _items_cust_bill_pkg { $amount = $cust_bill_pkg->usage; } + my $unit_amount = + ( $cust_bill_pkg->unitrecur > 0 ) ? $cust_bill_pkg->unitrecur + : $amount; + if ( !$type || $type eq 'R' ) { warn "$me _items_cust_bill_pkg adding recur\n" @@ -2418,7 +2422,7 @@ sub _items_cust_bill_pkg { if ( $cust_bill_pkg->hidden ) { $r->{amount} += $amount; - $r->{unit_amount} += $cust_bill_pkg->unitrecur; + $r->{unit_amount} += $unit_amount; push @{ $r->{ext_description} }, @d; } else { $r = { @@ -2427,7 +2431,7 @@ sub _items_cust_bill_pkg { pkgnum => $cust_bill_pkg->pkgnum, amount => $amount, recur_show_zero => $cust_bill_pkg->recur_show_zero, - unit_amount => $cust_bill_pkg->unitrecur, + unit_amount => $unit_amount, quantity => $cust_bill_pkg->quantity, %item_dates, ext_description => \@d, @@ -2442,7 +2446,7 @@ sub _items_cust_bill_pkg { if ( $cust_bill_pkg->hidden ) { $u->{amount} += $amount; - $u->{unit_amount} += $cust_bill_pkg->unitrecur; + $u->{unit_amount} += $unit_amount, push @{ $u->{ext_description} }, @d; } else { $u = { @@ -2451,7 +2455,7 @@ sub _items_cust_bill_pkg { pkgnum => $cust_bill_pkg->pkgnum, amount => $amount, recur_show_zero => $cust_bill_pkg->recur_show_zero, - unit_amount => $cust_bill_pkg->unitrecur, + unit_amount => $unit_amount, quantity => $cust_bill_pkg->quantity, %item_dates, ext_description => \@d, -- cgit v1.2.1 From d0eb979ed67e3ad9e1af8ef5cf04376ea5f74c04 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Fri, 17 Aug 2012 12:52:53 -0700 Subject: disable date editor on new installs --- FS/FS/AccessRight.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index e730bde82..d6e0adb79 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -407,6 +407,7 @@ sub default_superuser_rights { 'Edit usage', 'Credit card void', 'Echeck void', + 'Edit customer package dates', ); no warnings 'uninitialized'; -- cgit v1.2.1 From 9bafdefcce8d3586429d2878f148bb4fd211b4e2 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Fri, 17 Aug 2012 18:53:49 -0700 Subject: quotation reports, RT#16996 --- FS/FS/AccessRight.pm | 1 + FS/FS/access_right.pm | 1 + FS/FS/quotation.pm | 153 +++++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 154 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index d6e0adb79..26867c318 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -264,6 +264,7 @@ tie my %rights, 'Tie::IxHash', 'List all customers', 'Advanced customer search', 'List zip codes', #NEW + 'List quotations', 'List invoices', 'List packages', 'Summarize packages', diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index 22fe94da8..397b456ce 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -197,6 +197,7 @@ sub _upgrade_data { # class method 'Unsuspend customer package' => 'Unsuspend customer', 'New prospect' => 'Generate quotation', 'Delete invoices' => 'Void invoices', + 'List invoices' => 'List quotations', 'List services' => [ 'Services: Accounts', 'Services: Domains', diff --git a/FS/FS/quotation.pm b/FS/FS/quotation.pm index 9e7723c77..bf2711b0a 100644 --- a/FS/FS/quotation.pm +++ b/FS/FS/quotation.pm @@ -147,7 +147,34 @@ sub cust_bill_pkg { #actually quotation_pkg objects qsearch('quotation_pkg', { quotationnum=>$self->quotationnum }); } -=back +=item total_setup + +=cut + +sub total_setup { + my $self = shift; + $self->_total('setup'); +} + +=item total_recur [ FREQ ] + +=cut + +sub total_recur { + my $self = shift; +#=item total_recur [ FREQ ] + #my $freq = @_ ? shift : ''; + $self->_total('recur'); +} + +sub _total { + my( $self, $method ) = @_; + + my $total = 0; + $total += $_->$method() for $self->cust_bill_pkg; + sprintf('%.2f', $total); + +} =item enable_previous @@ -155,6 +182,130 @@ sub cust_bill_pkg { #actually quotation_pkg objects sub enable_previous { 0 } +=back + +=head1 CLASS METHODS + +=over 4 + + +=item search_sql_where HASHREF + +Class method which returns an SQL WHERE fragment to search for parameters +specified in HASHREF. Valid parameters are + +=over 4 + +=item _date + +List reference of start date, end date, as UNIX timestamps. + +=item invnum_min + +=item invnum_max + +=item agentnum + +=item charged + +List reference of charged limits (exclusive). + +=item owed + +List reference of charged limits (exclusive). + +=item open + +flag, return open invoices only + +=item net + +flag, return net invoices only + +=item days + +=item newest_percust + +=back + +Note: validates all passed-in data; i.e. safe to use with unchecked CGI params. + +=cut + +sub search_sql_where { + my($class, $param) = @_; + #if ( $DEBUG ) { + # warn "$me search_sql_where called with params: \n". + # join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n"; + #} + + my @search = (); + + #agentnum + if ( $param->{'agentnum'} =~ /^(\d+)$/ ) { + push @search, "( prospect_main.agentnum = $1 OR cust_main.agentnum = $1 )"; + } + +# #refnum +# if ( $param->{'refnum'} =~ /^(\d+)$/ ) { +# push @search, "cust_main.refnum = $1"; +# } + + #prospectnum + if ( $param->{'prospectnum'} =~ /^(\d+)$/ ) { + push @search, "quotation.prospectnum = $1"; + } + + #custnum + if ( $param->{'custnum'} =~ /^(\d+)$/ ) { + push @search, "cust_bill.custnum = $1"; + } + + #_date + if ( $param->{_date} ) { + my($beginning, $ending) = @{$param->{_date}}; + + push @search, "quotation._date >= $beginning", + "quotation._date < $ending"; + } + + #quotationnum + if ( $param->{'quotationnum_min'} =~ /^(\d+)$/ ) { + push @search, "quotation.quotationnum >= $1"; + } + if ( $param->{'quotationnum_max'} =~ /^(\d+)$/ ) { + push @search, "quotation.quotationnum <= $1"; + } + +# #charged +# if ( $param->{charged} ) { +# my @charged = ref($param->{charged}) +# ? @{ $param->{charged} } +# : ($param->{charged}); +# +# push @search, map { s/^charged/cust_bill.charged/; $_; } +# @charged; +# } + + my $owed_sql = FS::cust_bill->owed_sql; + + #days + push @search, "quotation._date < ". (time-86400*$param->{'days'}) + if $param->{'days'}; + + #agent virtualization + my $curuser = $FS::CurrentUser::CurrentUser; + #false laziness w/search/quotation.html + push @search,' ( '. $curuser->agentnums_sql( table=>'prospect_main' ). + ' OR '. $curuser->agentnums_sql( table=>'cust_main' ). + ' ) '; + + join(' AND ', @search ); + +} + +=back + =head1 BUGS =head1 SEE ALSO -- cgit v1.2.1 From 74264d593e365fd864769a48cf69aa46246a97c3 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 20 Aug 2012 13:32:34 -0700 Subject: 'Usage: Time Worked' off by default --- FS/FS/AccessRight.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 26867c318..b38c2671d 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -400,6 +400,7 @@ sub default_superuser_rights { 'Delete refund', #? 'Edit customer package dates', 'Time queue', + 'Usage: Time worked', 'Redownload resolved batches', 'Raw SQL', 'Configuration download', -- cgit v1.2.1 From 3c755c5662be8bfe62a646b5e5ea2e2aae3143d8 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 21 Aug 2012 13:51:10 -0700 Subject: mobile numbers searchable, RT#18840 --- FS/FS/cust_main/Search.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm index 2d347e140..7b2f30dc4 100644 --- a/FS/FS/cust_main/Search.pm +++ b/FS/FS/cust_main/Search.pm @@ -85,7 +85,7 @@ sub smart_search { 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). ' ( '. join(' OR ', map "$_ = '$phonen'", - qw( daytime night fax ) + qw( daytime night mobile fax ) ). ' ) '. " AND $agentnums_sql", #agent virtualization -- cgit v1.2.1 From 0f54bc9de62911521dec0d6d418703a7af8033f6 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 21 Aug 2012 18:45:10 -0700 Subject: add agent email, RT#18231 --- FS/FS/Conf.pm | 7 +++++ FS/FS/Cron/agent_email.pm | 79 +++++++++++++++++++++++++++++++++++++++++++++++ FS/bin/freeside-daily | 23 ++++++-------- 3 files changed, 96 insertions(+), 13 deletions(-) create mode 100644 FS/FS/Cron/agent_email.pm (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index d152a0145..42432b2a4 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -5245,6 +5245,13 @@ and customer address. Include units.', ], }, + { + 'key' => 'agent-email_day', + 'section' => '', + 'description' => 'On this day of each month, agents with master customer records containing email addresses will be emailed a list of their customers and balances.', + 'type' => 'text', + }, + { key => "apacheroot", section => "deprecated", description => "DEPRECATED", type => "text" }, { key => "apachemachine", section => "deprecated", description => "DEPRECATED", type => "text" }, { key => "apachemachines", section => "deprecated", description => "DEPRECATED", type => "text" }, diff --git a/FS/FS/Cron/agent_email.pm b/FS/FS/Cron/agent_email.pm new file mode 100644 index 000000000..f3fb945b1 --- /dev/null +++ b/FS/FS/Cron/agent_email.pm @@ -0,0 +1,79 @@ +package FS::Cron::agent_email; +use base qw( Exporter ); + +use strict; +use vars qw( @EXPORT_OK $DEBUG ); +use Date::Simple qw(today); +use URI::Escape; +use FS::Mason qw( mason_interps ); +use FS::Conf; +use FS::Misc qw(send_email); +use FS::Record qw(qsearch);# qsearchs); +use FS::agent; + +@EXPORT_OK = qw ( agent_email ); +$DEBUG = 1; + +sub agent_email { + my %opt = @_; + + my $conf = new FS::Conf; + + my $day = $conf->config('agent-email_day') or return; + return unless $day == today->day; + + if ( 1 ) { #XXX if ( %%%RT_ENABLED%%% ) { + require RT; + RT::LoadConfig(); + RT::Init(); + RT::ConnectToDatabase(); + } + + my $from = $conf->config('invoice_from'); + + my $outbuf = '';; + my( $fs_interp, $rt_interp ) = mason_interps('standalone', 'outbuf'=>\$outbuf); + + my $comp = '/search/cust_main.html'; + my %args = ( + 'cust_fields' => 'Cust# | Cust. Status | Customer | Current Balance', + '_type' => 'html-print', + ); + my $query = join('&', map "$_=".uri_escape($args{$_}), keys %args ); + + my $extra_sql = $opt{a} ? " AND agentnum IN ( $opt{a} ) " : ''; + + foreach my $agent ( qsearch({ + 'table' => 'agent', + 'hashref' => { + 'disabled' => '', + 'agent_custnum' => { op=>'!=', value=>'' }, + }, + 'extra_sql' => $extra_sql, + }) + ) + { + + $FS::Mason::Request::QUERY_STRING = $query. '&agentnum='. $agent->agentnum; + $fs_interp->exec($comp); + + my @email = $agent->agent_cust_main->invoicing_list or next; + + warn "emailing ". join(',',@email). " for agent ". $agent->agent. "\n" + if $DEBUG; + send_email( + 'from' => $from, + 'to' => \@email, + 'subject' => 'Customer report', + 'body' => $outbuf, + 'content-type' => 'text/html', + #'content-encoding' + ); + + $outbuf = ''; + + } + +} + +1; diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 2b33d1671..8e8ae4ff9 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -7,7 +7,7 @@ use FS::Conf; &untaint_argv; #what it sounds like (eww) use vars qw(%opt); -getopts("p:a:d:vl:sy:nmrkg:uo", \%opt); +getopts("p:a:d:vl:sy:nmrkg:o", \%opt); my $user = shift or die &usage; adminsuidsetup $user; @@ -51,16 +51,6 @@ unless ( $opt{k} ) { notify_flat_delay(%opt); } -#debian Pg 8.1+ auto-vaccums, 7.4 w/postgresql-contrib -if ( $opt{u} ) { - use FS::Cron::vacuum qw(vacuum); - vacuum(); -} - -#you can skip this just by not having the config -use FS::Cron::backup qw(backup); -backup(); - #same use FS::Cron::rt_tasks qw(rt_daily); rt_daily(%opt); @@ -70,11 +60,20 @@ use FS::Cron::pay_batch qw(batch_submit batch_receive); batch_submit(%opt); batch_receive(%opt); +#you can skip this by not having the config +use FS::Cron::agent_email qw(agent_email); +agent_email(%opt); + my $deldir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc/"; unlink <${deldir}.invoice*>; unlink <${deldir}.letter*>; unlink <${deldir}.CGItemp*>; +#backup should be last +#you can skip this just by not having the config +use FS::Cron::backup qw(backup); +backup(); + ### # subroutines ### @@ -145,8 +144,6 @@ the bill and collect methods of a cust_main object. See L. -k: skip notify_flat_delay - -u: Do a vacuum (starting with version 1.9, this is not run by default). - user: From the mapsecrets file - see config.html from the base documentation custnum: if one or more customer numbers are specified, only bills those -- cgit v1.2.1 From f88c4a7668591d51e6e923938721010fd0f2fa59 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 21 Aug 2012 18:45:45 -0700 Subject: add agent email, RT#18231 --- FS/FS/Cron/agent_email.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Cron/agent_email.pm b/FS/FS/Cron/agent_email.pm index f3fb945b1..992aa35a2 100644 --- a/FS/FS/Cron/agent_email.pm +++ b/FS/FS/Cron/agent_email.pm @@ -12,7 +12,7 @@ use FS::Record qw(qsearch);# qsearchs); use FS::agent; @EXPORT_OK = qw ( agent_email ); -$DEBUG = 1; +$DEBUG = 0; sub agent_email { my %opt = @_; -- cgit v1.2.1 From 03b8791b0253e3fd66a6eae75ff54bdd7b51db9d Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 22 Aug 2012 12:08:44 -0700 Subject: add "National ID, plus account and phone services" import format, RT#18946 --- FS/FS/cust_main/Import.pm | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main/Import.pm b/FS/FS/cust_main/Import.pm index ee14cbaed..19c0d52a4 100644 --- a/FS/FS/cust_main/Import.pm +++ b/FS/FS/cust_main/Import.pm @@ -210,8 +210,23 @@ sub batch_import { cust_pkg.pkgpart cust_pkg.bill svc_acct.username svc_acct._password ); - push @fields, map "svc_phone.$_", qw(countrycode phonenum sip_password pin); - push @fields, map "svc_hardware.$_", qw(typenum ip_addr hw_addr serial); + push @fields, map "svc_phone.$_", qw(countrycode phonenum sip_password pin); + push @fields, map "svc_hardware.$_", qw(typenum ip_addr hw_addr serial); + + $payby = 'BILL'; + } elsif ( $format eq 'national_id-acct_phone') { + @fields = qw( agent_custid refnum + last first company address1 address2 city state zip country + daytime night + ship_last ship_first ship_company ship_address1 ship_address2 + ship_city ship_state ship_zip ship_country + national_id + payinfo paycvv paydate + invoicing_list + cust_pkg.pkgpart cust_pkg.bill + svc_acct.username svc_acct._password + ); + push @fields, map "svc_phone.$_", qw(countrycode phonenum sip_password pin); $payby = 'BILL'; } else { -- cgit v1.2.1 From 1c7805046b0d15dd57db594211b924bc10e48ab7 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Sun, 26 Aug 2012 13:27:14 -0700 Subject: fix listing of previous balances when two customer invoices are generated in the same second, RT#18928 --- FS/FS/cust_bill.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index c5b707bb1..c48c80627 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -433,7 +433,8 @@ sub previous { my @cust_bill = sort { $a->_date <=> $b->_date } grep { $_->owed != 0 } qsearch( 'cust_bill', { 'custnum' => $self->custnum, - '_date' => { op=>'<', value=>$self->_date }, + #'_date' => { op=>'<', value=>$self->_date }, + 'invnum' => { op=>'<', value=>$self->invnum }, } ) ; foreach ( @cust_bill ) { $total += $_->owed; } -- cgit v1.2.1 From f674b7c9b094749fcef770d1ae03640b69b1ec83 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 28 Aug 2012 02:05:55 -0700 Subject: remove validation from national_id old format per customer, RT#18543 --- FS/FS/cust_main/NationalID.pm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main/NationalID.pm b/FS/FS/cust_main/NationalID.pm index cc8d55685..a742b7637 100644 --- a/FS/FS/cust_main/NationalID.pm +++ b/FS/FS/cust_main/NationalID.pm @@ -36,11 +36,15 @@ sub set_national_id_from_cgi { } elsif ( $cgi->param('national_id2') =~ /\S/ ) { my $oldic = $cgi->param('national_id2'); $oldic =~ s/\s//g; - if ( $oldic =~ /^\w\d{9}$/ ) { + + # can you please remove validation for "Old IC/Passport:" field, customer + # will have other field format like, RF/123456, I/5234234 ... + #if ( $oldic =~ /^\w\d{9}$/ ) { $self->national_id($oldic); - } else { - $error ||= "Illegal Old IC/Passport: ". $cgi->param('national_id2'); - } + #} else { + # $error ||= "Illegal Old IC/Passport: ". $cgi->param('national_id2'); + #} + } else { $error ||= 'Either NRIC or Old IC/Passport is required'; } -- cgit v1.2.1 From 9f2220031123f06ab275840a3129c9807b9a782a Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 28 Aug 2012 02:06:15 -0700 Subject: add slipip to "National ID..." import format, RT#18946 --- FS/FS/cust_main/Import.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main/Import.pm b/FS/FS/cust_main/Import.pm index 19c0d52a4..eadcc1a55 100644 --- a/FS/FS/cust_main/Import.pm +++ b/FS/FS/cust_main/Import.pm @@ -224,7 +224,7 @@ sub batch_import { payinfo paycvv paydate invoicing_list cust_pkg.pkgpart cust_pkg.bill - svc_acct.username svc_acct._password + svc_acct.username svc_acct._password svc_acct.slipip ); push @fields, map "svc_phone.$_", qw(countrycode phonenum sip_password pin); @@ -336,7 +336,7 @@ sub batch_import { $cust_pkg{$1} = parse_datetime( shift @columns ); } - } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) { + } elsif ( $field =~ /^svc_acct\.(username|_password|slipip)$/ ) { $svc_x{$1} = shift @columns; -- cgit v1.2.1 From dfa1e92c5af9bd54186cd46f47ea528622f60894 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sun, 26 Aug 2012 23:03:51 -0700 Subject: avoid displaying default service addresses on invoices, #940 --- FS/FS/Template_Mixin.pm | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 8277c0046..d35fd55f2 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -894,7 +894,6 @@ sub print_generic { warn "$me setting options\n" if $DEBUG > 1; - my $multilocation = scalar($cust_main->cust_location); #too expensive? my %options = (); $options{'section'} = $section if $multisection; $options{'format'} = $format; @@ -904,7 +903,6 @@ sub print_generic { $options{'summary_page'} = $summarypage; $options{'skip_usage'} = scalar(@$extra_sections) && !grep{$section == $_} @$extra_sections; - $options{'multilocation'} = $multilocation; $options{'multisection'} = $multisection; warn "$me searching for line items\n" @@ -2111,8 +2109,6 @@ ignored. multisection: a flag indicating that this is a multisection invoice, which does something complicated. -multilocation: a flag to display the location label for the package. - Returns a list of hashrefs, each of which may contain: pkgnum, description, amount, unit_amount, quantity, _is_setup, and @@ -2134,13 +2130,13 @@ sub _items_cust_bill_pkg { my $unsquelched = $opt{unsquelched} || ''; #unused my $section = $opt{section}->{description} if $opt{section}; my $summary_page = $opt{summary_page} || ''; #unused - my $multilocation = $opt{multilocation} || ''; my $multisection = $opt{multisection} || ''; my $discount_show_always = 0; my $maxlength = $conf->config('cust_bill-latex_lineitem_maxlength') || 50; my $cust_main = $self->cust_main;#for per-agent cust_bill-line_item-ate_style + # and location labels my @b = (); my ($s, $r, $u) = ( undef, undef, undef ); @@ -2255,7 +2251,7 @@ sub _items_cust_bill_pkg { $cust_pkg->h_labels_short($self->_date, undef, 'I') unless $cust_bill_pkg->pkgpart_override; #don't redisplay services - if ( $multilocation ) { + if ( $cust_pkg->locationnum != $cust_main->ship_locationnum ) { my $loc = $cust_pkg->location_label; $loc = substr($loc, 0, $maxlength). '...' if $format eq 'latex' && length($loc) > $maxlength; @@ -2357,7 +2353,7 @@ sub _items_cust_bill_pkg { warn "$me _items_cust_bill_pkg done adding service details\n" if $DEBUG > 1; - if ( $multilocation ) { + if ( $cust_pkg->locationnum != $cust_main->ship_locationnum ) { my $loc = $cust_pkg->location_label; $loc = substr($loc, 0, $maxlength). '...' if $format eq 'latex' && length($loc) > $maxlength; -- cgit v1.2.1 From abb5095e4f202875934937166af1efe912f77d34 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sun, 26 Aug 2012 23:04:19 -0700 Subject: make address fields work in customer search results, #940 --- FS/FS/cust_main/Search.pm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm index 7b2f30dc4..b07223ec5 100644 --- a/FS/FS/cust_main/Search.pm +++ b/FS/FS/cust_main/Search.pm @@ -798,6 +798,9 @@ sub search { my @select = ( 'cust_main.custnum', + # there's a good chance that we'll need these + 'cust_main.bill_locationnum', + 'cust_main.ship_locationnum', FS::UI::Web::cust_sql_fields($params->{'cust_fields'}), ); -- cgit v1.2.1 From 36e4318e1ccec27ae76a3d1505718a3d47af67c9 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Tue, 28 Aug 2012 18:45:30 -0700 Subject: sqlradius data volume report improvements, #18823 --- FS/FS/svc_acct.pm | 26 +++++++++++++++++--------- FS/FS/svc_broadband.pm | 6 ++++++ 2 files changed, 23 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e67db43c6..7ce79ae01 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -2808,6 +2808,13 @@ Arrayref of additional WHERE clauses, will be ANDed together. sub search { my ($class, $params) = @_; + my @from = ( + ' LEFT JOIN cust_svc USING ( svcnum ) ', + ' LEFT JOIN part_svc USING ( svcpart ) ', + ' LEFT JOIN cust_pkg USING ( pkgnum ) ', + ' LEFT JOIN cust_main USING ( custnum ) ', + ); + my @where = (); # domain @@ -2852,9 +2859,17 @@ sub search { push @where, "svcpart = $1"; } + if ( $params->{'exportnum'} =~ /^(\d+)$/ ) { + push @from, ' LEFT JOIN export_svc USING ( svcpart )'; + push @where, "exportnum = $1"; + } + # sector and tower my @where_sector = $class->tower_sector_sql($params); - push @where, @where_sector if @where_sector; + if ( @where_sector ) { + push @where, @where_sector; + push @from, ' LEFT JOIN tower_sector USING ( sectornum )'; + } # here is the agent virtualization #if ($params->{CurrentUser}) { @@ -2875,16 +2890,9 @@ sub search { push @where, @{ $params->{'where'} } if $params->{'where'}; + my $addl_from = join(' ', @from); my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; - my $addl_from = ' LEFT JOIN cust_svc USING ( svcnum ) '. - ' LEFT JOIN part_svc USING ( svcpart ) '. - ' LEFT JOIN cust_pkg USING ( pkgnum ) '. - ' LEFT JOIN cust_main USING ( custnum ) '; - - $addl_from .= ' LEFT JOIN tower_sector USING ( sectornum )' - if @where_sector; - my $count_query = "SELECT COUNT(*) FROM svc_acct $addl_from $extra_sql"; #if ( keys %svc_acct ) { # $count_query .= ' WHERE '. diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm index 82102697d..26659d52a 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -245,6 +245,12 @@ sub search { push @where, "svcpart = $1"; } + #exportnum + if ( $params->{'exportnum'} =~ /^(\d+)$/ ) { + push @from, 'LEFT JOIN export_svc USING ( svcpart )'; + push @where, "exportnum = $1"; + } + #ip_addr if ( $params->{'ip_addr'} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ ) { push @where, "ip_addr = '$1'"; -- cgit v1.2.1 From dc6eb0609882ec1443a79a309577108e92011dc9 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 29 Aug 2012 15:24:02 -0700 Subject: fix "time" parameter when querying events --- FS/FS/part_event.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm index 62f16fa1c..b7371c9ab 100644 --- a/FS/FS/part_event.pm +++ b/FS/FS/part_event.pm @@ -306,8 +306,8 @@ sub targets { }); my @tested_objects; foreach my $object ( @objects ) { - my $cust_event = $self->new_cust_event($object); - next unless $cust_event->test_conditions('time' => $time); + my $cust_event = $self->new_cust_event($object, 'time' => $time); + next unless $cust_event->test_conditions; $object->set('cust_event', $cust_event); push @tested_objects, $object; -- cgit v1.2.1 From 8864bd26231dc8c6ec436c62af553bdb3d77be9a Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 29 Aug 2012 15:24:21 -0700 Subject: after_event condition, #18687 --- FS/FS/part_event/Condition/after_event.pm | 78 +++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) create mode 100644 FS/FS/part_event/Condition/after_event.pm (limited to 'FS') diff --git a/FS/FS/part_event/Condition/after_event.pm b/FS/FS/part_event/Condition/after_event.pm new file mode 100644 index 000000000..c59d84748 --- /dev/null +++ b/FS/FS/part_event/Condition/after_event.pm @@ -0,0 +1,78 @@ +package FS::part_event::Condition::after_event; + +use strict; +use FS::Record qw( qsearchs ); +use FS::part_event; +use FS::cust_event; + +use base qw( FS::part_event::Condition ); + +sub description { "After running another event" } + +# Runs the event at least X days after the most recent time another event +# ran on the same object. + +sub option_fields { + ( + 'eventpart' => { label=>'Event', type=>'select-part_event', }, + 'run_delay' => { label=>'Delay', type=>'freq', value=>'1', }, + ); +} + +# Specification: +# Given an event B that has this condition, where the "eventpart" +# option is set to event A, and the "run_delay" option is set to +# X days. +# This condition is TRUE if: +# - Event A last ran X or more days in the past, +# AND +# - Event B has not run since the most recent occurrence of event A. + +sub condition { + # similar to "once_every", but with a different eventpart + my($self, $object, %opt) = @_; + + my $obj_pkey = $object->primary_key; + my $tablenum = $object->$obj_pkey(); + + my $before = $self->option_age_from('run_delay',$opt{'time'}); + my $eventpart = $self->option('eventpart'); + + my %hash = ( + 'eventpart' => $eventpart, + 'tablenum' => $tablenum, + 'status' => { op => '!=', value => 'failed' }, + ); + + my $most_recent_other = qsearchs( { + 'table' => 'cust_event', + 'hashref' => \%hash, + 'order_by' => " ORDER BY _date DESC LIMIT 1", + } ) + or return 0; # if it hasn't run at all, return false + + return 0 if $most_recent_other->_date > $before; # we're still in the delay + + # now see if there's been an instance of this event since the one we're + # following... + $hash{'eventpart'} = $self->eventpart; + if ( $opt{'cust_event'} and $opt{'cust_event'}->eventnum =~ /^(\d+)$/ ) { + $hash{'eventnum'} = { op => '!=', value => $1 }; + } + + my $most_recent_self = qsearchs( { + 'table' => 'cust_event', + 'hashref' => \%hash, + 'order_by' => " ORDER BY _date DESC LIMIT 1", + } ); + + return 0 if defined($most_recent_self) + and $most_recent_self->_date >= $most_recent_other->_date; + # the follower has already run + + 1; +} + +# condition_sql, maybe someday + +1; -- cgit v1.2.1 From 56fbf4de4af0a18b611daaa50e42b5dac047a937 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 29 Aug 2012 16:11:43 -0700 Subject: clean up eventpart selection --- FS/FS/part_event/Condition/after_event.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_event/Condition/after_event.pm b/FS/FS/part_event/Condition/after_event.pm index c59d84748..1d8d2124e 100644 --- a/FS/FS/part_event/Condition/after_event.pm +++ b/FS/FS/part_event/Condition/after_event.pm @@ -14,7 +14,10 @@ sub description { "After running another event" } sub option_fields { ( - 'eventpart' => { label=>'Event', type=>'select-part_event', }, + 'eventpart' => { label=>'Event', type=>'select-part_event', + disable_empty => 1, + hashref => { disabled => '' }, + }, 'run_delay' => { label=>'Delay', type=>'freq', value=>'1', }, ); } -- cgit v1.2.1 From 7c9457296c5dd8985eda5a8325ba1254223ec953 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 30 Aug 2012 00:48:08 -0700 Subject: commissions per agent and package class, RT#18232 --- FS/FS.pm | 2 + FS/FS/Schema.pm | 28 +++-- FS/FS/agent_pkg_class.pm | 117 +++++++++++++++++++++ .../Action/Mixin/credit_agent_pkg_class.pm | 25 +++++ FS/FS/part_event/Action/Mixin/credit_pkg.pm | 7 +- .../Action/pkg_agent_credit_pkg_class.pm | 9 ++ FS/t/agent_pkg_class.t | 5 + 7 files changed, 184 insertions(+), 9 deletions(-) create mode 100644 FS/FS/agent_pkg_class.pm create mode 100644 FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm create mode 100644 FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm create mode 100644 FS/t/agent_pkg_class.t (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index 8bbff12e5..5ab3f71e5 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -270,6 +270,8 @@ L - Sales person class L - Agent (reseller) class +L - Agent (reseller) package class commission class + L - Agent type class L - Class linking agent types (see L) with package definitions (see L) diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 0f1d1513a..4f4390c57 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -473,16 +473,16 @@ sub tables_hashref { 'index' => [ ['typenum'], ['disabled'], ['agent_custnum'] ], }, - 'sales' => { + 'agent_pkg_class' => { 'columns' => [ - 'salesnum', 'serial', '', '', '', '', - 'salesperson', 'varchar', '', $char_d, '', '', - 'agentnum', 'int', 'NULL', '', '', '', - 'disabled', 'char', 'NULL', 1, '', '', + 'agentpkgclassnum', 'serial', '', '', '', '', + 'agentnum', 'int', '', '', '', '', + 'classnum', 'int', 'NULL', '', '', '', + 'commission_percent', 'decimal', '', '7,4', '', '', ], - 'primary_key' => 'salesnum', - 'unique' => [], - 'index' => [ ['salesnum'], ['disabled'] ], + 'primary_key' => 'agentpkgclassnum', + 'unique' => [ [ 'agentnum', 'classnum' ], ], + 'index' => [ [ 'agentnum' ], [ 'classnum' ] ], }, 'agent_type' => { @@ -506,6 +506,18 @@ sub tables_hashref { 'index' => [ ['typenum'] ], }, + 'sales' => { + 'columns' => [ + 'salesnum', 'serial', '', '', '', '', + 'salesperson', 'varchar', '', $char_d, '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'salesnum', + 'unique' => [], + 'index' => [ ['salesnum'], ['disabled'] ], + }, + 'cust_attachment' => { 'columns' => [ 'attachnum', 'serial', '', '', '', '', diff --git a/FS/FS/agent_pkg_class.pm b/FS/FS/agent_pkg_class.pm new file mode 100644 index 000000000..1683c1a14 --- /dev/null +++ b/FS/FS/agent_pkg_class.pm @@ -0,0 +1,117 @@ +package FS::agent_pkg_class; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::agent_pkg_class - Object methods for agent_pkg_class records + +=head1 SYNOPSIS + + use FS::agent_pkg_class; + + $record = new FS::agent_pkg_class \%hash; + $record = new FS::agent_pkg_class { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::agent_pkg_class object represents an commission for a specific agent +and package class. FS::agent_pkg_class inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item agentpkgclassnum + +primary key + +=item agentnum + +agentnum + +=item classnum + +classnum + +=item commission_percent + +commission_percent + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'agent_pkg_class'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + $self->commission_percent(0) unless length($self->commission_percent); + + my $error = + $self->ut_numbern('agentpkgclassnum') + || $self->ut_foreign_key('agentnum', 'agent', 'agentnum') + || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum') + || $self->ut_float('commission_percent') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm b/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm new file mode 100644 index 000000000..73d32e0a7 --- /dev/null +++ b/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm @@ -0,0 +1,25 @@ +package FS::part_event::Action::Mixin::credit_agent_pkg_class; +use base qw( FS::part_event::Action::Mixin::credit_pkg ); + +use strict; + +sub option_fields { + my $class = shift; + my %option_fields = $class->SUPER::option_fields; + delete $option_fields{'percent'}; + %option_fields; +} + +sub _calc_credit_percent { + my( $self, $cust_pkg ) = @_; + + my $agent_pkg_class = qsearchs( 'agent_pkg_class', { + 'agentnum' => $self->cust_main($cust_pkg)->agentnum, + 'classnum' => $cust_pkg->classnum, + }); + + $agent_pkg_class ? $agent_pkg_class->commission_percent : 0; + +} + +1; diff --git a/FS/FS/part_event/Action/Mixin/credit_pkg.pm b/FS/FS/part_event/Action/Mixin/credit_pkg.pm index aeda92f91..9dcd701a9 100644 --- a/FS/FS/part_event/Action/Mixin/credit_pkg.pm +++ b/FS/FS/part_event/Action/Mixin/credit_pkg.pm @@ -51,7 +51,7 @@ sub _calc_credit { } } - my $percent = $self->option('percent'); + my $percent = $self->_calc_credit_percent($cust_pkg); #my @arg = $no_cust_pkg{$what} ? () : ($cust_pkg); my @arg = ($what eq 'setup_cost') ? () : ($cust_pkg); @@ -60,4 +60,9 @@ sub _calc_credit { } +sub _calc_credit_percent { + my( $self, $cust_pkg ) = @_; + $self->option('percent'); +} + 1; diff --git a/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm b/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm new file mode 100644 index 000000000..3dcf668f9 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm @@ -0,0 +1,9 @@ +package FS::part_event::Action::pkg_agent_credit_pkg_class; + +use strict; +use base qw( FS::part_event::Action::Mixin::credit_agent_pkg_class + FS::part_event::Action::pkg_agent_credit ); + +sub description { 'Credit the agent an amount based on their commission percentage for the referred package class'; } + +1; diff --git a/FS/t/agent_pkg_class.t b/FS/t/agent_pkg_class.t new file mode 100644 index 000000000..dc0fa12b2 --- /dev/null +++ b/FS/t/agent_pkg_class.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::agent_pkg_class; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 966ef9f5a09505f18f2f7c6ca0da9246d88470bb Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 30 Aug 2012 00:48:43 -0700 Subject: commissions per agent and package class, RT#18232 --- FS/MANIFEST | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index e8b676028..bb10fb7b1 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -666,3 +666,5 @@ t/cust_tax_exempt_pkg_void.t FS/cust_bill_pkg_discount_void.pm t/cust_bill_pkg_discount_void.t FS/Trace.pm +FS/agent_pkg_class.pm +t/agent_pkg_class.t -- cgit v1.2.1 From eeaf714340d952dd557f685aa76cf9a94cdc6b73 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 30 Aug 2012 01:06:24 -0700 Subject: no need for these indices --- FS/FS/Schema.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 4f4390c57..709e9f9c6 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -482,7 +482,7 @@ sub tables_hashref { ], 'primary_key' => 'agentpkgclassnum', 'unique' => [ [ 'agentnum', 'classnum' ], ], - 'index' => [ [ 'agentnum' ], [ 'classnum' ] ], + 'index' => [], }, 'agent_type' => { -- cgit v1.2.1 From b19863929523e3c340f0e98431968e16b7d2270b Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 30 Aug 2012 01:09:12 -0700 Subject: commissions per agent and package class, RT#18232 --- FS/FS/Mason.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 663a48e72..b3c2d4a5b 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -91,6 +91,7 @@ if ( -e $addl_handler_use_file ) { use Text::CSV_XS; use Spreadsheet::WriteExcel; use Spreadsheet::WriteExcel::Utility; + use OLE::Storage_Lite; use Excel::Writer::XLSX; use Excel::Writer::XLSX::Utility; @@ -323,6 +324,7 @@ if ( -e $addl_handler_use_file ) { use FS::cust_bill_pkg_tax_rate_location_void; use FS::cust_tax_exempt_pkg_void; use FS::cust_bill_pkg_discount_void; + use FS::agent_pkg_class; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { @@ -366,7 +368,7 @@ if ( -e $addl_handler_use_file ) { use RT::Interface::Web::Request; - #nother undeclared web UI dep (for ticket links graph) + #another undeclared web UI dep (for ticket links graph) use IPC::Run::SafeHandles; #slow, unreliable, segfaults and is optional -- cgit v1.2.1 From 0a6135e4fa5ede927bbdda24640429bfd5bf1224 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 5 Sep 2012 23:47:27 -0700 Subject: fix noisy warning --- FS/FS/Mason.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index b3c2d4a5b..39c7dfdc6 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -93,7 +93,7 @@ if ( -e $addl_handler_use_file ) { use Spreadsheet::WriteExcel::Utility; use OLE::Storage_Lite; use Excel::Writer::XLSX; - use Excel::Writer::XLSX::Utility; + #use Excel::Writer::XLSX::Utility; #redundant with above use Business::CreditCard 0.30; #for mask-aware cardtype() use NetAddr::IP; -- cgit v1.2.1 From 4da4ab642c2f0fea8e685fec904e62160a612929 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 5 Sep 2012 23:47:54 -0700 Subject: spelling --- FS/FS/Report/FCC_477.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Report/FCC_477.pm b/FS/FS/Report/FCC_477.pm index 4c94fff2e..49bb8a852 100644 --- a/FS/FS/Report/FCC_477.pm +++ b/FS/FS/Report/FCC_477.pm @@ -45,8 +45,8 @@ Documentation. ); @technology = ( - 'Asymetric xDSL', - 'Symetric xDSL', + 'Asymmetric xDSL', + 'Symmetric xDSL', 'Other Wireline', 'Cable Modem', 'Optical Carrier', -- cgit v1.2.1 From caaa554c0f4550b23b97b2de76aee2bdd12252ba Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 6 Sep 2012 08:01:45 -0700 Subject: spelling --- FS/FS/part_export/acct_xmlrpc.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/acct_xmlrpc.pm b/FS/FS/part_export/acct_xmlrpc.pm index d746f29bc..96ad1fa67 100644 --- a/FS/FS/part_export/acct_xmlrpc.pm +++ b/FS/FS/part_export/acct_xmlrpc.pm @@ -37,7 +37,7 @@ tie my %options, 'Tie::IxHash', 'notes' => <<'END', Configurable, real-time export of accounts via the XML-RPC protocol.

-If using "Individual values" parameter style, specfify one parameter per line.
+If using "Individual values" parameter style, specify one parameter per line.

If using "Struct of name/value pairs" parameter style, specify one name and value on each line, separated by whitespace.
-- cgit v1.2.1 From b7ce9a95a6fa002d0d537c950f11f8a23d3dfc25 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 6 Sep 2012 11:46:59 -0700 Subject: fix 477 part IIB, #18503 --- FS/FS/Conf.pm | 2 +- FS/FS/Schema.pm | 1 + FS/FS/part_pkg.pm | 20 ++++++++++++++++++++ 3 files changed, 22 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 42432b2a4..667263f9c 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3301,7 +3301,7 @@ and customer address. Include units.', { 'key' => 'cust_pkg-show_fcc_voice_grade_equivalent', 'section' => 'UI', - 'description' => "Show a field on package definitions for assigning a DS0 equivalency number suitable for use on FCC form 477.", + 'description' => "Show fields on package definitions for FCC Form 477 classification", 'type' => 'checkbox', }, diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 709e9f9c6..ab679c491 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1911,6 +1911,7 @@ sub tables_hashref { 'credit_weight', 'real', 'NULL', '', '', '', 'agentnum', 'int', 'NULL', '', '', '', 'fcc_ds0s', 'int', 'NULL', '', '', '', + 'fcc_voip_class','char', 'NULL', 1, '', '', 'no_auto', 'char', 'NULL', 1, '', '', 'recur_show_zero', 'char', 'NULL', 1, '', '', 'setup_show_zero', 'char', 'NULL', 1, '', '', diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 061001bdc..91bcdc5b5 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -103,6 +103,9 @@ inherits from FS::Record. The following fields are currently supported: =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477 +=item fcc_voip_class - Which column of FCC form 477 part II.B this package +belongs in. + =item successor - Foreign key for the part_pkg that replaced this record. If this record is not obsolete, will be null. @@ -622,6 +625,7 @@ sub check { : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right) ) || $self->ut_numbern('fcc_ds0s') + || $self->ut_numbern('fcc_voip_class') || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart') || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart') || $self->SUPER::check @@ -1592,6 +1596,22 @@ sub _upgrade_data { # class method } } + # set any package with FCC voice lines to the "VoIP with broadband" category + # for backward compatibility + my $journal = 'part_pkg_fcc_voip_class'; + if (!FS::upgrade_journal->is_done($journal)) { + @part_pkg = qsearch('part_pkg', { + fcc_ds0s => { op => '>', value => 0 }, + fcc_voip_class => '' + }); + foreach my $part_pkg (@part_pkg) { + $part_pkg->set(fcc_voip_class => 2); + my $error = $part_pkg->replace; + die $error if $error; + } + FS::upgrade_journal->set_done($journal); + } + } =item curuser_pkgs_sql -- cgit v1.2.1 From f8c8b9782ff5400790c2fb6dae017ce01790e56e Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 6 Sep 2012 11:47:02 -0700 Subject: separate all 477 reports by state, #18503 --- FS/FS/cust_pkg.pm | 37 ++++++++++++++++++++++++------------- 1 file changed, 24 insertions(+), 13 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index ea29a2c68..c34eb43b5 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -3317,7 +3317,12 @@ specifies the user for agent virtualization =item fcc_line - boolean selects packages containing fcc form 477 telco lines +boolean; if true, returns only packages with more than 0 FCC phone lines. + +=item state, country + +Limit to packages with a service location in the specified state and country. +For FCC 477 reporting, mostly. =back @@ -3491,8 +3496,8 @@ sub search { if ( exists($params->{'censustract'}) ) { $params->{'censustract'} =~ /^([.\d]*)$/; - my $censustract = "cust_main.censustract = '$1'"; - $censustract .= ' OR cust_main.censustract is NULL' unless $1; + my $censustract = "cust_location.censustract = '$1'"; + $censustract .= ' OR cust_location.censustract is NULL' unless $1; push @where, "( $censustract )"; } @@ -3504,10 +3509,22 @@ sub search { ) { if ($1) { - push @where, "cust_main.censustract LIKE '$1%'"; + push @where, "cust_location.censustract LIKE '$1%'"; } else { push @where, - "( cust_main.censustract = '' OR cust_main.censustract IS NULL )"; + "( cust_location.censustract = '' OR cust_location.censustract IS NULL )"; + } + } + + ### + # parse country/state + ### + for (qw(state country)) { # parsing rules are the same for these + if ( exists($params->{$_}) + && uc($params->{$_}) =~ /^([A-Z]{2})$/ ) + { + # XXX post-2.3 only--before that, state/country may be in cust_main + push @where, "cust_location.$_ = '$1'"; } } @@ -3635,7 +3652,8 @@ sub search { my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '. 'LEFT JOIN part_pkg USING ( pkgpart ) '. - 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '; + 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '. + 'LEFT JOIN cust_location USING ( locationnum ) '; my $select; my $count_query; @@ -3644,13 +3662,6 @@ sub search { $select = "DISTINCT substr($zip,1,5) as zip"; $orderby = "ORDER BY substr($zip,1,5)"; - $addl_from .= 'LEFT JOIN cust_location ON ( - cust_location.locationnum = COALESCE( - cust_pkg.locationnum, - cust_main.ship_locationnum, - cust_main.bill_locationnum - ) - )'; $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )"; } else { $select = join(', ', -- cgit v1.2.1 From 97bd512eba99c5d3b6c6f5ae5bfeaa48eeee1cd4 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 10 Sep 2012 17:25:11 -0700 Subject: make selfservice_process-pkgpart and manual_process-pkgpart into agent overrides, RT#19304 --- FS/FS/ClientAPI/MasonComponent.pm | 3 ++- FS/FS/ClientAPI/MyAccount.pm | 5 +++-- FS/FS/Conf.pm | 4 +++- 3 files changed, 8 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MasonComponent.pm b/FS/FS/ClientAPI/MasonComponent.pm index 61208c129..c4094ffe0 100644 --- a/FS/FS/ClientAPI/MasonComponent.pm +++ b/FS/FS/ClientAPI/MasonComponent.pm @@ -53,7 +53,8 @@ my %session_callbacks = ( my %args = @$argsref; %args = ( %args, - 'process-pkgpart' => scalar($conf->config('selfservice_process-pkgpart')), + 'process-pkgpart' => + scalar($conf->config('selfservice_process-pkgpart', $cust_main->agentnum)), 'process-display' => scalar($conf->config('selfservice_process-display')), 'process-skip_first' => $conf->exists('selfservice_process-skip_first'), 'num_payments' => scalar($cust_main->cust_pay), diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index eddb16456..3f7c00432 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -14,6 +14,7 @@ use Business::CreditCard; use HTML::Entities; use Text::CSV_XS; use Spreadsheet::WriteExcel; +use OLE::Storage_Lite; use FS::UI::Web::small_custview qw(small_custview); #less doh use FS::UI::Web; use FS::UI::bytecount qw( display_bytecount ); @@ -929,7 +930,7 @@ sub validate_payment { #changing the hidden form values my $conf = new FS::Conf; my $fee_display = $conf->config('selfservice_process-display') || 'add'; - my $fee_pkgpart = $conf->config('selfservice_process-pkgpart'); + my $fee_pkgpart = $conf->config('selfservice_process-pkgpart', $cust_main->agentnum); my $fee_skip_first = $conf->exists('selfservice_process-skip_first'); if ( $fee_display eq 'add' and $fee_pkgpart @@ -1101,7 +1102,7 @@ sub do_process_payment { #no error, so order the fee package if applicable... my $conf = new FS::Conf; - my $fee_pkgpart = $conf->config('selfservice_process-pkgpart'); + my $fee_pkgpart = $conf->config('selfservice_process-pkgpart', $cust_main->agentnum); my $fee_skip_first = $conf->exists('selfservice_process-skip_first'); if ( $fee_pkgpart and ! $fee_skip_first || scalar($cust_main->cust_pay) ) { diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 42432b2a4..321ba0b89 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1363,7 +1363,7 @@ and customer address. Include units.', { 'key' => 'invoice_latexextracouponspace', 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice textheight space to reserve for a tear off coupon. Include units.', + 'description' => 'Optional LaTeX invoice textheight space to reserve for a tear off coupon. Include units. Default is 3.6cm', 'type' => 'text', 'per_agent' => 1, 'validate' => sub { shift =~ @@ -2555,6 +2555,7 @@ and customer address. Include units.', 'section' => 'billing', 'description' => 'Package to add to each manual credit card and ACH payment entered by employees from the backend. Enabling this option may be in violation of your merchant agreement(s), so please check it(/them) carefully before enabling this option.', 'type' => 'select-part_pkg', + 'per_agent' => 1, }, { @@ -2580,6 +2581,7 @@ and customer address. Include units.', 'section' => 'billing', 'description' => 'Package to add to each manual credit card and ACH payment entered by the customer themselves in the self-service interface. Enabling this option may be in violation of your merchant agreement(s), so please check it(/them) carefully before enabling this option.', 'type' => 'select-part_pkg', + 'per_agent' => 1, }, { -- cgit v1.2.1 From 05669195e91e450449405bd3dc355e8e17f36565 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 10 Sep 2012 17:26:13 -0700 Subject: store a commission agentnum with credits? RT#18231 --- FS/FS/Schema.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 709e9f9c6..b1e7a9c5d 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -937,6 +937,7 @@ sub tables_hashref { 'closed', 'char', 'NULL', 1, '', '', 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances 'eventnum', 'int', 'NULL', '', '', '', #triggering event for commission + #'commission_agentnum', 'int', 'NULL', '', '', '', # ], 'primary_key' => 'crednum', 'unique' => [], -- cgit v1.2.1 From 97d5dd9cb66d37a692c0eac78091019befd02a17 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 11 Sep 2012 06:18:48 -0700 Subject: freeswitch export, RT#18087 --- FS/FS/part_export/freeswitch.pm | 180 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 180 insertions(+) create mode 100644 FS/FS/part_export/freeswitch.pm (limited to 'FS') diff --git a/FS/FS/part_export/freeswitch.pm b/FS/FS/part_export/freeswitch.pm new file mode 100644 index 000000000..7447849c8 --- /dev/null +++ b/FS/FS/part_export/freeswitch.pm @@ -0,0 +1,180 @@ +package FS::part_export::freeswitch; +use base qw( FS::part_export ); + +use vars qw( %info ); # $DEBUG ); +#use Data::Dumper; +use Tie::IxHash; +use Text::Template; +#use FS::Record qw( qsearch qsearchs ); +#use FS::Schema qw( dbdef ); + +#$DEBUG = 1; + +tie my %options, 'Tie::IxHash', + 'user' => { label => 'SSH username', default=>'root', }, + 'directory' => { label => 'Directory to store FreeSWITCH account XML files', + default => '/usr/local/freeswitch/conf/directory/', + }, + 'domain' => { label => 'Optional fixed SIP domain to use, overrides svc_phone domain', }, + 'reload' => { label => 'Reload command', + default => '/usr/local/freeswitch/bin/fs_cli -x reloadxml', + }, + 'user_template' => { label => 'User XML configuration template', + type => 'textarea', + default => <<'END', + + + + + + + +END + }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision phone services to FreeSWITCH XML configuration files', + 'options' => \%options, + 'notes' => <<'END', +Export XML account configuration files to FreeSWITCH, one per phone services. +

+You will need to +setup SSH for unattended operation. +END +); + +sub rebless { shift; } + +sub _export_insert { + my( $self, $svc_phone ) = ( shift, shift ); + + eval "use Net::SCP;"; + die $@ if $@; + + #create and copy over file + + my $tempdir = '%%%FREESIDE_CONF%%%/cache.'. $FS::UID::datasrc; + + my $svcnum = $svc_phone->svcnum; + + my $fh = new File::Temp( + TEMPLATE => "$tempdir/freeswitch.$svcnum.XXXXXXXX", + DIR => $dir, + #UNLINK => 0, + ); + + print $fh $self->freeswitch_template_fillin( $svc_phone, 'user' ) + or die "print to freeswitch template failed: $!"; + close $fh; + + my $scp = new Net::SCP; + my $user = $self->option('user')||'root'; + my $host = $self->machine; + my $dir = $self->option('directory'); + + $scp->scp( $fh->filename, "$user\@$host:$dir/$svcnum.xml" ) + or return $scp->{errstr}; + + #signal freeswitch to reload config + $self->freeswitch_ssh( command => $self->option('reload') ); + + ''; + +} + +sub _export_replace { + my( $self, $new, $old ) = ( shift, shift, shift ); + + $self->_export_insert($new, @_); +} + +sub _export_delete { + my( $self, $svc_phone ) = ( shift, shift ); + + my $dir = $self->option('directory'); + my $svcnum = $svc_phone->svcnum; + + #delete file + $self->freeswitch_ssh( command => "rm $dir/$svcnum.xml" ); + + #signal freeswitch to reload config + $self->freeswitch_ssh( command => $self->option('reload') ); + + ''; +} + +sub freeswitch_template_fillin { + my( $self, $svc_phone, $template ) = (shift, shift, shift); + + $template ||= 'user'; #? + + #cache a %tt hash? + my $tt = new Text::Template ( + TYPE => 'STRING', + SOURCE => $self->option($template.'_template'), + DELIMITERS => [ '<%', '%>' ], + ); + + my $domain = $self->option('domain') + || $svc_phone->domain + || '$${sip_profile}'; + + #false lazinessish w/phone_shellcommands::_export_command + my %hash = ( + 'domain' => $domain, + map { $_ => $svc_phone->getfield($_) } $svc_phone->fields + ); + + #might as well do em all, they're all going in an XML file as attribs + foreach ( keys %hash ) { + $hash{$_} =~ s/'/'/g; + $hash{$_} =~ s/"/"/g; + } + + $tt->fill_in( + HASH => \%hash, + ); +} + +##a good idea to queue anything that could fail or take any time +#sub shellcommands_queue { +# my( $self, $svcnum ) = (shift, shift); +# my $queue = new FS::queue { +# 'svcnum' => $svcnum, +# 'job' => "FS::part_export::freeswitch::ssh_cmd", +# }; +# $queue->insert( @_ ); +#} + +sub freeswitch_ssh { #method + my $self = shift; + ssh_cmd( user => $self->option('user')||'root', + host => $self->machine, + @_, + ); +} + +sub ssh_cmd { #subroutine, not method + use Net::OpenSSH; + my $opt = { @_ }; + open my $def_in, '<', '/dev/null' or die "unable to open /dev/null"; + my $ssh = Net::OpenSSH->new( $opt->{'user'}.'@'.$opt->{'host'}, + default_stdin_fh => $def_in, + ); + die "Couldn't establish SSH connection: ". $ssh->error if $ssh->error; + my ($output, $errput) = $ssh->capture2( #{stdin_discard => 1}, + $opt->{'command'} + ); + die "Error running SSH command: ". $ssh->error if $ssh->error; + + #who the fuck knows what freeswitch reload outputs, probably a fucking + # ascii advertisement for cluecon + #die $errput if $errput; + #die $output if $output; + + ''; +} + +1; -- cgit v1.2.1 From cbcb3efd652e3a81d68b810167c5da9164ce352c Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 13 Sep 2012 17:33:10 -0700 Subject: fix RADIUS schema for long attribute values, RT#19377 --- FS/FS/Schema.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 37bba68cb..4ef2a6352 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2672,12 +2672,12 @@ sub tables_hashref { 'radius_attr' => { 'columns' => [ - 'attrnum', 'serial', '', '', '', '', - 'groupnum', 'int', '', '', '', '', + 'attrnum', 'serial', '', '', '', '', + 'groupnum', 'int', '', '', '', '', 'attrname', 'varchar', '', $char_d, '', '', - 'value', 'varchar', '', $char_d, '', '', - 'attrtype', 'char', '', 1, '', '', - 'op', 'char', '', 2, '', '', + 'value', 'varchar', '', 255, '', '', + 'attrtype', 'char', '', 1, '', '', + 'op', 'char', '', 2, '', '', ], 'primary_key' => 'attrnum', 'unique' => [], -- cgit v1.2.1 From df845c7ef328e81b4f305152253ac9ca0de7626d Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 17 Sep 2012 21:58:05 -0700 Subject: fix 79 char footer --- FS/FS/pay_batch/BoM.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/pay_batch/BoM.pm b/FS/FS/pay_batch/BoM.pm index 7bfc22a64..719b504e5 100644 --- a/FS/FS/pay_batch/BoM.pm +++ b/FS/FS/pay_batch/BoM.pm @@ -31,13 +31,13 @@ $name = 'BoM'; }, header => sub { my $pay_batch = shift; - sprintf( "A%10s%04u%06u%05u%54s\n", + sprintf( "A%10s%04u%06u%05u%54s\n", #80 $origid, $pay_batch->batchnum, jdate($pay_batch->download), $datacenter, "") . - sprintf( "XD%03u%06u%-15s%-30s%09u%-12s \n", + sprintf( "XD%03u%06u%-15s%-30s%09u%-12s \n", #80 $typecode, jdate($pay_batch->download), $shortname, @@ -48,7 +48,7 @@ $name = 'BoM'; row => sub { my ($cust_pay_batch, $pay_batch) = @_; my ($account, $aba) = split('@', $cust_pay_batch->payinfo); - sprintf( "D%010.0f%09u%-12s%-29s%-19s\n", + sprintf( "D%010.0f%09u%-12s%-29s%-19s\n", #80 $cust_pay_batch->amount * 100, $aba, $account, @@ -58,8 +58,8 @@ $name = 'BoM'; }, footer => sub { my ($pay_batch, $batchcount, $batchtotal) = @_; - sprintf( "YD%08u%014.0f%56s\n", $batchcount, $batchtotal*100, ""). - sprintf( "Z%014u%04u%014u%05u%41s\n", + sprintf( "YD%08u%014.0f%56s\n", $batchcount, $batchtotal*100, ""). #80 + sprintf( "Z%014u%04u%014u%05u%42s\n", #80 now $batchtotal*100, $batchcount, "0", "0", ""); }, ); -- cgit v1.2.1 From 1ad547a47f16b4230762e752fbe48d460ed997e1 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 18 Sep 2012 02:18:04 -0700 Subject: export host selection per service, RT#17914 --- FS/FS.pm | 4 + FS/FS/Record.pm | 21 ++- FS/FS/Schema.pm | 31 ++++- FS/FS/part_export.pm | 160 +++++++++++++++++++++- FS/FS/part_export/acct_google.pm | 10 +- FS/FS/part_export/acct_http.pm | 1 + FS/FS/part_export/acct_plesk.pm | 8 +- FS/FS/part_export/acct_sql.pm | 12 +- FS/FS/part_export/acct_sql_status.pm | 1 + FS/FS/part_export/acct_xmlrpc.pm | 1 + FS/FS/part_export/amazon_ec2.pm | 1 + FS/FS/part_export/artera_turbo.pm | 1 + FS/FS/part_export/broadband_http.pm | 1 + FS/FS/part_export/broadband_nas.pm | 1 + FS/FS/part_export/broadband_shellcommands.pm | 1 + FS/FS/part_export/broadband_snmp.pm | 1 + FS/FS/part_export/broadband_sql.pm | 1 + FS/FS/part_export/broadband_sqlradius.pm | 1 + FS/FS/part_export/communigate_pro.pm | 1 + FS/FS/part_export/communigate_pro_singledomain.pm | 1 + FS/FS/part_export/cp.pm | 1 + FS/FS/part_export/cpanel.pm | 2 + FS/FS/part_export/cust_http.pm | 1 + FS/FS/part_export/cyrus.pm | 2 + FS/FS/part_export/dashcs_e911.pm | 1 + FS/FS/part_export/domain_sql.pm | 1 + FS/FS/part_export/everyone_net.pm | 2 + FS/FS/part_export/ez_prepaid.pm | 1 + FS/FS/part_export/forward_sql.pm | 1 + FS/FS/part_export/globalpops_voip.pm | 1 + FS/FS/part_export/http.pm | 1 + FS/FS/part_export/http_status.pm | 1 + FS/FS/part_export/ikano.pm | 1 + FS/FS/part_export/indosoft.pm | 1 + FS/FS/part_export/infostreet.pm | 1 + FS/FS/part_export/internal_diddb.pm | 1 + FS/FS/part_export/ldap.pm | 1 + FS/FS/part_export/netsapiens.pm | 9 +- FS/FS/part_export/null.pm | 1 + FS/FS/part_export/phone_shellcommands.pm | 1 + FS/FS/part_export/phone_sqlopensips.pm | 10 +- FS/FS/part_export/phone_sqlradius.pm | 9 +- FS/FS/part_export/postfix.pm | 1 + FS/FS/part_export/prizm.pm | 11 +- FS/FS/part_export/radiator.pm | 2 + FS/FS/part_export/router.pm | 1 + FS/FS/part_export/rt_ticket.pm | 1 + FS/FS/part_export/send_email.pm | 1 + FS/FS/part_export/shellcommands.pm | 30 +--- FS/FS/part_export/sqlmail.pm | 1 + FS/FS/part_export/sqlradius.pm | 1 + FS/FS/part_export/textradius.pm | 1 + FS/FS/part_export/trango.pm | 1 + FS/FS/part_export/vitelity.pm | 1 + FS/FS/part_export/vpopmail.pm | 1 + FS/FS/part_export/www_plesk.pm | 9 +- FS/FS/part_export/www_shellcommands.pm | 1 + FS/FS/part_export_machine.pm | 155 +++++++++++++++++++++ FS/FS/part_svc.pm | 2 +- FS/FS/svc_export_machine.pm | 111 +++++++++++++++ FS/MANIFEST | 4 + FS/t/part_export_machine.t | 5 + FS/t/svc_export_machine.t | 5 + 63 files changed, 586 insertions(+), 68 deletions(-) create mode 100644 FS/FS/part_export_machine.pm create mode 100644 FS/FS/svc_export_machine.pm create mode 100644 FS/t/part_export_machine.t create mode 100644 FS/t/svc_export_machine.t (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index 5ab3f71e5..2d963b54f 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -284,6 +284,10 @@ L - Agent payment gateway class L - Service class +L - Export hostname choice class + +L - Customer export hostname class + L - Customer package class L - Customer package option class diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 0ac269f4c..ca68c3596 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2421,10 +2421,9 @@ sub ut_coordn { } - =item ut_domain COLUMN -Check/untaint host and domain names. +Check/untaint host and domain names. May not be null. =cut @@ -2432,11 +2431,27 @@ sub ut_domain { my( $self, $field ) = @_; #$self->getfield($field) =~/^(\w+\.)*\w+$/ $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/ - or return "Illegal (domain) $field: ". $self->getfield($field); + or return "Illegal (hostname) $field: ". $self->getfield($field); $self->setfield($field,$1); ''; } +=item ut_domainn COLUMN + +Check/untaint host and domain names. May be null. + +=cut + +sub ut_domainn { + my( $self, $field ) = @_; + if ( $self->getfield($field) =~ /^()$/ ) { + $self->setfield($field,''); + ''; + } else { + $self->ut_domain($field); + } +} + =item ut_name COLUMN Check/untaint proper names; allows alphanumerics, spaces and the following diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 4ef2a6352..6e3956a83 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1890,6 +1890,29 @@ sub tables_hashref { 'index' => [ [ 'svcnum' ], [ 'optionname' ] ], }, + 'svc_export_machine' => { + 'columns' => [ + 'svcexportmachinenum', 'serial', '', '', '', '', + 'svcnum', 'int', '', '', '', '', + 'machinenum', 'int', '', '', '', '', + ], + 'primary_key' => 'svcexportmachinenum', + 'unique' => [], + 'index' => [], + }, + + 'part_export_machine' => { + 'columns' => [ + 'machinenum', 'serial', '', '', '', '', + 'exportnum', 'int', '', '', '', '', + 'machine', 'varchar', 'NULL', $char_d, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'machinenum', + 'unique' => [ [ 'exportnum', 'machine' ] ], + 'index' => [ [ 'exportnum' ] ], + }, + 'part_pkg' => { 'columns' => [ 'pkgpart', 'serial', '', '', '', '', @@ -2623,11 +2646,11 @@ sub tables_hashref { 'part_export' => { 'columns' => [ - 'exportnum', 'serial', '', '', '', '', + 'exportnum', 'serial', '', '', '', '', 'exportname', 'varchar', 'NULL', $char_d, '', '', - 'machine', 'varchar', '', $char_d, '', '', - 'exporttype', 'varchar', '', $char_d, '', '', - 'nodomain', 'char', 'NULL', 1, '', '', + 'machine', 'varchar', 'NULL', $char_d, '', '', + 'exporttype', 'varchar', '', $char_d, '', '', + 'nodomain', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'exportnum', 'unique' => [], diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 45773e097..97394af18 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -4,10 +4,11 @@ use strict; use vars qw( @ISA @EXPORT_OK $DEBUG %exports ); use Exporter; use Tie::IxHash; -use base qw( FS::option_Common FS::m2m_Common ); # m2m for 'export_nas' +use base qw( FS::option_Common FS::m2m_Common ); use FS::Record qw( qsearch qsearchs dbh ); use FS::part_svc; use FS::part_export_option; +use FS::part_export_machine; use FS::export_svc; #for export modules, though they should probably just use it themselves @@ -108,6 +109,50 @@ otherwise returns false. If a hash reference of options is supplied, part_export_option records are created (see L). +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + #kinda false laziness with process_m2name + my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ } + grep /\S/, + split /[\n\r]{1,2}/, + $self->part_export_machine_textarea; + + foreach my $machine ( @machines ) { + + my $part_export_machine = new FS::part_export_machine { + 'exportnum' => $self->exportnum, + 'machine' => $machine, + }; + $error = $part_export_machine->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + =item delete Delete this record from the database. @@ -117,13 +162,13 @@ Delete this record from the database. #foreign keys would make this much less tedious... grr dumb mysql sub delete { my $self = shift; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -147,10 +192,103 @@ sub delete { } } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; + foreach my $part_export_machine ( $self->part_export_machine ) { + my $error = $part_export_machine->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; +} + +=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ] + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +If a list or hash reference of options is supplied, option records are created +or modified. + +=cut +sub replace { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::replace(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if ( $self->part_export_machine_textarea ) { + + my %part_export_machine = map { $_->machine => $_ } + $self->part_export_machine; + + my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ } + grep /\S/, + split /[\n\r]{1,2}/, + $self->part_export_machine_textarea; + + foreach my $machine ( @machines ) { + + if ( $part_export_machine{$machine} ) { + + if ( $part_export_machine{$machine}->disabled eq 'Y' ) { + $part_export_machine{$machine}->disabled(''); + $error = $part_export_machine{$machine}->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + delete $part_export_machine{$machine}; #so we don't disable it below + + } else { + + my $part_export_machine = new FS::part_export_machine { + 'exportnum' => $self->exportnum, + 'machine' => $machine + }; + $error = $part_export_machine->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + } + + + foreach my $part_export_machine ( values %part_export_machine ) { + $part_export_machine->disabled('Y'); + $error = $part_export_machine->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } =item check @@ -166,7 +304,7 @@ sub check { my $error = $self->ut_numbern('exportnum') || $self->ut_textn('exportname') - || $self->ut_domain('machine') + || $self->ut_domainn('machine') || $self->ut_alpha('exporttype') ; return $error if $error; @@ -233,6 +371,20 @@ sub cust_svc { $self->export_svc; } +=item part_export_machine + +Returns all machines as FS::part_export_machine objects (see +L). + +=cut + +sub part_export_machine { + my $self = shift; + map { $_ } #behavior of sort undefined in scalar context + sort { $a->machine cmp $b->machine } + qsearch('part_export_machine', { 'exportnum' => $self->exportnum } ); +} + =item export_svc Returns a list of associated FS::export_svc records. diff --git a/FS/FS/part_export/acct_google.pm b/FS/FS/part_export/acct_google.pm index afc45db81..d153728e9 100644 --- a/FS/FS/part_export/acct_google.pm +++ b/FS/FS/part_export/acct_google.pm @@ -16,10 +16,12 @@ tie my %options, 'Tie::IxHash', # admin logins. %info = ( - 'svc' => 'svc_acct', - 'desc' => 'Google hosted mail', - 'options' => \%options, - 'nodomain' => 'Y', + 'svc' => 'svc_acct', + 'desc' => 'Google hosted mail', + 'options' => \%options, + 'nodomain' => 'Y', + 'no_machine' => 1, + 'default_svc_class' => 'Email', 'notes' => <<'END' Export accounts to the Google Provisioning API. Requires REST::Google::Apps::Provisioning from CPAN. diff --git a/FS/FS/part_export/acct_http.pm b/FS/FS/part_export/acct_http.pm index b4c64ac62..23df7b37d 100644 --- a/FS/FS/part_export/acct_http.pm +++ b/FS/FS/part_export/acct_http.pm @@ -51,6 +51,7 @@ tie %options, 'Tie::IxHash', 'svc' => 'svc_acct', 'desc' => 'Send an HTTP or HTTPS GET or POST request, for accounts.', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Send an HTTP or HTTPS GET or POST to the specified URL on account addition, modification and deletion. For HTTPS support, diff --git a/FS/FS/part_export/acct_plesk.pm b/FS/FS/part_export/acct_plesk.pm index d8d70a30e..50b6faebf 100644 --- a/FS/FS/part_export/acct_plesk.pm +++ b/FS/FS/part_export/acct_plesk.pm @@ -15,9 +15,11 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Plesk managed mail service', - 'options'=> \%options, + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to Plesk managed mail service', + 'options' => \%options, + 'no_machine' => 1, + 'default_svc_class' => 'Email', 'notes' => <<'END' Real-time export to Plesk managed server. diff --git a/FS/FS/part_export/acct_sql.pm b/FS/FS/part_export/acct_sql.pm index ffe39caa5..8163f2017 100644 --- a/FS/FS/part_export/acct_sql.pm +++ b/FS/FS/part_export/acct_sql.pm @@ -60,11 +60,13 @@ my $postfix_native_mailbox_map = keys %postfix_native_mailbox_map ); %info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export of accounts to SQL databases '. - '(vpopmail, Postfix+Courier IMAP, others?)', - 'options' => \%options, - 'nodomain' => '', + 'svc' => 'svc_acct', + 'desc' => 'Real-time export of accounts to SQL databases '. + '(vpopmail, Postfix+Courier IMAP, others?)', + 'options' => \%options, + 'nodomain' => '', + 'no_machine' => 1, + 'default_svc_class' => 'Email', 'notes' => < 'Mailbox status information from SQL', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, 'notes' => < 'svc_acct', 'desc' => 'Configurable provisioning of accounts via the XML-RPC protocol', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END', Configurable, real-time export of accounts via the XML-RPC protocol.

diff --git a/FS/FS/part_export/amazon_ec2.pm b/FS/FS/part_export/amazon_ec2.pm index 0e65ca00c..06e2c238e 100644 --- a/FS/FS/part_export/amazon_ec2.pm +++ b/FS/FS/part_export/amazon_ec2.pm @@ -20,6 +20,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Export to Amazon EC2', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Create instances in the Amazon EC2 (Elastic compute cloud). Install Net::Amazon::EC2 perl module. Advisable to set svc_external-skip_manual config diff --git a/FS/FS/part_export/artera_turbo.pm b/FS/FS/part_export/artera_turbo.pm index c006db9cd..e22bbf2af 100644 --- a/FS/FS/part_export/artera_turbo.pm +++ b/FS/FS/part_export/artera_turbo.pm @@ -37,6 +37,7 @@ tie my %options, 'Tie::IxHash', 'Real-time export to Artera Turbo Reseller API', 'options' => \%options, #'nodomain' => 'Y', + 'no_machine' => 1, 'notes' => <<'END' Real-time export to Artera Turbo Reseller API. Requires installation of diff --git a/FS/FS/part_export/broadband_http.pm b/FS/FS/part_export/broadband_http.pm index 9edfee5d3..c1ed7fca6 100644 --- a/FS/FS/part_export/broadband_http.pm +++ b/FS/FS/part_export/broadband_http.pm @@ -45,6 +45,7 @@ tie %options, 'Tie::IxHash', 'svc' => 'svc_broadband', 'desc' => 'Send an HTTP or HTTPS GET or POST request, for accounts.', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END'

Send an HTTP or HTTPS GET or POST to the specified URL on account addition, modification and deletion. For HTTPS support, diff --git a/FS/FS/part_export/broadband_nas.pm b/FS/FS/part_export/broadband_nas.pm index a160c9944..5a8ffac3b 100644 --- a/FS/FS/part_export/broadband_nas.pm +++ b/FS/FS/part_export/broadband_nas.pm @@ -43,6 +43,7 @@ FS::UID->install_callback( 'svc' => 'svc_broadband', 'desc' => 'Create a NAS entry in Freeside', 'options' => \%options, + 'no_machine' => 1, 'weight' => 10, 'notes' => <<'END'

Create an entry in the NAS (RADIUS client) table, inheriting the IP diff --git a/FS/FS/part_export/broadband_shellcommands.pm b/FS/FS/part_export/broadband_shellcommands.pm index c7f0fbb33..cf9c36c8f 100644 --- a/FS/FS/part_export/broadband_shellcommands.pm +++ b/FS/FS/part_export/broadband_shellcommands.pm @@ -107,3 +107,4 @@ sub ssh_cmd { #subroutine, not method ''; } +1; diff --git a/FS/FS/part_export/broadband_snmp.pm b/FS/FS/part_export/broadband_snmp.pm index cb1740efc..44b4dbabb 100644 --- a/FS/FS/part_export/broadband_snmp.pm +++ b/FS/FS/part_export/broadband_snmp.pm @@ -52,6 +52,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_broadband', 'desc' => 'Send SNMP requests to the service IP address', 'options' => \%options, + 'no_machine' => 1, 'weight' => 10, 'notes' => <<'END' Send one or more SNMP SET requests to the IP address registered to the service. diff --git a/FS/FS/part_export/broadband_sql.pm b/FS/FS/part_export/broadband_sql.pm index 697d3cdac..4f526c805 100644 --- a/FS/FS/part_export/broadband_sql.pm +++ b/FS/FS/part_export/broadband_sql.pm @@ -24,6 +24,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Real-time export of broadband services to SQL databases ', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, 'notes' => < 'svc_broadband', 'desc' => 'Real-time export to SQL-backed RADIUS (such as FreeRadius) for broadband services', 'options' => \%options, + 'no_machine' => 1, 'nas' => 'Y', 'notes' => <radcheck, radreply, and usergroup diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm index a3ec5e0be..8b66225d2 100644 --- a/FS/FS/part_export/communigate_pro.pm +++ b/FS/FS/part_export/communigate_pro.pm @@ -36,6 +36,7 @@ tie %options, 'Tie::IxHash', 'svc' => [qw( svc_acct svc_domain svc_forward svc_mailinglist )], 'desc' => 'Real-time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server', 'options' => \%options, + 'default_svc_class' => 'Email', 'notes' => <<'END' Real time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro diff --git a/FS/FS/part_export/communigate_pro_singledomain.pm b/FS/FS/part_export/communigate_pro_singledomain.pm index e25043fbb..cecea2826 100644 --- a/FS/FS/part_export/communigate_pro_singledomain.pm +++ b/FS/FS/part_export/communigate_pro_singledomain.pm @@ -16,6 +16,7 @@ tie my %options, 'Tie::IxHash', %FS::part_export::communigate_pro::options, 'Real-time export to a CommuniGate Pro mail server, one domain only', 'options' => \%options, 'nodomain' => 'Y', + 'default_svc_class' => 'Email', 'notes' => <<'END' Real time export to a CommuniGate Pro diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm index 96fa43710..2ae97e12d 100644 --- a/FS/FS/part_export/cp.pm +++ b/FS/FS/part_export/cp.pm @@ -18,6 +18,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_acct', 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', 'options'=> \%options, + 'default_svc_class' => 'Email', 'notes' => <<'END' Real-time export to Critial Path Account Provisioning Protocol. diff --git a/FS/FS/part_export/cpanel.pm b/FS/FS/part_export/cpanel.pm index 0ad00df01..6c61e3d2b 100644 --- a/FS/FS/part_export/cpanel.pm +++ b/FS/FS/part_export/cpanel.pm @@ -190,3 +190,5 @@ sub cpanel_connect { $whm; } + +1; diff --git a/FS/FS/part_export/cust_http.pm b/FS/FS/part_export/cust_http.pm index e8b677be2..e834f93ea 100644 --- a/FS/FS/part_export/cust_http.pm +++ b/FS/FS/part_export/cust_http.pm @@ -55,6 +55,7 @@ tie %options, 'Tie::IxHash', 'svc' => 'cust_main', 'desc' => 'Send an HTTP or HTTPS GET or POST request, for customers.', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Send an HTTP or HTTPS GET or POST to the specified URL on customer addition, modification and deletion. For HTTPS support, diff --git a/FS/FS/part_export/cyrus.pm b/FS/FS/part_export/cyrus.pm index 84c9e5a30..246d5b3dc 100644 --- a/FS/FS/part_export/cyrus.pm +++ b/FS/FS/part_export/cyrus.pm @@ -17,6 +17,8 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Real-time export to Cyrus IMAP server', 'options' => \%options, 'nodomain' => 'Y', + 'no_machine' => 1, #de facto... but "server" option should move to it + 'default_svc_class' => 'Email', 'notes' => <<'END' Integration with Cyrus IMAP Server. diff --git a/FS/FS/part_export/dashcs_e911.pm b/FS/FS/part_export/dashcs_e911.pm index 320d0a67b..2717233cf 100644 --- a/FS/FS/part_export/dashcs_e911.pm +++ b/FS/FS/part_export/dashcs_e911.pm @@ -20,6 +20,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_phone', 'desc' => 'Provision e911 services via Dash Carrier Services', 'notes' => 'Provision e911 services via Dash Carrier Services', + 'no_machine' => 1, 'options' => \%options, ); diff --git a/FS/FS/part_export/domain_sql.pm b/FS/FS/part_export/domain_sql.pm index 0749fec09..ff0d949f1 100644 --- a/FS/FS/part_export/domain_sql.pm +++ b/FS/FS/part_export/domain_sql.pm @@ -26,6 +26,7 @@ my $postfix_transport_static = 'desc' => 'Real time export of domains to SQL databases '. '(postfix, others?)', 'options' => \%options, + 'no_machine' => 1, 'notes' => < 'svc_acct', 'desc' => 'Real-time export to Everyone.net outsourced mail service', 'options'=> \%options, + 'no_machine' => 1, + 'default_svc_class' => 'Email', 'notes' => <<'END' Real-time export to Everyone.net via the XRC Remote API. diff --git a/FS/FS/part_export/ez_prepaid.pm b/FS/FS/part_export/ez_prepaid.pm index d171eb135..9f454df54 100644 --- a/FS/FS/part_export/ez_prepaid.pm +++ b/FS/FS/part_export/ez_prepaid.pm @@ -34,6 +34,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_external', 'desc' => 'Purchase EZ-Prepaid PIN', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END'

Export to the EZ-Prepaid PIN purchase service. If the purchase is allowed, the PIN will be stored as svc_external.id.

diff --git a/FS/FS/part_export/forward_sql.pm b/FS/FS/part_export/forward_sql.pm index 563efcc44..eb4137801 100644 --- a/FS/FS/part_export/forward_sql.pm +++ b/FS/FS/part_export/forward_sql.pm @@ -10,6 +10,7 @@ use FS::Record; 'desc' => 'Real-time export of forwards to SQL databases ', #.' (vpopmail, Postfix+Courier IMAP, others?)', 'options' => __PACKAGE__->sql_options, + 'no_machine' => 1, 'notes' => < 'svc_phone', 'desc' => 'Provision phone numbers to VoIP Innovations (formerly GlobalPOPs VoIP)', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Requires installation of Net::GlobalPOPs::MediaServicesAPI diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm index 3749224ff..c35c89f12 100644 --- a/FS/FS/part_export/http.pm +++ b/FS/FS/part_export/http.pm @@ -43,6 +43,7 @@ tie %options, 'Tie::IxHash', 'svc' => 'svc_domain', 'desc' => 'Send an HTTP or HTTPS GET or POST request', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Send an HTTP or HTTPS GET or POST to the specified URL. For HTTPS support, Crypt::SSLeay diff --git a/FS/FS/part_export/http_status.pm b/FS/FS/part_export/http_status.pm index 5342106b4..6fbd3fbe6 100644 --- a/FS/FS/part_export/http_status.pm +++ b/FS/FS/part_export/http_status.pm @@ -17,6 +17,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_dsl', 'desc' => 'Retrieve status information via HTTP or HTTPS', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Fields from the service can be substituted in the URL as $field. END diff --git a/FS/FS/part_export/ikano.pm b/FS/FS/part_export/ikano.pm index eedc9d0ac..23917bf9e 100644 --- a/FS/FS/part_export/ikano.pm +++ b/FS/FS/part_export/ikano.pm @@ -31,6 +31,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_dsl', 'desc' => 'Provision DSL to Ikano', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Requires installation of Net::Ikano from CPAN. diff --git a/FS/FS/part_export/indosoft.pm b/FS/FS/part_export/indosoft.pm index b5734019b..02ae5efc5 100644 --- a/FS/FS/part_export/indosoft.pm +++ b/FS/FS/part_export/indosoft.pm @@ -17,6 +17,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Export conferences to the Indosoft Conference Bridge', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Export conferences to the Indosoft conference bridge. Net::Indosoft::Voicebridge is required. diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index ef16c7c54..51f57605a 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -19,6 +19,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Real-time export to InfoStreet streetSmartAPI', 'options' => \%options, 'nodomain' => 'Y', + 'no_machine' => 1, 'notes' => <<'END' Real-time export to InfoStreet streetSmartAPI. diff --git a/FS/FS/part_export/internal_diddb.pm b/FS/FS/part_export/internal_diddb.pm index a94e43e28..b51f63173 100644 --- a/FS/FS/part_export/internal_diddb.pm +++ b/FS/FS/part_export/internal_diddb.pm @@ -17,6 +17,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Provision phone numbers from the internal DID database', 'notes' => 'After adding the export, DIDs may be imported under Tools -> Importing -> Import phone numbers (DIDs)', 'options' => \%options, + 'no_machine' => 1, ); sub rebless { shift; } diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 838532021..fe634d230 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -41,6 +41,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_acct', 'desc' => 'Real-time export to LDAP', 'options' => \%options, + 'default_svc_class' => 'Email', 'notes' => <<'END' Real-time export to arbitrary LDAP attributes. Requires installation of Net::LDAP from CPAN. diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm index 6e2ee8ae3..2e37d04b6 100644 --- a/FS/FS/part_export/netsapiens.pm +++ b/FS/FS/part_export/netsapiens.pm @@ -72,10 +72,11 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => [ 'svc_phone', ], # 'part_device', - 'desc' => 'Provision phone numbers to NetSapiens', - 'options' => \%options, - 'notes' => <<'END' + 'svc' => [ 'svc_phone', ], # 'part_device', + 'desc' => 'Provision phone numbers to NetSapiens', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<'END' Requires installation of REST::Client from CPAN. diff --git a/FS/FS/part_export/null.pm b/FS/FS/part_export/null.pm index 0145af3a4..3a764883c 100644 --- a/FS/FS/part_export/null.pm +++ b/FS/FS/part_export/null.pm @@ -11,3 +11,4 @@ sub _export_insert {} sub _export_replace {} sub _export_delete {} +1; diff --git a/FS/FS/part_export/phone_shellcommands.pm b/FS/FS/part_export/phone_shellcommands.pm index 040af27a7..5c1ae0153 100644 --- a/FS/FS/part_export/phone_shellcommands.pm +++ b/FS/FS/part_export/phone_shellcommands.pm @@ -138,3 +138,4 @@ sub ssh_cmd { #subroutine, not method &Net::SSH::ssh_cmd( { @_ } ); } +1; diff --git a/FS/FS/part_export/phone_sqlopensips.pm b/FS/FS/part_export/phone_sqlopensips.pm index 3d01c1624..7b07ecf4a 100644 --- a/FS/FS/part_export/phone_sqlopensips.pm +++ b/FS/FS/part_export/phone_sqlopensips.pm @@ -21,10 +21,11 @@ tie %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_phone', - 'desc' => 'Export DIDs to OpenSIPs dr_rules table', - 'options' => \%options, - 'notes' => 'Export DIDs to OpenSIPs dr_rules table', + 'svc' => 'svc_phone', + 'desc' => 'Export DIDs to OpenSIPs dr_rules table', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => 'Export DIDs to OpenSIPs dr_rules table', ); sub rebless { shift; } @@ -93,3 +94,4 @@ sub dr_reload { ''; } +1; diff --git a/FS/FS/part_export/phone_sqlradius.pm b/FS/FS/part_export/phone_sqlradius.pm index 6b14bed3c..46c372cb4 100644 --- a/FS/FS/part_export/phone_sqlradius.pm +++ b/FS/FS/part_export/phone_sqlradius.pm @@ -39,10 +39,11 @@ tie %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_phone', - 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) for phone provisioning and rating', - 'options' => \%options, - 'notes' => < 'svc_phone', + 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) for phone provisioning and rating', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <radcheck table to any SQL database for FreeRADIUS or ICRADIUS. diff --git a/FS/FS/part_export/postfix.pm b/FS/FS/part_export/postfix.pm index 4fd19ee61..9a8d617f3 100644 --- a/FS/FS/part_export/postfix.pm +++ b/FS/FS/part_export/postfix.pm @@ -22,6 +22,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_forward', 'desc' => 'Postfix text files', 'options' => \%options, + 'default_svc_class' => 'Email', 'notes' => <<'END' Batch export of Postfix aliases and virtual files. File::Rsync diff --git a/FS/FS/part_export/prizm.pm b/FS/FS/part_export/prizm.pm index 02e89c6d3..996448951 100644 --- a/FS/FS/part_export/prizm.pm +++ b/FS/FS/part_export/prizm.pm @@ -79,11 +79,12 @@ possibly harmful. EOT %info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Real-time export to Northbound Interface', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => $notes, + 'svc' => 'svc_broadband', + 'desc' => 'Real-time export to Northbound Interface', + 'options' => \%options, + 'nodomain' => 'Y', + 'no_machine' => 1, + 'notes' => $notes, ); sub prizm_command { diff --git a/FS/FS/part_export/radiator.pm b/FS/FS/part_export/radiator.pm index 2ac3edb22..f09d36abb 100644 --- a/FS/FS/part_export/radiator.pm +++ b/FS/FS/part_export/radiator.pm @@ -11,6 +11,8 @@ tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; 'desc' => 'Real-time export to RADIATOR', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, + 'default_svc_class' => 'Internet', 'notes' => <<'END', Real-time export of the radusers table to any SQL database in Radiator-native format. diff --git a/FS/FS/part_export/router.pm b/FS/FS/part_export/router.pm index 6a1d676f4..3071ece74 100644 --- a/FS/FS/part_export/router.pm +++ b/FS/FS/part_export/router.pm @@ -87,6 +87,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_broadband', 'desc' => 'Send a command to a router.', 'options' => \%options, + 'no_machine' => 1, 'notes' => 'Installation of Net::Telnet from CPAN is required for telnet connections. This export will execute if the following virtual fields are set on the router: admin_user, admin_password, admin_address, admin_timeout, admin_prompt. Option virtual fields are: admin_cmd_insert, admin_cmd_replace, admin_cmd_delete, admin_cmd_suspend, admin_cmd_unsuspend. See the module documentation for a full list of required/supported router virtual fields.', ); diff --git a/FS/FS/part_export/rt_ticket.pm b/FS/FS/part_export/rt_ticket.pm index b53b7da8a..7ae6105a0 100644 --- a/FS/FS/part_export/rt_ticket.pm +++ b/FS/FS/part_export/rt_ticket.pm @@ -127,6 +127,7 @@ tie my %options, 'Tie::IxHash', ( 'Create an RT ticket', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, 'notes' => ' Create a ticket in RT. The subject and body of the ticket will be generated from a message template.' diff --git a/FS/FS/part_export/send_email.pm b/FS/FS/part_export/send_email.pm index 05f623633..6ba131f18 100644 --- a/FS/FS/part_export/send_email.pm +++ b/FS/FS/part_export/send_email.pm @@ -85,6 +85,7 @@ tie my %options, 'Tie::IxHash', ( 'Send an email message', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, 'notes' => ' Send an email message. The subject and body of the message will be generated from a message template.' diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 20e909135..b9d6551db 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -97,12 +97,13 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_acct', - 'desc' => + 'svc' => 'svc_acct', + 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' + 'options' => \%options, + 'nodomain' => 'Y', + 'svc_machine' => 1, + 'notes' => <<'END' Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to @@ -124,24 +125,7 @@ running will not accept a domain as a parameter. You will need to this.form.unsuspend_stdin.value=""; '>
  • - - Note: On FreeBSD versions before 5.3 and 4.10 (4.10 is after 4.9, not - 4.1!), due to deficient locking in pw(1), you must disable the chpass(1), - chsh(1), chfn(1), passwd(1), and vipw(1) commands, or replace them with - wrappers that prepend "lockf /etc/passwd.lock". Alternatively, apply the - patch in - FreeBSD PR#23501 - and use the "FreeBSD 4.10 / 5.3 or later" button below. -
  • - 'Real-time export to SQL-backed mail server', 'options' => \%options, 'nodomain' => '', + 'default_svc_class' => 'Email', 'notes' => <<'END' Database schema can be made to work with Courier IMAP, Exim and Dovecot. Others could work but are untested. (more detailed description from diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 721396671..6760d09b7 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -110,6 +110,7 @@ END 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)', 'options' => \%options, 'nodomain' => 'Y', + 'no_machine' => 1, 'nas' => 'Y', # show export_nas selection in UI 'default_svc_class' => 'Internet', 'notes' => $notes1. diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index 869c7c7dc..07de87563 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -18,6 +18,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', 'options' => \%options, + 'default_svc_class' => 'Internet', 'notes' => <<'END' This will edit a text RADIUS users file in place on a remote server. Requires installation of diff --git a/FS/FS/part_export/trango.pm b/FS/FS/part_export/trango.pm index e7f1126dd..64d2cc4ec 100644 --- a/FS/FS/part_export/trango.pm +++ b/FS/FS/part_export/trango.pm @@ -68,6 +68,7 @@ tie my %options, 'Tie::IxHash', ( 'svc' => 'svc_broadband', 'desc' => 'Sends SNMP SETs to a Trango AP.', 'options' => \%options, + 'no_machine' => 1, 'notes' => 'Requires Net::SNMP. See the documentation for FS::part_export::trango for required virtual fields and usage information.', ); diff --git a/FS/FS/part_export/vitelity.pm b/FS/FS/part_export/vitelity.pm index 12c3a7fce..350a5ad48 100644 --- a/FS/FS/part_export/vitelity.pm +++ b/FS/FS/part_export/vitelity.pm @@ -26,6 +26,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_phone', 'desc' => 'Provision phone numbers to Vitelity', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Requires installation of Net::Vitelity diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index 799a8e1c1..5fca1704c 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -23,6 +23,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_acct', 'desc' => 'Real-time export to vpopmail text files', 'options' => \%options, + 'default_svc_class' => 'Email', 'notes' => <<'END' This export is currently unmaintained. See shellcommands_withdomain for an export that uses vpopmail CLI commands instead.
    diff --git a/FS/FS/part_export/www_plesk.pm b/FS/FS/part_export/www_plesk.pm index ccf9b3e17..a247f054e 100644 --- a/FS/FS/part_export/www_plesk.pm +++ b/FS/FS/part_export/www_plesk.pm @@ -18,10 +18,11 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_www', - 'desc' => 'Real-time export to Plesk managed hosting service', - 'options'=> \%options, - 'notes' => <<'END' + 'svc' => 'svc_www', + 'desc' => 'Real-time export to Plesk managed hosting service', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<'END' Real-time export to Plesk managed server. Requires installation of diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm index d6116aba1..bef2e9470 100644 --- a/FS/FS/part_export/www_shellcommands.pm +++ b/FS/FS/part_export/www_shellcommands.pm @@ -188,3 +188,4 @@ sub ssh_cmd { #subroutine, not method ''; } +1; diff --git a/FS/FS/part_export_machine.pm b/FS/FS/part_export_machine.pm new file mode 100644 index 000000000..1598e0372 --- /dev/null +++ b/FS/FS/part_export_machine.pm @@ -0,0 +1,155 @@ +package FS::part_export_machine; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( dbh qsearch ); #qsearchs ); +use FS::part_export; +use FS::svc_export_machine; + +=head1 NAME + +FS::part_export_machine - Object methods for part_export_machine records + +=head1 SYNOPSIS + + use FS::part_export_machine; + + $record = new FS::part_export_machine \%hash; + $record = new FS::part_export_machine { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_export_machine object represents an export hostname choice. +FS::part_export_machine inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item machinenum + +primary key + +=item exportnum + +Export, see L + +=item machine + +Hostname or IP address + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'part_export_machine'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $svc_export_machine ( $self->svc_export_machine ) { + my $error = $svc_export_machine->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('machinenum') + || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum') + || $self->ut_domain('machine') + || $self->ut_enum('disabled', [ '', 'Y' ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=item svc_export_machine + +=cut + +sub svc_export_machine { + my $self = shift; + qsearch( 'svc_export_machine', { 'machinenum' => $self->machinenum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L + +=cut + +1; + diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index dd18e87f9..7f22411e0 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -591,7 +591,7 @@ sub _svc_defs { }; my $mod = $1; - if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^svc_acct_pop$/ ) { + if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^(svc_acct_pop|svc_export_machine)$/ ) { warn "skipping FS::$mod" if $DEBUG; next; } diff --git a/FS/FS/svc_export_machine.pm b/FS/FS/svc_export_machine.pm new file mode 100644 index 000000000..39629d8af --- /dev/null +++ b/FS/FS/svc_export_machine.pm @@ -0,0 +1,111 @@ +package FS::svc_export_machine; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_svc; +use FS::part_export_machine; + +=head1 NAME + +FS::svc_export_machine - Object methods for svc_export_machine records + +=head1 SYNOPSIS + + use FS::svc_export_machine; + + $record = new FS::svc_export_machine \%hash; + $record = new FS::svc_export_machine { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::svc_export_machine object represents a customer service export +hostname. FS::svc_export_machine inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item svcexportmachinenum + +primary key + +=item svcnum + +Customer service, see L + +=item machinenum + +Export hostname, see L + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'svc_export_machine'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('svcexportmachinenum') + || $self->ut_foreign_key('svcnum', 'cust_svc', 'svcnum') + || $self->ut_foreign_key('machinenum', 'part_export_machine', 'machinenum' ) + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index bb10fb7b1..479dcad60 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -668,3 +668,7 @@ t/cust_bill_pkg_discount_void.t FS/Trace.pm FS/agent_pkg_class.pm t/agent_pkg_class.t +FS/part_export_machine.pm +t/part_export_machine.t +FS/svc_export_machine.pm +t/svc_export_machine.t diff --git a/FS/t/part_export_machine.t b/FS/t/part_export_machine.t new file mode 100644 index 000000000..792bb5092 --- /dev/null +++ b/FS/t/part_export_machine.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export_machine; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_export_machine.t b/FS/t/svc_export_machine.t new file mode 100644 index 000000000..5279be2ca --- /dev/null +++ b/FS/t/svc_export_machine.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_export_machine; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 806d426d106efea2b2b13314108c4ac046511e1c Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 18 Sep 2012 02:56:30 -0700 Subject: export host selection per service, RT#17914 --- FS/FS/part_export.pm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 97394af18..c757d368d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -330,6 +330,31 @@ sub label { ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')'; } +=item label_html + +Returns a label for this export, "exportname: exporttype to machine". + +=cut + +sub label_html { + my $self = shift; + + my $label = $self->exportname + ? ''. $self->exportname. ': ' #
    '. + : ''; + + $label .= $self->exporttype; + + $label .= ' to '. ( $self->machine eq '_SVC_MACHINE' + ? 'per-service hostname' + : $self->machine + ) + if $self->machine; + + $label; + +} + #=item part_svc # #Returns the service definition (see L) for this export. -- cgit v1.2.1 From 7e2f43f75eeaa14a92b4eac6d435875eff63618c Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 19 Sep 2012 12:13:59 -0700 Subject: taqua 6.2 CDR format, #19307 --- FS/FS/cdr/taqua62.pm | 178 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 178 insertions(+) create mode 100644 FS/FS/cdr/taqua62.pm (limited to 'FS') diff --git a/FS/FS/cdr/taqua62.pm b/FS/FS/cdr/taqua62.pm new file mode 100644 index 000000000..862018e9c --- /dev/null +++ b/FS/FS/cdr/taqua62.pm @@ -0,0 +1,178 @@ +package FS::cdr::taqua62; + +use strict; +use vars qw(@ISA %info $da_rewrite); +use FS::cdr qw(_cdr_date_parser_maker); + +@ISA = qw(FS::cdr); + +%info = ( + 'name' => 'Taqua v6.2', + 'weight' => 131, + 'header' => 1, + 'import_fields' => [ + + #0 + '', #Key + '', #InsertTime, irrelevant + #RecordType + sub { + my($cdr, $field, $conf, $hashref) = @_; + $hashref->{skiprow} = 1 + unless ($field == 0 && $cdr->disposition == 100 ) #regular CDR + || ($field == 1 && $cdr->lastapp eq 'acctcode'); #accountcode + $cdr->cdrtypenum($field); + }, + + '', #RecordVersion + '', #OrigShelfNumber + '', #OrigCardNumber + '', #OrigCircuit + '', #OrigCircuitType + 'uniqueid', #SequenceNumber + 'sessionnum', #SessionNumber + #10 + 'src', #CallingPartyNumber + #CalledPartyNumber + sub { + my( $cdr, $field, $conf ) = @_; + if ( $cdr->calltypenum == 6 && $cdr->cdrtypenum == 0 ) { + $cdr->dst("+$field"); + } else { + $cdr->dst($field); + } + }, + + _cdr_date_parser_maker('startdate', 'gmt' => 1), #CallArrivalTime + _cdr_date_parser_maker('enddate', 'gmt' => 1), #CallCompletionTime + + #Disposition + #sub { my($cdr, $d ) = @_; $cdr->disposition( $disposition{$d}): }, + 'disposition', + # -1 => '', + # 0 => '', + # 100 => '', #regular cdr + # 101 => '', + # 102 => '', + # 103 => '', + # 104 => '', + # 105 => '', + # 201 => '', + # 203 => '', + # 204 => '', + + _cdr_date_parser_maker('answerdate', 'gmt' => 1), #DispositionTime + '', #TCAP + '', #OutboundCarrierConnectTime + '', #OutboundCarrierDisconnectTime + + #TermTrunkGroup + #it appears channels are actually part of trunk groups, but this data + #is interesting and we need a source and destination place to put it + 'dstchannel', #TermTrunkGroup + + #20 + + '', #TermShelfNumber + '', #TermCardNumber + '', #TermCircuit + '', #TermCircuitType + 'carrierid', #OutboundCarrierId + + #BillingNumber + #'charged_party', + sub { + my( $cdr, $field, $conf ) = @_; + + #could be more efficient for the no config case, if anyone ever needs that + $da_rewrite ||= $conf->config('cdr-taqua-da_rewrite'); + + if ( $da_rewrite && $field =~ /\d/ ) { + my $rewrite = $da_rewrite; + $rewrite =~ s/\s//g; + my @rewrite = split(',', $conf->config('cdr-taqua-da_rewrite') ); + if ( grep { $field eq $_ } @rewrite ) { + $cdr->charged_party( $cdr->src() ); + $cdr->calltypenum(12); + return; + } + } + if ( $cdr->is_tollfree ) { # thankfully this is already available + $cdr->charged_party($cdr->dst); # and this + } else { + $cdr->charged_party($field); + } + }, + + 'subscriber', #SubscriberName + 'lastapp', #ServiceName + '', #some weirdness #ChargeTime + 'lastdata', #ServiceInformation + + #30 + + '', #FacilityInfo + '', #all 1900-01-01 0#CallTraceTime + '', #all-1#UniqueIndicator + '', #all-1#PresentationIndicator + '', #empty#Pin + 'calltypenum', #CallType + + #nothing below is used by QIS... + + '', #Balt/empty #OrigRateCenter + '', #Balt/empty #TermRateCenter + + #OrigTrunkGroup + #it appears channels are actually part of trunk groups, but this data + #is interesting and we need a source and destination place to put it + 'channel', #OrigTrunkGroup + 'userfield', #empty#UserDefined + + #40 + + '', #empty#PseudoDestinationNumber + '', #all-1#PseudoCarrierCode + '', #empty#PseudoANI + '', #all-1#PseudoFacilityInfo + '', #OrigDialedDigits + '', #all-1#OrigOutboundCarrier + '', #IncomingCarrierID + 'dcontext', #JurisdictionInfo + '', #OrigDestDigits + '', #empty#AMALineNumber + + #50 + + '', #empty#AMAslpID + '', #empty#AMADigitsDialedWC + '', #OpxOffHook + '', #OpxOnHook + '', #OrigCalledNumber + '', #RedirectingNumber + '', #RouteAttempts + '', #OrigMGCPTerm + '', #TermMGCPTerm + '', #ReasonCode + + #60 + + '', #OrigIPCallID + '', #ESAIPTrunkGroup + '', #ESAReason + '', #BearerlessCall + '', #oCodec + '', #tCodec + '', #OrigTrunkGroupNumber + '', #TermTrunkGroupNumber + '', #TermRecord + '', #OrigRoutingIndicator + + #70 + + '', #TermRoutingIndicator + + ], +); + +1; -- cgit v1.2.1 From 3aea51067b7a187e6725c6677226819863b71fb7 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 19 Sep 2012 15:11:17 -0700 Subject: taqua CDR format label --- FS/FS/cdr/taqua.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cdr/taqua.pm b/FS/FS/cdr/taqua.pm index 390152a04..7ef6d769a 100644 --- a/FS/FS/cdr/taqua.pm +++ b/FS/FS/cdr/taqua.pm @@ -7,7 +7,7 @@ use FS::cdr qw(_cdr_date_parser_maker); @ISA = qw(FS::cdr); %info = ( - 'name' => 'Taqua', + 'name' => 'Taqua v6.0', 'weight' => 130, 'header' => 1, 'import_fields' => [ #some of these are kind arbitrary... -- cgit v1.2.1 From dd204a0e9ccfd6374b843fa8e5ad4585768d11e0 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 20 Sep 2012 01:24:52 -0700 Subject: fix part_pkg upgrade, fallout from 18503 --- FS/FS/part_pkg.pm | 83 +++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 72 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 91bcdc5b5..70b2d4dd6 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1598,18 +1598,79 @@ sub _upgrade_data { # class method # set any package with FCC voice lines to the "VoIP with broadband" category # for backward compatibility - my $journal = 'part_pkg_fcc_voip_class'; - if (!FS::upgrade_journal->is_done($journal)) { - @part_pkg = qsearch('part_pkg', { - fcc_ds0s => { op => '>', value => 0 }, - fcc_voip_class => '' - }); - foreach my $part_pkg (@part_pkg) { - $part_pkg->set(fcc_voip_class => 2); - my $error = $part_pkg->replace; - die $error if $error; + # + # recover from a bad upgrade bug + my $upgrade = 'part_pkg_fcc_voip_class_FIX'; + if (!FS::upgrade_journal->is_done($upgrade)) { + my $bad_upgrade = qsearchs('upgrade_journal', + { upgrade => 'part_pkg_fcc_voip_class' } + ); + if ( $bad_upgrade ) { + my $where = 'WHERE history_date <= '.$bad_upgrade->_date. + ' AND history_date > '.($bad_upgrade->_date - 600); + my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) } + qsearch({ + 'select' => '*', + 'table' => 'h_part_pkg_option', + 'hashref' => {}, + 'extra_sql' => "$where AND history_action = 'delete'", + 'order_by' => 'ORDER BY history_date ASC', + }); + my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) } + qsearch({ + 'select' => '*', + 'table' => 'h_pkg_svc', + 'hashref' => {}, + 'extra_sql' => "$where AND history_action = 'replace_old'", + 'order_by' => 'ORDER BY history_date ASC', + }); + my %opt; + foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) { + my $pkgpart ||= $deleted->pkgpart; + $opt{$pkgpart} ||= { + options => {}, + pkg_svc => {}, + primary_svc => '', + hidden_svc => {}, + }; + if ( $deleted->isa('FS::part_pkg_option') ) { + $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue; + } else { # pkg_svc + my $svcpart = $deleted->svcpart; + $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity; + $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden; + $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc; + } + } + foreach my $pkgpart (keys %opt) { + my $part_pkg = FS::part_pkg->by_key($pkgpart); + my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} ); + if ( $error ) { + die "error recovering damaged pkgpart $pkgpart:\n$error\n"; + } + } + } # $bad_upgrade exists + else { # do the original upgrade, but correctly this time + @part_pkg = qsearch('part_pkg', { + fcc_ds0s => { op => '>', value => 0 }, + fcc_voip_class => '' + }); + foreach my $part_pkg (@part_pkg) { + $part_pkg->set(fcc_voip_class => 2); + my @pkg_svc = $part_pkg->pkg_svc; + my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc; + my %hidden = map {$_->svcpart, $_->hidden } @pkg_svc; + my $error = $part_pkg->replace( + $part_pkg->replace_old, + options => { $part_pkg->options }, + pkg_svc => \%quantity, + hidden_svc => \%hidden, + primary_svc => ($part_pkg->svcpart || ''), + ); + die $error if $error; + } } - FS::upgrade_journal->set_done($journal); + FS::upgrade_journal->set_done($upgrade); } } -- cgit v1.2.1 From 54422869b5d895058a78454ddfc7c01789cb56f7 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 20 Sep 2012 13:02:58 -0700 Subject: increase upgrade window from last fix --- FS/FS/part_pkg.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 70b2d4dd6..6e7f8f87e 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1607,7 +1607,7 @@ sub _upgrade_data { # class method ); if ( $bad_upgrade ) { my $where = 'WHERE history_date <= '.$bad_upgrade->_date. - ' AND history_date > '.($bad_upgrade->_date - 600); + ' AND history_date > '.($bad_upgrade->_date - 3600); my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) } qsearch({ 'select' => '*', -- cgit v1.2.1 From 36a1e9c1661fb552d368f2f675dcb0793d733748 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Sun, 23 Sep 2012 18:07:47 -0700 Subject: export host selection per service, RT#17914 --- FS/FS/Mason.pm | 1 + FS/FS/Schema.pm | 3 ++- FS/FS/svc_Common.pm | 54 +++++++++++++++++++++++++++++++++++++++------ FS/FS/svc_export_machine.pm | 19 +++++++++++++--- 4 files changed, 66 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 39c7dfdc6..11af25efa 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -325,6 +325,7 @@ if ( -e $addl_handler_use_file ) { use FS::cust_tax_exempt_pkg_void; use FS::cust_bill_pkg_discount_void; use FS::agent_pkg_class; + use FS::svc_export_machine; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 6e3956a83..7be8c664f 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1894,10 +1894,11 @@ sub tables_hashref { 'columns' => [ 'svcexportmachinenum', 'serial', '', '', '', '', 'svcnum', 'int', '', '', '', '', + 'exportnum', 'int', '', '', '', '', 'machinenum', 'int', '', '', '', '', ], 'primary_key' => 'svcexportmachinenum', - 'unique' => [], + 'unique' => [ ['svcnum', 'exportnum'] ], 'index' => [], }, diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index a6daf44c8..7aede54a6 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -200,12 +200,13 @@ I. If I is set to an array reference, the jobnums of any export jobs will be added to the referenced array. -If I is set to an array reference of FS::tablename objects (for -example, FS::acct_snarf objects), they will have their svcnum field set and -will be inserted after this record, but before any exports are run. Each -element of the array can also optionally be a two-element array reference -containing the child object and the name of an alternate field to be filled in -with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]> +If I is set to an array reference of FS::tablename objects +(for example, FS::svc_export_machine or FS::acct_snarf objects), they +will have their svcnum field set and will be inserted after this record, +but before any exports are run. Each element of the array can also +optionally be a two-element array reference containing the child object +and the name of an alternate field to be filled in with the newly-inserted +svcnum, for example C<[ $svc_forward, 'srcsvc' ]> If I is set (to a scalar jobnum or an array reference of jobnums), all provisioning jobs will have a dependancy on the supplied @@ -439,7 +440,16 @@ sub expire { Replaces OLD_RECORD with this one. If there is an error, returns the error, otherwise returns false. -Currently available options are: I and I. +Currently available options are: I, I and +I. + +If I is set to an array reference of FS::tablename objects +(for example, FS::svc_export_machine or FS::acct_snarf objects), they +will have their svcnum field set and will be inserted or replaced after +this record, but before any exports are run. Each element of the array +can also optionally be a two-element array reference containing the +child object and the name of an alternate field to be filled in with +the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]> If I is set (to a scalar jobnum or an array reference of jobnums), all provisioning jobs will have a dependancy on the supplied @@ -462,6 +472,8 @@ sub replace { ? shift : { @_ }; + my $objects = $options->{'child_objects'} || []; + my @jobnums = (); local $FS::queue::jobnums = \@jobnums; warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n" @@ -511,6 +523,34 @@ sub replace { return $error; } + foreach my $object ( @$objects ) { + my($field, $obj); + if ( ref($object) eq 'ARRAY' ) { + ($obj, $field) = @$object; + } else { + $obj = $object; + $field = 'svcnum'; + } + $obj->$field($new->svcnum); + + my $oldobj = qsearchs( $obj->table, { + $field => $new->svcnum, + map { $_ => $obj->$_ } $obj->_svc_child_partfields, + }); + + if ( $oldobj ) { + my $pkey = $oldobj->primary_key; + $obj->$pkey($oldobj->$pkey); + $obj->replace($oldobj); + } else { + $error = $obj->insert; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + #new-style exports! unless ( $noexport_hack ) { diff --git a/FS/FS/svc_export_machine.pm b/FS/FS/svc_export_machine.pm index 39629d8af..10f7b6821 100644 --- a/FS/FS/svc_export_machine.pm +++ b/FS/FS/svc_export_machine.pm @@ -2,10 +2,13 @@ package FS::svc_export_machine; use strict; use base qw( FS::Record ); -use FS::Record; # qw( qsearch qsearchs ); +use FS::Record qw( qsearchs ); #qsearch ); use FS::cust_svc; +use FS::part_export; use FS::part_export_machine; +sub _svc_child_partfields { ('exportnum') }; + =head1 NAME FS::svc_export_machine - Object methods for svc_export_machine records @@ -89,14 +92,24 @@ sub check { my $error = $self->ut_numbern('svcexportmachinenum') - || $self->ut_foreign_key('svcnum', 'cust_svc', 'svcnum') - || $self->ut_foreign_key('machinenum', 'part_export_machine', 'machinenum' ) + || $self->ut_foreign_key('svcnum', 'cust_svc', 'svcnum' ) + || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum' ) + || $self->ut_foreign_key('machinenum', 'part_export_machine', 'machinenum') ; return $error if $error; $self->SUPER::check; } +=item part_export_machine + +=cut + +sub part_export_machine { + my $self = shift; + qsearchs('part_export_machine', { 'machinenum' => $self->machinenum } ); +} + =back =head1 BUGS -- cgit v1.2.1 From 6868dfdef35b338f5f4f6c0bc9cae535dc344ab9 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Sun, 23 Sep 2012 18:36:09 -0700 Subject: export host selection per service, RT#17914 --- FS/FS/part_export.pm | 21 +++++++++++++++++++++ FS/FS/part_export/shellcommands.pm | 13 ++++++------- FS/FS/part_export/shellcommands_withdomain.pm | 9 +++++---- 3 files changed, 32 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index c757d368d..b0f708a66 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -9,6 +9,7 @@ use FS::Record qw( qsearch qsearchs dbh ); use FS::part_svc; use FS::part_export_option; use FS::part_export_machine; +use FS::svc_export_machine; use FS::export_svc; #for export modules, though they should probably just use it themselves @@ -470,6 +471,26 @@ sub _rebless { $self; } +=item svc_machine + +=cut + +sub svc_machine { + my( $self, $svc_x ) = @_; + + return $self->machine unless $self->machine eq '_SVC_MACHINE'; + + my $svc_export_machine = qsearchs('svc_export_machine', { + 'svcnum' => $svc_x->svcnum, + 'exportnum' => $self->exportnum, + }) + #would only happen if you add this export to existing services without a + #machine set then try to run exports without setting it... right? + or die "No hostname selected for ".($self->exportname || $self->exporttype); + + return $svc_export_machine->part_export_machine->machine; +} + #these should probably all go away, just let the subclasses define em =item export_insert SVC_OBJECT diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index b9d6551db..ca4e52420 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -98,8 +98,7 @@ tie my %options, 'Tie::IxHash', %info = ( 'svc' => 'svc_acct', - 'desc' => - 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', + 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%options, 'nodomain' => 'Y', 'svc_machine' => 1, @@ -344,7 +343,7 @@ sub _export_command { my @ssh_cmd_args = ( user => $self->option('user') || 'root', - host => $self->machine, + host => $self->svc_machine($svc_acct), command => $command_string, stdin_string => $stdin_string, ignored_errors => $self->option('ignored_errors') || '', @@ -357,7 +356,7 @@ sub _export_command { eval { ssh_cmd(@ssh_cmd_args) }; $error = $@; $error = $error->full_message if ref $error; # Exception::Class::Base - return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + return $error. ' ('. $self->exporttype. ' to '. $self->svc_machine($svc_acct). ')' if $error; } else { @@ -417,7 +416,7 @@ sub _export_replace { # $error ||= "can't change RADIUS groups"; #} } - return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + return $error. ' ('. $self->exporttype. ' to '. $self->svc_machine($new). ')' if $error; $new_agent_custid = $new_cust_main ? $new_cust_main->agent_custid : ''; @@ -441,7 +440,7 @@ sub _export_replace { my @ssh_cmd_args = ( user => $self->option('user') || 'root', - host => $self->machine, + host => $self->svc_machine($new), command => $command_string, stdin_string => $stdin_string, ignored_errors => $self->option('ignored_errors') || '', @@ -454,7 +453,7 @@ sub _export_replace { eval { ssh_cmd(@ssh_cmd_args) }; $error = $@; $error = $error->full_message if ref $error; # Exception::Class::Base - return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + return $error. ' ('. $self->exporttype. ' to '. $self->svc_machine($new). ')' if $error; } else { diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm index 1ebf5f633..1b59589bf 100644 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -80,10 +80,11 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export via remote SSH (vpopmail, ISPMan)', - 'options' => \%options, - 'notes' => <<'END' + 'svc' => 'svc_acct', + 'desc' => 'Real-time export via remote SSH (vpopmail, ISPMan, MagicMail)', + 'options' => \%options, + 'svc_machine' => 1, + 'notes' => <<'END' Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow -- cgit v1.2.1 From 82d8565fbeaebd69177a3a14d833685ecb86a545 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 26 Sep 2012 00:53:05 -0700 Subject: tax calculation and reporting for new customer locations, #940 --- FS/FS/Schema.pm | 22 +- FS/FS/Upgrade.pm | 3 + FS/FS/cust_bill_ApplicationCommon.pm | 5 + FS/FS/cust_bill_pkg.pm | 486 +++++++++++++++++++++++++++++++++-- FS/FS/cust_credit_bill_pkg.pm | 62 ++++- FS/FS/cust_main/Billing.pm | 125 +++++---- FS/FS/cust_main_county.pm | 241 +++++++++++++---- FS/FS/cust_tax_exempt_pkg.pm | 85 +++++- FS/FS/cust_tax_exempt_pkg_void.pm | 9 +- FS/FS/h_cust_main_exemption.pm | 19 ++ FS/FS/h_part_pkg.pm | 37 +++ FS/MANIFEST | 1 + 12 files changed, 943 insertions(+), 152 deletions(-) create mode 100644 FS/FS/h_cust_main_exemption.pm create mode 100644 FS/FS/h_part_pkg.pm (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 7be8c664f..a6a1cda5a 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', @@ -2740,10 +2740,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 +2766,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/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, L, L, L, 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 bab94c31d..02774c954 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'; + + my @cust_tax_exempt_pkg = splice @{ $cust_bill_pkg->cust_tax_exempt_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}; + 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 @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, + 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; @@ -1246,17 +1274,11 @@ sub _handle_taxes { } while ( !scalar(@taxes) && scalar(@elim) ); - @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) } - @taxes - if $self->cust_main_exemption; #just to be safe - - # 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 ]; @@ -1273,7 +1295,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 @@ -1296,14 +1318,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 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 +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_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) +=item billpkgnum - invoice line item (see L) that +was exempted from tax. =item taxnum - tax rate (see L) -=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 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 Lut_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/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, L, L. + +=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, L, L, schema.html from the base +documentation. + +=cut + +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 -- cgit v1.2.1 From 39533c66139210655fc47404a17fd4e9b9ca8a00 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 27 Sep 2012 19:12:43 -0700 Subject: DMA Radius Manager export, #18456 --- FS/FS/Schema.pm | 2 + FS/FS/part_export/dma_radiusmanager.pm | 336 +++++++++++++++++++++++++++++++++ FS/FS/radius_group.pm | 4 + 3 files changed, 342 insertions(+) create mode 100644 FS/FS/part_export/dma_radiusmanager.pm (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index a6a1cda5a..6ad4b742d 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -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'] ], 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/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; -- cgit v1.2.1 From 10370b0320f56af88c90e572644e91332815100f Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 27 Sep 2012 20:24:42 -0700 Subject: freeswitch provisioning: one file per domain, RT#18087 --- FS/FS/part_export/freeswitch.pm | 84 +++++++++++++++++++++++------------------ 1 file changed, 48 insertions(+), 36 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/freeswitch.pm b/FS/FS/part_export/freeswitch.pm index 7447849c8..eb490fd85 100644 --- a/FS/FS/part_export/freeswitch.pm +++ b/FS/FS/part_export/freeswitch.pm @@ -5,7 +5,8 @@ use vars qw( %info ); # $DEBUG ); #use Data::Dumper; use Tie::IxHash; use Text::Template; -#use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch ); #qsearchs ); +use FS::svc_phone; #use FS::Schema qw( dbdef ); #$DEBUG = 1; @@ -15,7 +16,7 @@ tie my %options, 'Tie::IxHash', 'directory' => { label => 'Directory to store FreeSWITCH account XML files', default => '/usr/local/freeswitch/conf/directory/', }, - 'domain' => { label => 'Optional fixed SIP domain to use, overrides svc_phone domain', }, + #'domain' => { label => 'Optional fixed SIP domain to use, overrides svc_phone domain', }, 'reload' => { label => 'Reload command', default => '/usr/local/freeswitch/bin/fs_cli -x reloadxml', }, @@ -38,9 +39,9 @@ END 'desc' => 'Provision phone services to FreeSWITCH XML configuration files', 'options' => \%options, 'notes' => <<'END', -Export XML account configuration files to FreeSWITCH, one per phone services. +Export XML account configuration files to FreeSWITCH, one per domain.

    -You will need to +You will need to enable the svc_phone-domain configuration setting and setup SSH for unattended operation. END ); @@ -50,6 +51,33 @@ sub rebless { shift; } sub _export_insert { my( $self, $svc_phone ) = ( shift, shift ); + $self->_export_rebuild_domain($svc_phone); + +} + +sub _export_replace { + my( $self, $new, $old ) = ( shift, shift, shift ); + + my $error = $self->_export_rebuild_domain($new); + return $error if $error; + + if ( $new->domsvc ne $old->domsvc && $old->domsvc ) { + $error = $self->_export_rebuild_domain($old); + return $error if $error; + } + + ''; +} + +sub _export_delete { + my( $self, $svc_phone ) = ( shift, shift ); + + $self->_export_rebuild_domain($svc_phone); +} + +sub _export_rebuild_domain { + my($self, $svc_phone) = ( shift, shift ); + eval "use Net::SCP;"; die $@ if $@; @@ -57,24 +85,34 @@ sub _export_insert { my $tempdir = '%%%FREESIDE_CONF%%%/cache.'. $FS::UID::datasrc; - my $svcnum = $svc_phone->svcnum; + my $domain = $svc_phone->domain or return "domain required"; my $fh = new File::Temp( - TEMPLATE => "$tempdir/freeswitch.$svcnum.XXXXXXXX", + TEMPLATE => "$tempdir/freeswitch.$domain.XXXXXXXX", DIR => $dir, #UNLINK => 0, ); - print $fh $self->freeswitch_template_fillin( $svc_phone, 'user' ) - or die "print to freeswitch template failed: $!"; - close $fh; + print $fh qq(\n); + + my @dom_svc_phone = qsearch( 'svc_phone', { 'domsvc'=>$svc_phone->domsvc } ); + + foreach my $dom_svc_phone (@dom_svc_phone) { + + print $fh $self->freeswitch_template_fillin( $dom_svc_phone, 'user' ) + or die "print to freeswitch template failed: $!"; + + } + + print $fh qq(\n); + $fh->flush; my $scp = new Net::SCP; my $user = $self->option('user')||'root'; my $host = $self->machine; my $dir = $self->option('directory'); - $scp->scp( $fh->filename, "$user\@$host:$dir/$svcnum.xml" ) + $scp->scp( $fh->filename, "$user\@$host:$dir/$domain.xml" ) or return $scp->{errstr}; #signal freeswitch to reload config @@ -84,27 +122,6 @@ sub _export_insert { } -sub _export_replace { - my( $self, $new, $old ) = ( shift, shift, shift ); - - $self->_export_insert($new, @_); -} - -sub _export_delete { - my( $self, $svc_phone ) = ( shift, shift ); - - my $dir = $self->option('directory'); - my $svcnum = $svc_phone->svcnum; - - #delete file - $self->freeswitch_ssh( command => "rm $dir/$svcnum.xml" ); - - #signal freeswitch to reload config - $self->freeswitch_ssh( command => $self->option('reload') ); - - ''; -} - sub freeswitch_template_fillin { my( $self, $svc_phone, $template ) = (shift, shift, shift); @@ -117,13 +134,8 @@ sub freeswitch_template_fillin { DELIMITERS => [ '<%', '%>' ], ); - my $domain = $self->option('domain') - || $svc_phone->domain - || '$${sip_profile}'; - #false lazinessish w/phone_shellcommands::_export_command my %hash = ( - 'domain' => $domain, map { $_ => $svc_phone->getfield($_) } $svc_phone->fields ); -- cgit v1.2.1 From f50a821d306b561d602edbdac0dac958b862ec0c Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 27 Sep 2012 20:25:27 -0700 Subject: tax debugging --- FS/FS/cust_main/Billing.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index bab94c31d..85cafd62c 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -1227,6 +1227,8 @@ sub _handle_taxes { $taxhash{'taxclass'} = $part_pkg->taxclass; + warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2; + my @taxes = (); # entries are cust_main_county objects my %taxhash_elim = %taxhash; my @elim = qw( district city county state ); @@ -1246,10 +1248,12 @@ sub _handle_taxes { } while ( !scalar(@taxes) && scalar(@elim) ); - @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) } + @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 -- cgit v1.2.1 From 3ded761f92af1bab8d3d8a8e9deccd97082aaf15 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 27 Sep 2012 23:38:32 -0700 Subject: fix caption/longtable conflict with modern LaTeX installs, #13908 --- FS/FS/Upgrade.pm | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'FS') diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index 8e697d31e..b7971ff48 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -70,6 +70,15 @@ sub upgrade_config { foreach grep { ! $conf->exists($_) && -s "$DIST_CONF/$_" } qw( quotation_html quotation_latex quotation_latexnotes ); + # change 'fslongtable' to 'longtable' + foreach my $name (qw(invoice_latex quotation_latex)) { + my $value = join("\n",$conf->config($name)); + if (length($value)) { + $value =~ s/fslongtable/longtable/g; + $conf->set($name, $value); + } + } + } sub upgrade_overlimit_groups { -- cgit v1.2.1 From 2b4bb0058f931376a3169d596aa31a17e3f46b04 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Fri, 28 Sep 2012 12:23:22 -0700 Subject: fix unsuspending packages which didn't have a suspend reason, fallout from #6587 --- FS/FS/cust_pkg.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index c34eb43b5..16adea3d7 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1427,7 +1427,8 @@ sub unsuspend { } - my $reason = $self->last_cust_pkg_reason('susp')->reason; + my $cust_pkg_reason = $self->last_cust_pkg_reason('susp'); + my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : ''; my %hash = $self->hash; my $inactive = time - $hash{'susp'}; @@ -1457,7 +1458,7 @@ sub unsuspend { my $unsusp_pkg; - if ( $reason->unsuspend_pkgpart ) { + if ( $reason && $reason->unsuspend_pkgpart ) { my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart) or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart. " not found."; -- cgit v1.2.1 From 962cd26e8e33bf3653cca439dbd9bd52f46bad29 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Fri, 28 Sep 2012 13:38:03 -0700 Subject: auto-upgrade tax data from start of 2012, #940 --- FS/FS/Upgrade.pm | 3 +++ FS/FS/cust_bill_pkg.pm | 34 +++++++++++++++++++++++++++------- 2 files changed, 30 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index b7971ff48..7dd889f2c 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -290,6 +290,9 @@ sub upgrade_data { #flag monthly tax exemptions 'cust_tax_exempt_pkg' => [], + + #kick off tax location history upgrade + 'cust_bill_pkg' => [], ; \%hash; diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index b8ae81d86..20c8e5a55 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -940,15 +940,14 @@ sub upgrade_tax_location { # 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; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; eval { use FS::h_cust_main; @@ -1108,7 +1107,8 @@ sub upgrade_tax_location { push @{ $nontax_items{$taxclass} }, $item; } } - printf("%d tax items: \$%.2f\n", scalar(@tax_items), map {$_->setup} @tax_items); + printf("%d tax items: \$%.2f\n", scalar(@tax_items), map {$_->setup} @tax_items) + if @tax_items; # Use a variation on the procedure in # FS::cust_main::Billing::_handle_taxes to identify taxes that apply @@ -1378,21 +1378,41 @@ sub upgrade_tax_location { } #foreach (@tax_links) } #foreach $tax_item - $dbh->commit if $commit_each_invoice; + $dbh->commit if $commit_each_invoice and $oldAutoCommit; $committed = 1; } #foreach $invnum continue { if (!$committed) { - $dbh->rollback; + $dbh->rollback if $oldAutoCommit; die "Upgrade halted.\n" unless $commit_each_invoice; } } - $dbh->commit unless $commit_each_invoice; + $dbh->commit if $oldAutoCommit and !$commit_each_invoice; ''; } +sub _upgrade_data { + # Create a queue job to run upgrade_tax_location from January 1, 2012 to + # the present date. + eval { + use FS::queue; + use Date::Parse 'str2time'; + }; + my $class = shift; + my $upgrade = 'tax_location_2012'; + return if FS::upgrade_journal->is_done($upgrade); + my $job = FS::queue->new({ + 'job' => 'FS::cust_bill_pkg::upgrade_tax_location' + }); + # call it kind of like a class method, not that it matters much + $job->insert($class, 's' => str2time('2012-01-01')); + # Then mark the upgrade as done, so that we don't queue the job twice + # and somehow run two of them concurrently. + FS::upgrade_journal->set_done($upgrade); +} + =back =head1 BUGS -- cgit v1.2.1 From 302ed74842d5eae7bcc7c5ce68ee5f102c381d6f Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sat, 29 Sep 2012 00:20:38 -0700 Subject: also fix longtable in alternate invoice templates, #13908 --- FS/FS/Upgrade.pm | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index 7dd889f2c..3f76f5116 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -71,11 +71,16 @@ sub upgrade_config { qw( quotation_html quotation_latex quotation_latexnotes ); # change 'fslongtable' to 'longtable' - foreach my $name (qw(invoice_latex quotation_latex)) { - my $value = join("\n",$conf->config($name)); - if (length($value)) { + # in invoice and quotation main templates, and also in all secondary + # invoice templates + my @latex_confs = + qsearch('conf', { 'name' => {op=>'LIKE', value=>'%latex%'} }); + + foreach my $c (@latex_confs) { + my $value = $c->value; + if (length($value) and $value =~ /fslongtable/) { $value =~ s/fslongtable/longtable/g; - $conf->set($name, $value); + $conf->set($c->name, $value, $c->agentnum); } } -- cgit v1.2.1 From b752066a97429e6c93069754b79553548dccdba9 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Sat, 29 Sep 2012 12:20:13 -0700 Subject: speling --- FS/FS/Conf.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index b72cf0313..5c43b3ac9 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3469,7 +3469,7 @@ and customer address. Include units.', { 'key' => 'postal_invoice-recurring_only', 'section' => 'billing', - 'description' => 'The postal invoice fee is omitted on invoices without reucrring charges when this is set.', + 'description' => 'The postal invoice fee is omitted on invoices without recurring charges when this is set.', 'type' => 'checkbox', }, -- cgit v1.2.1 From a655a75c52c62be3faef81a5cb74de6e52e1b3f6 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Sat, 29 Sep 2012 15:43:47 -0700 Subject: correct intrastate parsing, RT#18790 --- FS/FS/cdr.pm | 131 ++++++++++++++++++++--------- FS/FS/detail_format/sum_duration_prefix.pm | 5 +- 2 files changed, 96 insertions(+), 40 deletions(-) (limited to 'FS') diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm index 3a6b01ba5..05179f264 100644 --- a/FS/FS/cdr.pm +++ b/FS/FS/cdr.pm @@ -478,6 +478,80 @@ sub set_status_and_rated_price { } } +=item parse_number [ OPTION => VALUE ... ] + +Returns two scalars, the countrycode and the rest of the number. + +Options are passed as name-value pairs. Currently available options are: + +=over 4 + +=item column + +The column containing the number to be parsed. Defaults to dst. + +=item international_prefix + +The digits for international dialing. Defaults to '011' The value '+' is +always recognized. + +=item domestic_prefix + +The digits for domestic long distance dialing. Defaults to '1' + +=back + +=cut + +sub parse_number { + my ($self, %options) = @_; + + my $field = $options{column} || 'dst'; + my $intl = $options{international_prefix} || '011'; + my $countrycode = ''; + my $number = $self->$field(); + + my $to_or_from = 'concerning'; + $to_or_from = 'from' if $field eq 'src'; + $to_or_from = 'to' if $field eq 'dst'; + warn "parsing call $to_or_from $number\n" if $DEBUG; + + #remove non-phone# stuff and whitespace + $number =~ s/\s//g; +# my $proto = ''; +# $dest =~ s/^(\w+):// and $proto = $1; #sip: +# my $siphost = ''; +# $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com + + if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/ + || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/ + ) + { + + my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 ); + #first look for 1 digit country code + if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) { + $countrycode = $one; + $number = $u1.$u2.$rest; + } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2 + $countrycode = $two; + $number = $u2.$rest; + } else { #3 digit country code + $countrycode = $three; + $number = $rest; + } + + } else { + my $domestic_prefix = + exists($options{domestic_prefix}) ? $options{domestic_prefix} : ''; + $countrycode = length($domestic_prefix) ? $domestic_prefix : '1'; + $number =~ s/^$countrycode//;# if length($number) > 10; + } + + return($countrycode, $number); + +} + =item rate [ OPTION => VALUE ... ] Rates this CDR according and sets the status to 'rated'. @@ -557,51 +631,22 @@ sub rate_prefix { # (or calling station id for toll free calls) ### - my( $to_or_from, $number ); + my( $to_or_from, $column ); if ( $self->is_tollfree && ! $part_pkg->option_cacheable('disable_tollfree') ) { #tollfree call $to_or_from = 'from'; - $number = $self->src; + $column = 'src'; } else { #regular call $to_or_from = 'to'; - $number = $self->dst; + $column = 'dst'; } - warn "parsing call $to_or_from $number\n" if $DEBUG; - - #remove non-phone# stuff and whitespace - $number =~ s/\s//g; -# my $proto = ''; -# $dest =~ s/^(\w+):// and $proto = $1; #sip: -# my $siphost = ''; -# $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com - #determine the country code - my $intl = $part_pkg->option_cacheable('international_prefix') || '011'; - my $countrycode = ''; - if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/ - || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/ - ) - { - - my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 ); - #first look for 1 digit country code - if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) { - $countrycode = $one; - $number = $u1.$u2.$rest; - } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2 - $countrycode = $two; - $number = $u2.$rest; - } else { #3 digit country code - $countrycode = $three; - $number = $rest; - } - - } else { - my $domestic_prefix = $part_pkg->option_cacheable('domestic_prefix'); - $countrycode = length($domestic_prefix) ? $domestic_prefix : '1'; - $number =~ s/^$countrycode//;# if length($number) > 10; - } + my ($countrycode, $number) = $self->parse_number( + column => $column, + international_prefix => $part_pkg->option_cacheable('international_prefix'), + domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'), + ); warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG; my $pretty_dst = "+$countrycode $number"; @@ -622,12 +667,20 @@ sub rate_prefix { # -disregard private or unknown numbers # -there is exactly one record in rate_prefix for a given NPANXX # -default to interstate if we can't find one or both of the prefixes - my $dstprefix = $self->dst; + my (undef, $dstprefix) = $self->parse_number( + column => 'dst', + international_prefix => $part_pkg->option_cacheable('international_prefix'), + domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'), + ); $dstprefix =~ /^(\d{6})/; $dstprefix = qsearchs('rate_prefix', { 'countrycode' => '1', 'npa' => $1, }) || ''; - my $srcprefix = $self->src; + my (undef, $srcprefix) = $self->parse_number( + column => 'src', + international_prefix => $part_pkg->option_cacheable('international_prefix'), + domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'), + ); $srcprefix =~ /^(\d{6})/; $srcprefix = qsearchs('rate_prefix', { 'countrycode' => '1', 'npa' => $1, diff --git a/FS/FS/detail_format/sum_duration_prefix.pm b/FS/FS/detail_format/sum_duration_prefix.pm index 04590415c..cd7bbe3cc 100644 --- a/FS/FS/detail_format/sum_duration_prefix.pm +++ b/FS/FS/detail_format/sum_duration_prefix.pm @@ -25,7 +25,10 @@ sub append { my $self = shift; my $prefixes = ($self->{prefixes} ||= {}); foreach my $cdr (@_) { - my $phonenum = $self->{inbound} ? $cdr->src : $cdr->dst; + my (undef, $phonenum) = $cdr->parse_number( + column => ( $self->{inbound} ? 'src' : 'dst' ), + ); + $phonenum =~ /^(\d{$prefix_length})/; my $prefix = $1 || 'other'; warn "$me appending ".$cdr->dst." to $prefix\n" if $DEBUG; -- cgit v1.2.1 From 7e27595a5c5780e4f5ec82f37e9ebd8a3f4cef7c Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Sat, 29 Sep 2012 15:57:56 -0700 Subject: adding missing test file --- FS/t/cust_tax_exempt_pkg_void.t | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 FS/t/cust_tax_exempt_pkg_void.t (limited to 'FS') diff --git a/FS/t/cust_tax_exempt_pkg_void.t b/FS/t/cust_tax_exempt_pkg_void.t new file mode 100644 index 000000000..42d86205f --- /dev/null +++ b/FS/t/cust_tax_exempt_pkg_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_tax_exempt_pkg_void; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 51b5bd15c154065a9a0f521565bd6187609c8348 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 1 Oct 2012 12:53:00 -0700 Subject: assorted fixes for DMA export, #18456 --- FS/FS/part_export/dma_radiusmanager.pm | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/dma_radiusmanager.pm b/FS/FS/part_export/dma_radiusmanager.pm index ab77c4645..6e56c996b 100644 --- a/FS/FS/part_export/dma_radiusmanager.pm +++ b/FS/FS/part_export/dma_radiusmanager.pm @@ -9,6 +9,10 @@ use FS::radius_group; use Tie::IxHash; use Digest::MD5 'md5_hex'; +use Locale::Country qw(code2country); +use Locale::SubCountry; +use Date::Format 'time2str'; + tie %options, 'Tie::IxHash', 'dbname' => { label=>'Database name', default=>'radius' }, 'username' => { label=>'Database username' }, @@ -57,6 +61,12 @@ sub dma_rm_queue { my $cust_main = $cust_pkg->cust_main; my $location = $cust_pkg->cust_location; + my $address = $location->address1; + $address .= ' '.$location->address2 if $location->address2; + my $country = code2country($location->country); + my $lsc = Locale::SubCountry->new($location->country); + my $state = $lsc->full_name($location->state) if defined($lsc); + my %params = ( # for the remote side username => $svc_acct->username, @@ -70,9 +80,9 @@ sub dma_rm_queue { mobile => $cust_main->mobile, address => $location->address1, # address2? city => $location->city, - state => $location->state, + state => $state, #full name zip => $location->zip, - country => $location->country, + country => $country, #full name gpslat => $location->latitude, gpslong => $location->longitude, comment => 'svcnum'.$svcnum, @@ -118,6 +128,8 @@ sub dma_rm_action { $params{srvid} = $srvid; if ( $action eq 'insert' ) { + $params{'createdon'} = time2str('%Y-%m-%d', time); + $params{'expiration'} = time2str('%Y-%m-%d', time); warn "rm_users: inserting svcnum$svcnum\n" if $DEBUG; my $sth = $dbh->prepare( 'INSERT INTO rm_users ( '. join(', ', keys(%params)). @@ -323,12 +335,14 @@ sub nas_ids { # pass these through unchanged my @ids = grep { /^\d+$/ } @nasnames; @nasnames = grep { not /^\d+$/ } @nasnames; - my $in_nasnames = join(',', map {$dbh->quote($_)} @nasnames); + if ( @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; + 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; } -- cgit v1.2.1