diff options
Diffstat (limited to 'FS')
98 files changed, 3397 insertions, 598 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 471e32aff..1b581b247 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -156,6 +156,8 @@ tie my %rights, 'Tie::IxHash', 'View package definition costs', #NEWNEW 'Change package start date', 'Change package contract end date', + 'Unmask customer DL', + 'Unmask customer SSN', ], ### @@ -509,4 +511,3 @@ L<FS::access_right>, L<FS::access_group>, L<FS::access_user> =cut 1; - diff --git a/FS/FS/Auth/internal.pm b/FS/FS/Auth/internal.pm index eea4870d7..dfc5f301d 100644 --- a/FS/FS/Auth/internal.pm +++ b/FS/FS/Auth/internal.pm @@ -48,7 +48,9 @@ sub change_password { my($self, $access_user, $new_password) = @_; # do nothing if the password is unchanged - return if $self->authenticate( $access_user, $new_password ); + #XXX breaks password changes in employee edit ($access_user object already + # has new [plaintext] password) + #return if $self->authenticate( $access_user, $new_password ); $self->change_password_fields( $access_user, $new_password ); diff --git a/FS/FS/ClientAPI/MasonComponent.pm b/FS/FS/ClientAPI/MasonComponent.pm index 3a4bfe133..d615c271c 100644 --- a/FS/FS/ClientAPI/MasonComponent.pm +++ b/FS/FS/ClientAPI/MasonComponent.pm @@ -63,6 +63,7 @@ my %session_callbacks = ( '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', $cust_main->agentnum)), + 'surcharge_flatfee' => scalar($conf->config('credit-card-surcharge-flatfee', $cust_main->agentnum)), ); @$argsref = ( %args ); diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 66697efb5..6cb0a7cc4 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -87,6 +87,8 @@ sub skin_info { my($context, $session, $custnum) = _custoragent_session_custnum($p); #return { 'error' => $session } if $context eq 'error'; + my $domain = $session->{'domain'}; + my $agentnum = ''; if ( $context eq 'customer' && $custnum ) { @@ -105,7 +107,7 @@ sub skin_info { $p->{'agentnum'} = $agentnum; my $conf = new FS::Conf; - + my $timeout = $conf->config('selfservice-session_timeout') || '1 hour'; #false laziness w/Signup.pm my $skin_info_cache_agent = _cache->get("skin_info_cache_agent$agentnum"); @@ -120,6 +122,8 @@ sub skin_info { warn "$me populating skin info cache for agentnum $agentnum\n" if $DEBUG > 1; + my $menu = $conf->config("ng_selfservice-menu", $agentnum ); + $skin_info_cache_agent = { 'agentnum' => $agentnum, ( map { $_ => scalar( $conf->config($_, $agentnum) ) } @@ -143,7 +147,93 @@ sub skin_info { ( map { $_ => join("\n", $conf->config("selfservice-$_", $agentnum ) ) } qw( head body_header body_footer company_address ) ), 'money_char' => $conf->config("money_char") || '$', - 'menu' => join("\n", $conf->config("ng_selfservice-menu", $agentnum ) ) || + 'menu' => _menu($domain,$menu), + }; + + _cache->set("skin_info_cache_agent$agentnum", $skin_info_cache_agent, $timeout); + + } + + #{ %$skin_info_cache_agent }; + $skin_info_cache_agent; + +} + +## checks if page is in menu listing, if not sends to main with error. +sub check_access { + my $p = shift; + my $error; + + return if $p->{'page'} eq "index.php"; + return if $p->{'page'} eq "ip_login.php"; + + return if substr($p->{'page'}, 0, length("process_")) eq "process_"; + + my $conf = new FS::Conf; + + my($context, $session, $custnum) = _custoragent_session_custnum($p); + + my $domain = ref($session) ? $session->{'domain'} : ''; + + my $agentnum = ''; + if ( $context eq 'customer' && $custnum ) { + + my $sth = dbh->prepare('SELECT agentnum FROM cust_main WHERE custnum = ?') + or die dbh->errstr; + + $sth->execute($custnum) or die $sth->errstr; + + $agentnum = $sth->fetchrow_arrayref->[0] + or die "no agentnum for custnum $custnum"; + + #} elsif ( $context eq 'agent' ) { + } elsif ( defined($p->{'agentnum'}) and $p->{'agentnum'} =~ /^(\d+)$/ ) { + $agentnum = $1; + } + $p->{'agentnum'} = $agentnum; + + my $menu = $conf->config("ng_selfservice-menu", $agentnum ); + + my $allowed_pages = _menu($domain,$menu); + + my %allowed; + my @lines = split /\n/, $allowed_pages; + foreach my $line (@lines) { + chomp; # remove newlines + $line =~ s/^\s+//; # remove leading whitespace + next unless length($line); + my (@pages) = split(/ /, $line, 2); + $allowed{$pages[0]} = $pages[1]; + } + + $error = "You do not have access to the page ".$allowed{$p->{page}} unless $allowed{$p->{page}}; + + return { 'error' => $error, }; + +} + +sub _menu { + my $p = shift; + my $m = shift; + + my $menu; + + if ($p eq 'ip_mac') { + $menu = 'main.php Home + + payment.php Payments + payment_cc.php Credit Card Payment + payment_ach.php Electronic Check Payment + payment_paypal.php PayPal Payment + payment_webpay.php Webpay Payments + + docs.php FAQs + + logout.php Logout + '; + } + else { + $menu = join("\n", $m ) || 'main.php Home services.php Services @@ -172,16 +262,31 @@ sub skin_info { docs.php FAQs logout.php Logout - ', - }; + '; + } + return $menu; +} - _cache->set("skin_info_cache_agent$agentnum", $skin_info_cache_agent); +sub get_mac_address { + my $p = shift; - } +## access radius exports acct tables to get mac + my @part_export = (); + @part_export = ( + qsearch( 'part_export', { 'exporttype' => 'sqlradius' } ), + qsearch( 'part_export', { 'exporttype' => 'sqlradius_withdomain' } ), + qsearch( 'part_export', { 'exporttype' => 'broadband_sqlradius' } ), + ); - #{ %$skin_info_cache_agent }; - $skin_info_cache_agent; + my @sessions; + foreach my $part_export (@part_export) { + push @sessions, ( @{ $part_export->usage_sessions( { + 'ip' => $p->{'ip'}, + 'session_status' => 'open', + } ) } ); + } + return { 'mac_address' => $sessions[0]->{'callingstationid'}, }; } sub login_info { @@ -191,8 +296,8 @@ sub login_info { my %info = ( %{ skin_info($p) }, - 'phone_login' => $conf->exists('selfservice_server-phone_login'), - 'single_domain'=> scalar($conf->config('selfservice_server-single_domain')), + 'phone_login' => $conf->exists('selfservice_server-phone_login'), + 'single_domain' => scalar($conf->config('selfservice_server-single_domain')), 'banner_url' => scalar($conf->config('selfservice-login_banner_url')), 'banner_image_md5' => md5_hex($conf->config_binary('selfservice-login_banner_image')), @@ -239,11 +344,20 @@ sub login { } elsif ( $p->{'domain'} eq 'ip_mac' ) { - my $svc_broadband = qsearchs( 'svc_broadband', { 'mac_addr' => $p->{'username'} } ); - return { error => 'IP address not found' } + return { error => 'MAC address empty '.$p->{'username'} } + unless $p->{'username'}; + + my $mac_address = $p->{'username'}; + $mac_address =~ s/[\:\,\-\. ]//g; + $mac_address =~ tr/[a-z]/[A-Z/; + + my $svc_broadband = qsearchs( 'svc_broadband', { 'mac_addr' => $mac_address } ); + return { error => 'MAC address not found '.$p->{'username'} } unless $svc_broadband; $svc_x = $svc_broadband; + $session->{'domain'} = $p->{'domain'}; + } elsif ( $p->{email} && (my $contact = FS::contact->by_selfservice_email($p->{email})) ) @@ -630,6 +744,8 @@ sub customer_info_short { for (@cust_main_editable_fields) { $return{$_} = $cust_main->get($_); } + $return{$_} = $cust_main->masked($_) for qw/ss stateid/; + #maybe a little more expensive, but it should be cached by now for (@location_editable_fields) { $return{$_} = $cust_main->bill_location->get($_) @@ -921,6 +1037,7 @@ sub payment_info { $return{paybatch} = $return{payunique}; #back compat $return{credit_card_surcharge_percentage} = $conf->config('credit-card-surcharge-percentage', $cust_main->agentnum); + $return{credit_card_surcharge_flatfee} = $conf->config('credit-card-surcharge-flatfee', $cust_main->agentnum); return { 'error' => '', %return, @@ -1730,20 +1847,34 @@ sub update_payby { }) or return { 'error' => 'unknown custpaybynum '. $p->{'custpaybynum'} }; + my $cust_main = qsearchs( 'cust_main', {custnum => $cust_payby->custnum} ) + or return { 'error' => 'unknown custnum '.$cust_payby->custnum }; + foreach my $field ( qw( weight payby payinfo paycvv paydate payname paystate paytype payip ) ) { next unless exists($p->{$field}); $cust_payby->set($field,$p->{$field}); } + $cust_payby->set( 'paymask' => $cust_payby->mask_payinfo ); - my $error = $cust_payby->replace; - if ( $error ) { - return { 'error' => $error }; - } else { - return { 'custpaybynum' => $cust_payby->custpaybynum }; + # Update column if given a value, and the given value wasn't + # the value generated by $cust_main->masked($column); + $cust_main->set( $_, $p->{$_} ) + for grep{ $p->{$_} !~ /^x/i; } + grep{ exists $p->{$_} } + qw/ss stateid/; + + # Perform updates within a transaction + local $FS::UID::AutoCommit = 0; + + if ( my $error = $cust_payby->replace || $cust_main->replace ) { + dbh->rollback; + return { error => $error }; } - + + dbh->commit; + return { custpaybynum => $cust_payby->custpaybynum }; } sub verify_payby { @@ -3899,4 +4030,3 @@ sub _custoragent_session_custnum { } 1; - diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm index dcf34fdaa..fefa577b7 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -227,6 +227,8 @@ sub ss2clientapi { 'quotation_add_pkg' => 'MyAccount/quotation/quotation_add_pkg', 'quotation_remove_pkg' => 'MyAccount/quotation/quotation_remove_pkg', 'quotation_order' => 'MyAccount/quotation/quotation_order', + 'get_mac_address' => 'MyAccount/get_mac_address', + 'check_access' => 'MyAccount/check_access', 'freesideinc_service' => 'Freeside/freesideinc_service', }; diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 9b891879b..fd05231d6 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -781,6 +781,22 @@ my $validate_email = sub { $_[0] =~ }, { + 'key' => 'credit-card-surcharge-flatfee', + 'section' => 'credit_cards', + 'description' => 'Add a credit card surcharge to invoices, as a flat fee. WARNING: Although recently permitted to US merchants in general, specific consumer protection laws may prohibit or restrict this practice in California, Colorado, Connecticut, Florda, Kansas, Maine, Massachusetts, New York, Oklahome, and Texas. Surcharging is also generally prohibited in most countries outside the US, AU and UK. When allowed, typically not permitted to be above 4%.', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'credit-card-surcharge-text', + 'section' => 'credit_cards', + 'description' => 'Text for the credit card surcharge invoice line. If not set, it will default to Credit Card Surcharge.', + 'type' => 'text', + 'per_agent' => 1, + }, + + { 'key' => 'discount-show-always', 'section' => 'invoicing', 'description' => 'Generate a line item on an invoice even when a package is discounted 100%', @@ -1215,6 +1231,7 @@ my $validate_email = sub { $_[0] =~ 'section' => 'invoicing', 'description' => 'Indicates that html and latex invoices should be in summary style and make use of invoice_latexsummary.', 'type' => 'checkbox', + 'per_agent' => 1, }, { @@ -1578,9 +1595,19 @@ and customer address. Include units.', { 'key' => 'invoice_sections', 'section' => 'invoicing', - 'description' => 'Split invoice into sections and label according to package category when enabled.', + 'description' => 'Split invoice into sections and label according to either package category or location when enabled.', 'type' => 'checkbox', 'per_agent' => 1, + 'config_bool' => 1, + }, + + { + 'key' => 'invoice_sections_multilocation', + 'section' => 'invoicing', + 'description' => 'Enable invoice_sections for for any bill with at least this many locations on the bill.', + 'type' => 'text', + 'per_agent' => 1, + 'validate' => sub { shift =~ /^\d+$/ ? undef : 'Please enter a number' }, }, { @@ -1599,6 +1626,15 @@ and customer address. Include units.', }, { + 'key' => 'invoice_sections_with_taxes', + 'section' => 'invoicing', + 'description' => 'Include taxes within each section of mutli-section invoices.', + 'type' => 'checkbox', + 'per_agent' => 1, + 'agent_bool' => 1, + }, + + { 'key' => 'summary_subtotals_method', 'section' => 'invoicing', 'description' => 'How to group line items when calculating summary subtotals. By default, it will be the same method used for grouping invoice sections.', @@ -1679,6 +1715,13 @@ and customer address. Include units.', 'description' => 'Template to use for manual payment receipts.', %msg_template_options, }, + + { + 'key' => 'payment_receipt_msgnum_auto', + 'section' => 'notification', + 'description' => 'Automatic payments will cause a post-payment to use a message template for automatic payment receipts rather than a post payment statement.', + %msg_template_options, + }, { 'key' => 'payment_receipt_from', @@ -1771,7 +1814,7 @@ and customer address. Include units.', { 'key' => 'passwordmin', 'section' => 'password', - 'description' => 'Minimum password length (default 6)', + 'description' => 'Minimum password length (default 8)', 'type' => 'text', }, @@ -2134,7 +2177,7 @@ and customer address. Include units.', { 'key' => 'unmask_ss', - 'section' => 'e-checks', + 'section' => 'deprecated', 'description' => "Don't mask social security numbers in the web interface.", 'type' => 'checkbox', }, @@ -2753,6 +2796,13 @@ and customer address. Include units.', }, { + 'key' => 'manual_process-single_invoice_amount', + 'section' => 'deprecated', + 'description' => 'When entering manual credit card and ACH payments, amount will not autofill if the customer has more than one open invoice', + 'type' => 'checkbox', + }, + + { 'key' => 'manual_process-pkgpart', 'section' => 'payments', 'description' => 'Package to add to each manual credit card and ACH payment entered by employees from the backend. WARNING: Although recently permitted to US merchants in general, specific consumer protection laws may prohibit or restrict this practice in California, Colorado, Connecticut, Florda, Kansas, Maine, Massachusetts, New York, Oklahome, and Texas. Surcharging is also generally prohibited in most countries outside the US, AU and UK.', @@ -5961,4 +6011,3 @@ and customer address. Include units.', ); 1; - diff --git a/FS/FS/IP_Mixin.pm b/FS/FS/IP_Mixin.pm index beb41d290..fc3a0146b 100644 --- a/FS/FS/IP_Mixin.pm +++ b/FS/FS/IP_Mixin.pm @@ -94,6 +94,15 @@ sub ip_check { $self->ip_addr(''); } + # strip user-entered leading 0's from IPv4 addresses + # Parsers like NetAddr::IP interpret them as octal instead of decimal + $self->ip_addr( + join( '.', ( + map{ int($_) } + split( /\./, $self->ip_addr ) + )) + ) if $self->ip_addr =~ /\./ && $self->ip_addr =~ /[\.^]0/; + if ( $self->ip_addr and !$self->router and $self->conf->exists('auto_router') ) { @@ -130,6 +139,10 @@ sub assign_ip_addr { my $self = shift; my %opt = @_; + #otherwise we'll get the same assignment for concurrent identical calls + # this will serialize them + $_->lock_table foreach @subclasses; + my @blocks; my $na = $self->NetAddr; @@ -260,18 +273,22 @@ sub router { FS::router->by_key($self->routernum); } -=item used_addresses [ BLOCK ] +=item used_addresses [ FS::addr_block ] + +Returns a list of all addresses in use within the given L<FS::addr_block>. -Returns a list of all addresses (in BLOCK, or in all blocks) -that are in use. If called as an instance method, excludes -that instance from the search. +If called as an instance method, excludes that instance from the search. =cut sub used_addresses { - my $self = shift; - my $block = shift; - return ( map { $_->_used_addresses($block, $self) } @subclasses ); + my ($self, $block) = @_; + + ( + $block->ip_gateway ? $block->ip_gateway : (), + $block->NetAddr->broadcast->addr, + map { $_->_used_addresses($block, $self ) } @subclasses + ); } sub _used_addresses { diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 669c44e70..fd2c32513 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -1,7 +1,7 @@ package FS::Misc; use strict; -use vars qw ( @ISA @EXPORT_OK $DEBUG ); +use vars qw ( @ISA @EXPORT_OK $DEBUG $DISABLE_ALL_NOTICES ); use Exporter; use Carp; use Data::Dumper; @@ -22,7 +22,6 @@ use Encode; generate_ps generate_pdf do_print csv_from_fixed ocr_image - bytes_substr money_pretty ); @@ -44,6 +43,32 @@ Miscellaneous subroutines. This module contains miscellaneous subroutines called from multiple other modules. These are not OO or necessarily related, but are collected here to eliminate code duplication. +=head1 DISABLE ALL NOTICES + +Set $FS::Misc::DISABLE_ALL_NOTICES to suppress: + +=over 4 + +=item FS::cust_bill::send_csv + +=item FS::cust_bill::spool_csv + +=item FS::msg_template::email::send_prepared + +=item FS::Misc::send_email + +=item FS::Misc::do_print + +=item FS::Misc::send_fax + +=item FS::Template_Mixin::postal_mail_fsinc + +=back + +=cut + +$DISABLE_ALL_NOTICES = 0; + =head1 SUBROUTINES =over 4 @@ -119,6 +144,12 @@ FS::UID->install_callback( sub { sub send_email { my(%options) = @_; + + if ( $DISABLE_ALL_NOTICES ) { + warn 'send_email() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG; + return; + } + if ( $DEBUG ) { my %doptions = %options; $doptions{'body'} = '(full body not shown in debug)'; @@ -451,6 +482,11 @@ sub send_fax { die 'HylaFAX support has not been configured.' unless $conf->exists('hylafax'); + if ( $DISABLE_ALL_NOTICES ) { + warn 'send_fax() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG; + return; + } + eval { require Fax::Hylafax::Client; }; @@ -870,6 +906,11 @@ global value and agentnum). sub do_print { my( $data, %opt ) = @_; + if ( $DISABLE_ALL_NOTICES ) { + warn 'do_print() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG; + return; + } + my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} ) ? $opt{'lpr'} : $conf->config('lpr', $opt{'agentnum'} ); @@ -982,23 +1023,26 @@ sub ocr_image { =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ] +DEPRECATED + Use Unicode::Truncate truncate_egc instead + A replacement for "substr" that counts raw bytes rather than logical characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters rather than output them. Unlike real "substr", is not an lvalue. =cut -sub bytes_substr { - my ($string, $offset, $length, $repl) = @_; - my $bytes = substr( - Encode::encode('utf8', $string), - $offset, - $length, - Encode::encode('utf8', $repl) - ); - my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET; - return Encode::decode('utf8', $bytes, $chk); -} +# sub bytes_substr { +# my ($string, $offset, $length, $repl) = @_; +# my $bytes = substr( +# Encode::encode('utf8', $string), +# $offset, +# $length, +# Encode::encode('utf8', $repl) +# ); +# my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET; +# return Encode::decode('utf8', $bytes, $chk); +# } =item money_pretty diff --git a/FS/FS/Misc/FixIPFormat.pm b/FS/FS/Misc/FixIPFormat.pm new file mode 100644 index 000000000..3f9a19bba --- /dev/null +++ b/FS/FS/Misc/FixIPFormat.pm @@ -0,0 +1,124 @@ +package FS::Misc::FixIPFormat; +use strict; +use warnings; +use FS::Record qw(dbh qsearchs); +use FS::upgrade_journal; + +=head1 NAME + +FS::Misc::FixIPFormat - Functions to repair bad IP address input + +=head1 DESCRIPTION + +Provides functions for freeside_upgrade to check IP address storage for +user-entered leading 0's in IP addresses. When read from database, NetAddr::IP +would treat the number as octal isntead of decimal. If a user entered +10.0.0.052, this may get invisibly translated to 10.0.0.42 when exported. +Base8:52 = Base0:42 + +Tied to freeside_upgrade with journal name TABLE__fixipformat + +see: RT# 80555 + +=head1 SYNOPSIS + +Usage: + + # require, not use - this module is only run once + require FS::Misc::FixIPFormat; + + my $error = FS::Misc::FixIPFormat::fix_bad_addresses_in_table( + 'svc_broadband', 'svcnum', 'ip_addr' + ); + die "oh no!" if $error; + +=head2 fix_bad_addresses_in_table TABLE, ID_COLUMN, IP_COLUMN + +$error = fix_bad_addresses_in_table( 'svc_broadband', 'svcnum', 'ip_addr' ); + +=cut + +sub fix_bad_addresses_in_table { + my ( $table ) = @_; + return if FS::upgrade_journal->is_done("${table}__fixipformat"); + for my $id ( find_bad_addresses_in_table( @_ )) { + if ( my $error = fix_ip_for_record( $id, @_ )) { + die "fix_bad_addresses_in_table(): $error"; + } + } + FS::upgrade_journal->set_done("${table}__fixipformat"); + 0; +} + +=head2 find_bad_addresses_in_table TABLE, ID_COLUMN, IP_COLUMN + +@id = find_bad_addresses_in_table( 'svc_broadband', 'svcnum', 'ip_addr' ); + +=cut + +sub find_bad_addresses_in_table { + my ( $table, $id_col, $ip_col ) = @_; + my @fix_ids; + + # using DBI directly for performance + my $sql_statement = " + SELECT $id_col, $ip_col + FROM $table + WHERE $ip_col IS NOT NULL + "; + my $sth = dbh->prepare( $sql_statement ) || die "SQL ERROR ".dbh->errstr; + $sth->execute || die "SQL ERROR ".dbh->errstr; + while ( my $row = $sth->fetchrow_hashref ) { + push @fix_ids, $row->{ $id_col } + if $row->{ $ip_col } =~ /[\.^]0\d/; + } + @fix_ids; +} + +=head2 fix_ip_for_record ID, TABLE, ID_COLUMN, IP_COLUMN + +Attempt to strip the leading 0 from a stored IP address record. If +the corrected IP address would be a duplicate of another record in the +same table, thow an exception. + +$error = fix_ip_for_record( 1001, 'svc_broadband', 'svcnum', 'ip_addr', ); + +=cut + +sub fix_ip_for_record { + my ( $id, $table, $id_col, $ip_col ) = @_; + + my $row = qsearchs($table, {$id_col => $id}) + || die "Error finding $table record for id $id"; + + my $ip = $row->getfield( $ip_col ); + my $fixed_ip = join( '.', + map{ int($_) } + split( /\./, $ip ) + ); + + return undef unless $ip ne $fixed_ip; + + if ( my $dupe_row = qsearchs( $table, {$ip_col => $fixed_ip} )) { + if ( $dupe_row->getfield( $id_col ) != $row->getfield( $id_col )) { + # Another record in the table has this IP address + # Eg one ip is provisioned as 10.0.0.51 and another is + # provisioned as 10.0.0.051. Cannot auto-correct by simply + # trimming leading 0. Die, let support decide how to fix. + + die "Invalid IP address could not be auto-corrected - ". + "($table - $id_col = $id, $ip_col = $ip) ". + "colission with another reocrd - ". + "($table - $id_col = ".$dupe_row->getfield( $id_col )." ". + "$ip_col = ",$dupe_row->getfield( $ip_col )." ) - ". + "The entry must be corrected to continue"; + } + } + + warn "Autocorrecting IP address problem for ". + "($table - $id_col = $id, $ip_col = $ip) $fixed_ip\n"; + $row->setfield( $ip_col, $fixed_ip ); + $row->replace; +} + +1; diff --git a/FS/FS/Misc/Savepoint.pm b/FS/FS/Misc/Savepoint.pm new file mode 100644 index 000000000..f8e2c5ff5 --- /dev/null +++ b/FS/FS/Misc/Savepoint.pm @@ -0,0 +1,160 @@ +package FS::Misc::Savepoint; + +use strict; +use warnings; + +use Exporter; +use vars qw( @ISA @EXPORT @EXPORT_OK ); +@ISA = qw( Exporter ); +@EXPORT = qw( savepoint_create savepoint_release savepoint_rollback ); + +use FS::UID qw( dbh ); +use Carp qw( croak ); + +=head1 NAME + +FS::Misc::Savepoint - Provides methods for SQL Savepoints + +=head1 SYNOPSIS + + use FS::Misc::Savepoint; + + # Only valid within a transaction + local $FS::UID::AutoCommit = 0; + + savepoint_create( 'savepoint_label' ); + + my $error_msg = do_some_things(); + + if ( $error_msg ) { + savepoint_rollback_and_release( 'savepoint_label' ); + } else { + savepoint_release( 'savepoint_label' ); + } + + +=head1 DESCRIPTION + +Provides methods for SQL Savepoints + +Using a savepoint allows for a partial roll-back of SQL statements without +forcing a rollback of the entire enclosing transaction. + +=head1 METHODS + +=over 4 + +=item savepoint_create LABEL + +=item savepoint_create { label => LABEL, dbh => DBH } + +Executes SQL to create a savepoint named LABEL. + +Savepoints cannot work while AutoCommit is enabled. + +Savepoint labels must be valid sql identifiers. If your choice of label +would not make a valid column name, it probably will not make a valid label. + +Savepoint labels must be unique within the transaction. + +=cut + +sub savepoint_create { + my %param = _parse_params( @_ ); + + $param{dbh}->do("SAVEPOINT $param{label}") + or die $param{dbh}->errstr; +} + +=item savepoint_release LABEL + +=item savepoint_release { label => LABEL, dbh => DBH } + +Release the savepoint - preserves the SQL statements issued since the +savepoint was created, but does not commit the transaction. + +The savepoint label is freed for future use. + +=cut + +sub savepoint_release { + my %param = _parse_params( @_ ); + + $param{dbh}->do("RELEASE SAVEPOINT $param{label}") + or die $param{dbh}->errstr; +} + +=item savepoint_rollback LABEL + +=item savepoint_rollback { label => LABEL, dbh => DBH } + +Roll back the savepoint - forgets all SQL statements issues since the +savepoint was created, but does not commit or roll back the transaction. + +The savepoint still exists. Additional statements may be executed, +and savepoint_rollback called again. + +=cut + +sub savepoint_rollback { + my %param = _parse_params( @_ ); + + $param{dbh}->do("ROLLBACK TO SAVEPOINT $param{label}") + or die $param{dbh}->errstr; +} + +=item savepoint_rollback_and_release LABEL + +=item savepoint_rollback_and_release { label => LABEL, dbh => DBH } + +Rollback and release the savepoint + +=cut + +sub savepoint_rollback_and_release { + savepoint_rollback( @_ ); + savepoint_release( @_ ); +} + +=back + +=head1 METHODS - Internal + +=over 4 + +=item _parse_params + +Create %params from function input + +Basic savepoint label validation + +Complain when trying to use savepoints without disabling AutoCommit + +=cut + +sub _parse_params { + my %param = ref $_[0] ? %{ $_[0] } : ( label => $_[0] ); + $param{dbh} ||= dbh; + + # Savepoints may be any valid SQL identifier up to 64 characters + $param{label} =~ /^\w+$/ + or croak sprintf( + 'Invalid savepont label(%s) - use only numbers, letters, _', + $param{label} + ); + + croak sprintf( 'Savepoint(%s) failed - AutoCommit=1', $param{label} ) + if $FS::UID::AutoCommit; + + %param; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +=cut + +1;
\ No newline at end of file diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 5de4ca752..9dd08cfd8 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2881,11 +2881,9 @@ to 127.0.0.1. sub ut_ip { my( $self, $field ) = @_; $self->setfield($field, '127.0.0.1') if $self->getfield($field) eq '::1'; - $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ - or return "Illegal (IP address) $field: ". $self->getfield($field); - for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; } - $self->setfield($field, "$1.$2.$3.$4"); - ''; + return "Illegal (IP address) $field: ".$self->getfield($field) + unless $self->getfield($field) =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/; + $self->ut_ip46($field); } =item ut_ipn COLUMN @@ -2913,7 +2911,17 @@ Check/untaint IPv4 or IPv6 address. sub ut_ip46 { my( $self, $field ) = @_; - my $ip = NetAddr::IP->new($self->getfield($field)) + my $ip_addr = $self->getfield( $field ); + + # strip user-entered leading 0's from IPv4 addresses + # Parsers like NetAddr::IP interpret them as octal instead of decimal + $ip_addr = join( '.', ( + map{ int($_) } + split( /\./, $ip_addr ) + ) + ) if $ip_addr =~ /\./ && $ip_addr =~ /[\.^]0/; + + my $ip = NetAddr::IP->new( $ip_addr ) or return "Illegal (IP address) $field: ".$self->getfield($field); $self->setfield($field, lc($ip->addr)); return ''; @@ -3211,6 +3219,60 @@ sub ut_enumn { : ''; } +=item ut_date COLUMN + +Check/untaint a column containing a date string. + +Date will be normalized to YYYY-MM-DD format + +=cut + +sub ut_date { + my ( $self, $field ) = @_; + my $value = $self->getfield( $field ); + + my @date = split /[\-\/]/, $value; + if ( scalar(@date) == 3 ) { + @date = @date[2,0,1] if $date[2] >= 1900; + + local $@; + my $ymd; + eval { + # DateTime will die given invalid date + $ymd = DateTime->new( + year => $date[0], + month => $date[1], + day => $date[2], + )->ymd('-'); + }; + + unless( $@ ) { + $self->setfield( $field, $ymd ) unless $value eq $ymd; + return ''; + } + + } + return "Illegal (date) field $field: $value"; +} + +=item ut_daten COLUMN + +Check/untaint a column containing a date string. + +Column may be null. + +Date will be normalized to YYYY-MM-DD format + +=cut + +sub ut_daten { + my ( $self, $field ) = @_; + + $self->getfield( $field ) =~ /^()$/ + ? $self->setfield( $field, '' ) + : $self->ut_date( $field ); +} + =item ut_flag COLUMN Check/untaint a column if it contains either an empty string or 'Y'. This @@ -3579,7 +3641,19 @@ sub _quote { && driver_name eq 'Pg' ) { - dbh->quote($value, { pg_type => PG_BYTEA() }); + local $@; + + eval { $value = dbh->quote($value, { pg_type => PG_BYTEA() }); }; + + if ( $@ && $@ =~ /Wide character/i ) { + warn 'Correcting malformed UTF-8 string for binary quote()' + if $DEBUG; + utf8::decode($value); + utf8::encode($value); + $value = dbh->quote($value, { pg_type => PG_BYTEA() }); + } + + $value; } else { dbh->quote($value); } diff --git a/FS/FS/Report/Queued/FutureAutobill.pm b/FS/FS/Report/Queued/FutureAutobill.pm new file mode 100644 index 000000000..82c902172 --- /dev/null +++ b/FS/FS/Report/Queued/FutureAutobill.pm @@ -0,0 +1,132 @@ +package FS::Report::Queued::FutureAutobill; +use strict; +use warnings; +use vars qw( $job ); + +use FS::Conf; +use FS::cust_main; +use FS::cust_main::Location; +use FS::cust_payby; +use FS::CurrentUser; +use FS::Log; +use FS::Mason qw(mason_interps); +use FS::Record qw( qsearch ); +use FS::UI::Web; +use FS::UID qw( dbh ); + +use DateTime; +use File::Temp; +use Data::Dumper; +use HTML::Entities qw( encode_entities ); + +=head1 NAME + +FS::Report::Queued::FutureAutobill - Future Auto-Bill Transactions Report + +=head1 DESCRIPTION + +Future Autobill report generated within the job queue. + +Report results are saved to temp storage as a Mason fragment +that is rendered by the queued report viewer. + +For every customer with a valid auto-bill payment method, +report runs bill_and_collect() for each day, from today through +the report target date. After recording the results, all +operations are rolled back. + +This report relies on the ability to safely run bill_and_collect(), +with all exports and messaging disabled, and then to roll back the +results. + +=head1 PARAMETERS + +C<agentnum>, C<target_date> + +=cut + +sub make_report { + $job = shift; + my $param = shift; + my $outbuf; + my $DEBUG = 0; + + my $time_begin = time(); + + my $report_fh = File::Temp->new( + TEMPLATE => 'report.future_autobill.XXXXXXXX', + DIR => sprintf( '%s/cache.%s', $FS::Conf::base_dir, $FS::UID::datasrc ), + UNLINK => 0 + ) or die "Cannot create report file: $!"; + + if ( $DEBUG ) { + warn Dumper( $job ); + warn Dumper( $param ); + warn $report_fh; + warn $report_fh->filename; + } + + my $curuser = FS::CurrentUser->load_user( $param->{CurrentUser} ) + or die 'Unable to set report user'; + + my ( $fs_interp ) = FS::Mason::mason_interps( + 'standalone', + outbuf => \$outbuf, + ); + $fs_interp->error_mode('fatal'); + $fs_interp->error_format('text'); + + $FS::Mason::Request::QUERY_STRING = sprintf( + 'target_date=%s&agentnum=%s', + encode_entities( $param->{target_date} ), + encode_entities( $param->{agentnum} || '' ), + ); + $FS::Mason::Request::FSURL = $param->{RootURL}; + + my $mason_request = $fs_interp->make_request( + comp => '/search/future_autobill.html' + ); + + { + local $@; + eval{ $mason_request->exec() }; + if ( $@ ) { + my $error = ref $@ eq 'HTML::Mason::Exception' ? $@->error : $@; + + my $log = FS::Log->new('FS::Report::Queued::FutureAutobill'); + $log->error( + "Error generating report: $FS::Mason::Request::QUERY_STRING $error" + ); + die $error; + } + } + + my $report_fn; + if ( $report_fh->filename =~ /report\.(future_autobill.+)$/ ) { + $report_fn = $1 + } else { + die 'Error parsing report filename '.$report_fh->filename; + } + + my $report_title = FS::cust_payby->future_autobill_report_title(); + my $time_rendered = time() - $time_begin; + + if ( $DEBUG ) { + warn "Generated content:\n"; + warn $outbuf; + warn $report_fn; + warn $report_title; + } + + print $report_fh qq{<% include("/elements/header.html", '$report_title') %>\n}; + print $report_fh $outbuf; + print $report_fh qq{<!-- Time to render report $time_rendered seconds -->}; + print $report_fh qq{<% include("/elements/footer.html") %>\n}; + + die sprintf + "<a href=%s/misc/queued_report.html?report=%s>view</a>\n", + $param->{RootURL}, + $report_fn; +} + +1; diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 0c4d9bfa6..7c4f97309 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -745,6 +745,12 @@ sub cust_bill_pkg_detail { } +=item cust_bill_pkg_discount: Discounts issued + +Arguments: agentnum, refnum, cust_classnum + +=cut + sub cust_bill_pkg_discount { my $self = shift; my ($speriod, $eperiod, $agentnum, %opt) = @_; @@ -770,6 +776,60 @@ sub cust_bill_pkg_discount { $self->scalar_sql($total_sql); } +=item cust_bill_pkg_discount_or_waived: Discounts and waived fees issued + +Arguments: agentnum, refnum, cust_classnum + +=cut + +sub cust_bill_pkg_discount_or_waived { + + my $self = shift; + my ($speriod, $eperiod, $agentnum, %opt) = @_; + + $agentnum ||= $opt{'agentnum'}; + + my $total_sql = " + SELECT + COALESCE( + SUM( + COALESCE( + cust_bill_pkg_discount.amount, + CAST(( SELECT optionvalue + FROM part_pkg_option + WHERE + part_pkg_option.pkgpart = cust_pkg.pkgpart + AND optionname = 'setup_fee' + ) AS NUMERIC ) + ) + ), + 0 + ) + FROM cust_bill_pkg + LEFT JOIN cust_bill_pkg_discount USING (billpkgnum) + LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum + LEFT JOIN part_pkg USING (pkgpart) + LEFT JOIN cust_bill USING ( invnum ) + LEFT JOIN cust_main ON cust_pkg.custnum = cust_main.custnum + WHERE + ( + cust_bill_pkg_discount.billpkgdiscountnum IS NOT NULL + OR ( + cust_pkg.setup = cust_bill_pkg.sdate + AND cust_pkg.waive_setup = 'Y' + ) + ) + AND cust_bill_pkg.pkgpart_override IS NULL + " . join "\n", + map { " AND ( $_ ) " } + grep { $_ } + $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), + $self->with_report_option(%opt), + $self->in_time_period_and_agent($speriod, $eperiod, $agentnum); + + $self->scalar_sql($total_sql); +} + sub cust_bill_pkg_taxes { my $self = shift; my ($speriod, $eperiod, $agentnum, %opt) = @_; @@ -1055,7 +1115,7 @@ sub calculate_churn_cust { as suspended, SUM((s_active = 0 and s_suspended > 0 and e_active > 0)::int) as resumed, - SUM((s_active > 0 and e_active = 0 and e_suspended = 0)::int) + SUM((e_active = 0 and e_cancelled > s_cancelled)::int) as cancelled FROM ($cust_sql) AS x "; diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 245fb68f8..2a7a9d177 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2736,6 +2736,7 @@ sub tables_hashref { 'country', 'char', '', 2, '', '', 'payby', 'char', '', 4, '', '', 'payinfo', 'varchar', 'NULL', 512, '', '', + #'paymask', 'varchar', 'NULL', $char_d, '', '', #'exp', @date_type, '', '', 'exp', 'varchar', 'NULL', 11, '', '', 'payname', 'varchar', 'NULL', $char_d, '', '', @@ -2749,7 +2750,7 @@ sub tables_hashref { ], 'primary_key' => 'paybatchnum', 'unique' => [], - 'index' => [ ['batchnum'], ['invnum'], ['custnum'] ], + 'index' => [ ['batchnum'], ['invnum'], ['custnum'],['status'] ], 'foreign_keys' => [ { columns => [ 'batchnum' ], table => 'pay_batch', @@ -3269,7 +3270,7 @@ sub tables_hashref { 'columns' => [ 'pkgpart', 'serial', '', '', '', '', 'pkgpartbatch', 'varchar', 'NULL', $char_d, '', '', - 'pkg', 'varchar', '', $char_d, '', '', + 'pkg', 'varchar', '', 104, '', '', 'comment', 'varchar', 'NULL', 2*$char_d, '', '', 'promo_code', 'varchar', 'NULL', $char_d, '', '', 'freq', 'varchar', '', $char_d, '', '', #billing frequency @@ -4890,6 +4891,9 @@ sub tables_hashref { 'suid', 'int', 'NULL', '', '', '', 'shared_svcnum', 'int', 'NULL', '', '', '', 'serviceid', 'varchar', 'NULL', 64, '', '',#srvexport/reportfields + 'speed_test_up', 'int', 'NULL', '', '', '', + 'speed_test_down', 'int', 'NULL', '', '', '', + 'speed_test_latency', 'int', 'NULL', '', '', '', ], 'primary_key' => 'svcnum', 'unique' => [ [ 'ip_addr' ], [ 'mac_addr' ] ], @@ -4927,6 +4931,8 @@ sub tables_hashref { 'height', 'decimal', 'NULL', '', '', '', 'veg_height', 'decimal', 'NULL', '', '', '', 'color', 'varchar', 'NULL', 6, '', '', + 'up_rate_limit', 'int', 'NULL', '', '', '', + 'down_rate_limit', 'int', 'NULL', '', '', '', ], 'primary_key' => 'towernum', 'unique' => [ [ 'towername' ] ], # , 'agentnum' ] ], @@ -4957,8 +4963,9 @@ sub tables_hashref { 'east', 'decimal', 'NULL', '10,7', '', '', 'south', 'decimal', 'NULL', '10,7', '', '', 'north', 'decimal', 'NULL', '10,7', '', '', - 'title', 'varchar', 'NULL', $char_d,'', '', + 'up_rate_limit', 'int', 'NULL', '', '', '', + 'down_rate_limit', 'int', 'NULL', '', '', '', ], 'primary_key' => 'sectornum', 'unique' => [ [ 'towernum', 'sectorname' ], [ 'ip_addr' ], ], @@ -5965,6 +5972,7 @@ sub tables_hashref { 'path', 'varchar', '', 2*$char_d, '', '', '_date', @date_type, '', '', 'render_seconds', 'int', 'NULL', '', '', '', + 'pid', 'int', 'NULL', '', '', '', ], 'primary_key' => 'lognum', 'unique' => [], diff --git a/FS/FS/TemplateItem_Mixin.pm b/FS/FS/TemplateItem_Mixin.pm index 28fbd591d..28ef845c9 100644 --- a/FS/FS/TemplateItem_Mixin.pm +++ b/FS/FS/TemplateItem_Mixin.pm @@ -107,14 +107,13 @@ Returns a formatted time period for this line item. =cut sub time_period_pretty { - my( $self, $part_pkg, $agentnum ) = @_; + my( $self, $part_pkg, $agentnum, %opt ) = @_; #more efficient to look some of this conf stuff up outside the # invoice/template display loop we're called from # (Template_Mixin::_invoice_cust_bill_pkg) and pass them in as options - return '' if $conf->exists('disable_line_item_date_ranges') - || $part_pkg->option('disable_line_item_date_ranges',1) + return '' if $opt{'disable_line_item_date_ranges'} || ! $self->sdate || ! $self->edate; diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 88fd4e87f..34e9e6ef8 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -19,7 +19,7 @@ use HTML::Entities; use Cwd; use FS::UID; use FS::Misc qw( send_email ); -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::Conf; use FS::Misc qw( generate_ps generate_pdf ); use FS::pkg_category; @@ -299,7 +299,7 @@ before that line item (quotations only) =item template -Dprecated. Used as a suffix for a configuration template. Please +Deprecated. Used as a suffix for a configuration template. Please don't use this, it deprecated in favor of more flexible alternatives. =back @@ -825,7 +825,7 @@ sub print_generic { ); } - if ( $conf->exists('invoice_usesummary', $agentnum) ) { + if ( $conf->config_bool('invoice_usesummary', $agentnum) ) { $invoice_data{'summarypage'} = $summarypage = 1; } @@ -933,9 +933,9 @@ sub print_generic { my $unsquelched = $params{unsquelch_cdr} || $cust_main->squelch_cdr ne 'Y'; my $multisection = $self->has_sections; - $conf->exists($tc.'sections', $cust_main->agentnum) || - $conf->exists($tc.'sections_by_location', $cust_main->agentnum); - $invoice_data{'multisection'} = $multisection; + if ( $multisection ) { + $invoice_data{multisection} = $conf->config($tc.'sections_method') || 1; + } my $late_sections; my $extra_sections = []; my $extra_lines = (); @@ -1092,7 +1092,7 @@ sub print_generic { } } else { # subtotal sectioning is the same as for the actual invoice sections - @summary_subtotals = @sections; + @summary_subtotals = grep $_->{subtotal}, @sections; } # Hereafter, push sections to both @sections and @summary_subtotals @@ -1196,6 +1196,9 @@ sub print_generic { my %options = (); $options{'section'} = $section if $multisection; + $options{'section_with_taxes'} = 1 + if $multisection + && $conf->config_bool('invoice_sections_with_taxes', $cust_main->agentnum); $options{'format'} = $format; $options{'escape_function'} = $escape_function; $options{'no_usage'} = 1 unless $unsquelched; @@ -1204,13 +1207,28 @@ sub print_generic { $options{'skip_usage'} = scalar(@$extra_sections) && !grep{$section == $_} @$extra_sections; $options{'preref_callback'} = $params{'preref_callback'}; + $options{'disable_line_item_date_ranges'} = + $conf->exists('disable_line_item_date_ranges'); warn "$me searching for line items\n" if $DEBUG > 1; + my %section_tax_lines; + my %seen_tax_lines; foreach my $line_item ( $self->_items_pkg(%options), $self->_items_fee(%options) ) { + # When bill is sectioned by location, fees may be displayed within the + # appropriate location section. Suppress this fee from the taxes/fees + # end section, so it doesn't appear to be charged twice and make the + # subtotals seem incorrect + next + if $line_item->{locationnum} + && ref $options{section} + && !exists $options{section}->{locationnum} + && $self->has_sections + && $conf->config($tc.'sections_method') eq 'location'; + warn "$me adding line item ". join(', ', map "$_=>".$line_item->{$_}, keys %$line_item). "\n" if $DEBUG > 1; @@ -1232,9 +1250,56 @@ sub print_generic { } $line_item->{'ext_description'} ||= []; + if ( $options{section_with_taxes} && ref $line_item->{pkg_tax} ) { + for my $line_tax ( @{$ line_item->{pkg_tax} } ) { + + # It is rarely possible for the same tax record to be presented here + # multiple times. See cust_bill_pkg::_pkg_tax_list for more info + next if $seen_tax_lines{ $line_tax->{billpkgtaxlocationnum} }; + $seen_tax_lines{ $line_tax->{billpkgtaxlocationnum} } = 1; + + $section_tax_lines{ $line_tax->{taxname} } += $line_tax->{amount}; + } + } + push @detail_items, $line_item; } + # If conf flag invoice_sections_with_taxes: + # - Add @detail_items for taxes into each section + # - Update section subtotal to include taxes + if ( $options{section_with_taxes} && %section_tax_lines ) { + for my $taxname ( keys %section_tax_lines ) { + + push @detail_items, { + section => $section, + amount => sprintf($money_char."%.2f",$section_tax_lines{$taxname}), + description => &$escape_function($taxname), + }; + + # Append taxes to total. If line format resembles "$5.00 to $12.00" + # append to the second value. + + # $section->{subtotal} = '$5.00 to 12.00'; # for testing: + if ($section->{subtotal} =~ /to/) { + my @subtotal = split /\s/, $section->{subtotal}; + $subtotal[2] =~ s/[^\d\.]//g; + $subtotal[2] = sprintf( + $money_char."%.2f", + ( $subtotal[2] + $section_tax_lines{$taxname} ) + ); + $section->{subtotal} = join ' ', @subtotal; + } else { + $section->{subtotal} =~ s/[^\d\.]//g; + $section->{subtotal} = sprintf( + $money_char . "%.2f", + ( $section->{subtotal} + $section_tax_lines{$taxname} ) + ); + } + + } + } + if ( $section->{'description'} ) { push @buf, ( ['','-----------'], [ $section->{'description'}. ' sub-total', @@ -1281,27 +1346,36 @@ sub print_generic { #$tax_section->{'summarized'} = ''; #why? $summarypage && !$tax_weight ? 'Y' : ''; #$tax_section->{'sort_weight'} = $tax_weight; + my $invoice_sections_with_taxes = $conf->config_bool( + 'invoice_sections_with_taxes', $cust_main->agentnum + ); + foreach my $tax ( @items_tax ) { - $taxtotal += $tax->{'amount'}; my $description = &$escape_function( $tax->{'description'} ); my $amount = sprintf( '%.2f', $tax->{'amount'} ); if ( $multisection ) { + if ( !$invoice_sections_with_taxes ) { + + $taxtotal += $tax->{'amount'}; + + push @detail_items, { + ext_description => [], + ref => '', + quantity => '', + description => $description, + amount => $money_char. $amount, + product_code => '', + section => $tax_section, + }; - push @detail_items, { - ext_description => [], - ref => '', - quantity => '', - description => $description, - amount => $money_char. $amount, - product_code => '', - section => $tax_section, - }; - + } } else { + $taxtotal += $tax->{'amount'}; + push @total_items, { 'total_item' => $description, 'total_amount' => $other_money_char. $amount, @@ -1322,6 +1396,14 @@ sub print_generic { $other_money_char. sprintf('%.2f', $self->charged - $taxtotal ); if ( $multisection ) { + + if ( $conf->config_bool('invoice_sections_with_taxes', $cust_main->agentnum) ) { + # If all tax items are displayed in location/category sections, + # remove the empty tax section + @sections = grep{ $_ ne $tax_section } @sections + unless grep{ $_->{section} eq $tax_section } @detail_items; + } + if ( $taxtotal > 0 ) { # there are taxes, so prepare the section to be displayed. # $taxtotal already includes any line items that were already in the @@ -1335,13 +1417,14 @@ sub print_generic { $tax_section->{'description'} = $self->mt($tax_description); $tax_section->{'summarized'} = ''; - # append it if it's not already there - if ( !grep $tax_section, @sections ) { - push @sections, $tax_section; - push @summary_subtotals, $tax_section; - } - } + # append tax section unless it's already there + push @sections, $tax_section + unless grep {$_ eq $tax_section} @sections; + push @summary_subtotals, $tax_section + unless grep {$_ eq $tax_section} @summary_subtotals; + + } } else { unshift @total_items, $total; } @@ -1982,7 +2065,7 @@ sub balance_due_msg { my $msg = $self->mt('Balance Due'); return $msg unless $self->terms; # huh? if ( !$self->conf->exists('invoice_show_prior_due_date') - or $self->conf->exists('invoice_sections') ) { + || $self->has_sections ) { # if enabled, the due date is shown with Total New Charges (see # _items_total) and not here # (yes, or if invoice_sections is enabled; this is just for compatibility) @@ -2190,8 +2273,7 @@ sub generate_email { warn "$me generating plain text invoice" if $DEBUG; - # 'print_text' argument is no longer used - @text = map Encode::encode_utf8($_), $self->print_text(\%args); + @text = $self->print_text(\%args); } else { @@ -2207,7 +2289,11 @@ sub generate_email { 'Encoding' => 'quoted-printable', 'Charset' => 'UTF-8', #'Encoding' => '7bit', - 'Data' => \@text, + 'Data' => [ + map + { Encode::encode('UTF-8', $_, Encode::FB_WARN | Encode::LEAVE_SRC ) } + @text + ], 'Disposition' => 'inline', ); @@ -2286,7 +2372,11 @@ sub generate_email { ' </title>', ' </head>', ' <body bgcolor="#e8e8e8">', - Encode::encode_utf8($html), + Encode::encode( + 'UTF-8', + $html, + Encode::FB_WARN | Encode::LEAVE_SRC + ), ' </body>', '</html>', ], @@ -2423,6 +2513,11 @@ use MIME::Base64; sub postal_mail_fsinc { my ( $self, %opt ) = @_; + if ( $FS::Misc::DISABLE_PRINT ) { + warn 'postal_mail_fsinc() disabled by $FS::Misc::DISABLE_PRINT' if $DEBUG; + return; + } + my $url = 'https://ws.freeside.biz/print'; my $cust_main = $self->cust_main; @@ -2618,7 +2713,13 @@ sub _items_sections { foreach my $display ($cust_bill_pkg->cust_bill_pkg_display) { next if ( $display->summary && $opt{summary} ); - my $section = $display->section; + #my $section = $display->section; + #false laziness with the method, but for efficiency inside this loop + my $section = $display->get('section'); + if ( !$section && !$cust_bill_pkg->hidden ) { + $section = $cust_bill_pkg->get('categoryname'); #cust_bill->cust_bill_pkg added it (XXX quotations / quotation_section) + } + my $type = $display->type; # Set $section = undef if we're sectioning by location and this # line item _has_ a location (i.e. isn't a fee). @@ -3043,6 +3144,10 @@ sub _items_fee { my @cust_bill_pkg = grep { $_->feepart } $self->cust_bill_pkg; my $escape_function = $options{escape_function}; + my $locale = $self->cust_main + ? $self->cust_main->locale + : $self->prospect_main->locale; + my @items; foreach my $cust_bill_pkg (@cust_bill_pkg) { # cache this, so we don't look it up again in every section @@ -3054,16 +3159,30 @@ sub _items_fee { warn "fee definition not found for line item #".$cust_bill_pkg->billpkgnum."\n"; next; } - if ( exists($options{section}) and exists($options{section}{category}) ) - { - my $categoryname = $options{section}{category}; - # then filter for items that have that section - if ( $part_fee->categoryname ne $categoryname ) { - warn "skipping fee '".$part_fee->itemdesc."'--not in section $categoryname\n" if $DEBUG; - next; - } - } # otherwise include them all in the main section - # XXX what to do when sectioning by location? + + # If _items_fee is called while building a sectioned invoice, + # - invoice_sections_method: category + # Skip fee records that do not match the section category. + # - invoice_sections_method: location + # Skip fee records always for location sections. + # The fee records will be presented in the tax/fee section instead. + if ( + exists( $options{section} ) + and + ( + ( + exists( $options{section}{category} ) + and + $part_fee->categoryname ne $options{section}{category} + ) + or + exists( $options{section}{location}) + ) + ) { + warn "skipping fee '".$part_fee->itemdesc. + "'--not in section $options{section}{category}\n" if $DEBUG; + next; + } my @ext_desc; my %base_invnums; # invnum => invoice date @@ -3083,14 +3202,19 @@ sub _items_fee { $self->mt('from invoice #[_1] on [_2]', $_, $base_invnums{$_}) ); } - my $desc = $part_fee->itemdesc_locale($self->cust_main->locale); + my $desc = $part_fee->itemdesc_locale($locale); # but not escape the base description line + my @pkg_tax = $cust_bill_pkg->_pkg_tax_list + if $options{section_with_taxes}; + push @items, { feepart => $cust_bill_pkg->feepart, + billpkgnum => $cust_bill_pkg->billpkgnum, amount => sprintf('%.2f', $cust_bill_pkg->setup + $cust_bill_pkg->recur), description => $desc, - ext_description => \@ext_desc + pkg_tax => \@pkg_tax, + ext_description => \@ext_desc, # sdate/edate? }; } @@ -3188,6 +3312,8 @@ location (whichever is defined). multisection: a flag indicating that this is a multisection invoice, which does something complicated. +section_with_taxes: Look up and include applied taxes for each record + Returns a list of hashrefs, each of which may contain: pkgnum, description, amount, unit_amount, quantity, pkgpart, _is_setup, and @@ -3222,6 +3348,8 @@ sub _items_cust_bill_pkg { my $cust_main = $self->cust_main;#for per-agent cust_bill-line_item-ate_style + my $agentnum = $self->agentnum; + # for location labels: use default location on the invoice date my $default_locationnum; if ( $conf->exists('invoice-all_pkg_addresses') ) { @@ -3347,6 +3475,9 @@ sub _items_cust_bill_pkg { # not normally used, but pass this to the template anyway $classname = $part_pkg->classname; + my @pkg_tax = $cust_bill_pkg->_pkg_tax_list + if $opt{section_with_taxes}; + if ( (!$type || $type eq 'S') && ( $cust_bill_pkg->setup != 0 || $cust_bill_pkg->setup_show_zero @@ -3367,8 +3498,15 @@ sub _items_cust_bill_pkg { || ($discount_show_always and $cust_bill_pkg->unitrecur > 0) || $cust_bill_pkg->recur_show_zero; - $description .= $cust_bill_pkg->time_period_pretty( $part_pkg, - $self->agentnum ) + my $disable_date_ranges = + $opt{disable_line_item_date_ranges} + || $part_pkg->option('disable_line_item_date_ranges', 1); + + $description .= $cust_bill_pkg->time_period_pretty( + $part_pkg, + $agentnum, + disable_date_ranges => $disable_date_ranges, + ) if $part_pkg->is_prepaid #for prepaid, "display the validity period # triggered by the recurring charge freq # (RT#26274) @@ -3420,6 +3558,7 @@ sub _items_cust_bill_pkg { push @{ $s->{ext_description} }, @d; } else { $s = { + billpkgnum => $cust_bill_pkg->billpkgnum, _is_setup => 1, description => $description, pkgpart => $pkgpart, @@ -3431,6 +3570,7 @@ sub _items_cust_bill_pkg { ext_description => \@d, svc_label => ($svc_label || ''), locationnum => $cust_pkg->locationnum, # sure, why not? + pkg_tax => \@pkg_tax, }; }; @@ -3463,10 +3603,15 @@ sub _items_cust_bill_pkg { $description = $self->mt('Usage charges'); } - my $part_pkg = $cust_pkg->part_pkg; + my $disable_date_ranges = + $opt{disable_line_item_date_ranges} + || $part_pkg->option('disable_line_item_date_ranges', 1); - $description .= $cust_bill_pkg->time_period_pretty( $part_pkg, - $self->agentnum ); + $description .= $cust_bill_pkg->time_period_pretty( + $part_pkg, + $agentnum, + disable_date_ranges => $disable_date_ranges, + ); my @d = (); my @seconds = (); # for display of usage info @@ -3584,6 +3729,7 @@ sub _items_cust_bill_pkg { push @{ $r->{ext_description} }, @d; } else { $r = { + billpkgnum => $cust_bill_pkg->billpkgnum, description => $description, pkgpart => $pkgpart, pkgnum => $cust_bill_pkg->pkgnum, @@ -3595,6 +3741,7 @@ sub _items_cust_bill_pkg { ext_description => \@d, svc_label => ($svc_label || ''), locationnum => $cust_pkg->locationnum, + pkg_tax => \@pkg_tax, }; $r->{'seconds'} = \@seconds if grep {defined $_} @seconds; } @@ -3613,6 +3760,7 @@ sub _items_cust_bill_pkg { } elsif ( $amount ) { # create a new usage line $u = { + billpkgnum => $cust_bill_pkg->billpkgnum, description => $description, pkgpart => $pkgpart, pkgnum => $cust_bill_pkg->pkgnum, @@ -3622,6 +3770,7 @@ sub _items_cust_bill_pkg { %item_dates, ext_description => \@d, locationnum => $cust_pkg->locationnum, + pkg_tax => \@pkg_tax, }; } # else this has no usage, so don't create a usage section } @@ -3755,4 +3904,68 @@ sub _items_discounts_avail { } +=item has_sections AGENTNUM + +Return true if invoice_sections should be enabled for this bill. + (Inherited by both cust_bill and cust_bill_void) + +Determination: +* False if not an invoice +* True always if conf invoice_sections is enabled +* True always if sections_by_location is enabled +* True if conf invoice_sections_multilocation > 1, + and location_count >= invoice_sections_multilocation +* Else, False + +=cut + +sub has_sections { + my ($self, $agentnum) = @_; + + return 0 unless $self->invnum > 0; + + $agentnum ||= $self->agentnum; + return 1 if $self->conf->config_bool('invoice_sections', $agentnum); + return 1 if $self->conf->exists('sections_by_location', $agentnum); + + my $location_min = $self->conf->config( + 'invoice_sections_multilocation', $agentnum, + ); + + return 1 + if $location_min + && $self->location_count >= $location_min; + + 0; +} + + +=item location_count + +Return the number of locations billed on this invoice + +=cut + +sub location_count { + my ($self) = @_; + return 0 unless $self->invnum; + + # SELECT COUNT( DISTINCT cust_pkg.locationnum ) + # FROM cust_bill_pkg + # LEFT JOIN cust_pkg USING (pkgnum) + # WHERE invnum = 278 + # AND cust_bill_pkg.pkgnum > 0 + + my $result = qsearchs({ + select => 'COUNT(DISTINCT cust_pkg.locationnum) as location_count', + table => 'cust_bill_pkg', + addl_from => 'LEFT JOIN cust_pkg USING (pkgnum)', + extra_sql => 'WHERE invnum = '.dbh->quote( $self->invnum ) + . ' AND cust_bill_pkg.pkgnum > 0' + }); + ref $result ? $result->location_count : 0; +} + + + 1; diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 6cc04b9de..54128682e 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -743,6 +743,7 @@ use FS::CurrentUser; use FS::Record qw(qsearchs); use FS::queue; use FS::CGI qw(rooturl); +use FS::Report::Queued::FutureAutobill; $DEBUG = 0; diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index ebda99e7b..d3ee8d810 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -5,7 +5,7 @@ use strict; use vars qw( @EXPORT_OK $DEBUG $me $cgi $freeside_uid $conf_dir $cache_dir $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name - $AutoCommit %callback @callback $callback_hack + $AutoCommit $ForceObeyAutoCommit %callback @callback $callback_hack ); use subs qw( getsecrets ); use Carp qw( carp croak cluck confess ); @@ -26,7 +26,17 @@ $freeside_uid = scalar(getpwnam('freeside')); $conf_dir = "%%%FREESIDE_CONF%%%"; $cache_dir = "%%%FREESIDE_CACHE%%%"; +# Code wanting to issue a COMMIT statement to the database is expected to +# obey the convention of checking this flag first. Setting $AutoCommit = 0 +# should (usually) suppress COMMIT statements. $AutoCommit = 1; #ours, not DBI + +# Not all methods obey $AutoCommit, by design choice. Setting +# $ForceObeyAutoCommit = 1 will override that design choice for: +# &FS::cust_main::Billing::collect +# &FS::cust_main::Billing::do_cust_event +$ForceObeyAutoCommit = 0; + $callback_hack = 0; =head1 NAME diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index 0069e207a..b47752de2 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -153,7 +153,7 @@ If you need to continue using the old Form 477 report, turn on the # boolean+text previous_balance-exclude_from_total is now two separate options my $total_new_charges = $conf->config('previous_balance-exclude_from_total'); - if (length($total_new_charges) > 0) { + if ( defined $total_new_charges && length($total_new_charges) > 0 ) { $conf->set('previous_balance-text-total_new_charges', $total_new_charges); $conf->set('previous_balance-exclude_from_total', ''); } @@ -174,8 +174,8 @@ If you need to continue using the old Form 477 report, turn on the $conf->delete('unsuspendauto'); } - if ($conf->config('cust-fields') =~ / \| Payment Type/) { - my $cust_fields = $conf->config('cust-fields'); + my $cust_fields = $conf->config('cust-fields'); + if ( defined $cust_fields && $cust_fields =~ / \| Payment Type/ ) { # so we can potentially use 'Payment Types' or somesuch in the future $cust_fields =~ s/ \| Payment Type( \|)/$1/; $cust_fields =~ s/ \| Payment Type$//; @@ -192,6 +192,19 @@ If you need to continue using the old Form 477 report, turn on the $lh->maketext($_) if length($_); } } + + unless ( FS::upgrade_journal->is_done('deprecate_unmask_ss') ) { + if ( $conf->config_bool( 'unmask_ss' )) { + warn "'unmask_ssn' deprecated from global configuration\n"; + for my $access_group ( qsearch( access_group => {} )) { + $access_group->grant_access_right( 'Unmask customer SSN' ); + warn " - 'Unmask customer SSN' access right granted to '" . + $access_group->groupname . "' employee group\n"; + } + } + FS::upgrade_journal->set_done('deprecate_unmask_ss'); + } + } sub upgrade_overlimit_groups { @@ -338,7 +351,10 @@ sub upgrade { }); foreach my $object ( @objects ) { my $payinfo = $object->decrypt($object->payinfo); - die "error decrypting payinfo" if $payinfo eq $object->payinfo; + if ( $payinfo eq $object->payinfo ) { + warn "error decrypting payinfo for $table: $payinfo\n"; + next; + } $object->payinfo($payinfo); my $error = $object->replace; die $error if $error; @@ -501,6 +517,23 @@ sub upgrade_data { #'compliance solutions' -> 'compliance_solutions' 'tax_rate' => [], 'tax_rate_location' => [], + + #upgrade part_event_condition_option agentnum to a multiple hash value + 'part_event_condition_option' =>[], + + #fix ip format + 'svc_circuit' => [], + + #fix ip format + 'svc_hardware' => [], + + #fix ip format + 'svc_pbx' => [], + + #fix ip format + 'tower_sector' => [], + + ; \%hash; @@ -711,4 +744,3 @@ Sure. =cut 1; - diff --git a/FS/FS/access_group.pm b/FS/FS/access_group.pm index a2b977409..4f6c85b45 100644 --- a/FS/FS/access_group.pm +++ b/FS/FS/access_group.pm @@ -2,6 +2,7 @@ package FS::access_group; use base qw( FS::m2m_Common FS::m2name_Common FS::Record ); use strict; +use Carp qw( croak ); use FS::Record qw( qsearch qsearchs ); use FS::access_right; @@ -137,6 +138,54 @@ sub access_right { ); } +=item grant_access_right RIGHTNAME + +Grant the specified specified FS::access_right record to this group. +Return the FS::access_right record. + +=cut + +sub grant_access_right { + my ( $self, $rightname ) = @_; + + croak "grant_access_right() requires \$rightname" + unless $rightname; + + my $access_right = $self->access_right( $rightname ); + return $access_right if $access_right; + + $access_right = FS::access_right->new({ + righttype => 'FS::access_group', + rightobjnum => $self->groupnum, + rightname => $rightname, + }); + if ( my $error = $access_right->insert ) { + die "grant_access_right() error: $error"; + } + + $access_right; +} + +=item revoke_access_right RIGHTNAME + +Revoke the specified FS::access_right record from this group. + +=cut + +sub revoke_access_right { + my ( $self, $rightname ) = @_; + + croak "revoke_access_right() requires \$rightname" + unless $rightname; + + my $access_right = $self->access_right( $rightname ) + or return; + + if ( my $error = $access_right->delete ) { + die "revoke_access_right() error: $error"; + } +} + =back =head1 BUGS @@ -148,4 +197,3 @@ L<FS::Record>, schema.html from the base documentation. =cut 1; - diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index a9fdf5b1e..f23aa77f9 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -12,6 +12,7 @@ use FS::Record qw( qsearch qsearchs dbh ); use FS::agent; use FS::cust_main; use FS::sales; +use Carp qw( croak ); $DEBUG = 0; $me = '[FS::access_user]'; @@ -814,6 +815,103 @@ sub set_page_pref { return $error; } +=item get_pref NAME + +Fetch the prefvalue column from L<FS::access_user_pref> for prefname NAME + +Returns undef when no value has been saved, or when record has expired + +=cut + +sub get_pref { + my ( $self, $prefname ) = @_; + croak 'prefname parameter requrired' unless $prefname; + + my $pref_row = $self->get_pref_row( $prefname ) + or return undef; + + return undef + if $pref_row->expiration + && $pref_row->expiration < time(); + + $pref_row->prefvalue; +} + +=item get_pref_row NAME + +Fetch the row object from L<FS::access_user_pref> for prefname NAME + +returns undef when no row has been created + +=cut + +sub get_pref_row { + my ( $self, $prefname ) = @_; + croak 'prefname parameter required' unless $prefname; + + qsearchs( + access_user_pref => { + usernum => $self->usernum, + prefname => $prefname, + } + ); +} + +=item set_pref NAME, VALUE, [EXPIRATION_EPOCH] + +Add or update user preference in L<FS::access_user_pref> table + +Passing an undefined VALUE will delete the user preference + +Returns VALUE + +=cut + +sub set_pref { + my $self = shift; + my ( $prefname, $prefvalue, $expiration ) = @_; + + return $self->delete_pref( $prefname ) + unless defined $prefvalue; + + if ( my $pref_row = $self->get_pref_row( $prefname )) { + return $prefvalue + if $pref_row->prefvalue eq $prefvalue; + + $pref_row->prefvalue( $prefvalue ); + $pref_row->expiration( $expiration || ''); + + if ( my $error = $pref_row->replace ) { croak $error } + + return $prefvalue; + } + + my $pref_row = FS::access_user_pref->new({ + usernum => $self->usernum, + prefname => $prefname, + prefvalue => $prefvalue, + expiration => $expiration, + }); + if ( my $error = $pref_row->insert ) { croak $error } + + $prefvalue; +} + +=item delete_pref NAME + +Delete user preference from L<FS::access_user_pref> table + +=cut + +sub delete_pref { + my ( $self, $prefname ) = @_; + + my $pref_row = $self->get_pref_row( $prefname ) + or return; + + if ( my $error = $pref_row->delete ) { croak $error } +} + =back =head1 BUGS diff --git a/FS/FS/access_user_log.pm b/FS/FS/access_user_log.pm index 026670caf..552dd2ad8 100644 --- a/FS/FS/access_user_log.pm +++ b/FS/FS/access_user_log.pm @@ -53,6 +53,10 @@ _date =back +=item pid + +=back + =head1 METHODS =over 4 @@ -84,6 +88,7 @@ sub insert_new_path { 'path' => $path, '_date' => time, 'render_seconds' => $render_seconds, + 'pid' => $$, } ); #so we can still log pages after a transaction-aborting SQL error (and then @@ -127,6 +132,7 @@ sub check { || $self->ut_text('path') || $self->ut_number('_date') || $self->ut_numbern('render_seconds') + || $self->ut_numbern('pid') ; return $error if $error; diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm index ba0f61db1..5fd64bf7a 100755 --- a/FS/FS/addr_block.pm +++ b/FS/FS/addr_block.pm @@ -207,6 +207,27 @@ sub cidr { $self->NetAddr->cidr; } +=item free_addrs + +Returns an aref sorted list of free addresses in the block. + +=cut + +sub free_addrs { + my $self = shift; + + my %used_addr_map = + map {$_ => 1} + FS::IP_Mixin->used_addresses($self), + FS::Conf->new()->config('exclude_ip_addr'); + + [ + grep { !exists $used_addr_map{$_} } + map { $_->addr } + $self->NetAddr->hostenum + ]; +} + =item next_free_addr Returns a NetAddr::IP object corresponding to the first unassigned address @@ -416,4 +437,3 @@ now because that's the smallest block that makes any sense at all. =cut 1; - diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm index e70b9716a..8aff96a8d 100644 --- a/FS/FS/agent.pm +++ b/FS/FS/agent.pm @@ -294,7 +294,15 @@ sub payment_gateway { } } - my $override = qsearchs('agent_payment_gateway', { agentnum => $self->agentnum } ); + my $cardtype_search = "AND ( cardtype IS NULL OR cardtype <> 'ACH')"; + $cardtype_search = "AND ( cardtype IS NULL OR cardtype = 'ACH' )" if $options{method} eq 'ECHECK'; + + my $override = + qsearchs({ + "table" => 'agent_payment_gateway', + "hashref" => { agentnum => $self->agentnum, }, + "extra_sql" => $cardtype_search, + }); my $payment_gateway = FS::payment_gateway->by_key_or_default( gatewaynum => $override ? $override->gatewaynum : '', diff --git a/FS/FS/cdr/Import.pm b/FS/FS/cdr/Import.pm index f2263c552..ce7fe8bd4 100644 --- a/FS/FS/cdr/Import.pm +++ b/FS/FS/cdr/Import.pm @@ -60,6 +60,8 @@ sub dbi_import { my $dbd_type = $args{'dbd'} ? $args{'dbd'} : 'Pg'; my $status_column = $args{status_column} ? $args{status_column} : 'freesidestatus'; my $status_column_info = $args{status_column_info} ? $args{status_column} : 'VARCHAR(32)'; + my $st_sql; + my $batch_name = $args{batch_name} ? $args{batch_name} : 'CDR_DB'; my $queries = get_queries({ 'dbd' => $dbd_type, @@ -88,6 +90,7 @@ sub dbi_import { $dbi->do( $queries->{create_statustable} ) or die $dbi->errstr; } + $st_sql = "INSERT INTO $status_table ( $pkey, $status_column ) VALUES ( ?, 'done' )"; } ## check for column freeside status if not using status table and create it if not there. else { @@ -97,6 +100,7 @@ sub dbi_import { $dbi->do( $queries->{create_statuscolumn} ) or die $dbi->errstr; } + $st_sql = "UPDATE $table SET $status_column = 'done' WHERE $pkey = ?"; } #my @cols = values %{ $args{column_map} }; @@ -110,7 +114,7 @@ sub dbi_import { $sth->execute or die $sth->errstr. " executing $sql"; my $cdr_batch = new FS::cdr_batch({ - 'cdrbatch' => $args{batch_name} . '-import-'. time2str('%Y/%m/%d-%T',time), + 'cdrbatch' => $batch_name . '-import-'. time2str('%Y/%m/%d-%T',time), }); my $error = $cdr_batch->insert; die $error if $error; @@ -149,19 +153,6 @@ sub dbi_import { $imported++; - my $st_sql; - if ( $status_table ) { - - $st_sql = - 'INSERT INTO '. $status_table. " ( $pkey, $status_column ) ". - " VALUES ( ?, 'done' )"; - - } else { - - $st_sql = "UPDATE $table SET $status_column = 'done' WHERE $pkey = ?"; - - } - my $updated = $dbi->do($st_sql, undef, $pkey_value ); #$updates += $updated; die "failed to set status: ".$dbi->errstr."\n" unless $updated; @@ -195,7 +186,7 @@ sub get_queries { $port ||= '5000'; # check for pg default 5000 is sybase. my %dbi_connect_types = ( - 'Sybase' => ':host='.$host.';port='.$port, + 'Sybase' => ':server='.$host.';port='.$port, 'Pg' => ':host='.$info->{host}, ); diff --git a/FS/FS/cdr/ani_networks.pm b/FS/FS/cdr/ani_networks.pm index cac30c488..b00ea1360 100644 --- a/FS/FS/cdr/ani_networks.pm +++ b/FS/FS/cdr/ani_networks.pm @@ -37,42 +37,40 @@ use Time::Local; terminating_ocn:4:208:211 )], 'import_fields' => [ - - sub { #call_date and time + sub { #call_date and time my($cdr, $data, $conf, $param) = @_; $data =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/ or die "unparsable record_date: $data"; $cdr->set('calldate', "$2/$3/$1 $4:$5:$6"); + $cdr->set('startdate', "$2/$3/$1 $4:$5:$6"); }, - - 'charged_party', #bill to number - '', #translate number - - 'src', #originating number - - '', #originating lata - '', #originating city - '', #originating state - '', #originating country - - 'dst', #terminating number - - '', #terminating lata - '', #terminating city - '', #terminating state - '', #terminating city code - '', #terminating country - - '', #call type - '', #call transport - 'accountcode', #account code - '', #info digits - 'duration', #duration - '', #wholesale amount - '', #cic - 'src_lrn', #originating lrn - 'dst_lrn', #terminating lrn - '', #originating ocn - '', #terminating ocn + 'charged_party', #bill to number + '', #translate number + 'src', #originating number + '', #originating lata + '', #originating city + '', #originating state + '', #originating country + 'dst', #terminating number + '', #terminating lata + '', #terminating city + '', #terminating state + '', #terminating city code + '', #terminating country + '', #call type + '', #call transport + 'accountcode', #account code + '', #info digits + sub { #duration + my($cdr, $field) = @_; + $cdr->set(duration => $field); + $cdr->set(billsec => $field); + }, + '', #wholesale amount + '', #cic + 'src_lrn', #originating lrn + 'dst_lrn', #terminating lrn + '', #originating ocn + '', #terminating ocn ], diff --git a/FS/FS/cdr/telapi_voip.pm b/FS/FS/cdr/telapi_voip.pm index 65aed7666..abc7d5bd2 100644 --- a/FS/FS/cdr/telapi_voip.pm +++ b/FS/FS/cdr/telapi_voip.pm @@ -26,8 +26,10 @@ use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); my($cdr, $cdrtypename, $conf, $param) = @_; return unless length($cdrtypename); _init_cdr_types(); - die "no matching cdrtypenum for $cdrtypename" - unless defined $CDR_TYPES->{$cdrtypename}; + unless (defined $CDR_TYPES->{$cdrtypename}) { + warn "Skipping Record: CDR type name $cdrtypename does not exist!"; + $param->{skiprow} = 1; + } $cdr->cdrtypenum($CDR_TYPES->{$cdrtypename}); }, # type _cdr_min_parser_maker('billsec'), #PriceDurationMins diff --git a/FS/FS/contact.pm b/FS/FS/contact.pm index fa047f59d..81dfdbc01 100644 --- a/FS/FS/contact.pm +++ b/FS/FS/contact.pm @@ -199,8 +199,6 @@ sub insert { } - $error ||= $self->insert_password_history; - if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -302,6 +300,15 @@ sub insert { } } + if ( $self->get('password') ) { + my $error = $self->is_password_allowed($self->get('password')) + || $self->change_password($self->get('password')); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -811,7 +818,7 @@ sub authenticate_password { $hash eq $check_hash; - } else { + } else { return 0 if $self->_password eq ''; diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index bd1b8bbec..7158cb285 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -41,6 +41,7 @@ use FS::cust_bill_void; use FS::reason; use FS::reason_type; use FS::L10N; +use FS::Misc::Savepoint; $DEBUG = 0; $me = '[FS::cust_bill]'; @@ -148,15 +149,6 @@ Invoices are normally created by calling the bill method of a customer object sub table { 'cust_bill'; } sub template_conf { 'invoice_'; } -sub has_sections { - my $self = shift; - my $agentnum = $self->cust_main->agentnum; - my $tc = $self->template_conf; - - $self->conf->exists($tc.'sections', $agentnum) || - $self->conf->exists($tc.'sections_by_location', $agentnum); -} - # should be the ONLY occurrence of "Invoice" in invoice rendering code. # (except email_subject and invnum_date_pretty) sub notice_name { @@ -530,7 +522,13 @@ Returns the line items (see L<FS::cust_bill_pkg>) for this invoice. sub cust_bill_pkg { my $self = shift; qsearch( - { 'table' => 'cust_bill_pkg', + { + 'select' => 'cust_bill_pkg.*, pkg_category.categoryname', + 'table' => 'cust_bill_pkg', + 'addl_from' => ' LEFT JOIN cust_pkg USING ( pkgnum ) '. + ' LEFT JOIN part_pkg USING ( pkgpart ) '. + ' LEFT JOIN pkg_class USING ( classnum ) '. + ' LEFT JOIN pkg_category USING ( categorynum ) ', 'hashref' => { 'invnum' => $self->invnum }, 'order_by' => 'ORDER BY billpkgnum', #important? otherwise we could use # the AUTLOADED FK search. or should @@ -977,6 +975,9 @@ sub apply_payments_and_credits { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $savepoint_label = 'cust_bill__apply_payments_and_credits'; + savepoint_create( $savepoint_label ); + $self->select_for_update; #mutex my @payments = grep { $_->unapplied > 0 } @@ -1065,6 +1066,7 @@ sub apply_payments_and_credits { my $error = $app->insert(%options); if ( $error ) { + savepoint_rollback_and_release( $savepoint_label ); $dbh->rollback if $oldAutoCommit; return "Error inserting ". $app->table. " record: $error"; } @@ -1072,6 +1074,7 @@ sub apply_payments_and_credits { } + savepoint_release( $savepoint_label ); $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error @@ -1408,6 +1411,11 @@ See L</print_csv> for a description of the output format. sub send_csv { my($self, %opt) = @_; + if ( $FS::Misc::DISABLE_ALL_NOTICES ) { + warn 'send_csv() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG; + return; + } + #create file(s) my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/cust_bill"; @@ -1484,6 +1492,11 @@ in the ICS format. sub spool_csv { my($self, %opt) = @_; + if ( $FS::Misc::DISABLE_ALL_NOTICES ) { + warn 'spool_csv() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG; + return; + } + my $time = $opt{'time'} || time; my $cust_main = $self->cust_main; @@ -2719,7 +2732,7 @@ sub _items_svc_phone_sections { } -=sub _items_usage_class_summary OPTIONS +=item _items_usage_class_summary OPTIONS Returns a list of detail items summarizing the usage charges on this invoice. Each one will have 'amount', 'description' (the usage charge name), @@ -2768,7 +2781,7 @@ sub _items_usage_class_summary { return @l; } -=sub _items_previous() +=item _items_previous() Returns an array of hashrefs, each hashref representing a line-item on the current bill for previous unpaid invoices. @@ -2902,7 +2915,7 @@ sub _items_previous { } -=sub _items_previous_total +=item _items_previous_total Return sum of amounts from all items returned by _items_previous Results will vary based on invoicing conf flags @@ -2952,7 +2965,7 @@ sub __items_previous_map_invoice { } } -=sub _items_credits() +=item _items_credits() Return array of hashrefs containing credits to be shown as line-items when rendering this bill. @@ -3091,7 +3104,7 @@ sub _items_credits { @return; } -=sub _items_credits_total +=item _items_credits_total Return the total of al items from _items_credits Will vary based on invoice display conf flag @@ -3107,7 +3120,7 @@ sub _items_credits_total { -=sub _items_credits_postbill() +=item _items_credits_postbill() Returns an array of hashrefs for credits where - Credit issued after this invoice @@ -3149,7 +3162,7 @@ sub _items_credits_postbill { }} @cust_credit_bill; } -=sub _items_payments_postbill() +=item _items_payments_postbill() Returns an array of hashrefs for payments where - Payment occured after this invoice @@ -3185,7 +3198,7 @@ sub _items_payments_postbill { }} @cust_bill_pay; } -=sub _items_payments() +=item _items_payments() Return array of hashrefs containing payments to be shown as line-items when rendering this bill. @@ -3246,7 +3259,6 @@ sub _items_payments { if ($self->conf->exists('previous_balance-payments_since')) { if ($template eq 'statement') { -print "\nCASE 3\n"; # Case 3 (see above) # Return payments timestamped between the previous and following bills @@ -3270,7 +3282,7 @@ print "\nCASE 3\n"; } else { # Case 2 (see above) # Return payments timestamped between this and the previous bill -print "\nCASE 2\n"; + my $date_start = 0; my $date_end = $self->_date; @@ -3304,7 +3316,7 @@ print "\nCASE 2\n"; return @{ $self->get('_items_payments') }; } -=sub _items_payments_total +=item _items_payments_total Return a total of all records returned by _items_payments Results vary based on invoicing conf flags @@ -3361,7 +3373,7 @@ sub __items_payments_make_hashref { return @return; } -=sub _items_total() +=item _items_total() Generate the line-items to be shown on the bill in the "Totals" section diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 77dce2476..1262c3874 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -365,8 +365,10 @@ sub void { return $error; } + #more efficiently than below, because there could be lots + $self->void_cust_bill_pkg_detail($reprocess_cdrs); + foreach my $table (qw( - cust_bill_pkg_detail cust_bill_pkg_display cust_bill_pkg_discount cust_bill_pkg_tax_location @@ -374,17 +376,13 @@ sub void { cust_tax_exempt_pkg cust_bill_pkg_fee )) { - my %delete_args = (); - $delete_args{'reprocess_cdrs'} = $reprocess_cdrs - if $table eq 'cust_bill_pkg_detail'; - 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(%delete_args); + my $error = $void->insert || $linked->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -406,6 +404,40 @@ sub void { } +sub void_cust_bill_pkg_detail { + my( $self, $reprocess_cdrs ) = @_; + + my $from_cust_bill_pkg_detail = + 'FROM cust_bill_pkg_detail WHERE billpkgnum = ?'; + my $where_detailnum = + "WHERE detailnum IN ( SELECT detailnum $from_cust_bill_pkg_detail )"; + + if ( $reprocess_cdrs ) { + #well, technically this could have been on other invoices / termination + # partners... separate flag? + $self->scalar_sql( + "DELETE FROM cdr_termination + WHERE acctid IN ( SELECT acctid FROM cdr $where_detailnum ) + ", + $self->billpkgnum + ); + } + + my $setstatus = $reprocess_cdrs ? ', freesidestatus = NULL' : ''; + $self->scalar_sql( + "UPDATE cdr SET detailnum = NULL $setstatus $where_detailnum", + $self->billpkgnum + ); + + $self->scalar_sql("INSERT INTO cust_bill_pkg_detail_void + SELECT * $from_cust_bill_pkg_detail", + $self->billpkgnum + ); + + $self->scalar_sql("DELETE $from_cust_bill_pkg_detail", $self->billpkgnum); + +} + =item delete Not recommended. @@ -716,6 +748,7 @@ Returns the customer (L<FS::cust_main> object) for this line item. =cut sub cust_main { + carp "->cust_main called" if $DEBUG; # required for cust_main_Mixin equivalence # and use cust_bill instead of cust_pkg because this might not have a # cust_pkg @@ -1815,6 +1848,92 @@ sub upgrade_tax_location { ''; } +sub _pkg_tax_list { + # Return an array of hashrefs for each cust_bill_pkg_tax_location + # applied to this bill for this cust_bill_pkg.pkgnum. + # + # ! Important Note: + # In some situations, this list will contain more tax records than the + # ones directly related to $self->billpkgnum. The returned list contains + # all records, for this bill, charged against this billpkgnum's pkgnum. + # + # One must keep this in mind when using data returned by this method. + # + # An unaddressed deficiency in the cust_bill_pkg_tax_location model makes + # this necessary: When a linked-hidden package generates a tax/fee as a row + # in cust_bill_pkg_tax_location, there is not enough information to surmise + # with specificity which billpkgnum row represents the direct parent of the + # the linked-hidden package's tax row. The closest we can get to this + # backwards reassociation is to use the pkgnum. Therefore, when multiple + # billpkgnum's appear with the same pkgnum, this method is going to return + # the tax records for ALL of those billpkgnum's, not just $self->billpkgnum. + # + # This could be addressed with an update to the model, and to the billing + # routine that generates rows into cust_bill_pkg_tax_location. Perhaps a + # column, link_billpkgnum or parent_billpkgnum, recording the link. I'm not + # doing that now, because there would be no possible repair of data stored + # historically prior to such a fix. I need _pkg_tax_list() to not be + # broken for already-generated bills. + # + # Any code you write relying on _pkg_tax_list() MUST be aware of, and + # account for, the possible return of duplicated tax records returned + # when method is called on multiple cust_bill_pkg_tax_location rows. + # Duplicates can be identified by billpkgtaxlocationnum column. + + my $self = shift; + + my $search_selector; + if ( $self->pkgnum ) { + + # For taxes applied to normal billing items + $search_selector = + ' cust_bill_pkg_tax_location.pkgnum = ' + . dbh->quote( $self->pkgnum ); + + } elsif ( $self->feepart ) { + + # For taxes applied to fees, when the fee is not attached to a package + # i.e. late fees, billing events fees + $search_selector = + ' cust_bill_pkg_tax_location.taxable_billpkgnum = ' + . dbh->quote( $self->billpkgnum ); + + } else { + warn "_pkg_tax_list() unhandled case breaking taxes into sections"; + warn "_pkg_tax_list() $_: ".$self->$_ + for qw(pkgnum billpkgnum feepart); + return; + } + + map +{ + billpkgtaxlocationnum => $_->billpkgtaxlocationnum, + billpkgnum => $_->billpkgnum, + taxnum => $_->taxnum, + amount => $_->amount, + taxname => $_->taxname, + }, + qsearch({ + table => 'cust_bill_pkg_tax_location', + addl_from => ' + LEFT JOIN cust_bill_pkg + ON cust_bill_pkg.billpkgnum + = cust_bill_pkg_tax_location.taxable_billpkgnum + ', + select => join( ', ', (qw| + cust_bill_pkg.billpkgnum + cust_bill_pkg_tax_location.billpkgtaxlocationnum + cust_bill_pkg_tax_location.taxnum + cust_bill_pkg_tax_location.amount + |)), + extra_sql => + ' WHERE '. + ' cust_bill_pkg.invnum = ' . dbh->quote( $self->invnum ) . + ' AND '. + $search_selector + }); + +} + sub _upgrade_data { # Create a queue job to run upgrade_tax_location from January 1, 2012 to # the present date. @@ -1873,4 +1992,3 @@ from the base documentation. =cut 1; - diff --git a/FS/FS/cust_bill_void.pm b/FS/FS/cust_bill_void.pm index 50f69c9fa..43b295014 100644 --- a/FS/FS/cust_bill_void.pm +++ b/FS/FS/cust_bill_void.pm @@ -119,15 +119,6 @@ sub table { 'cust_bill_void'; } sub notice_name { 'VOIDED Invoice'; } sub template_conf { 'invoice_'; } -sub has_sections { - my $self = shift; - my $agentnum = $self->cust_main->agentnum; - my $tc = $self->template_conf; - - $self->conf->exists($tc.'sections', $agentnum) || - $self->conf->exists($tc.'sections_by_location', $agentnum); -} - =item insert @@ -375,4 +366,3 @@ L<FS::Record>, schema.html from the base documentation. =cut 1; - diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm index 094c4fa8b..2884f1278 100644 --- a/FS/FS/cust_event.pm +++ b/FS/FS/cust_event.pm @@ -315,11 +315,16 @@ sub join_sql { " JOIN part_event USING ( eventpart ) + LEFT JOIN cust_bill ON ( eventtable = 'cust_bill' AND tablenum = invnum ) LEFT JOIN cust_pkg ON ( eventtable = 'cust_pkg' AND tablenum = pkgnum ) LEFT JOIN cust_pay ON ( eventtable = 'cust_pay' AND tablenum = paynum ) + LEFT JOIN cust_pay_batch ON ( eventtable = 'cust_pay_batch' AND tablenum = paybatchnum ) + LEFT JOIN cust_statement ON ( eventtable = 'cust_statement' AND tablenum = cust_statement.statementnum ) + LEFT JOIN cust_svc ON ( eventtable = 'svc_acct' AND tablenum = svcnum ) LEFT JOIN cust_pkg AS cust_pkg_for_svc ON ( cust_svc.pkgnum = cust_pkg_for_svc.pkgnum ) + LEFT JOIN cust_main ON ( ( eventtable = 'cust_main' AND tablenum = cust_main.custnum ) OR ( eventtable = 'cust_bill' AND cust_bill.custnum = cust_main.custnum ) diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7c9868d7a..2e8fe8159 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -79,6 +79,7 @@ use FS::sales; use FS::cust_payby; use FS::contact; use FS::reason; +use FS::Misc::Savepoint; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -2212,11 +2213,15 @@ sub cancel_pkgs { my( $self, %opt ) = @_; # we're going to cancel services, which is not reversible + # unless exports are suppressed die "cancel_pkgs cannot be run inside a transaction" - if $FS::UID::AutoCommit == 0; + if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; + savepoint_create('cancel_pkgs'); + return ( 'access denied' ) unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); @@ -2233,7 +2238,8 @@ sub cancel_pkgs { my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref; my $error = $ban->insert; if ($error) { - dbh->rollback; + savepoint_rollback_and_release('cancel_pkgs'); + dbh->rollback if $oldAutoCommit; return ( $error ); } @@ -2253,11 +2259,13 @@ sub cancel_pkgs { 'time' => $cancel_time ); if ($error) { warn "Error billing during cancel, custnum ". $self->custnum. ": $error"; - dbh->rollback; + savepoint_rollback_and_release('cancel_pkgs'); + dbh->rollback if $oldAutoCommit; return ( "Error billing during cancellation: $error" ); } } - dbh->commit; + savepoint_release('cancel_pkgs'); + dbh->commit if $oldAutoCommit; my @errors; # try to cancel each service, the same way we would for individual packages, @@ -2271,17 +2279,22 @@ sub cancel_pkgs { warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ". $self->custnum."\n" if $DEBUG; + my $i = 0; foreach my $cust_svc (@sorted_cust_svc) { + my $savepoint = 'cancel_pkgs_'.$i++; + savepoint_create( $savepoint ); my $part_svc = $cust_svc->part_svc; next if ( defined($part_svc) and $part_svc->preserve ); # immediate cancel, no date option # transactionize individually my $error = try { $cust_svc->cancel } catch { $_ }; if ( $error ) { - dbh->rollback; + savepoint_rollback_and_release( $savepoint ); + dbh->rollback if $oldAutoCommit; push @errors, $error; } else { - dbh->commit; + savepoint_release( $savepoint ); + dbh->commit if $oldAutoCommit; } } if (@errors) { @@ -2297,8 +2310,11 @@ sub cancel_pkgs { @cprs = @{ delete $opt{'cust_pkg_reason'} }; } my $null_reason; + $i = 0; foreach (@pkgs) { my %lopt = %opt; + my $savepoint = 'cancel_pkgs_'.$i++; + savepoint_create( $savepoint ); if (@cprs) { my $cpr = shift @cprs; if ( $cpr ) { @@ -2319,10 +2335,12 @@ sub cancel_pkgs { } my $error = $_->cancel(%lopt); if ( $error ) { - dbh->rollback; + savepoint_rollback_and_release( $savepoint ); + dbh->rollback if $oldAutoCommit; push @errors, 'pkgnum '.$_->pkgnum.': '.$error; } else { - dbh->commit; + savepoint_release( $savepoint ); + dbh->commit if $oldAutoCommit; } } @@ -3922,6 +3940,27 @@ sub name { $name; } +=item batch_payment_payname + +Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company, +based on if a company name exists and is the account being used a business account. + +=cut + +sub batch_payment_payname { + my $self = shift; + my $cust_pay_batch = shift; + my $name; + + if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; } + else { $name = $self->first .' '. $self->last; } + + $name = $self->company + if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company); + + $name; +} + =item service_contact Returns the L<FS::contact> object for this customer that has the 'Service' @@ -5393,6 +5432,16 @@ sub process_bill_and_collect { $cust_main->bill_and_collect( %$param ); } +=item pending_invoice_count + +Return number of cust_bill with pending=Y for this customer + +=cut + +sub pending_invoice_count { + FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" ); +} + #starting to take quite a while for big dbs # (JRNL: journaled so it only happens once per database) # - seq scan of h_cust_main (yuck), but not going to index paycvv, so diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 08b10c1ff..1be7d39f9 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -1,6 +1,7 @@ package FS::cust_main::Billing; use strict; +use feature 'state'; use vars qw( $conf $DEBUG $me ); use Carp; use Data::Dumper; @@ -25,6 +26,7 @@ use FS::pkg_category; use FS::FeeOrigin_Mixin; use FS::Log; use FS::TaxEngine; +use FS::Misc::Savepoint; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -170,11 +172,8 @@ sub bill_and_collect { # In a batch tax environment, do not run collection if any pending # invoices were created. Collection will run after the next tax batch. - my $tax = FS::TaxEngine->new; - if ( $tax->info->{batch} and - qsearch('cust_bill', { custnum => $self->custnum, pending => 'Y' }) - ) - { + state $is_batch_tax = FS::TaxEngine->new->info->{batch} ? 1 : 0; + if ( $is_batch_tax && $self->pending_invoice_count ) { warn "skipped collection for custnum ".$self->custnum. " due to pending invoices\n" if $DEBUG; } elsif ( $conf->exists('cancelled_cust-noevents') @@ -1052,6 +1051,9 @@ sub _make_lines { } } + $lineitems++ + if $cust_pkg->waive_setup && $part_pkg->can('prorate_setup') && $part_pkg->prorate_setup($cust_pkg, $time); + if ( $cust_pkg->get('setup') ) { # don't change it } elsif ( $cust_pkg->get('start_date') ) { @@ -1752,7 +1754,10 @@ sub collect { $dbh->commit or die $dbh->errstr if $oldAutoCommit; #never want to roll back an event just because it returned an error - local $FS::UID::AutoCommit = 1; #$oldAutoCommit; + # unless $FS::UID::ForceObeyAutoCommit is set + local $FS::UID::AutoCommit = 1 + unless !$oldAutoCommit + && $FS::UID::ForceObeyAutoCommit; $self->do_cust_event( 'debug' => ( $options{'debug'} || 0 ), @@ -1960,9 +1965,13 @@ sub do_cust_event { } $dbh->commit or die $dbh->errstr if $oldAutoCommit; + #never want to roll back an event just because it or a different one # returned an error - local $FS::UID::AutoCommit = 1; #$oldAutoCommit; + # unless $FS::UID::ForceObeyAutoCommit is set + local $FS::UID::AutoCommit = 1 + unless !$oldAutoCommit + && $FS::UID::ForceObeyAutoCommit; foreach my $cust_event ( @$due_cust_event ) { @@ -2287,16 +2296,21 @@ sub apply_payments_and_credits { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $savepoint_label = 'Billing__apply_payments_and_credits'; + savepoint_create( $savepoint_label ); + $self->select_for_update; #mutex foreach my $cust_bill ( $self->open_cust_bill ) { my $error = $cust_bill->apply_payments_and_credits(%options); if ( $error ) { + savepoint_rollback_and_release( $savepoint_label ); $dbh->rollback if $oldAutoCommit; return "Error applying: $error"; } } + savepoint_release( $savepoint_label ); $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error diff --git a/FS/FS/cust_main/Billing_Batch.pm b/FS/FS/cust_main/Billing_Batch.pm index 38d100ef6..70dc28892 100644 --- a/FS/FS/cust_main/Billing_Batch.pm +++ b/FS/FS/cust_main/Billing_Batch.pm @@ -55,7 +55,8 @@ sub batch_card { return; } - my $invnum = delete $options{invnum}; + #my $invnum = delete $options{invnum}; + my $invnum = $options{invnum}; #pay fields should all come from either cust_payby or options, not both # in theory, could just pass payby, and use it to select cust_payby, @@ -114,7 +115,7 @@ sub batch_card { } ); foreach (qw( address1 address2 city state zip country latitude longitude - payby payinfo paydate payname paycode )) + payby payinfo paydate payname paycode paytype )) { $options{$_} = '' unless exists($options{$_}); } @@ -138,11 +139,16 @@ sub batch_card { 'country' => $options{country} || $loc->country, 'payby' => $options{payby} || $cust_payby->payby, 'payinfo' => $options{payinfo} || $cust_payby->payinfo, + 'paymask' => ( $options{payinfo} + ? FS::payinfo_Mixin->mask_payinfo( $options{payby}, + $options{payinfo} ) + : $cust_payby->paymask + ), 'exp' => $options{paydate} || $cust_payby->paydate, 'payname' => $options{payname} || $cust_payby->payname, 'paytype' => $options{paytype} || $cust_payby->paytype, 'amount' => $amount, # consolidating - 'paycode' => $options{paycode} || $cust_payby->paycode, + 'paycode' => $options{paycode} || '', } ); $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum) diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index f16752ba4..714a2e687 100644 --- a/FS/FS/cust_main/Billing_Realtime.pm +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -16,6 +16,7 @@ use FS::cust_bill_pay; use FS::cust_refund; use FS::banned_pay; use FS::payment_gateway; +use FS::Misc::Savepoint; $realtime_bop_decline_quiet = 0; @@ -27,6 +28,7 @@ $me = '[FS::cust_main::Billing_Realtime]'; our $BOP_TESTING = 0; our $BOP_TESTING_SUCCESS = 1; +our $BOP_TESTING_TIMESTAMP = ''; install_callback FS::UID sub { $conf = new FS::Conf; @@ -405,7 +407,7 @@ sub realtime_bop { confess "Can't call realtime_bop within another transaction ". '($FS::UID::AutoCommit is false)' - unless $FS::UID::AutoCommit; + unless $FS::UID::AutoCommit || $BOP_TESTING; local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG; @@ -421,6 +423,8 @@ sub realtime_bop { $options{amount} = $amount; } + return '' unless $options{amount} > 0; + # set fields from passed cust_payby _bop_cust_payby_options(\%options); @@ -454,16 +458,24 @@ sub realtime_bop { if $conf->config('credit-card-surcharge-percentage', $self->agentnum) && $options{method} eq 'CC'; + my $cc_surcharge_flat = 0; + $cc_surcharge_flat = $conf->config('credit-card-surcharge-flatfee', $self->agentnum) + if $conf->config('credit-card-surcharge-flatfee', $self->agentnum) + && $options{method} eq 'CC'; + # always add cc surcharge if called from event - if($options{'cc_surcharge_from_event'} && $cc_surcharge_pct > 0) { - $cc_surcharge = $options{'amount'} * $cc_surcharge_pct / 100; + if($options{'cc_surcharge_from_event'} && ($cc_surcharge_pct > 0 || $cc_surcharge_flat > 0)) { + if ($options{'amount'} > 0) { + $cc_surcharge = ($options{'amount'} * ($cc_surcharge_pct / 100)) + $cc_surcharge_flat; $options{'amount'} += $cc_surcharge; $options{'amount'} = sprintf("%.2f", $options{'amount'}); # round (again)? + } } - elsif($cc_surcharge_pct > 0) { # we're called not from event (i.e. from a - # payment screen), so consider the given - # amount as post-surcharge - $cc_surcharge = $options{'amount'} - ($options{'amount'} / ( 1 + $cc_surcharge_pct/100 )); + elsif($cc_surcharge_pct > 0 || $cc_surcharge_flat > 0) { + # we're called not from event (i.e. from a + # payment screen), so consider the given + # amount as post-surcharge + $cc_surcharge = $options{'amount'} - (($options{'amount'} - $cc_surcharge_flat) / ( 1 + $cc_surcharge_pct/100 )) if $options{'amount'} > 0; } $cc_surcharge = sprintf("%.2f",$cc_surcharge) if $cc_surcharge > 0; @@ -672,7 +684,7 @@ sub realtime_bop { my $cust_pay_pending = new FS::cust_pay_pending { 'custnum' => $self->custnum, 'paid' => $options{amount}, - '_date' => '', + '_date' => $BOP_TESTING ? $BOP_TESTING_TIMESTAMP : '', 'payby' => $bop_method2payby{$options{method}}, 'payinfo' => $options{payinfo}, 'paymask' => $options{paymask}, @@ -747,7 +759,7 @@ sub realtime_bop { return { reference => $cust_pay_pending->paypendingnum, map { $_ => $transaction->$_ } qw ( popup_url collectitems ) }; - } elsif ( $transaction->is_success() && $action2 ) { + } elsif ( !$BOP_TESTING && $transaction->is_success() && $action2 ) { $cust_pay_pending->status('authorized'); my $cpp_authorized_err = $cust_pay_pending->replace; @@ -936,7 +948,7 @@ sub _realtime_bop_result { 'custnum' => $self->custnum, 'invnum' => $options{'invnum'}, 'paid' => $cust_pay_pending->paid, - '_date' => '', + '_date' => $BOP_TESTING ? $BOP_TESTING_TIMESTAMP : '', 'payby' => $cust_pay_pending->payby, 'payinfo' => $options{'payinfo'}, 'paymask' => $options{'paymask'} || $cust_pay_pending->paymask, @@ -957,12 +969,16 @@ sub _realtime_bop_result { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $savepoint_label = '_realtime_bop_result'; + savepoint_create( $savepoint_label ); + #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () ); if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + savepoint_rollback( $savepoint_label ); + $cust_pay->invnum(''); #try again with no specific invnum $cust_pay->paynum(''); my $error2 = $cust_pay->insert( $options{'manual'} ? @@ -971,7 +987,8 @@ sub _realtime_bop_result { if ( $error2 ) { # gah. but at least we have a record of the state we had to abort in # from cust_pay_pending now. - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + savepoint_rollback_and_release( $savepoint_label ); + my $e = "WARNING: $options{method} captured but payment not recorded -". " error inserting payment (". $payment_gateway->gateway_module. "): $error2". @@ -986,9 +1003,10 @@ sub _realtime_bop_result { my $jobnum = $cust_pay_pending->jobnum; if ( $jobnum ) { my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } ); - + unless ( $placeholder ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + savepoint_rollback_and_release( $savepoint_label ); + my $e = "WARNING: $options{method} captured but job $jobnum not ". "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n"; warn $e; @@ -998,7 +1016,8 @@ sub _realtime_bop_result { $error = $placeholder->delete; if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + savepoint_rollback_and_release( $savepoint_label ); + my $e = "WARNING: $options{method} captured but could not delete ". "job $jobnum for paypendingnum ". $cust_pay_pending->paypendingnum. ": $error\n"; @@ -1020,8 +1039,8 @@ sub _realtime_bop_result { my $cpp_done_err = $cust_pay_pending->replace; if ( $cpp_done_err ) { + savepoint_rollback_and_release( $savepoint_label ); - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; my $e = "WARNING: $options{method} captured but payment not recorded - ". "error updating status for paypendingnum ". $cust_pay_pending->paypendingnum. ": $cpp_done_err \n"; @@ -1029,7 +1048,7 @@ sub _realtime_bop_result { return $e; } else { - + savepoint_release( $savepoint_label ); $dbh->commit or die $dbh->errstr if $oldAutoCommit; if ( $options{'apply'} ) { @@ -1068,9 +1087,11 @@ sub _realtime_bop_result { } my $cust_pkg; + my $cc_surcharge_text = 'Credit Card Surcharge'; + $cc_surcharge_text = $conf->config('credit-card-surcharge-text', $self->agentnum) if $conf->exists('credit-card-surcharge-text', $self->agentnum); my $charge_error = $self->charge({ 'amount' => $options{'cc_surcharge'}, - 'pkg' => 'Credit Card Surcharge', + 'pkg' => $cc_surcharge_text, 'setuptax' => 'Y', 'cust_pkg_ref' => \$cust_pkg, }); @@ -1193,6 +1214,7 @@ sub _realtime_bop_result { "resolved - error updating status for paypendingnum ". $cust_pay_pending->paypendingnum. ": $cpp_done_err \n"; warn $e; + #XXX internal system log $e (what's going on?) $perror = "$e ($perror)"; } @@ -1520,7 +1542,7 @@ sub realtime_refund_bop { my $payment_gateway = $self->agent->payment_gateway( 'method' => $options{method} ); - my( $processor, $login, $password, $namespace ) = + ( $processor, $login, $password, $namespace ) = map { my $method = "gateway_$_"; $payment_gateway->$method } qw( module username password namespace ); diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm index 815304bb4..bfaf6217c 100644 --- a/FS/FS/cust_main/Search.pm +++ b/FS/FS/cust_main/Search.pm @@ -96,8 +96,11 @@ sub smart_search { #cust_main phone numbers and contact phone number push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, + 'select' => 'cust_main.*', + 'table' => 'cust_main', + 'addl_from' => ' left join cust_contact using (custnum) '. + ' left join contact_phone using (contactnum) ', + 'hashref' => { %options }, 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). ' ( '. join(' OR ', map "$_ = '$phonen'", @@ -106,15 +109,14 @@ sub smart_search { " OR phonenum = '$phonenum' ". ' ) '. " AND $agentnums_sql", #agent virtualization - 'addl_from' => ' left join cust_contact using (custnum) left join contact_phone using (contactnum) ', } ); unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match #try looking for matches with extensions unless one was specified push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, + 'table' => 'cust_main', + 'hashref' => { %options }, 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). ' ( '. join(' OR ', map "$_ LIKE '$phonen\%'", @@ -132,8 +134,12 @@ sub smart_search { if ( $search =~ /@/ ) { #email address from cust_main_invoice and contact_email push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, + 'select' => 'cust_main.*', + 'table' => 'cust_main', + 'addl_from' => ' left join cust_main_invoice using (custnum) '. + ' left join cust_contact using (custnum) '. + ' left join contact_email using (contactnum) ', + 'hashref' => { %options }, 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). ' ( '. join(' OR ', map "$_ = '$search'", @@ -141,7 +147,6 @@ sub smart_search { ). ' ) '. " AND $agentnums_sql", #agent virtualization - 'addl_from' => ' left join cust_main_invoice using (custnum) left join cust_contact using (custnum) left join contact_email using (contactnum) ', } ); # custnum search (also try agent_custid), with some tweaking options if your @@ -206,6 +211,7 @@ sub smart_search { # probably the Right Thing: return customers that have any associated # locations matching the string, not just bill/ship location push @cust_main, qsearch( { + 'select' => 'cust_main.*', 'table' => 'cust_main', 'addl_from' => ' JOIN cust_location USING (custnum) ', 'hashref' => { %options, }, @@ -226,9 +232,9 @@ sub smart_search { #doesn't throw a wrench in the works) push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => + 'table' => 'cust_main', + 'hashref' => { %options }, + 'extra_sql' => ( keys(%options) ? ' AND ' : ' WHERE ' ). join(' AND ', " LOWER(first) = ". dbh->quote(lc($first)), @@ -236,7 +242,7 @@ sub smart_search { " LOWER(company) = ". dbh->quote(lc($company)), $agentnums_sql, ), - } ), + } ); #contacts? # probably not necessary for the "something a browser remembered" case @@ -282,11 +288,12 @@ sub smart_search { #cust_main and contacts push @cust_main, qsearch( { + 'select' => 'cust_main.*', 'table' => 'cust_main', - 'select' => 'cust_main.*, cust_contact.*, contact.contactnum, contact.last as contact_last, contact.first as contact_first, contact.title', + 'addl_from' => ' left join cust_contact using (custnum) '. + ' left join contact using (contactnum) ', 'hashref' => { %options }, 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - 'addl_from' => ' left join cust_contact on cust_main.custnum = cust_contact.custnum left join contact using (contactnum) ', } ); # or it just be something that was typed in... (try that in a sec) @@ -314,11 +321,12 @@ sub smart_search { if $conf->exists('address1-search'); push @cust_main, qsearch( { + 'select' => 'cust_main.*', 'table' => 'cust_main', - 'select' => 'cust_main.*, cust_contact.*, contact.contactnum, contact.last as contact_last, contact.first as contact_first, contact.title', + 'addl_from' => ' left join cust_contact using (custnum) '. + ' left join contact using (contactnum) ', 'hashref' => { %options }, 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - 'addl_from' => 'left join cust_contact on cust_main.custnum = cust_contact.custnum left join contact using (contactnum) ', } ); #no exact match, trying substring/fuzzy @@ -375,6 +383,7 @@ sub smart_search { if ( $conf->exists('address1-search') && length($value) >= $min_len ) { push @cust_main, qsearch( { + select => 'cust_main.*', table => 'cust_main', addl_from => 'JOIN cust_location USING (custnum)', extra_sql => 'WHERE '. @@ -456,6 +465,7 @@ sub smart_search { my $mask_search = FS::payinfo_Mixin->mask_payinfo('CARD', $card_search); push @cust_main, qsearch({ + 'select' => 'cust_main.*', 'table' => 'cust_main', 'addl_from' => ' JOIN cust_payby USING (custnum)', 'hashref' => {}, diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 8b5e06db2..4c82d106e 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -662,11 +662,75 @@ sub send_receipt { || ! $cust_bill ) { - my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum); + $error = $self->send_message_receipt( + 'cust_main' => $cust_main, + 'cust_bill' => $opt->{cust_bill}, + 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum) + ); + #not manual and no noemail flag (here or on the customer) + } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) { + + # check to see if they want to send specific message template as receipt for auto payments + if ( $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum) ) { + $error = $self->send_message_receipt( + 'cust_main' => $cust_main, + 'cust_bill' => $opt->{cust_bill}, + 'msgnum' => $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum), + ); + } + else { + my $queue = new FS::queue { + 'job' => 'FS::cust_bill::queueable_email', + 'paynum' => $self->paynum, + 'custnum' => $cust_main->custnum, + }; + + my %opt = ( + 'invnum' => $cust_bill->invnum, + 'no_coupon' => 1, + ); + + if ( my $mode = $conf->config('payment_receipt_statement_mode') ) { + $opt{'mode'} = $mode; + } else { + # backward compatibility, no good fix for this yet as some people may + # still have "invoice_latex_statement" and such options + $opt{'template'} = 'statement'; + $opt{'notice_name'} = 'Statement'; + } + + $error = $queue->insert(%opt); + } + + + + } + + warn "send_receipt: $error\n" if $error; +} + +=item send_message_receipt + +sends out a message receipt. +$error = $self->send_message_receipt( + 'cust_main' => $cust_main, + 'cust_bill' => $opt->{cust_bill}, + 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum) + ); + +=cut + +sub send_message_receipt { + my ($self, %opt) = @_; + my $cust_main = $opt{'cust_main'}; + my $cust_bill = $opt{'cust_bill'}; + my $msgnum = $opt{'msgnum'}; + my $error = ''; + if ( $msgnum ) { my %substitutions = (); - $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill}; + $substitutions{invnum} = $cust_bill->invnum if $cust_bill; my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum}); unless ($msg_template) { @@ -684,7 +748,7 @@ sub send_receipt { $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template'; if ($error) { warn "send_receipt: $error"; - return; + return $error; } my $queue = new FS::queue { @@ -695,39 +759,11 @@ sub send_receipt { $error = $queue->insert( $cust_msg->custmsgnum ); } else { - warn "payment_receipt is on, but no payment_receipt_msgnum\n"; - - } - - #not manual and no noemail flag (here or on the customer) - } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) { - - my $queue = new FS::queue { - 'job' => 'FS::cust_bill::queueable_email', - 'paynum' => $self->paynum, - 'custnum' => $cust_main->custnum, - }; - - my %opt = ( - 'invnum' => $cust_bill->invnum, - 'no_coupon' => 1, - ); - - if ( my $mode = $conf->config('payment_receipt_statement_mode') ) { - $opt{'mode'} = $mode; - } else { - # backward compatibility, no good fix for this yet as some people may - # still have "invoice_latex_statement" and such options - $opt{'template'} = 'statement'; - $opt{'notice_name'} = 'Statement'; + $error = "payment_receipt is on, but no payment_receipt_msgnum"; } - $error = $queue->insert(%opt); - - } - - warn "send_receipt: $error\n" if $error; + return $error; } =item cust_bill_pay diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index d29c6d055..614c11753 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -302,6 +302,7 @@ sub approve { '_date' => $new->_date, 'usernum' => $new->usernum, 'batchnum' => $new->batchnum, + 'invnum' => $old->invnum, 'gatewaynum' => $opt{'gatewaynum'}, 'processor' => $opt{'processor'}, 'auth' => $opt{'auth'}, diff --git a/FS/FS/cust_payby.pm b/FS/FS/cust_payby.pm index 704741f3d..4e9f04f51 100644 --- a/FS/FS/cust_payby.pm +++ b/FS/FS/cust_payby.pm @@ -1,5 +1,6 @@ package FS::cust_payby; use base qw( FS::payinfo_Mixin FS::cust_main_Mixin FS::Record ); +use feature 'state'; use strict; use Scalar::Util qw( blessed ); @@ -315,7 +316,6 @@ sub check { #encrypted #|| $self->ut_textn('payinfo') #encrypted #|| $self->ut_textn('paycvv') # || $self->ut_textn('paymask') #XXX something - #later #|| $self->ut_textn('paydate') || $self->ut_numbern('paystart_month') || $self->ut_numbern('paystart_year') || $self->ut_numbern('payissue') @@ -546,6 +546,9 @@ sub check { return $error if $error; } + $error = $self->ut_daten('paydate'); + return $error if $error; + $self->SUPER::check; } @@ -912,8 +915,81 @@ sub search_sql { =back +=item has_autobill_cards + +Returns the number of unexpired cards configured for autobill + +=cut + +sub has_autobill_cards { + scalar FS::Record::qsearch({ + table => 'cust_payby', + addl_from => 'JOIN cust_main USING (custnum)', + order_by => 'LIMIT 1', + hashref => { + paydate => { op => '>', value => DateTime->now->ymd }, + weight => { op => '>', value => 0 }, + }, + extra_sql => + "AND cust_payby.payby IN ('CARD', 'DCRD') ". + 'AND '. + $FS::CurrentUser::CurrentUser->agentnums_sql( table => 'cust_main' ), + }); +} + +=item has_autobill_checks + +Returns the number of check accounts configured for autobill + +=cut + +sub has_autobill_checks { + scalar FS::Record::qsearch({ + table => 'cust_payby', + addl_from => 'JOIN cust_main USING (custnum)', + order_by => 'LIMIT 1', + hashref => { + weight => { op => '>', value => 0 }, + }, + extra_sql => + "AND cust_payby.payby IN ('CHEK','DCHEK','DCHK') ". + 'AND '. + $FS::CurrentUser::CurrentUser->agentnums_sql( table => 'cust_main' ), + }); +} + +=item future_autobill_report_title + +Determine if the future_autobill report should be available. +If so, return a dynamic title for it + =cut +sub future_autobill_report_title { + # Perhaps this function belongs somewhere else + state $title; + return $title if defined $title; + + # Report incompatible with tax engines + return $title = '' if FS::TaxEngine->new->info->{batch}; + + my $has_cards = has_autobill_cards(); + my $has_checks = has_autobill_checks(); + my $_title = 'Future %s transactions'; + + if ( $has_cards && $has_checks ) { + $title = sprintf $_title, 'credit card and electronic check'; + } elsif ( $has_cards ) { + $title = sprintf $_title, 'credit card'; + } elsif ( $has_checks ) { + $title = sprintf $_title, 'electronic check'; + } else { + $title = ''; + } + + $title; +} + sub _upgrade_data { my $class = shift; @@ -921,7 +997,87 @@ sub _upgrade_data { local $ignore_expired_card = 1; local $ignore_invalid_card = 1; $class->upgrade_set_cardtype; + $class->_upgrade_data_paydate_edgebug; + +} + +=item _upgrade_data_paydate_edgebug + +Correct bad data injected into payment expire date column by Edge browser bug + +The month and year values may have an extra character injected into form POST +data by Edge browser. It was possible for some bad month values to slip +past data validation. + +If the stored value was out of range, it was causing payments screen to crash. +We can detect and fix this by dropping the second digit. + +If the stored value is is 11 or 12, it's possible the user inputted a 1. In +this case, the payment method will fail to authorize, but the record will +not cause crashdumps for being out of range. + +In short, check for any expiration month > 12, and drop the extra digit + +=cut + +sub _upgrade_data_paydate_edgebug { + my $journal_label = 'cust_payby_paydate_edgebug'; + return if FS::upgrade_journal->is_done( $journal_label ); + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + for my $row ( + FS::Record::qsearch( + cust_payby => { paydate => { op => '!=', value => '' }} + ) + ) { + next unless $row->ut_daten('paydate'); + + # paydate column stored in database has failed date validation + my $bad_paydate = $row->paydate; + + my @date = split /[\-\/]/, $bad_paydate; + @date = @date[2,0,1] if $date[2] > 1900; + + # Only autocorrecting when month > 12 - notify operator + unless ( $date[1] > 12 ) { + die sprintf( + 'Unable to correct bad paydate stored in cust_payby row '. + 'custpaybynum(%s) custnum(%s) paydate(%s)', + $row->custpaybynum, + $row->custnum, + $bad_paydate, + ); + } + + $date[1] = substr( $date[1], 0, 1 ); + $row->paydate( join('-', @date )); + + if ( my $error = $row->replace ) { + die sprintf( + 'Failed to autocorrect bad paydate stored in cust_payby row '. + 'custpaybynum(%s) custnum(%s) paydate(%s) - error: %s', + $row->custpaybynum, + $row->custnum, + $bad_paydate, + $error + ); + } + + warn sprintf( + 'Autocorrected bad paydate stored in cust_payby row '. + "custpaybynum(%s) custnum(%s) old-paydate(%s) new-paydate(%s)\n", + $row->custpaybynum, + $row->custnum, + $bad_paydate, + $row->paydate, + ); + + } + FS::upgrade_journal->set_done( $journal_label ); + dbh->commit unless $oldAutoCommit; } =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index b24b3abe3..f29ab9fc0 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2487,6 +2487,12 @@ sub change { $keep_dates = 0; $hash{'last_bill'} = ''; $hash{'bill'} = ''; + + # Optionally, carry over the next bill date from the changed cust_pkg + # so an invoice isn't generated until the customer's usual billing date + if ( $self->part_pkg->option('prorate_defer_change_bill', 1) ) { + $hash{bill} = $self->bill; + } } if ( $keep_dates ) { @@ -3329,11 +3335,10 @@ sub process_bulk_cust_pkg { my $param = shift; warn Dumper($param) if $DEBUG; - my $old_part_pkg = qsearchs('part_pkg', - { pkgpart => $param->{'old_pkgpart'} }); my $new_part_pkg = qsearchs('part_pkg', { pkgpart => $param->{'new_pkgpart'} }); - die "Must select a new package type\n" unless $new_part_pkg; + die "Must select a new package definition\n" unless $new_part_pkg; + #my $keep_dates = $param->{'keep_dates'} || 0; my $keep_dates = 1; # there is no good reason to turn this off @@ -3341,7 +3346,14 @@ sub process_bulk_cust_pkg { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } ); + my @old_pkgpart = ref($param->{'old_pkgpart'}) ? @{ $param->{'old_pkgpart'} } + : $param->{'old_pkgpart'}; + + my @cust_pkgs = qsearch({ + 'table' => 'cust_pkg', + 'extra_sql' => ' WHERE pkgpart IN ('. + join(',', @old_pkgpart). ')', + }); my $i = 0; foreach my $old_cust_pkg ( @cust_pkgs ) { @@ -5451,6 +5463,24 @@ sub fcc_477_count { } +=item fcc_477_record + +Returns a fcc_477 record based on option name. + +=cut + +sub fcc_477_record { + my ($self, $option_name) = @_; + + my $fcc_record = qsearchs({ + 'table' => 'part_pkg_fcc_option', + 'hashref' => { 'pkgpart' => $self->{Hash}->{pkgpart}, 'fccoptionname' => $option_name, }, + }); + + return ( $fcc_record ); + +} + =item tax_locationnum_sql Returns an SQL expression for the tax location for a package, based diff --git a/FS/FS/cust_pkg/Import.pm b/FS/FS/cust_pkg/Import.pm index 93bd88d7b..2b1832329 100644 --- a/FS/FS/cust_pkg/Import.pm +++ b/FS/FS/cust_pkg/Import.pm @@ -102,6 +102,7 @@ my %formatfields = ( 'default' => [], 'all_dates' => [], 'svc_acct' => [qw( username _password domsvc )], + 'svc_broadband' => [qw( ip_addr description routernum blocknum sectornum speed_up speed_down )], 'svc_phone' => [qw( countrycode phonenum sip_password pin )], 'svc_external' => [qw( id title )], 'location' => [qw( address1 address2 city state zip country )], diff --git a/FS/FS/deploy_zone.pm b/FS/FS/deploy_zone.pm index efa36610c..306b4fb44 100644 --- a/FS/FS/deploy_zone.pm +++ b/FS/FS/deploy_zone.pm @@ -418,6 +418,7 @@ sub process_block_lookup { die $response->status_line unless $response->is_success; $data = decode_json($response->content); die $data->{error}{message} if $data->{error}; + last unless scalar @{$data->{features}}; #Nothing to insert foreach my $feature (@{ $data->{features} }) { my $geoid = $feature->{attributes}{GEOID}; # the prize diff --git a/FS/FS/log_context.pm b/FS/FS/log_context.pm index 387883b63..74038fc05 100644 --- a/FS/FS/log_context.pm +++ b/FS/FS/log_context.pm @@ -26,6 +26,7 @@ my @contexts = ( qw( queue upgrade upgrade_taxable_billpkgnum + freeside-ipifony-download freeside-paymentech-upload freeside-paymentech-download test diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm index 37c1fab46..c2c370760 100644 --- a/FS/FS/msg_template/email.pm +++ b/FS/FS/msg_template/email.pm @@ -529,6 +529,11 @@ sub send_prepared { my $self = shift; my $cust_msg = shift or die "cust_msg required"; + if ( $FS::Misc::DISABLE_ALL_NOTICES ) { + warn 'send_prepared() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG; + return; + } + my $domain = 'example.com'; if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) { $domain = $1; diff --git a/FS/FS/part_event/Condition.pm b/FS/FS/part_event/Condition.pm index d1d519683..9900acaa9 100644 --- a/FS/FS/part_event/Condition.pm +++ b/FS/FS/part_event/Condition.pm @@ -533,6 +533,22 @@ sub condition_sql_option_integer { " AS $integer )"; } +=item condition_sql_option_money OPTION + +As I<condition_sql_option>, but cast the option value to DECIMAL so that +comparison to other monetary values is type-correct. + +=cut + +sub condition_sql_option_money { + my ($class, $option ) = @_; + + 'CAST( + COALESCE('. $class->condition_sql_option($option). + " ,'0') ". + " AS DECIMAL(10,2) )"; +} + =head1 NEW CONDITION CLASSES A module should be added in FS/FS/part_event/Condition/ which implements the diff --git a/FS/FS/part_event/Condition/agent.pm b/FS/FS/part_event/Condition/agent.pm index bdd4e12de..917cf468b 100644 --- a/FS/FS/part_event/Condition/agent.pm +++ b/FS/FS/part_event/Condition/agent.pm @@ -13,7 +13,7 @@ sub description { sub option_fields { ( - 'agentnum' => { label=>'Agent', type=>'select-agent', }, + 'agentnum' => { label=>'Agent', type=>'select-agent', multiple => '1' }, ); } @@ -22,16 +22,15 @@ sub condition { my $cust_main = $self->cust_main($object); - my $agentnum = $self->option('agentnum'); - - $cust_main->agentnum == $agentnum; + my $hashref = $self->option('agentnum') || {}; + grep $hashref->{ $_->agentnum }, $cust_main->agent; } sub condition_sql { my( $class, $table, %opt ) = @_; - "cust_main.agentnum = " . $class->condition_sql_option_integer('agentnum', $opt{'driver_name'}); + "cust_main.agentnum IN " . $class->condition_sql_option_option_integer('agentnum', $opt{'driver_name'}); } 1; diff --git a/FS/FS/part_event/Condition/cust_birthdate.pm b/FS/FS/part_event/Condition/cust_birthdate.pm new file mode 100644 index 000000000..874e3acd0 --- /dev/null +++ b/FS/FS/part_event/Condition/cust_birthdate.pm @@ -0,0 +1,64 @@ +package FS::part_event::Condition::cust_birthdate; +use base qw( FS::part_event::Condition ); +use strict; +use warnings; +use DateTime; + +=head2 NAME + +FS::part_event::Condition::cust_birthdate + +=head1 DESCRIPTION + +Billing event triggered by the time until the customer's next +birthday (cust_main.birthdate) + +=cut + +sub description { + 'Customer birthdate occurs within the given timeframe'; +} + +sub option_fields { + ( + timeframe => { + label => 'Timeframe', + type => 'freq', + value => '1m', + } + ); +} + +sub condition { + my( $self, $object, %opt ) = @_; + my $cust_main = $self->cust_main($object); + + my $birthdate = $cust_main->birthdate || return 0; + + my %timeframe; + if ( $self->option('timeframe') =~ /(\d+)([mwdh])/ ) { + my $k = {qw|m months w weeks d days h hours|}->{$2}; + $timeframe{ $k } = $1; + } else { + die "Unparsable timeframe given: ".$self->option('timeframe'); + } + + my $ck_dt = DateTime->from_epoch( epoch => $opt{time} ); + my $bd_dt = DateTime->from_epoch( epoch => $birthdate ); + + # Find the birthday for this calendar year. If customer birthday + # has already passed this year, find the birthday for next year. + my $next_bd_dt = DateTime->new( + month => $bd_dt->month, + day => $bd_dt->day, + year => $ck_dt->year, + ); + $next_bd_dt->add( years => 1 ) + if DateTime->compare( $next_bd_dt, $ck_dt ) == -1; + + # Does next birthday occur between now and specified duration? + $ck_dt->add( %timeframe ); + DateTime->compare( $next_bd_dt, $ck_dt ) != 1 ? 1 : 0; +} + +1; diff --git a/FS/FS/part_event/Condition/cust_pay_batch_declined.pm b/FS/FS/part_event/Condition/cust_pay_batch_declined.pm index b3a8d705f..8efb27854 100644 --- a/FS/FS/part_event/Condition/cust_pay_batch_declined.pm +++ b/FS/FS/part_event/Condition/cust_pay_batch_declined.pm @@ -16,36 +16,16 @@ sub eventtable_hashref { }; } -#sub option_fields { -# ( -# 'field' => 'description', -# -# 'another_field' => { 'label'=>'Amount', 'type'=>'money', }, -# -# 'third_field' => { 'label' => 'Types', -# 'type' => 'checkbox-multiple', -# 'options' => [ 'h', 's' ], -# 'option_labels' => { 'h' => 'Happy', -# 's' => 'Sad', -# }, -# ); -#} - sub condition { my($self, $cust_pay_batch, %opt) = @_; - #my $cust_main = $self->cust_main($object); - #my $value_of_field = $self->option('field'); - #my $time = $opt{'time'}; #use this instead of time or $^T - $cust_pay_batch->status =~ /Declined/i; - } -#sub condition_sql { -# my( $class, $table ) = @_; -# #... -# 'true'; -#} +sub condition_sql { + my( $class, $table ) = @_; + + "(cust_pay_batch.status IS NOT NULL AND cust_pay_batch.status = 'Declined')"; +} 1; diff --git a/FS/FS/part_event/Condition/has_referral_custnum.pm b/FS/FS/part_event/Condition/has_referral_custnum.pm index 007ce4548..a56e3faec 100644 --- a/FS/FS/part_event/Condition/has_referral_custnum.pm +++ b/FS/FS/part_event/Condition/has_referral_custnum.pm @@ -60,19 +60,20 @@ sub condition { sub condition_sql { my( $class, $table, %opt ) = @_; + my $active_sql = FS::cust_main->active_sql; + $active_sql =~ s/cust_main.custnum/cust_main.referral_custnum/; + + my $under = $class->condition_sql_option_money('balance'); + my $age = $class->condition_sql_option_age_from('age', $opt{'time'}); - my $balance_sql = FS::cust_main->balance_sql( $age ); - my $balance_date_sql = FS::cust_main->balance_date_sql; - my $active_sql = FS::cust_main->active_sql; - $balance_sql =~ s/cust_main.custnum/cust_main.referral_custnum/; + my $balance_date_sql = FS::cust_main->balance_date_sql($age); $balance_date_sql =~ s/cust_main.custnum/cust_main.referral_custnum/; - $active_sql =~ s/cust_main.custnum/cust_main.referral_custnum/; - - my $sql = "cust_main.referral_custnum IS NOT NULL". - " AND (".$class->condition_sql_option('active')." IS NULL OR $active_sql)". - " AND ($balance_date_sql <= $balance_sql)"; + my $bal_sql = "$balance_date_sql <= $under"; - return $sql; + "cust_main.referral_custnum IS NOT NULL + AND (". $class->condition_sql_option('active'). " IS NULL OR $active_sql) + AND (". $class->condition_sql_option('check_bal'). " IS NULL OR $bal_sql ) + "; } 1; diff --git a/FS/FS/part_event/Condition/invoice_has_not_been_sent.pm b/FS/FS/part_event/Condition/invoice_has_not_been_sent.pm new file mode 100644 index 000000000..882762dfe --- /dev/null +++ b/FS/FS/part_event/Condition/invoice_has_not_been_sent.pm @@ -0,0 +1,41 @@ +package FS::part_event::Condition::invoice_has_not_been_sent; + +use strict; +use FS::Record qw( qsearchs ); +use FS::cust_bill; +use Time::Local 'timelocal'; + +use base qw( FS::part_event::Condition ); + +sub description { + 'Invoice has not been sent previously'; +} + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 1, + 'cust_pkg' => 0, + }; +} + +sub condition { + my($self, $cust_bill, %opt) = @_; + + my $event = qsearchs( { + 'table' => 'cust_event', + 'addl_from' => 'LEFT JOIN part_event USING ( eventpart )', + 'hashref' => { + 'tablenum' => $cust_bill->{Hash}->{invnum}, + 'eventtable' => 'cust_bill', + 'status' => 'done', + }, + 'order_by' => " LIMIT 1", + } ); + + return 0 if $event; + + 1; + +} + +1;
\ No newline at end of file diff --git a/FS/FS/part_event_condition_option.pm b/FS/FS/part_event_condition_option.pm index 3256dc0bd..f1d1b6a15 100644 --- a/FS/FS/part_event_condition_option.pm +++ b/FS/FS/part_event_condition_option.pm @@ -138,6 +138,39 @@ sub optionvalue { } } +use FS::upgrade_journal; +sub _upgrade_data { #class method + my ($class, %opts) = @_; + + # migrate part_event_condition_option agentnum to part_event_condition_option_option agentnum + unless ( FS::upgrade_journal->is_done('agentnum_to_hash') ) { + + foreach my $condition_option (qsearch('part_event_condition_option', { optionname => 'agentnum', })) { + my %options; + my $optionvalue = $condition_option->get("optionvalue"); + if ($optionvalue eq 'HASH' ) { next; } + elsif ($optionvalue eq '') { + foreach my $agent (qsearch('agent', {})) { + $options{$agent->agentnum} = '1'; + } + + } + else { + $options{$optionvalue} = '1'; + } + + $condition_option->optionvalue(ref(\%options)); + my $error = $condition_option->replace(\%options); + die $error if $error; + + } + + FS::upgrade_journal->set_done('agentnum_to_hash'); + + } + +} + =back =head1 SEE ALSO diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 572a1b684..1a8f43de1 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -554,15 +554,19 @@ sub default_export_machine { die "no default export hostname for export ".$self->exportnum; } -#these should probably all go away, just let the subclasses define em - =item export_insert SVC_OBJECT =cut +# Do not overload! Overload _export_insert instead + sub export_insert { my $self = shift; #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_insert() suppressed by noexport_hack" if $DEBUG; + return; + } $self->_export_insert(@_); } @@ -579,9 +583,15 @@ sub export_insert { =cut +# Do not overload! Overload _export_replace instead + sub export_replace { my $self = shift; #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_replace() suppressed by noexport_hack" if $DEBUG; + return; + } $self->_export_replace(@_); } @@ -589,9 +599,15 @@ sub export_replace { =cut +# Do not overload! Overload _export_delete instead + sub export_delete { my $self = shift; #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_delete() suppressed by noexport_hack" if $DEBUG; + return; + } $self->_export_delete(@_); } @@ -599,9 +615,15 @@ sub export_delete { =cut +# Do not overload! Overload _export_suspend instead + sub export_suspend { my $self = shift; #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_suspend() suppressed by noexport_hack" if $DEBUG; + return; + } $self->_export_suspend(@_); } @@ -609,9 +631,15 @@ sub export_suspend { =cut +# Do not overload! Overload _export_unsuspend instead + sub export_unsuspend { my $self = shift; #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_unsuspend() suppressed by noexport_hack" if $DEBUG; + return; + } $self->_export_unsuspend(@_); } diff --git a/FS/FS/part_export/a2billing.pm b/FS/FS/part_export/a2billing.pm index 15410aebf..dbbd1bef8 100644 --- a/FS/FS/part_export/a2billing.pm +++ b/FS/FS/part_export/a2billing.pm @@ -105,7 +105,7 @@ sub replace { ''; } -sub export_insert { +sub _export_insert { my $self = shift; my $svc = shift; my $cust_pkg = $svc->cust_svc->cust_pkg; @@ -290,7 +290,7 @@ sub export_insert { ''; } -sub export_delete { +sub _export_delete { my $self = shift; my $svc = shift; @@ -376,7 +376,7 @@ sub export_delete { ''; } -sub export_replace { +sub _export_replace { my $self = shift; my $new = shift; my $old = shift || $self->replace_old; @@ -421,7 +421,7 @@ sub export_replace { ''; } -sub export_suspend { +sub _export_suspend { my $self = shift; my $svc = shift; @@ -446,7 +446,7 @@ sub export_suspend { $error || ''; } -sub export_unsuspend { +sub _export_unsuspend { my $self = shift; my $svc = shift; diff --git a/FS/FS/part_export/acct_opensrs.pm b/FS/FS/part_export/acct_opensrs.pm index 51cee97a3..c131900d3 100644 --- a/FS/FS/part_export/acct_opensrs.pm +++ b/FS/FS/part_export/acct_opensrs.pm @@ -87,7 +87,7 @@ sub app { return; } -sub export_insert { +sub _export_insert { my $self = shift; my $new = shift; my $app = $self->app; @@ -134,7 +134,7 @@ sub export_insert { } } -sub export_delete { +sub _export_delete { my $self = shift; my $old = shift; my $app = $self->app; @@ -160,7 +160,7 @@ sub export_delete { } } -sub export_replace { +sub _export_replace { my $self = shift; my ($new, $old) = @_; my $app = $self->app; @@ -222,7 +222,7 @@ sub export_replace { } } -sub export_suspend { +sub _export_suspend { my $self = shift; my $svc = shift; my $unsuspend = shift || 0; @@ -243,7 +243,7 @@ sub export_suspend { return; } -sub export_unsuspend { +sub _export_unsuspend { my ($self, $svc) = @_; $self->export_suspend($svc, 1); } diff --git a/FS/FS/part_export/aradial.pm b/FS/FS/part_export/aradial.pm index c7356bf39..c5c55452c 100644 --- a/FS/FS/part_export/aradial.pm +++ b/FS/FS/part_export/aradial.pm @@ -41,7 +41,7 @@ service types, create another export instance.</p> ' ); -sub export_insert { +sub _export_insert { my ($self, $svc) = @_; my $result = $self->request_user_edit( 'Add' => 1, @@ -54,7 +54,7 @@ sub export_insert { $result; } -sub export_replace { +sub _export_replace { my ($self, $new, $old) = @_; if ($new->email ne $old->email) { return $old->export_delete || $new->export_insert; @@ -70,7 +70,7 @@ sub export_replace { ); } -sub export_suspend { +sub _export_suspend { my ($self, $svc) = @_; $self->request_user_edit( 'Modify' => 1, @@ -79,7 +79,7 @@ sub export_suspend { ); } -sub export_unsuspend { +sub _export_unsuspend { my ($self, $svc) = @_; $self->request_user_edit( 'Modify' => 1, @@ -88,7 +88,7 @@ sub export_unsuspend { ); } -sub export_delete { +sub _export_delete { my ($self, $svc) = @_; $self->request_user_edit( 'ConfirmDelete' => 1, diff --git a/FS/FS/part_export/bandwidth_com.pm b/FS/FS/part_export/bandwidth_com.pm index 6d868e640..b39bffb69 100644 --- a/FS/FS/part_export/bandwidth_com.pm +++ b/FS/FS/part_export/bandwidth_com.pm @@ -69,7 +69,7 @@ value, or a list of fixed values, for the sip_server field.</P> END ); -sub export_insert { +sub _export_insert { my($self, $svc_phone) = (shift, shift); local $SIG{__DIE__}; try { @@ -100,7 +100,7 @@ sub export_insert { }; } -sub export_replace { +sub _export_replace { my ($self, $new, $old) = @_; # we only export the IP address and the phone number, # neither of which we can change in place. @@ -111,7 +111,7 @@ sub export_replace { ''; } -sub export_delete { +sub _export_delete { my ($self, $svc_phone) = (shift, shift); local $SIG{__DIE__}; try { diff --git a/FS/FS/part_export/broadband_nas.pm b/FS/FS/part_export/broadband_nas.pm index 8c152be45..d52ccae88 100644 --- a/FS/FS/part_export/broadband_nas.pm +++ b/FS/FS/part_export/broadband_nas.pm @@ -69,7 +69,7 @@ will be applied to the attached NAS record. =cut -sub export_insert { +sub _export_insert { my $self = shift; my $svc_broadband = shift; my %hash = ( @@ -103,7 +103,7 @@ sub export_insert { return; } -sub export_delete { +sub _export_delete { my $self = shift; my $svc_broadband = shift; my $svcnum = $svc_broadband->svcnum; @@ -118,7 +118,7 @@ sub export_delete { return; } -sub export_replace { +sub _export_replace { my $self = shift; my ($new_svc, $old_svc) = (shift, shift); diff --git a/FS/FS/part_export/broadband_snmp.pm b/FS/FS/part_export/broadband_snmp.pm index 56d7816b2..8ebc716e7 100644 --- a/FS/FS/part_export/broadband_snmp.pm +++ b/FS/FS/part_export/broadband_snmp.pm @@ -62,27 +62,27 @@ svc_broadband fields may be prefixed with <b>$new_</b> and <b>$old_</b> END ); -sub export_insert { +sub _export_insert { my $self = shift; $self->export_command('insert', @_); } -sub export_delete { +sub _export_delete { my $self = shift; $self->export_command('delete', @_); } -sub export_replace { +sub _export_replace { my $self = shift; $self->export_command('replace', @_); } -sub export_suspend { +sub _export_suspend { my $self = shift; $self->export_command('suspend', @_); } -sub export_unsuspend { +sub _export_unsuspend { my $self = shift; $self->export_command('unsuspend', @_); } diff --git a/FS/FS/part_export/broadband_snmp_get.pm b/FS/FS/part_export/broadband_snmp_get.pm index 1a8661286..35dcd3154 100644 --- a/FS/FS/part_export/broadband_snmp_get.pm +++ b/FS/FS/part_export/broadband_snmp_get.pm @@ -21,6 +21,7 @@ tie my %options, 'Tie::IxHash', 'snmp_community' => { 'label'=>'Community', 'default'=>'public' }, 'snmp_timeout' => { label=>'Timeout (seconds)', 'default'=>1 }, 'snmp_oid' => { label=>'Object ID', multiple=>1 }, + 'snmp_oid_name' => { label=>'Object Name', multiple=>1 }, ; %info = ( @@ -80,6 +81,7 @@ sub snmp_results { my $vers = $self->option('snmp_version'); my $time = ($self->option('snmp_timeout') || 1) * 1000000; my @oids = split("\n", $self->option('snmp_oid')); + my @oidnames = split("\n", $self->option('snmp_oid_name')); my %connect = ( 'DestHost' => $host, 'Community' => $comm, @@ -90,7 +92,9 @@ sub snmp_results { return { 'error' => 'Error creating SNMP session' } unless $snmp; return { 'error' => $snmp->{'ErrorStr'} } if $snmp->{'ErrorStr'}; my @out; - foreach my $oid (@oids) { + for (my $i=0; $i <= $#oids; $i++) { + my $oid = $oids[$i]; + my $oidname = $oidnames[$i]; $oid = $SNMP::MIB{$oid}->{'objectID'} if $SNMP::MIB{$oid}; my @values; if ($vers eq '1') { @@ -115,6 +119,7 @@ sub snmp_results { next; } my %result = map { $_ => $SNMP::MIB{$oid}{$_} } qw( objectID label ); + $result{'name'} = $oidname; # unbless @values, for ease of JSON encoding $result{'values'} = []; foreach my $value (@values) { diff --git a/FS/FS/part_export/broadworks.pm b/FS/FS/part_export/broadworks.pm index a04a70e9b..611bd00ec 100644 --- a/FS/FS/part_export/broadworks.pm +++ b/FS/FS/part_export/broadworks.pm @@ -6,6 +6,7 @@ use strict; use Tie::IxHash; use FS::Record qw(dbh qsearch qsearchs); use Locale::SubCountry; +use Carp qw(carp); our $me = '[broadworks]'; our %client; # exportnum => client object @@ -46,7 +47,7 @@ Until then, authentication will be denied.</P> END ); -sub export_insert { +sub _export_insert { my($self, $svc_x) = (shift, shift); my $cust_main = $svc_x->cust_main; @@ -68,7 +69,7 @@ sub export_insert { ''; } -sub export_replace { +sub _export_replace { my($self, $svc_new, $svc_old) = @_; my $cust_main = $svc_new->cust_main; @@ -121,7 +122,7 @@ sub export_replace { ''; } -sub export_delete { +sub _export_delete { my ($self, $svc_x) = @_; my $cust_main = $svc_x->cust_main; @@ -162,6 +163,12 @@ sub export_delete { sub export_device_insert { my ($self, $svc_x, $device) = @_; + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_device_insert() suppressed by noexport_hack' + if $self->option('debug'); + return; + } + if ( $device->count('svcnum = ?', $svc_x->svcnum) > 1 ) { return "This service already has a device."; } @@ -181,6 +188,13 @@ sub export_device_insert { sub export_device_replace { my ($self, $svc_x, $new_device, $old_device) = @_; + + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_device_replace() suppressed by noexport_hack' + if $self->option('debug'); + return; + } + my $cust_main = $svc_x->cust_main; my $groupId = $self->groupId($cust_main); @@ -205,6 +219,12 @@ sub export_device_replace { sub export_device_delete { my ($self, $svc_x, $device) = @_; + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_device_delete() suppressed by noexport_hack' + if $self->option('debug'); + return; + } + if ( $device->isa('FS::phone_device') ) { my $error = $self->set_endpoint( $self->userId($svc_x), '' ); return $error if $error; diff --git a/FS/FS/part_export/grandstream.pm b/FS/FS/part_export/grandstream.pm index 5c6f1ed8d..981eb1969 100644 --- a/FS/FS/part_export/grandstream.pm +++ b/FS/FS/part_export/grandstream.pm @@ -7,6 +7,7 @@ use MIME::Base64; use Tie::IxHash; use IPC::Run qw(run); use FS::CGI qw(rooturl); +use Carp qw(carp); $DEBUG = 0; @@ -50,6 +51,12 @@ sub rebless { shift; } sub gs_create_config { my($self, $mac, %opt) = (@_); + if ( $FS::svc_Common::noexport_hack ) { + carp 'gs_create_config() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + eval "use Net::SCP;"; die $@ if $@; @@ -131,6 +138,12 @@ sub gs_create { sub gs_delete { my($self, $mac) = (shift, shift); + if ( $FS::svc_Common::noexport_hack ) { + carp 'gs_delete() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + $mac = sprintf('%012s', lc($mac)); ssh_cmd( user => $self->option('user'), diff --git a/FS/FS/part_export/http_status.pm b/FS/FS/part_export/http_status.pm index 5c4a8d074..3e182d347 100644 --- a/FS/FS/part_export/http_status.pm +++ b/FS/FS/part_export/http_status.pm @@ -8,6 +8,7 @@ use URI::Escape; use LWP::UserAgent; use HTTP::Request::Common; use Email::Valid; +use Carp qw(carp); tie my %options, 'Tie::IxHash', 'url' => { label => 'URL', }, @@ -53,6 +54,12 @@ sub _export_delete { '' }; sub export_getstatus { my( $self, $svc_x, $htmlref, $hashref ) = @_; + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_getstatus() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + my $url; my $urlopt = $self->option('url'); no strict 'vars'; @@ -131,6 +138,12 @@ sub export_setstatus_listdel { sub export_setstatus_listX { my( $self, $svc_x, $action, $list, $address_item ) = @_; + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_setstatus_listX() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + my $option; if ( $list =~ /^[WA]/i ) { #Whitelist/Allow $option = 'whitelist_'; @@ -182,6 +195,12 @@ sub export_setstatus_vacationdel { sub export_setstatus_vacationX { my( $self, $svc_x, $action, $hr ) = @_; + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_setstatus_vacationX() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + my $option = 'vacation_'. $action. '_url'; my $subject = uri_escape($hr->{subject}); @@ -216,5 +235,3 @@ sub export_setstatus_vacationX { } 1; - -1; diff --git a/FS/FS/part_export/ikano.pm b/FS/FS/part_export/ikano.pm index 23917bf9e..68b1a9fde 100644 --- a/FS/FS/part_export/ikano.pm +++ b/FS/FS/part_export/ikano.pm @@ -10,6 +10,7 @@ use FS::Record qw(qsearch qsearchs dbh); use FS::part_export; use FS::svc_dsl; use Data::Dumper; +use Carp qw(carp); @ISA = qw(FS::part_export); $me= '[' . __PACKAGE__ . ']'; @@ -678,7 +679,13 @@ sub _export_delete { sub export_expire { my($self, $svc_dsl, $date) = (shift, shift, shift); - + + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_expire() suppressed by noexport_hack' + if $self->option('debug'); + return; + } + return 'Invalid operation - Import Mode is enabled' if $self->import_mode; my $result = $self->valid_order($svc_dsl,'expire'); diff --git a/FS/FS/part_export/nena2.pm b/FS/FS/part_export/nena2.pm index f6a730ebc..cc4069c72 100644 --- a/FS/FS/part_export/nena2.pm +++ b/FS/FS/part_export/nena2.pm @@ -10,6 +10,7 @@ use Date::Format qw(time2str); use Parse::FixedLength; use File::Temp qw(tempfile); use vars qw(%info %options $initial_load_hack $DEBUG); +use Carp qw( carp ); my %upload_targets; @@ -396,6 +397,13 @@ sub process { my $self = shift; my $batch = shift; local $DEBUG = $self->option('debug'); + + if ( $FS::svc_Common::noexport_hack ) { + carp 'FS::part_export::nena2::process() suppressed by noexport_hack' + if $DEBUG; + return; + } + local $FS::UID::AutoCommit = 0; my $error; diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm index ac78dbca5..c6110f5ac 100644 --- a/FS/FS/part_export/netsapiens.pm +++ b/FS/FS/part_export/netsapiens.pm @@ -7,6 +7,7 @@ use Tie::IxHash; use Date::Format qw( time2str ); use Regexp::Common qw( URI ); use REST::Client; +use Carp qw(carp); $me = '[FS::part_export::netsapiens]'; @@ -392,6 +393,12 @@ sub _export_unsuspend { sub export_device_insert { my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_device_insert() suppressed by noexport_hack' + if $self->option('debug'); + return; + } + my $domain = $self->ns_domain($svc_phone); my $countrycode = $svc_phone->countrycode; my $phonenum = $svc_phone->phonenum; @@ -426,6 +433,12 @@ sub export_device_insert { sub export_device_delete { my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_device_delete() suppressed by noexport_hack' + if $self->option('debug'); + return; + } + my $ns = $self->ns_device_command( 'DELETE', $self->ns_device($svc_phone, $phone_device), ); diff --git a/FS/FS/part_export/northern_911.pm b/FS/FS/part_export/northern_911.pm index 027a52d21..679f5daf6 100644 --- a/FS/FS/part_export/northern_911.pm +++ b/FS/FS/part_export/northern_911.pm @@ -47,7 +47,7 @@ sub client { return $self->get('client'); } -sub export_insert { +sub _export_insert { my( $self, $svc_phone ) = (shift, shift); my %location_hash = $svc_phone->location_hash; @@ -98,7 +98,7 @@ sub export_insert { ''; } -sub export_replace { +sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); # except when changing the phone number, exactly like export_insert; @@ -109,7 +109,7 @@ sub export_replace { $self->export_insert($new); } -sub export_delete { +sub _export_delete { my ($self, $svc_phone) = (shift, shift); if ($self->option('debug')) { diff --git a/FS/FS/part_export/phone_shellcommands.pm b/FS/FS/part_export/phone_shellcommands.pm index 71445bf27..3f01de36b 100644 --- a/FS/FS/part_export/phone_shellcommands.pm +++ b/FS/FS/part_export/phone_shellcommands.pm @@ -5,6 +5,7 @@ use vars qw(@ISA %info); use Tie::IxHash; use String::ShellQuote; use FS::part_export; +use Carp qw(carp); @ISA = qw(FS::part_export); @@ -103,6 +104,12 @@ sub _export_command { my $command = $self->option($action); return '' if $command =~ /^\s*$/; + if ( $FS::svc_Common::noexport_hack ) { + carp "_export_command($action) suppressed by noexport_hack" + if $self->option('debug'); + return; + } + #set variable for the command no strict 'vars'; { diff --git a/FS/FS/part_export/saisei.pm b/FS/FS/part_export/saisei.pm index fc0dee5ad..6db43c11d 100644 --- a/FS/FS/part_export/saisei.pm +++ b/FS/FS/part_export/saisei.pm @@ -9,6 +9,7 @@ use MIME::Base64; use REST::Client; use Data::Dumper; use FS::Conf; +use Carp qw(carp); =pod @@ -24,29 +25,52 @@ Saisei integration for Freeside This export offers basic svc_broadband provisioning for Saisei. -This is a customer integration with Saisei. This will setup a rate plan and tie -the rate plan to a host via the Saisei API when the broadband service is provisioned. -It will also untie the rate plan via the API upon unprovisioning of the broadband service. +This is a customer integration with Saisei. This will set up a rate plan and tie +the rate plan to a host and the access point via the Saisei API when the broadband service is provisioned. +It will also untie the host from the rate plan, setting it to the default rate plan via the API upon unprovisioning of the broadband service. -This export will use the broadband service descriptive label for the Saisei rate plan name and -will use the email from the first contact for the Saisei username that will be -attached to this rate plan. It will use the Saisei default Access Point. +This will create and modify the rate plans at Saisei as soon as the broadband service attached to this export is created or modified. +This will also create and modify an access point at Saisei as soon as the tower is created or modified. -Hostname or IP - Host name to Saisei API -Port - <I>Port number to Saisei API -User Name - <I>Saisei API user name -Password - <I>Saisei API password +To use this export, follow the below instructions: + +Create a new service definition and set the table to svc_broadband. The service name will become the Saisei rate plan name. +Set the upload and download speed for the service. This is required to be able to export the service to Saisei. +Attach this Saisei export to this service. + +Create a tower and add a sector to that tower. The sector name will be the name of the access point, +Make sure you have set the up and down rate limit for the tower and the sector. This is required to be able to export the access point. +The tower and sector will be set up as access points at Saisei upon the creation of the tower or sector. They will be modified at Saisei when modified in freeside. +Each sector will be attached to its tower access point using the Saisei uplink field. + +Create a package for the above created service, and order this package for a customer. + +Provision the service, making sure to enter the IP address associated with this service and select the tower and sector for it's access point. +This provisioned service will then be exported as a host to Saisei. + +Unprovisioning this service will set the host entry at Saisei to the default rate plan with the user and access point set to <none>. + +After this export is set up and attached to a service, you can export the already provisioned services by clicking the link Export provisioned services attached to this export. +Clicking on this link will export all services attached to this export not currently exported to Saisei. This module also provides generic methods for working through the L</Saisei API>. =cut +tie my %scripts, 'Tie::IxHash', + 'export_provisioned_services' => { component => '/elements/popup_link.html', + label => 'Export provisioned services', + description => 'will export provisioned services of part service with Saisei export attached.', + html_label => '<b>Export provisioned services attached to this export.</b>', + }, +; + tie my %options, 'Tie::IxHash', 'port' => { label => 'Port', default => 5000 }, - 'username' => { label => 'User Name', + 'username' => { label => 'Saisei API User Name', default => '' }, - 'password' => { label => 'Password', + 'password' => { label => 'Saisei API Password', default => '' }, 'debug' => { type => 'checkbox', label => 'Enable debug warnings' }, @@ -56,37 +80,56 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_broadband', 'desc' => 'Export broadband service/account to Saisei', 'options' => \%options, + 'scripts' => \%scripts, 'notes' => <<'END', -This is a customer integration with Saisei. This will setup a rate plan and tie -the rate plan to a host via the Saisei API when the broadband service is provisioned. -It will also untie the rate plan via the API upon unprovisioning of the broadband service. -<P>This export will use the broadband service descriptive label for the Saisei rate plan name and -will use the email from the first contact for the Saisei username that will be -attached to this rate plan. It will use the Saisei default Access Point. +This is a customer integration with Saisei. This will set up a rate plan and tie +the rate plan to a host and the access point via the Saisei API when the broadband service is provisioned. +It will also untie the host from the rate plan, setting it to the default rate plan via the API upon unprovisioning of the broadband service. +<P> +This will create and modify the rate plans at Saisei as soon as the broadband service attached to this export is created or modified. +This will also create and modify an access point at Saisei as soon as the tower is created or modified. +<P> +To use this export, follow the below instructions: +<P> +<OL> +<LI> +Create a new service definition and set the table to svc_broadband. The service name will become the Saisei rate plan name. +Set the upload and download speed for the service. This is required to be able to export the service to Saisei. +Attach this Saisei export to this service. +</LI> <P> -Required Fields: -<UL> -<LI>Hostname or IP - <I>Host name to Saisei API</I></LI> -<LI>Port - <I>Port number to Saisei API</I></LI> -<LI>User Name - <I>Saisei API user name</I></LI> -<LI>Password - <I>Saisei API password</I></LI> -</UL> +<LI> +Create a tower and add a sector to that tower. The sector name will be the name of the access point, +Make sure you have set the up and down rate limit for the tower and the sector. This is required to be able to export the access point. +The tower and sector will be set up as access points at Saisei upon the creation of the tower or sector. They will be modified at Saisei when modified in freeside. +Each sector will be attached to its tower access point using the Saisei uplink field. +</LI> +<P> +<LI> +Create a package for the above created service, and order this package for a customer. +</LI> +<P> +<LI> +Provision the service, making sure to enter the IP address associated with this service and select the tower and sector for it's access point. +This provisioned service will then be exported as a host to Saisei. +<P> +Unprovisioning this service will set the host entry at Saisei to the default rate plan with the user and access point set to <i>none</i>. +</LI> +<P> +<LI> +After this export is set up and attached to a service, you can export the already provisioned services by clicking the link <b>Export provisioned services attached to this export</b>. +Clicking on this link will export all services attached to this export not currently exported to Saisei. +</LI> +</OL> +<P> + END ); sub _export_insert { my ($self, $svc_broadband) = @_; - my $rateplan_name = $svc_broadband->{Hash}->{description}; - $rateplan_name =~ s/\s/_/g; - - - # load needed info from our end - my $cust_main = $svc_broadband->cust_main; - return "Could not load service customer" unless $cust_main; - my $conf = new FS::Conf; - # get policy list - my $policies = $self->api_get_policies(); + my $rateplan_name = $self->get_rateplan_name($svc_broadband); # check for existing rate plan my $existing_rateplan; @@ -94,24 +137,18 @@ sub _export_insert { # if no existing rate plan create one and modify it. $self->api_create_rateplan($svc_broadband, $rateplan_name) unless $existing_rateplan; - $self->api_modify_rateplan($policies->{collection}, $svc_broadband, $rateplan_name) unless ($self->{'__saisei_error'} || $existing_rateplan); + $self->api_modify_rateplan($svc_broadband, $rateplan_name) unless ($self->{'__saisei_error'} || $existing_rateplan); + return $self->api_error if $self->{'__saisei_error'}; # set rateplan to existing one or newly created one. my $rateplan = $existing_rateplan ? $existing_rateplan : $self->api_get_rateplan($rateplan_name); - my @email = map { $_->emailaddress } FS::Record::qsearch({ - 'table' => 'cust_contact', - 'select' => 'emailaddress', - 'addl_from' => ' JOIN contact_email USING (contactnum)', - 'hashref' => { 'custnum' => $cust_main->{Hash}->{custnum}, }, - }); - my $username = $email[0]; - my $description = $cust_main->{Hash}->{first}." ".$cust_main->{Hash}->{last}; + my $username = $svc_broadband->{Hash}->{svcnum}; + my $description = $svc_broadband->{Hash}->{description}; if (!$username) { $self->{'__saisei_error'} = 'no username - can not export'; - warn "No email found $username\n" if $self->option('debug'); - return; + return $self->api_error; } else { # check for existing user. @@ -120,59 +157,223 @@ sub _export_insert { # if no existing user create one. $self->api_create_user($username, $description) unless $existing_user; + return $self->api_error if $self->{'__saisei_error'}; # set user to existing one or newly created one. my $user = $existing_user ? $existing_user : $self->api_get_user($username); - ## add access point ? - - ## tie host to user - $self->api_add_host_to_user($user->{collection}->[0]->{name}, $rateplan->{collection}->[0]->{name}, $svc_broadband->{Hash}->{ip_addr}) unless $self->{'__saisei_error'}; + ## add access point + my $tower_sector = FS::Record::qsearchs({ + 'table' => 'tower_sector', + 'select' => 'tower.towername, + tower.up_rate_limit as tower_upratelimit, + tower.down_rate_limit as tower_downratelimit, + tower_sector.sectorname, + tower_sector.up_rate_limit as sector_upratelimit, + tower_sector.down_rate_limit as sector_downratelimit ', + 'addl_from' => 'LEFT JOIN tower USING ( towernum )', + 'hashref' => { + 'sectornum' => $svc_broadband->{Hash}->{sectornum}, + }, + }); + + my $tower_name = $tower_sector->{Hash}->{towername}; + $tower_name =~ s/\s/_/g; + + my $tower_opt = { + 'tower_name' => $tower_name, + 'tower_uprate_limit' => $tower_sector->{Hash}->{tower_upratelimit}, + 'tower_downrate_limit' => $tower_sector->{Hash}->{tower_downratelimit}, + }; + + my $tower_ap = process_tower($self, $tower_opt); + return $self->api_error if $self->{'__saisei_error'}; + + my $sector_name = $tower_sector->{Hash}->{sectorname}; + $sector_name =~ s/\s/_/g; + + my $sector_opt = { + 'tower_name' => $tower_name, + 'sector_name' => $sector_name, + 'sector_uprate_limit' => $tower_sector->{Hash}->{sector_upratelimit}, + 'sector_downrate_limit' => $tower_sector->{Hash}->{sector_downratelimit}, + }; + my $accesspoint = process_sector($self, $sector_opt); + return $self->api_error if $self->{'__saisei_error'}; + +## get custnum and pkgpart from cust_pkg for virtual access point + my $cust_pkg = FS::Record::qsearchs({ + 'table' => 'cust_pkg', + 'hashref' => { 'pkgnum' => $svc_broadband->{Hash}->{pkgnum}, }, + }); + my $virtual_ap_name = $cust_pkg->{Hash}->{custnum}.'_'.$cust_pkg->{Hash}->{pkgpart}.'_'.$svc_broadband->{Hash}->{speed_down}.'_'.$svc_broadband->{Hash}->{speed_up}; + + my $virtual_ap_opt = { + 'virtual_name' => $virtual_ap_name, + 'sector_name' => $sector_name, + 'virtual_uprate_limit' => $svc_broadband->{Hash}->{speed_up}, + 'virtual_downrate_limit' => $svc_broadband->{Hash}->{speed_down}, + }; + my $virtual_ap = process_virtual_ap($self, $virtual_ap_opt); + return $self->api_error if $self->{'__saisei_error'}; + + ## tie host to user add sector name as access point. + $self->api_add_host_to_user( + $user->{collection}->[0]->{name}, + $rateplan->{collection}->[0]->{name}, + $svc_broadband->{Hash}->{ip_addr}, + $virtual_ap->{collection}->[0]->{name}, + ) unless $self->{'__saisei_error'}; } - return ''; + return $self->api_error; } sub _export_replace { - my ($self, $svc_phone) = @_; - return ''; + my ($self, $svc_broadband) = @_; + my $error = $self->_export_insert($svc_broadband); + return $error; } sub _export_delete { my ($self, $svc_broadband) = @_; - my $cust_main = $svc_broadband->cust_main; - return "Could not load service customer" unless $cust_main; - my $conf = new FS::Conf; + my $rateplan_name = $self->get_rateplan_name($svc_broadband); - my $rateplan_name = $svc_broadband->{Hash}->{description}; - $rateplan_name =~ s/\s/_/g; + my $username = $svc_broadband->{Hash}->{svcnum}; - my @email = map { $_->emailaddress } FS::Record::qsearch({ - 'table' => 'cust_contact', - 'select' => 'emailaddress', - 'addl_from' => ' JOIN contact_email USING (contactnum)', - 'hashref' => { 'custnum' => $cust_main->{Hash}->{custnum}, }, - }); - my $username = $email[0]; - - ## tie host to user + ## untie host to user $self->api_delete_host_to_user($username, $rateplan_name, $svc_broadband->{Hash}->{ip_addr}) unless $self->{'__saisei_error'}; return ''; } sub _export_suspend { - my ($self, $svc_phone) = @_; + my ($self, $svc_broadband) = @_; return ''; } sub _export_unsuspend { - my ($self, $svc_phone) = @_; + my ($self, $svc_broadband) = @_; return ''; } +sub export_partsvc { + my ($self, $svc_part) = @_; + + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_partsvc() suppressed by noexport_hack' + if $self->option('debug'); + return; + } + + my $fcc_477_speeds; + if ($svc_part->{Hash}->{svc_broadband__speed_down} eq "down" || $svc_part->{Hash}->{svc_broadband__speed_up} eq "up") { + for my $type (qw( down up )) { + my $speed_type = "broadband_".$type."stream"; + foreach my $pkg_svc (FS::Record::qsearch({ + 'table' => 'pkg_svc', + 'select' => 'pkg_svc.*, part_pkg_fcc_option.fccoptionname, part_pkg_fcc_option.optionvalue', + 'addl_from' => ' LEFT JOIN part_pkg_fcc_option USING (pkgpart) ', + 'extra_sql' => " WHERE pkg_svc.svcpart = ".$svc_part->{Hash}->{svcpart}." AND pkg_svc.quantity > 0 AND part_pkg_fcc_option.fccoptionname = '".$speed_type."'", + })) { $fcc_477_speeds->{ + $pkg_svc->{Hash}->{pkgpart}}->{$speed_type} = $pkg_svc->{Hash}->{optionvalue} * 1000 unless !$pkg_svc->{Hash}->{optionvalue}; } + } + } + else { + $fcc_477_speeds->{1}->{broadband_downstream} = $svc_part->{Hash}->{"svc_broadband__speed_down"}; + $fcc_477_speeds->{1}->{broadband_upstream} = $svc_part->{Hash}->{"svc_broadband__speed_up"}; + } + + foreach my $key (keys %$fcc_477_speeds) { + + $svc_part->{Hash}->{speed_down} = $fcc_477_speeds->{$key}->{broadband_downstream}; + $svc_part->{Hash}->{speed_up} = $fcc_477_speeds->{$key}->{broadband_upstream}; + $svc_part->{Hash}->{svc_broadband__speed_down} = $fcc_477_speeds->{$key}->{broadband_downstream}; + $svc_part->{Hash}->{svc_broadband__speed_up} = $fcc_477_speeds->{$key}->{broadband_upstream}; + + my $temp_svc = $svc_part->{Hash}; + my $svc_broadband = {}; + map { if ($_ =~ /^svc_broadband__(.*)$/) { $svc_broadband->{Hash}->{$1} = $temp_svc->{$_}; } } keys %$temp_svc; + + my $rateplan_name = $self->get_rateplan_name($svc_broadband, $svc_part->{Hash}->{svc}); + + # check for existing rate plan + my $existing_rateplan; + $existing_rateplan = $self->api_get_rateplan($rateplan_name) unless $self->{'__saisei_error'}; + + # Modify the existing rate plan with new service data. + $self->api_modify_existing_rateplan($svc_broadband, $rateplan_name) unless ($self->{'__saisei_error'} || !$existing_rateplan); + + # if no existing rate plan create one and modify it. + $self->api_create_rateplan($svc_broadband, $rateplan_name) unless $existing_rateplan; + $self->api_modify_rateplan($svc_part, $rateplan_name) unless ($self->{'__saisei_error'} || $existing_rateplan); + + } + + return $self->api_error; + +} + +sub export_tower_sector { + my ($self, $tower) = @_; + + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_tower_sector() suppressed by noexport_hack' + if $self->option('debug'); + return; + } + + #modify tower or create it. + my $tower_name = $tower->{Hash}->{towername}; + $tower_name =~ s/\s/_/g; + my $tower_opt = { + 'tower_name' => $tower_name, + 'tower_uprate_limit' => $tower->{Hash}->{up_rate_limit}, + 'tower_downrate_limit' => $tower->{Hash}->{down_rate_limit}, + 'modify_existing' => '1', # modify an existing access point with this info + }; + + my $tower_access_point = process_tower($self, $tower_opt); + + #get list of all access points + my $hash_opt = { + 'table' => 'tower_sector', + 'select' => '*', + 'hashref' => { 'towernum' => $tower->{Hash}->{towernum}, }, + }; + + #for each one modify or create it. + foreach my $tower_sector ( FS::Record::qsearch($hash_opt) ) { + my $sector_name = $tower_sector->{Hash}->{sectorname}; + $sector_name =~ s/\s/_/g; + my $sector_opt = { + 'tower_name' => $tower_name, + 'sector_name' => $sector_name, + 'sector_uprate_limit' => $tower_sector->{Hash}->{up_rate_limit}, + 'sector_downrate_limit' => $tower_sector->{Hash}->{down_rate_limit}, + 'modify_existing' => '1', # modify an existing access point with this info + }; + my $sector_access_point = process_sector($self, $sector_opt); + } + + return $self->api_error; +} + +## creates the rateplan name +sub get_rateplan_name { + my ($self, $svc_broadband, $svc_name) = @_; + + my $service_part = FS::Record::qsearchs( 'part_svc', { 'svcpart' => $svc_broadband->{Hash}->{svcpart} } ) unless $svc_name; + my $service_name = $svc_name ? $svc_name : $service_part->{Hash}->{svc}; + + my $rateplan_name = $service_name . " " . $svc_broadband->{Hash}->{speed_down} . "-" . $svc_broadband->{Hash}->{speed_up}; + $rateplan_name =~ s/\s/_/g; + + return $rateplan_name; +} + =head1 Saisei API These methods allow access to the Saisei API using the credentials @@ -191,6 +392,7 @@ Returns empty on failure; retrieve error messages using L</api_error>. sub api_call { my ($self,$method,$path,$params) = @_; + $self->{'__saisei_error'} = ''; my $auth_info = $self->option('username') . ':' . $self->option('password'); $params ||= {}; @@ -218,7 +420,8 @@ sub api_call { } } else { - $self->{'__saisei_error'} = "Bad response from server during $method: " . $client->responseContent(); + $self->{'__saisei_error'} = "Bad response from server during $method: " . $client->responseContent() + unless ($method eq "GET"); warn "Response Content is\n".$client->responseContent."\n" if $self->option('debug'); return; } @@ -229,7 +432,7 @@ sub api_call { =head2 api_error -Returns the error string set by L</PortaOne API> methods, +Returns the error string set by L</Saisei API> methods, or a blank string if most recent call produced no errors. =cut @@ -253,7 +456,7 @@ sub api_get_policies { $self->{'__saisei_error'} = "Did not receive any global policies" unless $get_policies; - return $get_policies; + return $get_policies->{collection}; } =head2 api_get_rateplan @@ -268,8 +471,6 @@ sub api_get_rateplan { my $get_rateplan = $self->api_call("GET", "/rate_plans/$rateplan"); return if $self->api_error; - $self->{'__saisei_error'} = "Did not receive any rateplan info" - unless $get_rateplan; return $get_rateplan; } @@ -286,8 +487,6 @@ sub api_get_user { my $get_user = $self->api_call("GET", "/users/$user"); return if $self->api_error; - $self->{'__saisei_error'} = "Did not receive any user info" - unless $get_user; return $get_user; } @@ -300,14 +499,29 @@ Gets user info for specific access point. sub api_get_accesspoint { my $self = shift; - my $accesspoint; + my $accesspoint = shift; my $get_accesspoint = $self->api_call("GET", "/access_points/$accesspoint"); return if $self->api_error; - $self->{'__saisei_error'} = "Did not receive any user info" - unless $get_accesspoint; - return; + return $get_accesspoint; +} + +=head2 api_get_host + +Gets user info for specific host. + +=cut + +sub api_get_host { + my $self = shift; + my $ip = shift; + + my $get_host = $self->api_call("GET", "/hosts/$ip"); + + return if $self->api_error; + + return $get_host; } =head2 api_create_rateplan @@ -319,6 +533,9 @@ Creates a rateplan. sub api_create_rateplan { my ($self, $svc, $rateplan) = @_; + $self->{'__saisei_error'} = "No downrate listed for service $rateplan" if !$svc->{Hash}->{speed_down}; + $self->{'__saisei_error'} = "No uprate listed for service $rateplan" if !$svc->{Hash}->{speed_up}; + my $new_rateplan = $self->api_call( "PUT", "/rate_plans/$rateplan", @@ -326,22 +543,26 @@ sub api_create_rateplan { 'downstream_rate' => $svc->{Hash}->{speed_down}, 'upstream_rate' => $svc->{Hash}->{speed_up}, }, - ); + ) unless $self->{'__saisei_error'}; $self->{'__saisei_error'} = "Rate Plan not created" - unless $new_rateplan; # should never happen + unless ($new_rateplan || $self->{'__saisei_error'}); + return $new_rateplan; } =head2 api_modify_rateplan -Modify a rateplan. +Modify a new rateplan. =cut sub api_modify_rateplan { - my ($self,$policies,$svc,$rateplan_name) = @_; + my ($self,$svc,$rateplan_name) = @_; + + # get policy list + my $policies = $self->api_get_policies(); foreach my $policy (@$policies) { my $policyname = $policy->{name}; @@ -357,8 +578,8 @@ sub api_modify_rateplan { }, ); - $self->{'__saisei_error'} = "Rate Plan not modified" - unless $modified_rateplan; # should never happen + $self->{'__saisei_error'} = "Rate Plan not modified after create" + unless ($modified_rateplan || $self->{'__saisei_error'}); # should never happen } @@ -366,6 +587,31 @@ sub api_modify_rateplan { } +=head2 api_modify_existing_rateplan + +Modify a existing rateplan. + +=cut + +sub api_modify_existing_rateplan { + my ($self,$svc,$rateplan_name) = @_; + + my $modified_rateplan = $self->api_call( + "PUT", + "/rate_plans/$rateplan_name", + { + 'downstream_rate' => $svc->{Hash}->{speed_down}, + 'upstream_rate' => $svc->{Hash}->{speed_up}, + }, + ); + + $self->{'__saisei_error'} = "Rate Plan not modified" + unless ($modified_rateplan || $self->{'__saisei_error'}); # should never happen + + return; + +} + =head2 api_create_user Creates a user. @@ -384,7 +630,7 @@ sub api_create_user { ); $self->{'__saisei_error'} = "User not created" - unless $new_user; # should never happen + unless ($new_user || $self->{'__saisei_error'}); # should never happen return $new_user; @@ -397,19 +643,70 @@ Creates a access point. =cut sub api_create_accesspoint { - my ($self,$accesspoint) = @_; + my ($self,$accesspoint, $upratelimit, $downratelimit) = @_; # this has not been tested, but should work, if needed. - #my $new_accesspoint = $self->api_call( - # "PUT", - # "/access_points/$accesspoint", - # { - # 'description' => 'my description', - # }, - #); - - #$self->{'__saisei_error'} = "Access point not created" - # unless $new_accesspoint; # should never happen + my $new_accesspoint = $self->api_call( + "PUT", + "/access_points/$accesspoint", + { + 'downstream_rate_limit' => $downratelimit, + 'upstream_rate_limit' => $upratelimit, + }, + ); + + $self->{'__saisei_error'} = "Access point not created" + unless ($new_accesspoint || $self->{'__saisei_error'}); # should never happen + return; + +} + +=head2 api_modify_accesspoint + +Modify a new access point. + +=cut + +sub api_modify_accesspoint { + my ($self, $accesspoint, $uplink) = @_; + + my $modified_accesspoint = $self->api_call( + "PUT", + "/access_points/$accesspoint", + { + 'uplink' => $uplink, # name of attached access point + }, + ); + + $self->{'__saisei_error'} = "Rate Plan not modified" + unless ($modified_accesspoint || $self->{'__saisei_error'}); # should never happen + + return; + +} + +=head2 api_modify_existing_accesspoint + +Modify a existing accesspoint. + +=cut + +sub api_modify_existing_accesspoint { + my ($self, $accesspoint, $uplink, $upratelimit, $downratelimit) = @_; + + my $modified_accesspoint = $self->api_call( + "PUT", + "/access_points/$accesspoint", + { + 'downstream_rate_limit' => $downratelimit, + 'upstream_rate_limit' => $upratelimit, +# 'uplink' => $uplink, # name of attached access point + }, + ); + + $self->{'__saisei_error'} = "Access point not modified" + unless ($modified_accesspoint || $self->{'__saisei_error'}); # should never happen + return; } @@ -421,7 +718,7 @@ ties host to user, rateplan and default access point. =cut sub api_add_host_to_user { - my ($self,$user, $rateplan, $ip) = @_; + my ($self,$user, $rateplan, $ip, $accesspoint) = @_; my $new_host = $self->api_call( "PUT", @@ -429,11 +726,12 @@ sub api_add_host_to_user { { 'user' => $user, 'rate_plan' => $rateplan, + 'access_point' => $accesspoint, }, ); $self->{'__saisei_error'} = "Host not created" - unless $new_host; # should never happen + unless ($new_host || $self->{'__saisei_error'}); # should never happen return $new_host; @@ -441,7 +739,8 @@ sub api_add_host_to_user { =head2 api_delete_host_to_user -unties host to user and rateplan. +unties host from user and rateplan. +this will set the host entry at Saisei to the default rate plan with the user and access point set to <none>. =cut @@ -466,12 +765,152 @@ sub api_delete_host_to_user { ); $self->{'__saisei_error'} = "Host not created" - unless $delete_host; # should never happen + unless ($delete_host || $self->{'__saisei_error'}); # should never happen return $delete_host; } +sub process_tower { + my ($self, $opt) = @_; + + my $existing_tower_ap; + my $tower_name = $opt->{tower_name}; + + #check if tower has been set up as an access point. + $existing_tower_ap = $self->api_get_accesspoint($tower_name) unless $self->{'__saisei_error'}; + + # modify the existing accesspoint if changing tower . + $self->api_modify_existing_accesspoint ( + $tower_name, + '', # tower does not have a uplink on sectors. + $opt->{tower_uprate_limit}, + $opt->{tower_downrate_limit}, + ) if $existing_tower_ap && $opt->{modify_existing}; + + #if tower does not exist as an access point create it. + $self->api_create_accesspoint( + $tower_name, + $opt->{tower_uprate_limit}, + $opt->{tower_downrate_limit} + ) unless $existing_tower_ap; + + my $accesspoint = $self->api_get_accesspoint($tower_name); + + return $accesspoint; +} + +sub process_sector { + my ($self, $opt) = @_; + + my $existing_sector_ap; + my $sector_name = $opt->{sector_name}; + + #check if sector has been set up as an access point. + $existing_sector_ap = $self->api_get_accesspoint($sector_name); + + # modify the existing accesspoint if changing sector . + $self->api_modify_existing_accesspoint ( + $sector_name, + $opt->{tower_name}, + $opt->{sector_uprate_limit}, + $opt->{sector_downrate_limit}, + ) if $existing_sector_ap && $opt->{modify_existing}; + + #if sector does not exist as an access point create it. + $self->api_create_accesspoint( + $sector_name, + $opt->{sector_uprate_limit}, + $opt->{sector_downrate_limit}, + ) unless $existing_sector_ap; + + # Attach newly created sector to it's tower. + $self->api_modify_accesspoint($sector_name, $opt->{tower_name}) unless ($self->{'__saisei_error'} || $existing_sector_ap); + + # set access point to existing one or newly created one. + my $accesspoint = $existing_sector_ap ? $existing_sector_ap : $self->api_get_accesspoint($sector_name); + + return $accesspoint; +} + +sub process_virtual_ap { + my ($self, $opt) = @_; + + my $existing_virtual_ap; + my $virtual_name = $opt->{virtual_name}; + + #check if sector has been set up as an access point. + $existing_virtual_ap = $self->api_get_accesspoint($virtual_name); + + # modify the existing virtual accesspoint if changing it. this should never happen + $self->api_modify_existing_accesspoint ( + $virtual_name, + $opt->{sector_name}, + $opt->{virtual_uprate_limit}, + $opt->{virtual_downrate_limit}, + ) if $existing_virtual_ap && $opt->{modify_existing}; + + #if virtual ap does not exist as an access point create it. + $self->api_create_accesspoint( + $virtual_name, + $opt->{virtual_uprate_limit}, + $opt->{virtual_downrate_limit}, + ) unless $existing_virtual_ap; + +my $update_sector; +if ($existing_virtual_ap && ($existing_virtual_ap->{collection}->[0]->{uplink}->{link}->{name} ne $opt->{sector_name})) { + $update_sector = 1; +} + + # Attach newly created virtual ap to tower sector ap or if sector has changed. + $self->api_modify_accesspoint($virtual_name, $opt->{sector_name}) unless ($self->{'__saisei_error'} || ($existing_virtual_ap && !$update_sector)); + + # set access point to existing one or newly created one. + my $accesspoint = $existing_virtual_ap ? $existing_virtual_ap : $self->api_get_accesspoint($virtual_name); + + return $accesspoint; +} + +sub export_provisioned_services { + my $job = shift; + my $param = shift; + + my $part_export = FS::Record::qsearchs('part_export', { 'exportnum' => $param->{export_provisioned_services_exportnum}, } ) + or die "unknown exportnum $param->{export_provisioned_services_exportnum}"; + bless $part_export; + + my @svcparts = FS::Record::qsearch({ + 'table' => 'export_svc', + 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart ) ', + 'hashref' => { 'exportnum' => $param->{export_provisioned_services_exportnum}, }, + }); + my $part_count = scalar @svcparts; + + my $parts = join "', '", map { $_->{Hash}->{svcpart} } @svcparts; + + my @svcs = FS::Record::qsearch({ + 'table' => 'cust_svc', + 'addl_from' => 'LEFT JOIN svc_broadband USING ( svcnum ) ', + 'extra_sql' => " WHERE svcpart in ('".$parts."')", + }) unless !$parts; + + my $svc_count = scalar @svcs; + + my %status = {}; + for (my $c=1; $c <=100; $c=$c+1) { $status{int($svc_count * ($c/100))} = $c; } + + my $process_count=0; + foreach my $svc (@svcs) { + if ($status{$process_count}) { my $s = $status{$process_count}; $job->update_statustext($s); } + ## check if service exists as host if not export it. + _export_insert($part_export,$svc) unless api_get_host($part_export, $svc->{Hash}->{ip_addr}); + $process_count++; + } + + return; + +} + =head1 SEE ALSO L<FS::part_export> diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 09fa71b94..7099ca8ac 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -7,6 +7,7 @@ use String::ShellQuote; use Net::OpenSSH; use FS::part_export; use FS::Record qw( qsearch qsearchs ); +use Carp qw(carp); @ISA = qw(FS::part_export); @@ -267,6 +268,12 @@ sub _export_unsuspend { sub export_pkg_change { my( $self, $svc_acct, $new_cust_pkg, $old_cust_pkg ) = @_; + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_pkg_change() suppressed by noexport_hack' + if $self->option('debug'); + return; + } + my @fields = qw( pkgnum pkgpart agent_pkgid ); #others? my @date_fields = qw( order_date start_date setup bill last_bill susp adjourn resume cancel uncancel expire contract_end ); @@ -291,6 +298,13 @@ sub export_pkg_change { sub _export_command_or_super { my($self, $action) = (shift, shift); + + if ( $FS::svc_Common::noexport_hack ) { + carp "_export_command_or_super($action) suppressed by noexport_hack" + if $self->option('debug'); + return; + } + if ( $self->option($action) =~ /^\s*$/ ) { my $method = "SUPER::_export_$action"; $self->$method(@_); @@ -303,6 +317,12 @@ sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); + if ( $FS::svc_Common::noexport_hack ) { + carp "_export_command($action) suppressed by noexport_hack" + if $self->option('debug'); + return; + } + return '' if $command =~ /^\s*$/; my $stdin = $self->option($action."_stdin"); diff --git a/FS/FS/part_export/sipwise.pm b/FS/FS/part_export/sipwise.pm index 9d4e3366e..287e604bd 100644 --- a/FS/FS/part_export/sipwise.pm +++ b/FS/FS/part_export/sipwise.pm @@ -14,6 +14,7 @@ use FS::Misc::DateTime qw(parse_datetime); use DateTime; use Number::Phone; use Try::Tiny; +use Carp qw(carp); our $me = '[sipwise]'; our $DEBUG = 0; @@ -67,7 +68,7 @@ our %info = ( END ); -sub export_insert { +sub _export_insert { my($self, $svc_x) = (shift, shift); local $SIG{__DIE__}; @@ -88,7 +89,7 @@ sub export_insert { ''; } -sub export_replace { +sub _export_replace { my ($self, $svc_new, $svc_old) = @_; local $SIG{__DIE__}; @@ -110,7 +111,7 @@ sub export_replace { ''; } -sub export_delete { +sub _export_delete { my ($self, $svc_x) = (shift, shift); local $SIG{__DIE__}; @@ -135,7 +136,7 @@ sub export_delete { # logic to set subscribers to locked/active is in replace_subscriber -sub export_suspend { +sub _export_suspend { my $self = shift; my $svc_x = shift; my $role = $self->svc_role($svc_x); @@ -148,7 +149,7 @@ sub export_suspend { ''; } -sub export_unsuspend { +sub _export_unsuspend { my $self = shift; my $svc_x = shift; my $role = $self->svc_role($svc_x); @@ -295,6 +296,13 @@ previously, and the one it's linked to now. sub export_did { my $self = shift; my ($new, $old) = @_; + + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_did() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + if ( $old and $new->forward_svcnum ne $old->forward_svcnum ) { my $old_svc_acct = $self->acct_for_did($old); $self->replace_subscriber( $old_svc_acct ) if $old_svc_acct; diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 9e65e51a6..926e36fdb 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -8,7 +8,7 @@ use FS::Record qw( dbh qsearch qsearchs str2time_sql str2time_sql_closing ); use FS::part_export; use FS::svc_acct; use FS::export_svc; -use Carp qw( cluck ); +use Carp qw( carp cluck ); use NEXT; use Net::OpenSSH; @@ -489,6 +489,12 @@ sub suspended_usergroups { } sub sqlradius_insert { #subroutine, not method + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_insert() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my( $table, $username, %attributes ) = @_; @@ -527,6 +533,12 @@ sub sqlradius_insert { #subroutine, not method } sub sqlradius_usergroup_insert { #subroutine, not method + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_usergroup_insert() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my $username = shift; my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; @@ -565,6 +577,12 @@ sub sqlradius_usergroup_insert { #subroutine, not method } sub sqlradius_usergroup_delete { #subroutine, not method + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_usergroup_delete() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my $username = shift; my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; @@ -582,6 +600,12 @@ sub sqlradius_usergroup_delete { #subroutine, not method } sub sqlradius_rename { #subroutine, not method + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_rename() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my($new_username, $old_username) = (shift, shift); my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; @@ -595,6 +619,12 @@ sub sqlradius_rename { #subroutine, not method } sub sqlradius_attrib_delete { #subroutine, not method + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_attrib_delete() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my( $table, $username, @attrib ) = @_; @@ -609,6 +639,12 @@ sub sqlradius_attrib_delete { #subroutine, not method } sub sqlradius_delete { #subroutine, not method + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_delete() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my $username = shift; my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; @@ -883,6 +919,12 @@ sub usage_sessions { sub update_svc { my $self = shift; + if ( $FS::svc_Common::noexport_hack ) { + carp 'update_svc() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + my $conf = new FS::Conf; my $fdbh = dbh; @@ -1048,6 +1090,13 @@ sub export_nas_replace { shift->export_nas_action('replace', @_); } sub export_nas_action { my $self = shift; my ($action, $new, $old) = @_; + + if ( $FS::svc_Common::noexport_hack ) { + carp "export_nas_action($action) suppressed by noexport_hack" + if $self->option('debug') || $DEBUG; + return; + } + # find the NAS in the target table by its name my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname; my $nasnum = $new->nasnum; @@ -1061,6 +1110,12 @@ sub export_nas_action { } sub sqlradius_nas_insert { + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_nas_insert() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} }) @@ -1075,6 +1130,12 @@ VALUES (?, ?, ?, ?, ?, ?, ?)'); } sub sqlradius_nas_delete { + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_nas_delete() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?'); @@ -1082,6 +1143,12 @@ sub sqlradius_nas_delete { } sub sqlradius_nas_replace { + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_nas_replace() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} }) @@ -1157,6 +1224,12 @@ sub export_attr_action { } sub sqlradius_attr_insert { + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_attr_insert() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; @@ -1180,6 +1253,12 @@ sub sqlradius_attr_insert { } sub sqlradius_attr_delete { + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_attr_delete() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; @@ -1231,6 +1310,12 @@ sub export_group_replace { } sub sqlradius_group_replace { + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_group_replace() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my $usergroup = shift; $usergroup =~ /^(rad)?usergroup$/ @@ -1271,6 +1356,12 @@ Note this is NOT the opposite of sqlradius_connect. =cut sub sqlradius_user_disconnect { + + if ( $FS::svc_Common::noexport_hack ) { + carp 'sqlradius_user_disconnect() suppressed by noexport_hack' if $DEBUG; + return; + } + my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; # get list of nas diff --git a/FS/FS/part_export/thinktel.pm b/FS/FS/part_export/thinktel.pm index 67cf2b0da..9ab645539 100644 --- a/FS/FS/part_export/thinktel.pm +++ b/FS/FS/part_export/thinktel.pm @@ -131,7 +131,7 @@ sub check_svc { # check the service for validity ''; } -sub export_insert { +sub _export_insert { my($self, $svc_x) = (shift, shift); my $error = $self->check_svc($svc_x); @@ -294,7 +294,7 @@ sub insert_trunk { } } -sub export_replace { +sub _export_replace { my ($self, $svc_new, $svc_old) = @_; my $error = $self->check_svc($svc_new); @@ -412,7 +412,7 @@ sub replace_gateway { } } -sub export_delete { +sub _export_delete { my ($self, $svc_x) = (shift, shift); my $role = $self->svc_role($svc_x) diff --git a/FS/FS/part_export/tower_towercoverage.pm b/FS/FS/part_export/tower_towercoverage.pm index 5d3f8351a..ef8b266cf 100644 --- a/FS/FS/part_export/tower_towercoverage.pm +++ b/FS/FS/part_export/tower_towercoverage.pm @@ -102,7 +102,7 @@ sub insert { ''; } -sub export_insert { +sub _export_insert { my ($self, $sector) = @_; return unless $self->option('use_coverage'); @@ -175,7 +175,7 @@ sub export_insert { } -sub export_replace { # do the same thing as insert +sub _export_replace { # do the same thing as insert my $self = shift; $self->export_insert(@_); } diff --git a/FS/FS/part_export/voip_ms.pm b/FS/FS/part_export/voip_ms.pm index 251988485..1eedd66ac 100644 --- a/FS/FS/part_export/voip_ms.pm +++ b/FS/FS/part_export/voip_ms.pm @@ -133,7 +133,7 @@ our %info = ( END ); -sub export_insert { +sub _export_insert { my($self, $svc_x) = (shift, shift); my $role = $self->svc_role($svc_x); @@ -162,7 +162,7 @@ sub export_insert { ''; } -sub export_replace { +sub _export_replace { my ($self, $svc_new, $svc_old) = @_; my $role = $self->svc_role($svc_new); my $error; @@ -175,7 +175,7 @@ sub export_replace { ''; } -sub export_delete { +sub _export_delete { my ($self, $svc_x) = (shift, shift); my $role = $self->svc_role($svc_x); if ( $role eq 'subacct' ) { @@ -204,7 +204,7 @@ sub export_delete { ''; } -sub export_suspend { +sub _export_suspend { my $self = shift; my $svc_x = shift; my $role = $self->svc_role($svc_x); @@ -215,7 +215,7 @@ sub export_suspend { ''; } -sub export_unsuspend { +sub _export_unsuspend { my $self = shift; my $svc_x = shift; my $role = $self->svc_role($svc_x); diff --git a/FS/FS/part_pkg/discount_Mixin.pm b/FS/FS/part_pkg/discount_Mixin.pm index 1e4653639..ec37624f2 100644 --- a/FS/FS/part_pkg/discount_Mixin.pm +++ b/FS/FS/part_pkg/discount_Mixin.pm @@ -102,7 +102,10 @@ sub calc_discount { # $chg_months: the number of months we are charging recur for # $months: $chg_months or the months left on the discount, whchever is less - my $chg_months = $cust_pkg->part_pkg->freq || 1; + my $chg_months = 1; + unless ($cust_pkg->part_pkg->freq !~ /^\d+$/) { + $chg_months = $cust_pkg->part_pkg->freq || 1; + } if ( defined($param->{'months'}) ) { # then override $chg_months = $param->{'months'}; } diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm index 6fd9c7d08..c06328b1b 100644 --- a/FS/FS/part_pkg/flat.pm +++ b/FS/FS/part_pkg/flat.pm @@ -57,6 +57,12 @@ tie my %contract_years, 'Tie::IxHash', ( 'the customer\'s next bill date', 'type' => 'checkbox', }, + 'prorate_defer_change_bill' => { + 'name' => 'When synchronizing, defer bill for '. + 'package changes until the customer\'s '. + 'next bill date', + 'type' => 'checkbox', + }, 'prorate_round_day' => { 'name' => 'When synchronizing, round the prorated '. 'period', @@ -87,7 +93,8 @@ tie my %contract_years, 'Tie::IxHash', ( }, 'fieldorder' => [ qw( recur_temporality start_1st - sync_bill_date prorate_defer_bill prorate_round_day + sync_bill_date prorate_defer_bill + prorate_defer_change_bill prorate_round_day suspend_bill unsuspend_adjust_bill bill_recur_on_cancel bill_suspend_as_cancel diff --git a/FS/FS/part_pkg/flat_introrate.pm b/FS/FS/part_pkg/flat_introrate.pm index e43a525d2..f12b1accd 100644 --- a/FS/FS/part_pkg/flat_introrate.pm +++ b/FS/FS/part_pkg/flat_introrate.pm @@ -94,7 +94,7 @@ sub base_recur { sub item_discount { my ($self, $cust_pkg) = @_; - return unless $self->option('show_as_discount'); + return unless $self->option('show_as_discount',1); my $intro_end = $self->intro_end($cust_pkg); my $amount = sprintf('%.2f', $self->option('intro_fee') - $self->option('recur_fee') diff --git a/FS/FS/part_pkg/prorate_Mixin.pm b/FS/FS/part_pkg/prorate_Mixin.pm index 9e97cc593..9252143b9 100644 --- a/FS/FS/part_pkg/prorate_Mixin.pm +++ b/FS/FS/part_pkg/prorate_Mixin.pm @@ -30,7 +30,7 @@ tie our %prorate_round_day_opts, 'Tie::IxHash', }, 'prorate_defer_bill' => { 'name' => 'When prorating, defer the first bill until the '. - 'billing day', + 'billing day or customers next bill date if synchronizing.', 'type' => 'checkbox', }, 'prorate_verbose' => { diff --git a/FS/FS/part_pkg/sql_external.pm b/FS/FS/part_pkg/sql_external.pm index 9bf107b7d..a3866f34e 100644 --- a/FS/FS/part_pkg/sql_external.pm +++ b/FS/FS/part_pkg/sql_external.pm @@ -19,6 +19,10 @@ our @detail_cols = ( qw(amount format duration phonenum accountcode 'shortname' => 'External SQL query', 'inherit_fields' => [ 'prorate_Mixin', 'global_Mixin' ], 'fields' => { + 'sync_bill_date' => { 'name' => 'Prorate first month to synchronize '. + 'with the customer\'s other packages', + 'type' => 'checkbox', + }, 'cutoff_day' => { 'name' => 'Billing Day (1 - 28) for prorating or '. 'subscription', 'default' => '1', @@ -50,7 +54,7 @@ our @detail_cols = ( qw(amount format duration phonenum accountcode }, }, - 'fieldorder' => [qw( recur_method cutoff_day ), + 'fieldorder' => [qw( recur_method cutoff_day sync_bill_date), FS::part_pkg::prorate_Mixin::fieldorder, qw( datasrc db_username db_password query query_style )], @@ -140,6 +144,12 @@ sub calc_recur { ($cust_pkg->quantity || 1) * $self->calc_recur_Common($cust_pkg,$sdate,$details,$param); } +sub cutoff_day { + my( $self, $cust_pkg ) = @_; + my $error = FS::part_pkg::flat::cutoff_day( $self, $cust_pkg ); + return $error; +} + sub can_discount { 1; } sub is_free { 0; } diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index dcc78435b..b82996e0d 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -519,6 +519,18 @@ sub part_export_dsl_pull { grep $_->can('dsl_pull'), $self->part_export; } +=item part_export_partsvc + +Returns a list of any exports (see L<FS::part_export>) for this service that +are capable of pushing a change after part svc is changed. + +=cut + +sub part_export_partsvc { + my $self = shift; + grep $_->can('export_partsvc'), $self->part_export; +} + =item cust_svc [ PKGPART ] Returns a list of associated customer services (FS::cust_svc records). @@ -861,10 +873,10 @@ sub process { map { my $f = $svcdb.'__'.$_; my $flag = $param->{ $f.'_flag' } || ''; #silence warnings - if ( $flag =~ /^[MAH]$/ ) { + if ( $flag =~ /^[MAHP]$/ ) { $param->{ $f } = delete( $param->{ $f.'_classnum' } ); } - if ( ( $flag =~ /^[MAHS]$/ or $_ eq 'usergroup' ) + if ( ( $flag =~ /^[MAHSP]$/ or $_ eq 'usergroup' ) and ref($param->{ $f }) ) { $param->{ $f } = join(',', @{ $param->{ $f } }); } @@ -909,6 +921,11 @@ sub process { ); die "$error\n" if $error; + + foreach my $part_svc_export ( $new->part_export_partsvc ) { + $error = $part_svc_export->export_partsvc($new); + } + return $error if $error; } =item process_bulk_cust_svc diff --git a/FS/FS/part_svc_column.pm b/FS/FS/part_svc_column.pm index 75a2dfb1a..e055af35a 100644 --- a/FS/FS/part_svc_column.pm +++ b/FS/FS/part_svc_column.pm @@ -97,7 +97,7 @@ sub check { ; return $error if $error; - $self->columnflag =~ /^([DFSMAHX]?)$/ + $self->columnflag =~ /^([DFSMAHXP]?)$/ or return "illegal columnflag ". $self->columnflag; $self->columnflag(uc($1)); diff --git a/FS/FS/pay_batch/RBC.pm b/FS/FS/pay_batch/RBC.pm index 21dae4256..3d1d98b17 100644 --- a/FS/FS/pay_batch/RBC.pm +++ b/FS/FS/pay_batch/RBC.pm @@ -174,6 +174,9 @@ $name = 'RBC'; die "invalid branch/routing number '$aba'\n"; } + ## set custname to business name if business checking or savings account is used otherwise leave as first and last name. + my $custname = $cust_pay_batch->cust_main->batch_payment_payname($cust_pay_batch); + $i++; ## set to D for debit by default, then override to what cust_pay_batch has as payments may not have paycode. @@ -194,8 +197,7 @@ $name = 'RBC'; sprintf("%010.0f",$cust_pay_batch->amount*100). ' '. time2str("%Y%j", time + 86400). - sprintf("%-30.30s", encode('utf8', $cust_pay_batch->cust_main->first . ' ' . - $cust_pay_batch->cust_main->last)). + sprintf("%-30.30s", encode('utf8', $custname)). 'E'. # English ' '. sprintf("%-15s", $shortname). @@ -226,5 +228,10 @@ $name = 'RBC'; }, ); +## this format can handle credit transactions +sub can_handle_credits { + 1; +} + 1; diff --git a/FS/FS/pay_batch/paymentech.pm b/FS/FS/pay_batch/paymentech.pm index 3cf3134ff..094d50114 100644 --- a/FS/FS/pay_batch/paymentech.pm +++ b/FS/FS/pay_batch/paymentech.pm @@ -8,7 +8,7 @@ use Date::Format 'time2str'; use Date::Parse 'str2time'; use Tie::IxHash; use FS::Conf; -use FS::Misc 'bytes_substr'; +use Unicode::Truncate 'truncate_egc'; my $conf; my ($bin, $merchantID, $terminalID, $username, $password, $with_recurringInd); @@ -67,12 +67,8 @@ my $gateway; $hash->{'error_message'} = $hash->{'procStatusMessage'}; } }, - 'approved' => sub { my $hash = shift; - $hash->{'approvalStatus'} - }, - 'declined' => sub { my $hash = shift; - ! $hash->{'approvalStatus'} - }, + 'approved' => sub { shift->{'approvalStatus'} == 1 }, + 'declined' => sub { shift->{'approvalStatus'} != 1 }, ); my %paytype = ( @@ -131,12 +127,14 @@ my %paymentech_countries = map { $_ => 1 } qw( US CA GB UK ); ecpBankAcctType => $paytype{lc($_->paytype)}, ecpDelvMethod => 'A', ), - avsZip => bytes_substr($_->zip, 0, 10), - avsAddress1 => bytes_substr($_->address1, 0, 30), - avsAddress2 => bytes_substr($_->address2, 0, 30), - avsCity => bytes_substr($_->city, 0, 20), - avsState => bytes_substr($_->state, 0, 2), - avsName => bytes_substr($_->first. ' '. $_->last, 0, 30), + # truncate_egc will die() on empty string + avsZip => $_->zip ? truncate_egc($_->zip, 10) : undef, + avsAddress1 => $_->address1 ? truncate_egc($_->address1, 30) : undef, + avsAddress2 => $_->address2 ? truncate_egc($_->address2, 30) : undef, + avsCity => $_->city ? truncate_egc($_->city, 20) : undef, + avsState => $_->state ? truncate_egc($_->state, 2) : undef, + avsName => ($_->first || $_->last) + ? truncate_egc($_->first. ' '. $_->last, 30) : undef, ( $paymentech_countries{ $_->country } ? ( avsCountryCode => $_->country ) : () diff --git a/FS/FS/svc_IP_Mixin.pm b/FS/FS/svc_IP_Mixin.pm index c89245fe2..4c2180ece 100644 --- a/FS/FS/svc_IP_Mixin.pm +++ b/FS/FS/svc_IP_Mixin.pm @@ -3,7 +3,8 @@ use base 'FS::IP_Mixin'; use strict; use NEXT; -use FS::Record qw(qsearchs qsearch); +use Carp qw(croak carp); +use FS::Record qw(qsearchs qsearch dbh); use FS::Conf; use FS::router; use FS::part_svc_router; @@ -80,7 +81,7 @@ sub svc_ip_check { my $error = $self->ip_check; return $error if $error; if ( my $router = $self->router ) { - if ( grep { $_->routernum eq $router->routernum } $self->allowed_routers ) { + if ( grep { $_->routernum == $router->routernum } $self->allowed_routers ) { return ''; } else { return 'Router '.$router->routername.' not available for this service'; @@ -90,21 +91,71 @@ sub svc_ip_check { } sub _used_addresses { - my ($class, $block, $exclude) = @_; - my $ip_field = $class->table_info->{'ip_field'} - or return (); - # if the service doesn't have an ip_field, then it has no IP addresses - # in use, yes? - - my %hash = ( $ip_field => { op => '!=', value => '' } ); - #$hash{'blocknum'} = $block->blocknum if $block; - $hash{'svcnum'} = { op => '!=', value => $exclude->svcnum } if ref $exclude; - map { my $na = $_->NetAddr; $na ? $na->addr : () } - qsearch({ - table => $class->table, - hashref => \%hash, - extra_sql => " AND $ip_field != '0e0'", - }); + my ($class, $block, $exclude_svc) = @_; + + croak "_used_addresses() requires an FS::addr_block parameter" + unless ref $block && $block->isa('FS::addr_block'); + + my $ip_field = $class->table_info->{'ip_field'}; + if ( !$ip_field ) { + carp "_used_addresses() skipped, no ip_field"; + return; + } + + my %qsearch = ( $ip_field => { op => '!=', value => '' }); + $qsearch{svcnum} = { op => '!=', value => $exclude_svc->svcnum } + if ref $exclude_svc && $exclude_svc->svcnum; + + my $block_na = $block->NetAddr; + + my $octets; + if ($block->ip_netmask >= 24) { + $octets = 3; + } elsif ($block->ip_netmask >= 16) { + $octets = 2; + } elsif ($block->ip_netmask >= 8) { + $octets = 1; + } + + # e.g. + # SELECT ip_addr + # FROM svc_broadband + # WHERE ip_addr != '' + # AND ip_addr != '0e0' + # AND ip_addr LIKE '10.0.2.%'; + # + # For /24, /16 and /8 this approach is fast, even when svc_broadband table + # contains 650,000+ ip records. For other allocations, this approach is + # not speedy, but usable. + # + # Note: A use case like this would could greatly benefit from a qsearch() + # parameter to bypass FS::Record objects creation and just + # return hashrefs from DBI. 200,000 hashrefs are many seconds faster + # than 200,000 FS::Record objects + my %qsearch_param = ( + table => $class->table, + select => $ip_field, + hashref => \%qsearch, + extra_sql => " AND $ip_field != '0e0' ", + ); + if ( $octets ) { + my $block_str = join('.', (split(/\D/, $block_na->first))[0..$octets-1]); + $qsearch_param{extra_sql} + .= " AND $ip_field LIKE ".dbh->quote("${block_str}.%"); + } + + if ( $block->ip_netmask % 8 ) { + # Some addresses returned by qsearch may be outside the network block, + # so each ip address is tested to be in the block before it's returned. + return + grep { $block_na->contains( NetAddr::IP->new( $_ ) ) } + map { $_->$ip_field } + qsearch( \%qsearch ); + } + + return + map { $_->$ip_field } + qsearch( \%qsearch_param ); } sub _is_used { diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index de9199da4..1118c0d53 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -329,6 +329,15 @@ sub table_info { disable_select => 1, #UI wonky, pry works otherwise }, 'sectornum' => 'Tower sector', + 'routernum' => 'Router/block', + 'blocknum' => { + 'label' => 'Address block', + 'type' => 'select', + 'select_table' => 'addr_block', + 'select_key' => 'blocknum', + 'select_label' => 'cidr', + 'disable_inventory' => 1, + }, 'usergroup' => { label => 'RADIUS groups', type => 'select-radius_group.html', @@ -341,7 +350,7 @@ sub table_info { type => 'text', disable_inventory => 1, disable_select => 1, - disable_part_svc_column => 1, + #disable_part_svc_column => 1, }, 'upbytes' => { label => 'Upload', type => 'text', @@ -1971,6 +1980,9 @@ sub _op_usage { return '' unless $amount; + return '' + if $self->cust_svc->part_svc->part_svc_column($column)->columnflag eq 'F'; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm index 38594f0df..02136c594 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -107,15 +107,23 @@ sub table_info { 'fields' => { 'svcnum' => 'Service', 'description' => 'Descriptive label', - 'speed_down' => 'Download speed (Kbps)', - 'speed_up' => 'Upload speed (Kbps)', + 'speed_up' => { + 'label' => 'Upload speed (Kbps)', + 'type' => 'fcc_477_speed', + 'def_info' => 'both upload and download speed must be set to FCC 477 information if using that modifier', + }, + 'speed_down' => { + 'label' => 'Download speed (Kbps)', + 'type' => 'fcc_477_speed', + 'def_info' => 'both upload and download speed must be set to FCC 477 information if using that modifier', + }, 'ip_addr' => 'IP address', - 'blocknum' => - { 'label' => 'Address block', - 'type' => 'select', - 'select_table' => 'addr_block', - 'select_key' => 'blocknum', - 'select_label' => 'cidr', + 'blocknum' => { + 'label' => 'Address block', + 'type' => 'select', + 'select_table' => 'addr_block', + 'select_key' => 'blocknum', + 'select_label' => 'cidr', 'disable_inventory' => 1, }, 'plan_id' => 'Service Plan Id', @@ -134,6 +142,7 @@ sub table_info { #select_table => 'radius_group', #select_key => 'groupnum', #select_label => 'groupname', + disable_select => 1, disable_inventory => 1, multiple => 1, }, @@ -147,6 +156,9 @@ sub table_info { disable_inventory => 1, }, 'serviceid' => 'Torrus serviceid', #but is should be hidden + 'speed_test_up' => { 'label' => 'Speed test upload (Kbps)' }, + 'speed_test_down' => { 'label' => 'Speed test download (Kbps)' }, + 'speed_test_latency' => 'Speed test latency (ms)', }, }; } @@ -352,6 +364,8 @@ sub check { || $self->ut_textn('description') || $self->ut_numbern('speed_up') || $self->ut_numbern('speed_down') + || $self->ut_numbern('speed_test_up') + || $self->ut_numbern('speed_test_down') || $self->ut_ipn('ip_addr') || $self->ut_hexn('mac_addr') || $self->ut_hexn('auth_key') @@ -501,6 +515,11 @@ sub _upgrade_data { #next SVC; } + require FS::Misc::FixIPFormat; + FS::Misc::FixIPFormat::fix_bad_addresses_in_table( + 'svc_broadband', 'svcnum', 'ip_addr', + ); + ''; } @@ -523,4 +542,3 @@ FS::part_svc, schema.html from the base documentation. =cut 1; - diff --git a/FS/FS/svc_cable.pm b/FS/FS/svc_cable.pm index 9e818e142..5e3f180b8 100644 --- a/FS/FS/svc_cable.pm +++ b/FS/FS/svc_cable.pm @@ -36,6 +36,26 @@ from FS::Record. The following fields are currently supported: primary key +=item providernum + +Provider (see L<FS::cable_provider>) + +=item ordernum + +Provider order number + +=item modelnum + +Cable device model (see L<FS::cable_model>) + +=item serialnum + +Cable device serial number + +=item mac_addr + +Cable device MAC address + =back =head1 METHODS diff --git a/FS/FS/svc_circuit.pm b/FS/FS/svc_circuit.pm index 7f49715b9..7f2ef807c 100644 --- a/FS/FS/svc_circuit.pm +++ b/FS/FS/svc_circuit.pm @@ -236,6 +236,17 @@ sub search_sql_addl_from { 'LEFT JOIN circuit_type USING ( typenum )'; } +sub _upgrade_data { + + require FS::Misc::FixIPFormat; + FS::Misc::FixIPFormat::fix_bad_addresses_in_table( + 'svc_circuit', 'svcnum', 'endpoint_ip_addr', + ); + + ''; + +} + =back =head1 SEE ALSO @@ -245,4 +256,3 @@ L<FS::Record> =cut 1; - diff --git a/FS/FS/svc_dsl.pm b/FS/FS/svc_dsl.pm index dcd6d1dbe..c07f1866c 100644 --- a/FS/FS/svc_dsl.pm +++ b/FS/FS/svc_dsl.pm @@ -50,15 +50,25 @@ FS::svc_Common. The following fields are currently supported: =over 4 -=item svcnum - Primary key (assigned automatcially for new DSL)) +=item svcnum -=item pushed - Time DSL order pushed to vendor/telco, if applicable +Primary key (assigned automatcially for new DSL)) -=item desired_due_date - Desired Due Date +=item pushed -=item due_date - Due Date +Time DSL order pushed to vendor/telco, if applicable -=item vendor_order_id - Vendor/telco DSL order # +=item desired_due_date + +Desired Due Date + +=item due_date + +Due Date + +=item vendor_order_id + +Vendor/telco DSL order # =item vendor_order_type @@ -69,27 +79,45 @@ Vendor/telco DSL order type (e.g. (M)ove, (A)dd, (C)hange, (D)elete, or similar) Vendor/telco DSL order status (e.g. (N)ew, (A)ssigned, (R)ejected, (M)revised, (C)ompleted, (X)cancelled, or similar) -=item first - End-user first name +=item first + +End-user first name + +=item last + +End-user last name + +=item company -=item last - End-user last name +End-user company name -=item company - End-user company name +=item phonenum -=item phonenum - DSL Telephone Number +DSL Telephone Number -=item gateway_access_number - Gateway access number, if different +=item gateway_access_number -=item loop_type - Loop-type - vendor/telco-specific +Gateway access number, if different -=item local_voice_provider - Local Voice Provider's name +=item loop_type -=item circuitnum - Circuit # +Loop-type - vendor/telco-specific + +=item local_voice_provider + +Local Voice Provider's name + +=item circuitnum + +Circuit # =item vpi =item vci -=item rate_band - Rate Band +=item rate_band + +Rate Band =item isp_chg @@ -101,13 +129,21 @@ Vendor/telco DSL order status (e.g. (N)ew, (A)ssigned, (R)ejected, (M)revised, Ikano-specific fields, do not use otherwise -=item username - if outsourced PPPoE/RADIUS, username +=item username + +if outsourced PPPoE/RADIUS, username + +=item password + +if outsourced PPPoE/RADIUS, password + +=item monitored -=item password - if outsourced PPPoE/RADIUS, password +Order is monitored (auto-pull/sync), either Y or blank -=item monitored - Order is monitored (auto-pull/sync), either Y or blank +=item last_pull -=item last_pull - time of last data pull from vendor/telco +time of last data pull from vendor/telco =back diff --git a/FS/FS/svc_hardware.pm b/FS/FS/svc_hardware.pm index 4bff483e1..019a5646c 100644 --- a/FS/FS/svc_hardware.pm +++ b/FS/FS/svc_hardware.pm @@ -245,6 +245,17 @@ sub display_hw_addr { join(':', $self->hw_addr =~ /../g) : $self->hw_addr) } +sub _upgrade_data { + + require FS::Misc::FixIPFormat; + FS::Misc::FixIPFormat::fix_bad_addresses_in_table( + 'svc_hardware', 'svcnum', 'ip_addr', + ); + + ''; + +} + =back =head1 SEE ALSO @@ -254,4 +265,3 @@ L<FS::Record>, L<FS::svc_Common>, schema.html from the base documentation. =cut 1; - diff --git a/FS/FS/svc_pbx.pm b/FS/FS/svc_pbx.pm index a5e181d9d..b0f6e8d98 100644 --- a/FS/FS/svc_pbx.pm +++ b/FS/FS/svc_pbx.pm @@ -387,6 +387,17 @@ sub sum_cdrs { qsearchs ( $psearch->{query} ); } +sub _upgrade_data { + + require FS::Misc::FixIPFormat; + FS::Misc::FixIPFormat::fix_bad_addresses_in_table( + 'svc_pbx', 'svcnum', 'ip_addr', + ); + + ''; + +} + =back =head1 BUGS @@ -399,4 +410,3 @@ L<FS::cust_pkg>, schema.html from the base documentation. =cut 1; - diff --git a/FS/FS/tower.pm b/FS/FS/tower.pm index 18b43fe7d..8a93d8f23 100644 --- a/FS/FS/tower.pm +++ b/FS/FS/tower.pm @@ -44,6 +44,14 @@ Tower name Disabled flag, empty or 'Y' +=item up_rate_limit + +Up Rate limit for towner + +=item down_rate_limit + +Down Rate limit for tower + =back =head1 METHODS @@ -118,6 +126,8 @@ sub check { || $self->ut_floatn('height') || $self->ut_floatn('veg_height') || $self->ut_alphan('color') + || $self->ut_numbern('up_rate_limit') + || $self->ut_numbern('down_rate_limit') ; return $error if $error; diff --git a/FS/FS/tower_sector.pm b/FS/FS/tower_sector.pm index 2e9232307..eb00d33be 100644 --- a/FS/FS/tower_sector.pm +++ b/FS/FS/tower_sector.pm @@ -95,6 +95,18 @@ The coverage map, as a PNG. The coordinate boundaries of the coverage map. +=item title + +The sector title. + +=item up_rate_limit + +Up rate limit for sector. + +=item down_rate_limit + +down rate limit for sector. + =back =head1 METHODS @@ -235,7 +247,7 @@ sub check { $self->ut_numbern('sectornum') || $self->ut_number('towernum', 'tower', 'towernum') || $self->ut_text('sectorname') - || $self->ut_textn('ip_addr') + || $self->ut_ip46n('ip_addr') || $self->ut_floatn('height') || $self->ut_numbern('freq_mhz') || $self->ut_numbern('direction') @@ -248,6 +260,8 @@ sub check { || $self->ut_decimaln('antenna_gain') || $self->ut_numbern('hardware_typenum') || $self->ut_textn('title') + || $self->ut_numbern('up_rate_limit') + || $self->ut_numbern('down_rate_limit') # all of these might get relocated as part of coverage refactoring || $self->ut_anything('image') || $self->ut_sfloatn('west') @@ -365,6 +379,21 @@ sub part_export { }); } +=item part_export_svc_broadband + +Returns all svc_broadband exports. + +=cut + +sub part_export_svc_broadband { + my $info = $FS::part_export::exports{'svc_broadband'} or return; + my @exporttypes = map { dbh->quote($_) } keys %$info or return; + qsearch({ + 'table' => 'part_export', + 'extra_sql' => 'WHERE exporttype IN(' . join(',', @exporttypes) . ')' + }); +} + =back =head1 SUBROUTINES @@ -442,6 +471,17 @@ sub process_generate_coverage { die $error if $error; } +sub _upgrade_data { + + require FS::Misc::FixIPFormat; + FS::Misc::FixIPFormat::fix_bad_addresses_in_table( + 'tower_sector', 'sectornum', 'ip_addr', + ); + + ''; + +} + =head1 BUGS =head1 SEE ALSO @@ -451,4 +491,3 @@ L<FS::tower>, L<FS::Record>, schema.html from the base documentation. =cut 1; - diff --git a/FS/bin/freeside-cdr-telapi-import b/FS/bin/freeside-cdr-telapi-import index 4a637f57f..6bb3e4a36 100755 --- a/FS/bin/freeside-cdr-telapi-import +++ b/FS/bin/freeside-cdr-telapi-import @@ -35,6 +35,11 @@ GetOptions( "enddate=s" => \$enddate, ); +$startdate = str2time($startdate) or die "can't parse start date $startdate\n"; + $startdate = time2str('%m-%d-%Y', $startdate); +$enddate = str2time($enddate) or die "can't parse start date $enddate\n"; + $enddate = time2str('%m-%d-%Y', $enddate); + my $fsuser = $ARGV[-1]; die usage() unless $fsuser; @@ -65,11 +70,13 @@ print $cfh $page; seek($cfh,0,0); - print "Importing batch $cdrbatch\n"; + warn "Importing batch $cdrbatch\n"; my $error = FS::cdr::batch_import({ 'batch_namevalue' => $cdrbatch, 'file' => $cfh->filename, 'format' => 'telapi_'.$type }); + warn "Error importing CDR's\n".$error if $error; + exit;
\ No newline at end of file diff --git a/FS/bin/freeside-ipifony-download b/FS/bin/freeside-ipifony-download index 10faa7483..1e77c3a75 100644 --- a/FS/bin/freeside-ipifony-download +++ b/FS/bin/freeside-ipifony-download @@ -5,14 +5,15 @@ use Getopt::Std; use Date::Format qw(time2str); use File::Temp qw(tempdir); use Net::SFTP::Foreign; +use File::Copy qw(copy); +use Text::CSV; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch qsearchs); use FS::cust_main; use FS::Conf; -use File::Copy qw(copy); -use Text::CSV; +use FS::Log; -my %opt; +our %opt; getopts('vqNa:P:C:e:', \%opt); # Product codes that are subject to flat rate E911 charges. For these @@ -104,24 +105,19 @@ if ( $opt{P} =~ /^(\d+)$/ ) { } # for now assume SFTP download as the only method -print STDERR "Connecting to $sftpuser\@$host...\n" if $opt{v}; - -my $sftp = Net::SFTP::Foreign->new( - host => $host, - user => $sftpuser, - port => $port, - # for now we don't support passwords. use authorized_keys. - timeout => 30, - #more => ($opt{v} ? '-v' : ''), -); -die "failed to connect to '$sftpuser\@$host'\n(".$sftp->error.")\n" - if $sftp->error; +my $sftp = sftp_connect($host, $sftpuser, $port); +if ( $sftp->error ) { + my $error = "Connection failed to $sftpuser\@$host: ". $sftp->error. + ", giving up."; + mylog('critical', $error); + die $error; +} $sftp->setcwd($path) if $path; my $files = $sftp->ls('ready', wanted => qr/\.csv$/, names_only => 1); if (!@$files) { - print STDERR "No charge files found.\n" if $opt{v}; + mylog('warning',"No charge files found."); exit(-1); } @@ -131,7 +127,7 @@ my %e911_qty; # custnum => sum of E911-subject quantity my %is_e911 = map {$_ => 1} @E911_CODES; FILE: foreach my $filename (@$files) { - print STDERR "Retrieving $filename\n" if $opt{v}; + mylog('debug', "Retrieving $filename"); $sftp->get("ready/$filename", "$tmpdir/$filename"); if($sftp->error) { warn "failed to download $filename\n"; @@ -140,7 +136,7 @@ FILE: foreach my $filename (@$files) { # make sure server archive dir exists if ( !$sftp->stat('done') ) { - print STDERR "Creating $path/done\n" if $opt{v}; + mylog('debug',"Creating $path/done"); $sftp->mkdir('done'); if($sftp->error) { # something is seriously wrong @@ -155,9 +151,9 @@ FILE: foreach my $filename (@$files) { #copy to local archive dir if ( $opt{a} ) { - print STDERR "Copying $tmpdir/$filename to archive dir $opt{a}\n" - if $opt{v}; + mylog('debug', "Copying $tmpdir/$filename to archive dir $opt{a}"); copy("$tmpdir/$filename", $opt{a}); + #log too? what's -a all about anyway? warn "failed to copy $tmpdir/$filename to $opt{a}: $!" if $!; } @@ -172,7 +168,7 @@ FILE: foreach my $filename (@$files) { @hash{@fields} = $csv->fields(); if ( $hash{custnum} =~ /^cust/ ) { # there appears to be a header row - print STDERR "skipping header row\n" if $opt{v}; + mylog('debug', "skipping header row"); next; } my $cust_main = @@ -181,8 +177,7 @@ FILE: foreach my $filename (@$files) { warn "customer #$hash{custnum} not found\n"; next; } - print STDERR "Found customer #$hash{custnum}: ".$cust_main->name."\n" - if $opt{v}; + mylog('debug',"Found customer #$hash{custnum}: ".$cust_main->name); my $amount = sprintf('%.2f',$hash{quantity} * $hash{unit_price}); @@ -233,8 +228,7 @@ FILE: foreach my $filename (@$files) { } $charge_opt{classnum} = $classnum_of{$classname}; } - print STDERR " Charging $hash{unit_price} * $hash{quantity}\n" - if $opt{v}; + mylog('debug', " Charging $hash{unit_price} * $hash{quantity}"); my $error = $cust_main->charge(\%charge_opt); if ($error) { warn "Error creating charge: $error" if $error; @@ -277,8 +271,7 @@ foreach my $custnum ( keys (%e911_qty) ) { $dbh->commit; -if ($opt{v}) { - print STDERR " +mylog('debug', " Finished! Processed files: @$files Created charges: $num_charges @@ -286,7 +279,43 @@ Finished! E911 charges: $num_e911 E911 lines: $num_lines Errors: $num_errors -"; +"); + +sub sftp_connect { + my ($host, $sftpuser, $port) = @_; + my $sftp; + my $connection_tries = 1; + + while (1) { + mylog('info', "Connecting to $sftpuser\@$host try number $connection_tries..."); + $sftp = Net::SFTP::Foreign->new( + host => $host, + user => $sftpuser, + port => $port, + # for now we don't support passwords. use authorized_keys. + timeout => 30, + #more => ($opt{v} ? '-v' : ''), + ); + + if ($sftp->error && $connection_tries < 1200) { + $connection_tries++; + mylog('error', "Connection failed to $sftpuser\@$host: ". $sftp->error. + ", trying again in 60 sec..."); + sleep 60; + } + else { last; } + } + + return $sftp; +} + +our $log; +sub mylog { + my( $level, $message ) = @_; + #warn "$message\n" if $opt{v}; + print STDERR "$message\n" if $opt{v}; + $log ||= FS::Log->new('freeside-ipifony-download'); + $log->log(level=>$level, message=>$message); } =head1 NAME @@ -320,7 +349,8 @@ directory is the one containing the "ready/" and "done/" subdirectories. =head1 OPTIONAL PARAMETERS --v: Be verbose. +-v: Be verbose; send debugging information to STDERR in addition to the +internal log.. -q: Include the quantity and unit price in the charge description. diff --git a/FS/bin/freeside-paymentech-download b/FS/bin/freeside-paymentech-download index 9a1f609bc..4d99df2d0 100755 --- a/FS/bin/freeside-paymentech-download +++ b/FS/bin/freeside-paymentech-download @@ -62,7 +62,7 @@ while ($ssh_retry > 0) { $sftp = Net::SFTP::Foreign->new( host => $host, user => $username, password => $password, - timeout => 30, + timeout => 300, ); last unless $sftp->error; $ssh_retry -= 1; diff --git a/FS/bin/freeside-paymentech-upload b/FS/bin/freeside-paymentech-upload index 799e6c42c..770239d8d 100755 --- a/FS/bin/freeside-paymentech-upload +++ b/FS/bin/freeside-paymentech-upload @@ -97,7 +97,7 @@ while ($ssh_retry > 0) { $sftp = Net::SFTP::Foreign->new( host => $host, user => $username, password => $password, - timeout => 30, + timeout => 300, ); last unless $sftp->error; $ssh_retry -= 1; |