diff options
Diffstat (limited to 'FS')
46 files changed, 1567 insertions, 242 deletions
@@ -67,6 +67,8 @@ L<FS::cust_main::Search> - Customer searching L<FS::cust_main::Import> - Batch customer importing +L<FS::contact::Import> - Batch contact importing + =head2 Database record classes L<FS::Record> - Database record base class diff --git a/FS/FS/API.pm b/FS/FS/API.pm index fd3793d4f..047bb4e60 100644 --- a/FS/FS/API.pm +++ b/FS/FS/API.pm @@ -1,6 +1,7 @@ package FS::API; use strict; +use Date::Parse; use FS::Conf; use FS::Record qw( qsearch qsearchs ); use FS::cust_main; @@ -16,7 +17,20 @@ FS::API - Freeside backend API =head1 SYNOPSIS - use FS::API; + use Frontier::Client; + use Data::Dumper; + + my $url = new URI 'http://localhost:8008/'; #or if accessing remotely, secure + # the traffic + + my $xmlrpc = new Frontier::Client url=>$url; + + my $result = $xmlrpc->call( 'FS.API.customer_info', + 'secret' => 'sharingiscaring', + 'custnum' => 181318, + ); + + print Dumper($result); =head1 DESCRIPTION @@ -525,6 +539,23 @@ sub update_customer { Returns general customer information. Takes a list of keys and values as parameters with the following keys: custnum, secret +Example: + + use Frontier::Client; + use Data::Dumper; + + my $url = new URI 'http://localhost:8008/'; #or if accessing remotely, secure + # the traffic + + my $xmlrpc = new Frontier::Client url=>$url; + + my $result = $xmlrpc->call( 'FS.API.customer_info', + 'secret' => 'sharingiscaring', + 'custnum' => 181318, + ); + + print Dumper($result); + =cut sub customer_info { @@ -542,6 +573,28 @@ sub customer_info { Returns customer service information. Takes a list of keys and values as parameters with the following keys: custnum, secret +Example: + + use Frontier::Client; + use Data::Dumper; + + my $url = new URI 'http://localhost:8008/'; #or if accessing remotely, secure + # the traffic + + my $xmlrpc = new Frontier::Client url=>$url; + + my $result = $xmlrpc->call( 'FS.API.customer_list_svcs', + 'secret' => 'sharingiscaring', + 'custnum' => 181318, + ); + + print Dumper($result); + + foreach my $cust_svc ( @{ $result->{'cust_svc'} } ) { + #print $cust_svc->{mac_addr}."\n" if exists $cust_svc->{mac_addr}; + print $cust_svc->{circuit_id}."\n" if exists $cust_svc->{circuit_id}; + } + =cut sub customer_list_svcs { @@ -597,10 +650,128 @@ sub location_info { return \%return; } +=item order_package OPTION => VALUE, ... + +Orders a new customer package. Takes a list of keys and values as paramaters +with the following keys: + +=over 4 + +=item secret + +API Secret + +=item custnum + +=item pkgpart + +=item quantity + +=item start_date + +=item contract_end + +=item address1 + +=item address2 + +=item city + +=item county + +=item state + +=item zip + +=item country + +=item setup_fee + +Including this implements per-customer custom pricing for this package, overriding package definition pricing + +=item recur_fee + +Including this implements per-customer custom pricing for this package, overriding package definition pricing + +=item invoice_details + +A single string for just one detail line, or an array reference of one or more +lines of detail + +=cut + +sub order_package { + my( $class, %opt ) = @_; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $opt{custnum} }) + or return { 'error' => 'Unknown custnum' }; + + #some conceptual false laziness w/cust_pkg/Import.pm + + my $cust_pkg = new FS::cust_pkg { + 'pkgpart' => $opt{'pkgpart'}, + 'quantity' => $opt{'quantity'} || 1, + }; + + #start_date and contract_end + foreach my $date_field (qw( start_date contract_end )) { + if ( $opt{$date_field} =~ /^(\d+)$/ ) { + $cust_pkg->$date_field( $opt{$date_field} ); + } elsif ( $opt{$date_field} ) { + $cust_pkg->$date_field( str2time( $opt{$date_field} ) ); + } + } + + #especially this part for custom pkg price + # (false laziness w/cust_pkg/Import.pm) + my $s = $opt{'setup_fee'}; + my $r = $opt{'recur_fee'}; + my $part_pkg = $cust_pkg->part_pkg; + if ( ( length($s) && $s != $part_pkg->option('setup_fee') ) + or ( length($r) && $r != $part_pkg->option('recur_fee') ) + ) + { + my $custom_part_pkg = $part_pkg->clone; + $custom_part_pkg->disabled('Y'); + my %options = $part_pkg->options; + $options{'setup_fee'} = $s if length($s); + $options{'recur_fee'} = $r if length($r); + my $error = $custom_part_pkg->insert( options=>\%options ); + return ( 'error' => "error customizing package: $error" ) if $error; + $cust_pkg->pkgpart( $custom_part_pkg->pkgpart ); + } + + my %order_pkg = ( 'cust_pkg' => $cust_pkg ); + + my @loc_fields = qw( address1 address2 city county state zip country ); + if ( grep length($opt{$_}), @loc_fields ) { + $order_pkg{'cust_location'} = new FS::cust_location { + map { $_ => $opt{$_} } @loc_fields, 'custnum' + }; + } + + $order_pkg{'invoice_details'} = $opt{'invoice_details'} + if $opt{'invoice_details'}; + + my $error = $cust_main->order_pkg( %order_pkg ); + + #if ( $error ) { + return { 'error' => $error, + #'pkgnum' => '', + }; + #} else { + # return { 'error' => '', + # #cust_main->order_pkg doesn't actually have a way to return pkgnum + # #'pkgnum' => $pkgnum, + # }; + #} + +} + =item change_package_location Updates package location. Takes a list of keys and values -as paramters with the following keys: +as parameters with the following keys: pkgnum @@ -719,7 +890,205 @@ sub bill_now { } -#next.. Advertising sources? +#next.. Delete Advertising sources? + +=item list_advertising_sources OPTION => VALUE, ... + +Lists all advertising sources. + +=over + +=item secret + +API Secret + +=back + +Example: + + my $result = FS::API->list_advertising_sources( + 'secret' => 'sharingiscaring', + ); + + if ( $result->{'error'} ) { + die $result->{'error'}; + } else { + # list advertising sources returns an array of hashes for sources. + print Dumper($result->{'sources'}); + } + +=cut + +#list_advertising_sources +sub list_advertising_sources { + my( $class, %opt ) = @_; + return _shared_secret_error() unless _check_shared_secret($opt{secret}); + + my @sources = qsearch('part_referral', {}, '', "") + or return { 'error' => 'No referrals' }; + + my $return = { + 'sources' => [ map $_->hashref, @sources ], + }; + + $return; +} + +=item add_advertising_source OPTION => VALUE, ... + +Add a new advertising source. + +=over + +=item secret + +API Secret + +=item referral + +Referral name + +=item disabled + +Referral disabled, Y for disabled or nothing for enabled + +=item agentnum + +Agent ID number + +=item title + +External referral ID + +=back + +Example: + + my $result = FS::API->add_advertising_source( + 'secret' => 'sharingiscaring', + 'referral' => 'test referral', + + #optional + 'disabled' => 'Y', + 'agentnum' => '2', #agent id number + 'title' => 'test title', + ); + + if ( $result->{'error'} ) { + die $result->{'error'}; + } else { + # add_advertising_source returns new source upon success. + print Dumper($result); + } + +=cut + +#add_advertising_source +sub add_advertising_source { + my( $class, %opt ) = @_; + return _shared_secret_error() unless _check_shared_secret($opt{secret}); + + use FS::part_referral; + + my $new_source = $opt{source}; + + my $source = new FS::part_referral $new_source; + + my $error = $source->insert; + + my $return = {$source->hash}; + $return = { 'error' => $error, } if $error; + + $return; +} + +=item edit_advertising_source OPTION => VALUE, ... + +Edit a advertising source. + +=over + +=item secret + +API Secret + +=item refnum + +Referral number to edit + +=item source + +hash of edited source fields. + +=over + +=item referral + +Referral name + +=item disabled + +Referral disabled, Y for disabled or nothing for enabled + +=item agentnum + +Agent ID number + +=item title + +External referral ID + +=back + +=back + +Example: + + my $result = FS::API->edit_advertising_source( + 'secret' => 'sharingiscaring', + 'refnum' => '4', # referral number to edit + 'source' => { + #optional + 'referral' => 'test referral', + 'disabled' => 'Y', + 'agentnum' => '2', #agent id number + 'title' => 'test title', + } + ); + + if ( $result->{'error'} ) { + die $result->{'error'}; + } else { + # edit_advertising_source returns updated source upon success. + print Dumper($result); + } + +=cut + +#edit_advertising_source +sub edit_advertising_source { + my( $class, %opt ) = @_; + return _shared_secret_error() unless _check_shared_secret($opt{secret}); + + use FS::part_referral; + + my $refnum = $opt{refnum}; + my $source = $opt{source}; + + my $old = FS::Record::qsearchs('part_referral', {'refnum' => $refnum,}); + my $new = new FS::part_referral { $old->hash }; + + foreach my $key (keys %$source) { + $new->$key($source->{$key}); + } + + my $error = $new->replace; + + my $return = {$new->hash}; + $return = { 'error' => $error, } if $error; + + $return; +} ## diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 161e466a2..471e32aff 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -291,6 +291,7 @@ tie my %rights, 'Tie::IxHash', { rightname=> 'List rating data', desc=>'Usage reports', global=>1 }, 'Billing event reports', 'Receivables report', + 'Basic payment and refund reports', 'Financial reports', { rightname=>'Send reports to customers', global=>1 }, { rightname=> 'List inventory', global=>1 }, @@ -329,7 +330,7 @@ tie my %rights, 'Tie::IxHash', 'Usage: Unrateable CDRs', 'Usage: Time worked', #gone in 4.x as a distinct ACL (for now?) { rightname=>'Employees: Commission Report', global=>1 }, - { rightname=>'Employees: Audit Report', global=>1 }, + { rightname=>'Employee Reports', global=>1 }, #{ rightname => 'List customers of all agents', global=>1 }, ], diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 5c86b7820..30ab96b49 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -882,6 +882,7 @@ sub payment_info { if ($cust_payby) { $return{payname} = $cust_payby->payname || ( $cust_main->first. ' '. $cust_main->get('last') ); + $return{custpaybynum} = $cust_payby->custpaybynum; if ( $cust_payby->payby =~ /^(CARD|DCRD)$/ ) { $return{card_type} = cardtype($cust_payby->payinfo); @@ -980,6 +981,7 @@ sub validate_payment { #false laziness w/process/payment.cgi my $payinfo; my $paycvv = ''; + my $replace_cust_payby; if ( $payby eq 'CHEK' || $payby eq 'DCHK' ) { $p->{'payinfo1'} =~ /^([\dx]+)$/ @@ -994,6 +996,7 @@ sub validate_payment { foreach my $cust_payby ($cust_main->cust_payby('CHEK','DCHK')) { if ( $cust_payby->paymask eq $payinfo ) { $payinfo = $cust_payby->payinfo; + $replace_cust_payby = $cust_payby; $achonfile = 1; last; } @@ -1014,6 +1017,7 @@ sub validate_payment { foreach my $cust_payby ($cust_main->cust_payby('CARD','DCRD')) { if ( $cust_payby->paymask eq $payinfo ) { $payinfo = $cust_payby->payinfo; + $replace_cust_payby = $cust_payby; $onfile = 1; last; } @@ -1055,6 +1059,8 @@ sub validate_payment { 'CHEK' => [ qw( ss paytype paystate stateid stateid_state payip ) ], ); + my %replace = ( 'replace' => $replace_cust_payby, ); + my $card_type = ''; $card_type = cardtype($payinfo) if $payby eq 'CARD'; @@ -1063,7 +1069,7 @@ sub validate_payment { 'amount' => sprintf('%.2f', $amount), 'payby' => $payby, 'payinfo' => $payinfo, - 'paymask' => $cust_main->mask_payinfo( $payby, $payinfo ), + 'paymask' => FS::payinfo_Mixin->mask_payinfo( $payby, $payinfo ), 'card_type' => $card_type, 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01', 'paydate_pretty' => $p->{'month'}. ' / '. $p->{'year'}, @@ -1076,6 +1082,7 @@ sub validate_payment { 'payname' => $payname, 'discount_term' => $discount_term, 'pkgnum' => $session->{'pkgnum'}, + %replace, map { $_ => $p->{$_} } ( @{ $payby2fields{$payby} }, qw( save auto ), ) @@ -1158,6 +1165,7 @@ sub do_process_payment { my $error = $cust_main->save_cust_payby( 'payment_payby' => $payby, + 'replace' => $validate->{'replace'}, # cust_payby object to replace %saveopt ); diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index d41cc741b..ed72354dd 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -898,6 +898,14 @@ my $validate_email = sub { $_[0] =~ }, { + 'key' => 'email-to-voice_domain', + 'section' => 'email_to_voice_services', + 'description' => 'The domain name that phone numbers will be attached to for sending email to voice emails via a 3rd party email to voice service. You will get this domain from your email to voice service provider. This is utilized on the email customer page or when using the email to voice billing event action. There you will be able to select the phone number for the email to voice service.', + 'type' => 'text', + 'per_agent' => 1, + }, + + { 'key' => 'next-bill-ignore-time', 'section' => 'billing', 'description' => 'Ignore the time portion of next bill dates when billing, matching anything from 00:00:00 to 23:59:59 on the billing day.', @@ -4302,6 +4310,7 @@ and customer address. Include units.', '' => 'Numeric only', '\d{7}' => 'Numeric only, exactly 7 digits', 'ww?d+' => 'Numeric with one or two letter prefix', + 'd+-w' => 'Numeric with a dash and one letter suffix', ], }, @@ -4479,7 +4488,7 @@ and customer address. Include units.', 'section' => 'addresses', 'description' => 'The year to use in census tract lookups. NOTE: you need to select 2012 or 2013 for Year 2010 Census tract codes. A selection of 2011 provides Year 2000 Census tract codes. Use the freeside-censustract-update tool if exisitng customers need to be changed.', 'type' => 'select', - 'select_enum' => [ qw( 2013 2012 2011 ) ], + 'select_enum' => [ qw( 2017 2016 2015 ) ], }, { @@ -5788,8 +5797,8 @@ and customer address. Include units.', { 'key' => 'logout-timeout', - 'section' => 'UI', - 'description' => 'If set, automatically log users out of the backoffice after this many minutes.', + 'section' => 'deprecated', + 'description' => 'Deprecated. Used to automatically log users out of the backoffice after this many minutes. Set session timeouts in employee groups instead.', 'type' => 'text', }, diff --git a/FS/FS/Cron/backup.pm b/FS/FS/Cron/backup.pm index 7d868c882..5276565c5 100644 --- a/FS/FS/Cron/backup.pm +++ b/FS/FS/Cron/backup.pm @@ -25,7 +25,7 @@ sub backup { my $ext; if ( driver_name eq 'Pg' ) { - system("pg_dump -Fc $database >/var/tmp/$database.Pg"); + system("pg_dump -Fc -T h_cdr -T h_queue -T h_queue_arg $database >/var/tmp/$database.Pg"); $ext = 'Pg'; } elsif ( driver_name eq 'mysql' ) { system("mysqldump $database >/var/tmp/$database.sql"); diff --git a/FS/FS/Cron/rt_tasks.pm b/FS/FS/Cron/rt_tasks.pm index 01ea0b5dd..077f23cc6 100644 --- a/FS/FS/Cron/rt_tasks.pm +++ b/FS/FS/Cron/rt_tasks.pm @@ -31,6 +31,8 @@ sub rt_daily { my $system = $FS::TicketSystem::system; return if !defined($system) || $system ne 'RT_Internal'; + system('/opt/rt3/sbin/rt-fulltext-indexer --quiet --limit 5400 &'); + # if -d or -y is in use, bail out. There's no reliable way to tell RT # to use an alternate system time. if ( $opt{'d'} or $opt{'y'} ) { diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 956ea6210..7bdb6059e 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -262,6 +262,7 @@ if ( -e $addl_handler_use_file ) { use FS::cust_category; use FS::prospect_main; use FS::contact; + use FS::contact::Import; use FS::phone_type; use FS::svc_pbx; use FS::discount; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index f2e9e6fba..479f9b1f1 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2647,7 +2647,7 @@ sub ut_currency { =item ut_text COLUMN Check/untaint text. Alphanumerics, spaces, and the following punctuation -symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] < > +symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] < > ~ May not be null. If there is an error, returns the error, otherwise returns false. @@ -2661,7 +2661,7 @@ sub ut_text { # \p{Word} = alphanumerics, marks (diacritics), and connectors # see perldoc perluniprops $self->getfield($field) - =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/ + =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\~$money_char]+)$/ or return gettext('illegal_or_empty_text'). " $field: ". $self->getfield($field); $self->setfield($field,$1); diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index d7c7452f1..d347c0653 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2335,6 +2335,7 @@ sub tables_hashref { 'taxratelocationnum', 'serial', '', '', '', '', 'data_vendor', 'varchar', 'NULL', $char_d, '', '', 'geocode', 'varchar', '', 20, '', '', + 'district', 'varchar', 'NULL', $char_d, '', '', 'city', 'varchar', 'NULL', $char_d, '', '', 'county', 'varchar', 'NULL', $char_d, '', '', 'state', 'char', 'NULL', 2, '', '', @@ -5796,6 +5797,25 @@ sub tables_hashref { ], }, + 'access_user_session_log' => { + 'columns' => [ + 'sessionlognum', 'serial', '', '', '', '', + 'usernum', 'int', '', '', '', '', + 'start_date', @date_type, '', '', + 'last_date', @date_type, '', '', + 'logout_date', @date_type, '', '', + 'logout_type', 'varchar', '', $char_d, '', '', + ], + 'primary_key' => 'sessionlognum', + 'unique' => [], + 'index' => [], + 'foreign_keys' => [ + { columns => [ 'usernum' ], + table => 'access_user', + }, + ], + }, + 'access_user' => { 'columns' => [ 'usernum', 'serial', '', '', '', '', @@ -5843,8 +5863,9 @@ sub tables_hashref { 'access_group' => { 'columns' => [ - 'groupnum', 'serial', '', '', '', '', - 'groupname', 'varchar', '', $char_d, '', '', + 'groupnum', 'serial', '', '', '', '', + 'groupname', 'varchar', '', $char_d, '', '', + 'session_timeout', 'int', 'NULL', '', '', '', ], 'primary_key' => 'groupnum', 'unique' => [ [ 'groupname' ] ], @@ -6995,7 +7016,7 @@ sub tables_hashref { 'vendor_order_status', 'varchar', 'NULL', $char_d, '', '', 'endpoint_ip_addr', 'varchar', 'NULL', 40, '', '', 'endpoint_mac_addr', 'varchar', 'NULL', 12, '', '', - 'internal_circuit_id', 'varchar', '', 64, '', '', + 'internal_circuit_id', 'varchar', 'NULL', 64, '', '', ], 'primary_key' => 'svcnum', 'unique' => [], diff --git a/FS/FS/TaxEngine/compliance_solutions.pm b/FS/FS/TaxEngine/compliance_solutions.pm index 92ca2ce02..1f0c16605 100644 --- a/FS/FS/TaxEngine/compliance_solutions.pm +++ b/FS/FS/TaxEngine/compliance_solutions.pm @@ -263,7 +263,7 @@ sub make_taxlines { # create a tax rate location if there isn't one yet my $taxname = $tax_data->{descript}; my $tax_rate = FS::tax_rate->new({ - data_vendor => 'compliance solutions', + data_vendor => 'compliance_solutions', taxname => $taxname, taxclassnum => '', taxauth => $tax_data->{'taxauthtype'}, # federal / state / city / district @@ -277,13 +277,16 @@ sub make_taxlines { $tax_rate = $tax_rate->replace_old; my $tax_rate_location = FS::tax_rate_location->new({ - data_vendor => 'compliance solutions', - state => $tax_data->{'state'}, - country => $tax_data->{'country'}, + data_vendor => 'compliance_solutions', geocode => $tax_data->{'geocode'}, + district => $tax_data->{'geo_district'}, + state => $tax_data->{'geo_state'}, + county => $tax_data->{'geo_county'}, + country => 'US', }); $error = $tax_rate_location->find_or_insert; - die "error inserting tax_rate_location record: $error\n" + die 'error inserting tax_rate_location record for '. $tax_data->{state}. + '/'. $tax_data->{country}. ' ('. $tax_data->{'geocode'}. "): $error\n" if $error; $tax_rate_location = $tax_rate_location->replace_old; diff --git a/FS/FS/TaxEngine/internal.pm b/FS/FS/TaxEngine/internal.pm index dbe9a99e0..5f5d2295a 100644 --- a/FS/FS/TaxEngine/internal.pm +++ b/FS/FS/TaxEngine/internal.pm @@ -23,7 +23,8 @@ sub add_sale { my ($self, $cust_bill_pkg) = @_; my $part_item = $cust_bill_pkg->part_X; - my $location = $cust_bill_pkg->tax_location; + my $location = $cust_bill_pkg->tax_location + or return; my $custnum = $self->{cust_main}->custnum; push @{ $self->{items} }, $cust_bill_pkg; diff --git a/FS/FS/TaxEngine/suretax.pm b/FS/FS/TaxEngine/suretax.pm index 1a00cdaaa..356f5f318 100644 --- a/FS/FS/TaxEngine/suretax.pm +++ b/FS/FS/TaxEngine/suretax.pm @@ -14,7 +14,7 @@ our $DEBUG = 1; # prints progress messages # $DEBUG = 2; # prints decoded request and response (noisy, be careful) # $DEBUG = 3; # prints raw response from the API, ridiculously unreadable -our $json = Cpanel::JSON::XS->new->pretty(1); +our $json = Cpanel::JSON::XS->new->pretty(0)->shrink(1); our %taxproduct_cache; @@ -328,13 +328,14 @@ sub make_taxlines { return; } - warn "sending SureTax request\n" if $DEBUG; + warn "encoding SureTax request\n" if $DEBUG; my $request_json = $json->encode($request); warn $request_json if $DEBUG > 1; my $host = $conf->config('suretax-hostname'); $host ||= 'testapi.taxrating.net'; + warn "sending SureTax request\n" if $DEBUG; # We are targeting the "V05" interface: # - accepts both telecom and general sales transactions # - produces results broken down by "invoice" (Freeside line item) @@ -346,8 +347,11 @@ sub make_taxlines { 'Accept' => 'application/json', ); + warn 'received SureTax response: '. $http_response->status_line. "\n" + if $DEBUG; + die $http_response->status_line. "\n" unless $http_response->is_success; + my $raw_response = $http_response->content; - warn "received response\n" if $DEBUG; warn $raw_response if $DEBUG > 2; my $response; if ( $raw_response =~ /^<\?xml/ ) { @@ -356,8 +360,10 @@ sub make_taxlines { $response = XMLin( $raw_response ); $raw_response = $response->{content}; } + + warn "decoding SureTax response\n" if $DEBUG; $response = eval { $json->decode($raw_response) } - or die "$raw_response\n"; + or die "Can't JSON-decode response: $raw_response\n"; # documentation implies this might be necessary $response = $response->{'d'} if exists $response->{'d'}; @@ -375,6 +381,7 @@ sub make_taxlines { } return if !$response->{GroupList}; + warn "creating FS objects from SureTax data\n" if $DEBUG; foreach my $taxable ( @{ $response->{GroupList} } ) { # each member of this array here corresponds to what SureTax calls an # "invoice" and we call a "line item". The invoice number is @@ -420,6 +427,7 @@ sub make_taxlines { }); } } + warn "TaxEngine/suretax.pm make_taxlines done; returning FS objects\n" if $DEBUG; return @elements; } diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index 6edec9072..0069e207a 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -497,6 +497,10 @@ sub upgrade_data { #mark certain taxes as system-maintained, # and fix whitespace 'cust_main_county' => [], + + #'compliance solutions' -> 'compliance_solutions' + 'tax_rate' => [], + 'tax_rate_location' => [], ; \%hash; diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index 409b44136..155da739e 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -155,6 +155,7 @@ sub _upgrade_data { # class method 'Refund payment' => [ 'Refund credit card payment', 'Refund Echeck payment' ], 'Regular void' => [ 'Void payments' ], 'Unvoid' => [ 'Unvoid payments', 'Unvoid invoices' ], + 'Employees: Audit Report' => [ 'Employee Reports' ], ); foreach my $oldright (keys %migrate) { @@ -233,9 +234,7 @@ sub _upgrade_data { # class method 'Usage: Unrateable CDRs', ], 'Provision customer service' => [ 'Edit password' ], - 'Financial reports' => [ 'Employees: Commission Report', - 'Employees: Audit Report', - ], + 'Financial reports' => 'Employee Reports', 'Change customer package' => 'Detach customer package', 'Services: Accounts' => 'Services: Cable Subscribers', 'Bulk change customer packages' => 'Bulk move customer services', @@ -261,6 +260,7 @@ sub _upgrade_data { # class method 'List customers' => 'Customers: Customer churn report', 'Edit customer note' => 'Delete customer note', 'Edit customer' => 'Edit customer invoice terms', + 'Financial reports' => 'Basic payment and refund reports', ); # foreach my $old_acl ( keys %onetime ) { diff --git a/FS/FS/access_user_session_log.pm b/FS/FS/access_user_session_log.pm new file mode 100644 index 000000000..d28ec8586 --- /dev/null +++ b/FS/FS/access_user_session_log.pm @@ -0,0 +1,124 @@ +package FS::access_user_session_log; +use base qw( FS::Record ); + +use strict; +#use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::access_user_session_log - Object methods for access_user_session_log records + +=head1 SYNOPSIS + + use FS::access_user_session_log; + + $record = new FS::access_user_session_log \%hash; + $record = new FS::access_user_session_log { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::access_user_session_log object represents an log of an employee session. +FS::access_user_session_log inherits from FS::Record. The following fields +are currently supported: + +=over 4 + +=item sessionlognum + +primary key + +=item usernum + +usernum + +=item start_date + +start_date + +=item last_date + +last_date + +=item logout_date + +logout_date + +=item logout_type + +logout_type + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new log entry. To add the entry to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +sub table { 'access_user_session_log'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid log entry. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('usernum') + || $self->ut_numbern('start_date') + || $self->ut_numbern('last_date') + || $self->ut_numbern('logout_date') + || $self->ut_text('logout_type') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/contact.pm b/FS/FS/contact.pm index 568d46f07..44c538806 100644 --- a/FS/FS/contact.pm +++ b/FS/FS/contact.pm @@ -10,6 +10,7 @@ use FS::Record qw( qsearch qsearchs dbh ); use FS::Cursor; use FS::contact_phone; use FS::contact_email; +use FS::contact::Import; use FS::queue; use FS::phone_type; #for cgi_contact_fields use FS::cust_contact; diff --git a/FS/FS/contact/Import.pm b/FS/FS/contact/Import.pm new file mode 100644 index 000000000..26bdcfa6e --- /dev/null +++ b/FS/FS/contact/Import.pm @@ -0,0 +1,161 @@ +package FS::contact::Import; + +use strict; +use vars qw( $DEBUG ); #$conf ); +use Data::Dumper; +use FS::Misc::DateTime qw( parse_datetime ); +use FS::Record qw( qsearchs ); +use FS::contact; +use FS::cust_main; + +$DEBUG = 0; + +=head1 NAME + +FS::contact::Import - Batch contact importing + +=head1 SYNOPSIS + + use FS::contact::Import; + + #import + FS::contact::Import::batch_import( { + file => $file, #filename + type => $type, #csv or xls + format => $format, #default + agentnum => $agentnum, + job => $job, #optional job queue job, for progressbar updates + pkgbatch => $pkgbatch, #optional batch unique identifier + } ); + die $error if $error; + + #ajax helper + use FS::UI::Web::JSRPC; + my $server = + new FS::UI::Web::JSRPC 'FS::contact::Import::process_batch_import', $cgi; + print $server->process; + +=head1 DESCRIPTION + +Batch contact importing. + +=head1 SUBROUTINES + +=item process_batch_import + +Load a batch import as a queued JSRPC job + +=cut + +sub process_batch_import { + my $job = shift; + my $param = shift; + warn Dumper($param) if $DEBUG; + + my $files = $param->{'uploaded_files'} + or die "No files provided.\n"; + + my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files; + + my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/'; + #my $dir = '/usr/local/etc/freeside/cache.'. $FS::UID::datasrc. '/'; + my $file = $dir. $files{'file'}; + + my $type; + if ( $file =~ /\.(\w+)$/i ) { + $type = lc($1); + } else { + #or error out??? + warn "can't parse file type from filename $file; defaulting to CSV"; + $type = 'csv'; + } + + my $error = + FS::contact::Import::batch_import( { + job => $job, + file => $file, + type => $type, + agentnum => $param->{'agentnum'}, + 'format' => $param->{'format'}, + } ); + + unlink $file; + + die "$error\n" if $error; + +} + +=item batch_import + +=cut + +my %formatfields = ( + 'default' => [ qw( custnum last first title comment selfservice_access emailaddress phonetypenum1 phonetypenum3 phonetypenum2 ) ], +); + +sub _formatfields { + \%formatfields; +} + +## not tested but maybe allow 2nd format to attach location in the future +my %import_options = ( + 'table' => 'contact', + + 'preinsert_callback' => sub { + my($record, $param) = @_; + my @location_params = grep /^location\./, keys %$param; + if (@location_params) { + my $cust_location = FS::cust_location->new({ + 'custnum' => $record->custnum, + }); + foreach my $p (@location_params) { + $p =~ /^location.(\w+)$/; + $cust_location->set($1, $param->{$p}); + } + + my $error = $cust_location->find_or_insert; # this avoids duplicates + return "error creating location: $error" if $error; + $record->set('locationnum', $cust_location->locationnum); + } + ''; + }, + +); + +sub _import_options { + \%import_options; +} + +sub batch_import { + my $opt = shift; + + my $iopt = _import_options; + $opt->{$_} = $iopt->{$_} foreach keys %$iopt; + + my $format = delete $opt->{'format'}; + + my $formatfields = _formatfields(); + die "unknown format $format" unless $formatfields->{$format}; + + my @fields; + foreach my $field ( @{ $formatfields->{$format} } ) { + push @fields, $field; + } + + $opt->{'fields'} = \@fields; + + FS::Record::batch_import( $opt ); + +} + +=head1 BUGS + +Not enough documentation. + +=head1 SEE ALSO + +L<FS::contact> + +=cut + +1;
\ No newline at end of file diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index f8157c478..925eb4e44 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4617,6 +4617,8 @@ PAYBYLOOP: next if grep(/^$field$/, qw( custpaybynum payby weight ) ); next if grep(/^$field$/, @preserve ); next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field); + # check if paymask exists, if so stop and don't save, no need for a duplicate. + return '' if $new->get('paymask') eq $cust_payby->get('paymask'); } # now check fields that can replace if one value is blank my $replace = 0; diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index d62120b3f..f16752ba4 100644 --- a/FS/FS/cust_main/Billing_Realtime.pm +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -6,6 +6,7 @@ use vars qw( $realtime_bop_decline_quiet ); #ugh use Carp; use Data::Dumper; use Business::CreditCard 0.35; +use Business::OnlinePayment; use FS::UID qw( dbh myconnect ); use FS::Record qw( qsearch qsearchs ); use FS::payby; diff --git a/FS/FS/cust_main/Import.pm b/FS/FS/cust_main/Import.pm index 646476162..9624529fa 100644 --- a/FS/FS/cust_main/Import.pm +++ b/FS/FS/cust_main/Import.pm @@ -325,6 +325,7 @@ sub batch_import { my %svc_x = (); my %bill_location = (); my %ship_location = (); + my $cust_payby = ''; foreach my $field ( @fields ) { if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) { @@ -409,17 +410,24 @@ sub batch_import { if ( $cust_main{'payinfo'} =~ /^\s*(\d+\@[\d\.]+)\s*$/ ) { - $cust_main{'payby'} = 'CHEK'; - $cust_main{'payinfo'} = $1; + delete $cust_main{'payinfo'}; - } else { + $cust_payby = new FS::cust_payby { + 'payby' => 'CHEK', + 'payinfo' => $1, + }; - $cust_main{'payby'} = 'CARD'; + } elsif ($cust_main{'payinfo'} =~ /^\s*([AD]?)(.*)\s*$/) { - if ($cust_main{'payinfo'} =~ /^\s*([AD]?)(.*)\s*$/) { - $cust_main{'payby'} = 'DCRD' if $1 eq 'D'; - $cust_main{'payinfo'} = $2; - } + delete $cust_main{'payinfo'}; + + $cust_payby = new FS::cust_payby { + 'payby' => ($1 eq 'D') ? 'DCRD' : 'CARD', + 'payinfo' => $2, + 'paycvv' => delete $cust_main{'paycvv'}, + 'paydate' => delete $cust_main{'paydate'}, + 'payname' => $cust_main{'first'}. ' '. $cust_main{'last'}, + }; } @@ -502,7 +510,10 @@ sub batch_import { $hash{$cust_pkg} = \@svc_x; } - my $error = $cust_main->insert( \%hash, $invoicing_list ); + my %options = ('invoicing_list' => $invoicing_list); + $options{'cust_payby'} = [ $cust_payby ] if $cust_payby; + + my $error = $cust_main->insert( \%hash, %options ); if ( $error ) { $dbh->rollback if $oldAutoCommit; diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm index d66809404..2ec87cd14 100644 --- a/FS/FS/cust_main/Search.pm +++ b/FS/FS/cust_main/Search.pm @@ -93,7 +93,7 @@ sub smart_search { my $phonenum = "$1$2$3"; #my $extension = $4; - #cust_main phone numbers + #cust_main phone numbers and contact phone number push @cust_main, qsearch( { 'table' => 'cust_main', 'hashref' => { %options }, @@ -102,20 +102,12 @@ sub smart_search { join(' OR ', map "$_ = '$phonen'", qw( daytime night mobile fax ) ). + " OR phonenum = '$phonenum' ". ' ) '. " AND $agentnums_sql", #agent virtualization + 'addl_from' => ' left join cust_contact using (custnum) left join contact_phone using (contactnum) ', } ); - #contact phone numbers - push @cust_main, - grep $agentnums_href->{$_->agentnum}, #agent virt - grep $_, #skip contacts that don't have cust_main records - map $_->contact->cust_main, - qsearch({ - 'table' => 'contact_phone', - 'hashref' => { 'phonenum' => $phonenum }, - }); - unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match #try looking for matches with extensions unless one was specified @@ -136,45 +128,40 @@ sub smart_search { } - if ( $search =~ /@/ ) { #email address - - # invoicing email address - push @cust_main, - grep $agentnums_href->{$_->agentnum}, #agent virt - map $_->cust_main, - qsearch( { - 'table' => 'cust_main_invoice', - 'hashref' => { 'dest' => $search }, - } - ); - - # contact email address - push @cust_main, - grep $agentnums_href->{$_->agentnum}, #agent virt - grep $_, #skip contacts that don't have cust_main records - map $_->contact->cust_main, - qsearch( { - 'table' => 'contact_email', - 'hashref' => { 'emailaddress' => $search }, - } - ); + if ( $search =~ /@/ ) { #email address from cust_main_invoice and contact_email + + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { %options }, + 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). + ' ( '. + join(' OR ', map "$_ = '$search'", + qw( dest emailaddress ) + ). + ' ) '. + " 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 # legacy cust "numbers" have letters - } elsif ( $search =~ /^\s*(\d+)\s*$/ - || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+' - && $search =~ /^\s*(\w\w?\d+)\s*$/ - ) - || ( $conf->config('cust_main-custnum-display_special') - # it's not currently possible for special prefixes to contain - # digits, so just strip off any alphabetic prefix and match - # the rest to custnum - && $search =~ /^\s*[[:alpha:]]*(\d+)\s*$/ - ) - || ( $conf->exists('address1-search' ) - && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D - ) - ) + } elsif ( $search =~ /^\s*(\d+)\s*$/ + or ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+' + && $search =~ /^\s*(\w\w?\d+)\s*$/ + ) + or ( $conf->config('cust_main-agent_custid-format') eq 'd+-w' + && $search =~ /^\s*(\d+-\w)\s*$/ + ) + or ( $conf->config('cust_main-custnum-display_special') + # it's not currently possible for special prefixes to contain + # digits, so just strip off any alphabetic prefix and match + # the rest to custnum + && $search =~ /^\s*[[:alpha:]]*(\d+)\s*$/ + ) + or ( $conf->exists('address1-search' ) + && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D + ) + ) { my $num = $1; @@ -278,8 +265,8 @@ sub smart_search { } elsif ( ! $NameParse->parse($value) ) { my %name = $NameParse->components; - $first = $name{'given_name_1'} || $name{'initials_1'}; #wtf NameParse, Ed? - $last = $name{'surname_1'}; + $first = lc($name{'given_name_1'}) || $name{'initials_1'}; #wtf NameParse, Ed? + $last = lc($name{'surname_1'}); } @@ -289,28 +276,18 @@ sub smart_search { #exact my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; - $sql .= "( LOWER(cust_main.last) = $q_last AND LOWER(cust_main.first) = $q_first )"; + $sql .= "( (LOWER(cust_main.last) = $q_last AND LOWER(cust_main.first) = $q_first) + OR (LOWER(contact.last) = $q_last AND LOWER(contact.first) = $q_first) )"; - #cust_main + #cust_main and contacts push @cust_main, qsearch( { 'table' => 'cust_main', - 'hashref' => \%options, + 'select' => 'cust_main.*, cust_contact.*, contact.contactnum, contact.last as contact_last, contact.first as contact_first, contact.title', + '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) ', } ); - #contacts - push @cust_main, - grep $agentnums_href->{$_->agentnum}, #agent virt - grep $_, #skip contacts that don't have cust_main records - map $_->cust_main, - qsearch( { - 'table' => 'contact', - 'hashref' => { 'first' => $first, - 'last' => $last, - }, - } - ); - # or it just be something that was typed in... (try that in a sec) } @@ -323,7 +300,9 @@ sub smart_search { OR LOWER(cust_main.last) = $q_value OR LOWER(cust_main.company) = $q_value OR LOWER(cust_main.ship_company) = $q_value - "; + OR LOWER(contact.first) = $q_value + OR LOWER(contact.last) = $q_value + )"; #address1 (yes, it's a kludge) $sql .= " OR EXISTS ( @@ -333,20 +312,12 @@ sub smart_search { )" if $conf->exists('address1-search'); - #contacts (look, another kludge) - $sql .= " OR EXISTS ( SELECT 1 FROM contact - WHERE ( LOWER(contact.first) = $q_value - OR LOWER(contact.last) = $q_value - ) - AND contact.custnum IS NOT NULL - AND contact.custnum = cust_main.custnum - ) - ) "; - push @cust_main, qsearch( { 'table' => 'cust_main', - 'hashref' => \%options, + 'select' => 'cust_main.*, cust_contact.*, contact.contactnum, contact.last as contact_last, contact.first as contact_first, contact.title', + '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 @@ -872,10 +843,24 @@ sub search { ## # with referrals ## - if ( $params->{'with_referrals'} ) { + if ( $params->{with_referrals} =~ /^\s*(\d+)\s*$/ ) { + + my $n = $1; + + # referral status + my $and_status = ''; + if ( grep { $params->{referral_status} eq $_ } FS::cust_main->statuses() ) { + my $method = $params->{referral_status}. '_sql'; + $and_status = ' AND '. FS::cust_main->$method(); + $and_status =~ s/ cust_main\./ referred_cust_main./g; + } + push @where, - ' EXISTS ( SELECT 1 FROM cust_main AS referred_cust_main - WHERE cust_main.custnum = referred_cust_main.referral_custnum )'; + " $n <= ( SELECT COUNT(*) FROM cust_main AS referred_cust_main + WHERE cust_main.custnum = referred_cust_main.referral_custnum + $and_status + )"; + } ## @@ -1064,8 +1049,48 @@ sub search { FS::UI::Web::cust_sql_fields($params->{'cust_fields'}), ); - my(@extra_headers) = (); - my(@extra_fields) = (); + my @extra_headers = (); + my @extra_fields = (); + my @extra_sort_fields = (); + + ## search contacts + if ($params->{'contacts'}) { + my $contact_params = $params->{'contacts'}; + + $addl_from .= + ' LEFT JOIN cust_contact ON ( cust_main.custnum = cust_contact.custnum ) '; + + if ($contact_params->{'contacts_firstname'} || $contact_params->{'contacts_lastname'}) { + $addl_from .= ' LEFT JOIN contact ON ( cust_contact.contactnum = contact.contactnum ) '; + my $first_query = " AND contact.first = '" . $contact_params->{'contacts_firstname'} . "'" + unless !$contact_params->{'contacts_firstname'}; + my $last_query = " AND contact.last = '" . $contact_params->{'contacts_lastname'} . "'" + unless !$contact_params->{'contacts_lastname'}; + $extra_sql .= " AND ( '1' $first_query $last_query )"; + } + + if ($contact_params->{'contacts_email'}) { + $addl_from .= ' LEFT JOIN contact_email ON ( cust_contact.contactnum = contact_email.contactnum ) '; + $extra_sql .= " AND ( contact_email.emailaddress = '" . $contact_params->{'contacts_email'} . "' )"; + } + + if ($contact_params->{'contacts_homephone'} || $contact_params->{'contacts_workphone'} || $contact_params->{'contacts_mobilephone'}) { + $addl_from .= ' LEFT JOIN contact_phone ON ( cust_contact.contactnum = contact_phone.contactnum ) '; + my $contacts_mobilephone; + foreach my $phone (qw( contacts_homephone contacts_workphone contacts_mobilephone )) { + (my $num = $contact_params->{$phone}) =~ s/\W//g; + if ( $num =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { $contact_params->{$phone} = "$1$2$3"; } + } + my $home_query = " AND ( contact_phone.phonetypenum = '2' AND contact_phone.phonenum = '" . $contact_params->{'contacts_homephone'} . "' )" + unless !$contact_params->{'contacts_homephone'}; + my $work_query = " AND ( contact_phone.phonetypenum = '1' AND contact_phone.phonenum = '" . $contact_params->{'contacts_workphone'} . "' )" + unless !$contact_params->{'contacts_workphone'}; + my $mobile_query = " AND ( contact_phone.phonetypenum = '3' AND contact_phone.phonenum = '" . $contact_params->{'contacts_mobilephone'} . "' )" + unless !$contact_params->{'contacts_mobilephone'}; + $extra_sql .= " AND ( '1' $home_query $work_query $mobile_query )"; + } + + } if ($params->{'flattened_pkgs'}) { @@ -1110,6 +1135,7 @@ sub search { my $p = $a[!.--$headercount. q!]; $p; };!; + unshift @extra_sort_fields, ''; } } @@ -1125,21 +1151,23 @@ sub search { unshift @extra_headers, 'Referrals'; unshift @extra_fields, 'num_referrals'; + unshift @extra_sort_fields, 'num_referrals'; } my $select = join(', ', @select); my $sql_query = { - 'table' => 'cust_main', - 'select' => $select, - 'addl_from' => $addl_from, - 'hashref' => {}, - 'extra_sql' => $extra_sql, - 'order_by' => $orderby, - 'count_query' => $count_query, - 'extra_headers' => \@extra_headers, - 'extra_fields' => \@extra_fields, + 'table' => 'cust_main', + 'select' => $select, + 'addl_from' => $addl_from, + 'hashref' => {}, + 'extra_sql' => $extra_sql, + 'order_by' => $orderby, + 'count_query' => $count_query, + 'extra_headers' => \@extra_headers, + 'extra_fields' => \@extra_fields, + 'extra_sort_fields' => \@extra_sort_fields, }; $sql_query; diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm index 195574627..8b6569a74 100644 --- a/FS/FS/cust_main_Mixin.pm +++ b/FS/FS/cust_main_Mixin.pm @@ -262,6 +262,17 @@ sub cust_statuscolor { : '000000'; } +=item agent_name + +=cut + +sub agent_name { + my $self = shift; + $self->cust_linked + ? $self->cust_main->agent_name + : $self->cust_unlinked_msg; +} + =item prospect_sql =item active_sql @@ -397,14 +408,21 @@ use Digest::SHA qw(sha1); # for duplicate checking sub email_search_result { my($class, $param) = @_; + my $conf = FS::Conf->new; + my $send_to_domain = $conf->config('email-to-voice_domain'); + my $msgnum = $param->{msgnum}; my $from = delete $param->{from}; my $subject = delete $param->{subject}; my $html_body = delete $param->{html_body}; my $text_body = delete $param->{text_body}; my $to_contact_classnum = delete $param->{to_contact_classnum}; + my $emailtovoice_name = delete $param->{emailtovoice_contact}; + my $error = ''; + my $to = $emailtovoice_name . '@' . $send_to_domain unless !$emailtovoice_name; + my $job = delete $param->{'job'} or die "email_search_result must run from the job queue.\n"; @@ -465,10 +483,14 @@ sub email_search_result { next; # unlinked object; nothing else we can do } +my %to = {}; +if ($to) { $to{'to'} = $to; } + my $cust_msg = $msg_template->prepare( 'cust_main' => $cust_main, 'object' => $obj, 'to_contact_classnum' => $to_contact_classnum, + %to, ); # For non-cust_main searches, we avoid duplicates based on message diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index b256daedc..c70a6795f 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2622,9 +2622,9 @@ sub change { foreach my $old_discount ($self->cust_pkg_discount_active) { # don't remove the old discount, we may still need to bill that package. my $new_discount = new FS::cust_pkg_discount { - 'pkgnum' => $cust_pkg->pkgnum, - 'discountnum' => $old_discount->discountnum, - 'months_used' => $old_discount->months_used, + 'pkgnum' => $cust_pkg->pkgnum, + map { $_ => $old_discount->$_() } + qw( discountnum months_used end_date usernum setuprecur ), }; $error = $new_discount->insert; if ( $error ) { diff --git a/FS/FS/cust_pkg/Import.pm b/FS/FS/cust_pkg/Import.pm index 63a9909e5..b827bcfe1 100644 --- a/FS/FS/cust_pkg/Import.pm +++ b/FS/FS/cust_pkg/Import.pm @@ -105,6 +105,7 @@ my %formatfields = ( 'svc_phone' => [qw( countrycode phonenum sip_password pin )], 'svc_external' => [qw( id title )], 'location' => [qw( address1 address2 city state zip country )], + 'quan_price' => [qw( quantity setup_fee recur_fee invoice_details )], ); sub _formatfields { @@ -116,8 +117,11 @@ my %import_options = ( 'preinsert_callback' => sub { my($record, $param) = @_; - my @location_params = grep /^location\./, keys %$param; + + my @location_params = grep { /^location\./ && length($param->{$_}) } + keys %$param; if (@location_params) { +warn join('-', @location_params); my $cust_location = FS::cust_location->new({ 'custnum' => $record->custnum, }); @@ -130,12 +134,53 @@ my %import_options = ( return "error creating location: $error" if $error; $record->set('locationnum', $cust_location->locationnum); } + + $record->quantity( $param->{'quan_price.quantity'} ) + if $param->{'quan_price.quantity'} > 0; + + my $s = $param->{'quan_price.setup_fee'}; + my $r = $param->{'quan_price.recur_fee'}; + my $part_pkg = $record->part_pkg; + if ( ( length($s) && $s != $part_pkg->option('setup_fee') ) + or ( length($r) && $r != $part_pkg->option('recur_fee') ) + ) + { + my $custom_part_pkg = $part_pkg->clone; + $custom_part_pkg->disabled('Y'); + my %options = $part_pkg->options; + $options{'setup_fee'} = $s if length($s); + $options{'recur_fee'} = $r if length($r); + my $error = $custom_part_pkg->insert( options=>\%options ); + return "error customizing package: $error" if $error; + $record->pkgpart( $custom_part_pkg->pkgpart ); + } + + ''; }, 'postinsert_callback' => sub { my( $record, $param ) = @_; + if ( $param->{'quan_price.invoice_details'} ) { + + my $weight = 0; + foreach my $detail (split(/\|/, $param->{'quan_price.invoice_details'})) { + + my $cust_pkg_detail = new FS::cust_pkg_detail { + 'pkgnum' => $record->pkgnum, + 'detail' => $detail, + 'detailtype' => 'I', + 'weight' => $weight++, + }; + + my $error = $cust_pkg_detail->insert; + return "error inserting invoice detail: $error" if $error; + + } + + } + my $formatfields = _formatfields; foreach my $svc_x ( grep /^svc/, keys %$formatfields ) { @@ -283,17 +328,20 @@ sub batch_import { }; } - my $formatfields = _formatfields(); + my @formats = split /-/, $format; + foreach my $f (@formats){ - die "unknown format $format" unless $formatfields->{$format}; + my $formatfields = _formatfields(); + die "unknown format $format" unless $formatfields->{$f}; - foreach my $field ( @{ $formatfields->{$format} } ) { + foreach my $field ( @{ $formatfields->{$f} } ) { - push @fields, sub { - my( $self, $value, $conf, $param ) = @_; - $param->{"$format.$field"} = $value; - }; + push @fields, sub { + my( $self, $value, $conf, $param ) = @_; + $param->{"$f.$field"} = $value; + }; + } } $opt->{'fields'} = \@fields; diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm index 1c2389989..ded57154f 100644 --- a/FS/FS/part_event.pm +++ b/FS/FS/part_event.pm @@ -582,9 +582,11 @@ sub actions { my( $class, $eventtable ) = @_; ( map { $_ => $actions{$_} } - sort { $actions{$a}->{'default_weight'}<=>$actions{$b}->{'default_weight'} } - # || $actions{$a}->{'description'} cmp $actions{$b}->{'description'} } - $class->all_actions( $eventtable ) + sort { + $actions{$a}->{'default_weight'} <=> $actions{$b}->{'default_weight'} + || $actions{$a}->{'description'} cmp $actions{$b}->{'description'} + } + $class->all_actions( $eventtable ) ); } diff --git a/FS/FS/part_event/Action/notice_to_emailtovoice.pm b/FS/FS/part_event/Action/notice_to_emailtovoice.pm new file mode 100644 index 000000000..3eaa73850 --- /dev/null +++ b/FS/FS/part_event/Action/notice_to_emailtovoice.pm @@ -0,0 +1,84 @@ +package FS::part_event::Action::notice_to_emailtovoice; + +use strict; +use base qw( FS::part_event::Action ); +use FS::Record qw( qsearchs ); +use FS::msg_template; +use FS::Conf; + +sub description { 'Email a email to voice notice'; } + +sub eventtable_hashref { + { + 'cust_main' => 1, + 'cust_bill' => 1, + 'cust_pkg' => 1, + 'cust_pay' => 1, + 'cust_pay_batch' => 1, + 'cust_statement' => 1, + 'svc_acct' => 1, + }; +} + +sub option_fields { + + #my $conf = new FS::Conf; + #my $to_domain = $conf->config('email-to-voice_domain'); + +( + 'to_name' => { 'label' => 'Address To', + 'type' => 'select', + 'options' => [ 'mobile', 'fax', 'daytime' ], + 'option_labels' => { 'mobile' => 'Mobile Phone #', + 'fax' => 'Fax #', + 'daytime' => 'Day Time #', + }, + 'post_field_label' => ' <font color="red">Make sure you have setup your email-to-voice_domain config option in your Configuration settings.</font>', + }, + + 'msgnum' => { 'label' => 'Template', + 'type' => 'select-table', + 'table' => 'msg_template', + 'name_col' => 'msgname', + 'hashref' => { disabled => '' }, + 'disable_empty' => 1, + }, + ); + +} + +sub default_weight { 56; } #? + +sub do_action { + my( $self, $object ) = @_; + + my $conf = new FS::Conf; + my $to_domain = $conf->config('email-to-voice_domain') + or die "Can't send notice with out send-to-domain, being set in global config \n"; + + my $cust_main = $self->cust_main($object); + + my $msgnum = $self->option('msgnum'); + my $name = $self->option('to_name'); + + my $msg_template = qsearchs('msg_template', { 'msgnum' => $msgnum } ) + or die "Template $msgnum not found"; + + my $to_name = $cust_main->$name + or die "Can't send notice with out " . $cust_main->$name . " number set"; + + ## remove - from phone number + $to_name =~ s/-//g; + + #my $to = $to_name . '@' . $self->option('to_domain'); + my $to = $to_name . '@' . $to_domain; + + $msg_template->send( + 'to' => $to, + 'cust_main' => $cust_main, + 'object' => $object, + ); + +} + +1; diff --git a/FS/FS/part_event/Condition/referred_cust_base_recur.pm b/FS/FS/part_event/Condition/referred_cust_base_recur.pm new file mode 100644 index 000000000..4ad4da763 --- /dev/null +++ b/FS/FS/part_event/Condition/referred_cust_base_recur.pm @@ -0,0 +1,51 @@ +package FS::part_event::Condition::referred_cust_base_recur; +use base qw( FS::part_event::Condition ); + +use List::Util qw( sum ); + +sub description { 'Referred customers recurring per month'; } + +sub option_fields { + ( + 'recur_times' => { label => 'Base recurring per month of referred customers is at least this many times base recurring per month of referring customer', + type => 'text', + value => '1', + }, + 'if_pkg_class' => { label => 'Only considering package of class', + type => 'select-pkg_class', + multiple => 1, + }, + ); +} + +sub condition { + my($self, $object, %opt) = @_; + + my $cust_main = $self->cust_main($object); + my @cust_pkg = $cust_main->billing_pkgs; + + my @referral_cust_main = $cust_main->referral_cust_main; + my @referral_cust_pkg = map $_->billing_pkgs, @referral_cust_main; + + my $if_pkg_class = $self->option('if_pkg_class') || {}; + if ( keys %$if_pkg_class ) { + @cust_pkg = grep $_->part_pkg->classnum, @cust_pkg; + @referral_cust_pkg = grep $_->part_pkg->classnum, @referral_cust_pkg; + } + + return 0 unless @cust_pkg && @referral_cust_pkg; + + my $recur = sum map $_->part_pkg->base_recur_permonth, @cust_pkg; + my $ref_recur = sum map $_->part_pkg->base_recur_permonth, @referral_cust_pkg; + + $ref_recur >= $self->option('recur_times') * $recur; +} + +#sub condition_sql { +# my( $class, $table ) = @_; +# +# #XXX TODO: this optimization +#} + +1; + diff --git a/FS/FS/part_export/acct_http.pm b/FS/FS/part_export/acct_http.pm index 414350bba..b84e008b9 100644 --- a/FS/FS/part_export/acct_http.pm +++ b/FS/FS/part_export/acct_http.pm @@ -69,10 +69,16 @@ tie %options, 'Tie::IxHash', 'no_machine' => 1, 'notes' => <<'END' Send an HTTP or HTTPS GET or POST to the specified URL on account addition, -modification and deletion. For HTTPS support, -<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a> -or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a> -is required. +modification and deletion. +<p>Each "Data" option takes a list of <i>name value</i> pairs on successive +lines. +<ul><li><i>name</i> is an unquoted, literal string without whitespace.</li> +<li><i>value</i> is a Perl expression that will be evaluated. If it's a +literal string, it must be quoted. This expression has access to the +svc_acct object as '$svc_x' (or '$new' and '$old' in "Replace Data") +and the customer record as '$cust_main'.</li></ul> +If "Success Regexp" is specified, the response from the server will be +tested against it to determine if the export succeeded.</p> END ); diff --git a/FS/FS/part_export/broadband_http.pm b/FS/FS/part_export/broadband_http.pm index 097ff34c3..cc1e45071 100644 --- a/FS/FS/part_export/broadband_http.pm +++ b/FS/FS/part_export/broadband_http.pm @@ -58,15 +58,12 @@ tie %options, 'Tie::IxHash', %info = ( 'svc' => 'svc_broadband', - 'desc' => 'Send an HTTP or HTTPS GET or POST request, for accounts.', + 'desc' => 'Send an HTTP or HTTPS GET or POST request, for wireless broadband services.', 'options' => \%options, 'no_machine' => 1, 'notes' => <<'END' -<p>Send an HTTP or HTTPS GET or POST to the specified URL on account addition, -modification and deletion. For HTTPS support, -<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a> -or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a> -is required.</p> +<p>Send an HTTP or HTTPS GET or POST to the specified URL on wireless broadband service addition, +modification and deletion. <p>Each "Data" option takes a list of <i>name value</i> pairs on successive lines. <ul><li><i>name</i> is an unquoted, literal string without whitespace.</li> diff --git a/FS/FS/part_export/broadband_shellcommands.pm b/FS/FS/part_export/broadband_shellcommands.pm index 44280a200..d3e495c45 100644 --- a/FS/FS/part_export/broadband_shellcommands.pm +++ b/FS/FS/part_export/broadband_shellcommands.pm @@ -70,7 +70,18 @@ sub _export_command { my $command = $self->option($action); return '' if $command =~ /^\s*$/; - #set variables for the command + my $command_string = $self->_export_subvars( $svc_broadband, $command ); + + $self->shellcommands_queue( $svc_broadband->svcnum, + user => $self->option('user')||'root', + host => $self->machine, + command => $command_string, + ); +} + +sub _export_subvars { + my( $self, $svc_broadband, $command ) = @_; + no strict 'vars'; { no strict 'refs'; @@ -85,20 +96,25 @@ sub _export_command { $locationnum = $cust_pkg ? $cust_pkg->locationnum : ''; $custnum = $cust_pkg ? $cust_pkg->custnum : ''; - #done setting variables for the command + eval(qq("$command")); +} - $self->shellcommands_queue( $svc_broadband->svcnum, +sub _export_replace { + my($self, $new, $old ) = (shift, shift, shift); + my $command = $self->option('replace'); + + my $command_string = $self->_export_subvars_replace( $new, $old, $command ); + + $self->shellcommands_queue( $new->svcnum, user => $self->option('user')||'root', host => $self->machine, - command => eval(qq("$command")), + command => $command_string, ); } -sub _export_replace { - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('replace'); +sub _export_subvars_replace { + my( $self, $new, $old, $command ) = @_; - #set variable for the command no strict 'vars'; { no strict 'refs'; @@ -120,15 +136,10 @@ sub _export_replace { $new_locationnum = $new_cust_pkg ? $new_cust_pkg->locationnum : ''; $new_custnum = $new_cust_pkg ? $new_cust_pkg->custnum : ''; - #done setting variables for the command - - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); + eval(qq("$command")); } + #a good idea to queue anything that could fail or take any time sub shellcommands_queue { my( $self, $svcnum ) = (shift, shift); diff --git a/FS/FS/part_export/broadband_shellcommands_expect.pm b/FS/FS/part_export/broadband_shellcommands_expect.pm new file mode 100644 index 000000000..ec525d38a --- /dev/null +++ b/FS/FS/part_export/broadband_shellcommands_expect.pm @@ -0,0 +1,19 @@ +package FS::part_export::broadband_shellcommands_expect; +use base qw( FS::part_export::shellcommands_expect ); + +use strict; +use FS::part_export::broadband_shellcommands; + +our %info = %FS::part_export::shellcommands_expect::info; +$info{'svc'} = 'svc_broadband'; +$info{'desc'} = 'Real time export via remote SSH, with interactive ("Expect"-like) scripting, for svc_broadband services'; + +sub _export_subvars { + FS::part_export::broadband_shellcommands::_export_subvars(@_) +} + +sub _export_subvars_replace { + FS::part_export::broadband_shellcommands::_export_subvars_replace(@_) +} + +1; diff --git a/FS/FS/part_export/dsl_http.pm b/FS/FS/part_export/dsl_http.pm new file mode 100644 index 000000000..ac61ec88d --- /dev/null +++ b/FS/FS/part_export/dsl_http.pm @@ -0,0 +1,72 @@ +package FS::part_export::dsl_http; +use base qw( FS::part_export::http ); + +use Tie::IxHash; + +tie our %options, 'Tie::IxHash', + 'method' => { label =>'Method', + type =>'select', + #options =>[qw(POST GET)], + options =>[qw(POST)], + default =>'POST' }, + 'url' => { label => 'URL', default => 'http://', }, + 'ssl_no_verify' => { label => 'Skip SSL certificate validation', + type => 'checkbox', + }, + 'insert_data' => { + label => 'Insert data', + type => 'textarea', + default => join("\n", + ), + }, + 'delete_data' => { + label => 'Delete data', + type => 'textarea', + default => join("\n", + ), + }, + 'replace_data' => { + label => 'Replace data', + type => 'textarea', + default => join("\n", + ), + }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'success_regexp' => { + label => 'Success Regexp', + default => '', + }, +; + +%info = ( + 'svc' => 'svc_dsl', + 'desc' => 'Send an HTTP or HTTPS GET or POST request, for DSL services.', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<'END' +Send an HTTP or HTTPS GET or POST to the specified URL on account addition, +modification and deletion. +<p>Each "Data" option takes a list of <i>name value</i> pairs on successive +lines. +<ul><li><i>name</i> is an unquoted, literal string without whitespace.</li> +<li><i>value</i> is a Perl expression that will be evaluated. If it's a +literal string, it must be quoted. This expression has access to the +svc_dsl object as '$svc_x' (or '$new' and '$old' in "Replace Data") +and the customer record as '$cust_main'.</li></ul> +If "Success Regexp" is specified, the response from the server will be +tested against it to determine if the export succeeded.</p> +END +); + +1; diff --git a/FS/FS/part_export/fiber_http.pm b/FS/FS/part_export/fiber_http.pm new file mode 100644 index 000000000..38b23c44e --- /dev/null +++ b/FS/FS/part_export/fiber_http.pm @@ -0,0 +1,73 @@ +package FS::part_export::fiber_http; +use base qw( FS::part_export::http ); + +use Tie::IxHash; + +tie our %options, 'Tie::IxHash', + 'method' => { label =>'Method', + type =>'select', + #options =>[qw(POST GET)], + options =>[qw(POST)], + default =>'POST' }, + 'url' => { label => 'URL', default => 'http://', }, + 'ssl_no_verify' => { label => 'Skip SSL certificate validation', + type => 'checkbox', + }, + 'insert_data' => { + label => 'Insert data', + type => 'textarea', + default => join("\n", + ), + }, + 'delete_data' => { + label => 'Delete data', + type => 'textarea', + default => join("\n", + ), + }, + 'replace_data' => { + label => 'Replace data', + type => 'textarea', + default => join("\n", + ), + }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'success_regexp' => { + label => 'Success Regexp', + default => '', + }, +; + +%info = ( + 'svc' => 'svc_fiber', + 'desc' => 'Send an HTTP or HTTPS GET or POST request, for FTTx services.', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<'END' +Send an HTTP or HTTPS GET or POST to the specified URL on account addition, +modification and deletion. +<p>Each "Data" option takes a list of <i>name value</i> pairs on successive +lines. +<ul><li><i>name</i> is an unquoted, literal string without whitespace.</li> +<li><i>value</i> is a Perl expression that will be evaluated. If it's a +literal string, it must be quoted. This expression has access to the +svc_fiber object as '$svc_x' (or '$new' and '$old' in "Replace Data") +and the customer record as '$cust_main'.</li></ul> +If "Success Regexp" is specified, the response from the server will be +tested against it to determine if the export succeeded.</p> +END +); + +1; + diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm index 42a35cb07..43ccfc525 100644 --- a/FS/FS/part_export/http.pm +++ b/FS/FS/part_export/http.pm @@ -59,14 +59,21 @@ tie %options, 'Tie::IxHash', %info = ( 'svc' => 'svc_domain', - 'desc' => 'Send an HTTP or HTTPS GET or POST request', + 'desc' => 'Send an HTTP or HTTPS GET or POST request, for domains1', 'options' => \%options, 'no_machine' => 1, 'notes' => <<'END' -Send an HTTP or HTTPS GET or POST to the specified URL. For HTTPS support, -<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a> -or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a> -is required. +Send an HTTP or HTTPS GET or POST to the specified URL on domain addition, +modification and deletion. +<p>Each "Data" option takes a list of <i>name value</i> pairs on successive +lines. +<ul><li><i>name</i> is an unquoted, literal string without whitespace.</li> +<li><i>value</i> is a Perl expression that will be evaluated. If it's a +literal string, it must be quoted. This expression has access to the +svc_domain object as '$svc_x' (or '$new' and '$old' in "Replace Data") +and the customer record as '$cust_main'.</li></ul> +If "Success Regexp" is specified, the response from the server will be +tested against it to determine if the export succeeded.</p> END ); diff --git a/FS/FS/part_export/pbxware.pm b/FS/FS/part_export/pbxware.pm index 4373e7ad5..9458fca0c 100644 --- a/FS/FS/part_export/pbxware.pm +++ b/FS/FS/part_export/pbxware.pm @@ -137,7 +137,7 @@ sub import_cdrs { # page's IDs or something. my $uniqueid = md5_hex(join(',',@$row)); if ( FS::cdr->row_exists('uniqueid = ?', $uniqueid) ) { - warn "skipped duplicate row in page $page\n" if $DEBUG > 1; + warn "skipped duplicate row in page $page\n" if $DEBUG; next CDR; } @@ -186,7 +186,7 @@ local $ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0; ] ); warn "$me $method\n" if $DEBUG; - warn $request->as_string."\n" if $DEBUG > 1; + warn $request->as_string."\n" if $DEBUG; my $ua = LWP::UserAgent->new; my $response = $ua->request($request); diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 647dc5f4d..775af17ae 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -4,6 +4,7 @@ use vars qw(@ISA %info); use Tie::IxHash; use Date::Format; use String::ShellQuote; +use Net::OpenSSH; use FS::part_export; use FS::Record qw( qsearch qsearchs ); @@ -296,7 +297,7 @@ sub _export_command_or_super { } else { $self->_export_command($action, @_); } -}; +} sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); @@ -305,6 +306,41 @@ sub _export_command { return '' if $command =~ /^\s*$/; my $stdin = $self->option($action."_stdin"); + my( $command_string, $stdin_string ) = + $self->_export_subvars( $svc_acct, $command, $stdin ); + + $self->ssh_or_queue( $svc_acct, $command_string, $stdin_string ); +} + +sub ssh_or_queue { + my( $self, $svc_acct, $command_string, $stdin_string ) = @_; + + my @ssh_cmd_args = ( + user => $self->option('user') || 'root', + host => $self->svc_machine($svc_acct), + command => $command_string, + stdin_string => $stdin_string, + ignored_errors => $self->option('ignored_errors') || '', + ignore_all_errors => $self->option('ignore_all_errors'), + fail_on_output => $self->option('fail_on_output'), + ); + + if ( $self->option($action. '_no_queue') ) { + # discard return value just like freeside-queued. + eval { ssh_cmd(@ssh_cmd_args) }; + $error = $@; + $error = $error->full_message if ref $error; # Exception::Class::Base + return $error. + ' ('. $self->exporttype. ' to '. $self->svc_machine($svc_acct). ')' + if $error; + } else { + $self->shellcommands_queue( $svc_acct->svcnum, @ssh_cmd_args ); + } +} + +sub _export_subvars { + my( $self, $svc_acct, $command, $stdin ) = @_; + no strict 'vars'; { no strict 'refs'; @@ -412,27 +448,7 @@ sub _export_command { my $command_string = eval(qq("$command")); return "error filling in command: $@" if $@; - my @ssh_cmd_args = ( - user => $self->option('user') || 'root', - host => $self->svc_machine($svc_acct), - command => $command_string, - stdin_string => $stdin_string, - ignored_errors => $self->option('ignored_errors') || '', - ignore_all_errors => $self->option('ignore_all_errors'), - fail_on_output => $self->option('fail_on_output'), - ); - - if ( $self->option($action. '_no_queue') ) { - # discard return value just like freeside-queued. - eval { ssh_cmd(@ssh_cmd_args) }; - $error = $@; - $error = $error->full_message if ref $error; # Exception::Class::Base - return $error. - ' ('. $self->exporttype. ' to '. $self->svc_machine($svc_acct). ')' - if $error; - } else { - $self->shellcommands_queue( $svc_acct->svcnum, @ssh_cmd_args ); - } + ( $command_string, $stdin_string ); } sub _export_replace { @@ -440,6 +456,16 @@ sub _export_replace { my $command = $self->option('usermod'); return '' if $command =~ /^\s*$/; my $stdin = $self->option('usermod_stdin'); + + my( $command_string, $stdin_string ) = + $self->_export_subvars_replace( $new, $old, $command, $stdin ); + + $self->ssh_or_queue( $new, $command_string, $stdin_string ); +} + +sub _export_subvars_replace { + my( $self, $new, $old, $command, $stdin ) = @_; + no strict 'vars'; { no strict 'refs'; @@ -511,27 +537,7 @@ sub _export_replace { my $command_string = eval(qq("$command")); - my @ssh_cmd_args = ( - user => $self->option('user') || 'root', - host => $self->svc_machine($new), - command => $command_string, - stdin_string => $stdin_string, - ignored_errors => $self->option('ignored_errors') || '', - ignore_all_errors => $self->option('ignore_all_errors'), - fail_on_output => $self->option('fail_on_output'), - ); - - if($self->option('usermod_no_queue')) { - # discard return value just like freeside-queued. - eval { ssh_cmd(@ssh_cmd_args) }; - $error = $@; - $error = $error->full_message if ref $error; # Exception::Class::Base - return $error. ' ('. $self->exporttype. ' to '. $self->svc_machine($new). ')' - if $error; - } - else { - $self->shellcommands_queue( $new->svcnum, @ssh_cmd_args ); - } + ( $command_string, $stdin_string ); } #a good idea to queue anything that could fail or take any time @@ -545,7 +551,6 @@ sub shellcommands_queue { } sub ssh_cmd { #subroutine, not method - use Net::OpenSSH; my $opt = { @_ }; open my $def_in, '<', '/dev/null' or die "unable to open /dev/null\n"; my $ssh = Net::OpenSSH->new( diff --git a/FS/FS/part_export/shellcommands_expect.pm b/FS/FS/part_export/shellcommands_expect.pm new file mode 100644 index 000000000..c2a4118e2 --- /dev/null +++ b/FS/FS/part_export/shellcommands_expect.pm @@ -0,0 +1,128 @@ +package FS::part_export::shellcommands_expect; +use base qw( FS::part_export::shellcommands ); + +use strict; +use Tie::IxHash; +use Net::OpenSSH; +use Expect; +#use FS::Record qw( qsearch qsearchs ); + +tie my %options, 'Tie::IxHash', + 'user' => { label =>'Remote username', default=>'root' }, + 'useradd' => { label => 'Insert commands', type => 'textarea', }, + 'userdel' => { label => 'Delete commands', type => 'textarea', }, + 'usermod' => { label => 'Modify commands', type => 'textarea', }, + 'suspend' => { label => 'Suspend commands', type => 'textarea', }, + 'unsuspend' => { label => 'Unsuspend commands', type => 'textarea', }, + 'debug' => { label => 'Enable debugging', + type => 'checkbox', + value => 1, + }, +; + +our %info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real time export via remote SSH, with interactive ("Expect"-like) scripting, for svc_acct services', + 'options' => \%options, + 'notes' => q[ +Interactively run commands via SSH in a remote terminal, like "Expect". In +most cases, you probably want a regular shellcommands (or broadband_shellcommands, etc.) export instead, unless +you have a specific need to interact with a terminal-based interface in an +"Expect"-like fashion. +<BR><BR> + +Each line specifies a string to match and a command to +run after that string is found, separated by the first space. For example, to +run "exit" after a prompt ending in "#" is sent, "# exit". You will need to +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. +<BR><BR> + +In commands, all variable substitutions of the regular shellcommands (or +broadband_shellcommands, etc.) export are available (use a backslash to escape +a literal $). +] +); + +sub _export_command { + my ( $self, $action, $svc_acct) = (shift, shift, shift); + my @lines = split("\n", $self->option($action) ); + + return '' unless @lines; + + my @commands = (); + foreach my $line (@lines) { + my($match, $command) = split(' ', $line, 2); + my( $command_string ) = $self->_export_subvars( $svc_acct, $command, '' ); + push @commands, [ $match, $command_string ]; + } + + $self->shellcommands_expect_queue( $svc_acct->svcnum, @commands ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + my @lines = split("\n", $self->option('replace') ); + + return '' unless @lines; + + my @commands = (); + foreach my $line (@lines) { + my($match, $command) = split(' ', $line, 2); + my( $command_string ) = $self->_export_subvars_replace( $new, $old, $command, '' ); + push @commands, [ $match, $command_string ]; + } + + $self->shellcommands_expect_queue( $new->svcnum, @commands ); +} + +sub shellcommands_expect_queue { + my( $self, $svcnum, @commands ) = @_; + + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::shellcommands_expect::ssh_expect", + }; + $queue->insert( + user => $self->option('user') || 'root', + host => $self->machine, + debug => $self->option('debug'), + commands => \@commands, + ); +} + +sub ssh_expect { #subroutine, not method + my $opt = { @_ }; + + my $dest = $opt->{'user'}.'@'.$opt->{'host'}; + + open my $def_in, '<', '/dev/null' or die "unable to open /dev/null\n"; + my $ssh = Net::OpenSSH->new( $dest, 'default_stdin_fh' => $def_in ); + # ignore_all_errors doesn't override SSH connection/auth errors-- + # probably correct + die "Couldn't establish SSH connection to $dest: ". $ssh->error + if $ssh->error; + + my ($pty, $pid) = $ssh->open2pty + or die "Couldn't start a remote terminal session"; + my $expect = Expect->init($pty); + #not useful #$expect->debug($opt->{debug} ? 3 : 0); + + foreach my $line ( @{ $opt->{commands} } ) { + my( $match, $command ) = @$line; + + warn "Waiting for '$match'\n" if $opt->{debug}; + + my $matched = $expect->expect(30, $match); + unless ( $matched ) { + my $err = "Never saw '$match'\n"; + warn $err; + die $err; + } + warn "Running '$command'\n" if $opt->{debug}; + $expect->send("$command\n"); + } + + ''; +} + +1; diff --git a/FS/FS/part_export/vitelity.pm b/FS/FS/part_export/vitelity.pm index 332e45712..d71553529 100644 --- a/FS/FS/part_export/vitelity.pm +++ b/FS/FS/part_export/vitelity.pm @@ -286,8 +286,8 @@ sub _export_insert { my $cust_main = $svc_phone->cust_svc->cust_pkg->cust_main; - return 'Customer company is required' - unless $cust_main->company; + #return 'Customer company is required' + # unless $cust_main->company; return 'Customer day phone (for contact, not porting) is required' unless $cust_main->daytime; @@ -306,7 +306,7 @@ sub _export_insert { 'partial' => 'no', 'wireless' => 'no', 'carrier' => $svc_phone->lnp_other_provider, - 'company' => $cust_main->company, + 'company' => $cust_main->company || $cust_main->contact, 'accnumber' => $svc_phone->lnp_other_provider_account, 'name' => $svc_phone->phone_name_or_cust, 'streetnumber' => $sa->{number}, @@ -410,6 +410,7 @@ sub e911_send { return '' if $self->option('disable_e911'); my %location = $svc_phone->location_hash; + $location{'zip'} =~ s/\-\d{4}$//; my %e911send = ( 'did' => $svc_phone->phonenum, 'name' => $svc_phone->phone_name_or_cust, @@ -425,7 +426,7 @@ sub e911_send { my $e911_result = $self->vitelity_command('e911send', %e911send); - unless ( $e911_result =~ /^(missingdata|invalid)/i ) { + unless ( $e911_result =~ /status=(missingdata|invalid)/i ) { warn "Vitelity response: $e911_result" if $self->option('debug'); return ''; } diff --git a/FS/FS/part_pkg/recur_Common.pm b/FS/FS/part_pkg/recur_Common.pm index 4ed83a46b..729fb6125 100644 --- a/FS/FS/part_pkg/recur_Common.pm +++ b/FS/FS/part_pkg/recur_Common.pm @@ -43,12 +43,17 @@ sub cutoff_day { my $recur_method = $self->option('recur_method',1) || 'anniversary'; my $cust_main = $cust_pkg->cust_main; - if ( $cust_main->force_prorate_day and $cust_main->prorate_day ) { - return ( $cust_main->prorate_day ); - } elsif ($recur_method eq 'prorate' || $recur_method eq 'subscription') { + return ( $cust_main->prorate_day ) + if $cust_main->prorate_day and ( $cust_main->force_prorate_day + || $recur_method eq 'prorate' + || $recur_method eq 'subscription' + ); - return split(/\s*,\s*/, $self->option('cutoff_day', 1) || '1'); - } + return split(/\s*,\s*/, $self->option('cutoff_day', 1) || '1') + if $recur_method eq 'prorate' + || $recur_method eq 'subscription'; + + return (); } sub calc_recur_Common { diff --git a/FS/FS/svc_circuit.pm b/FS/FS/svc_circuit.pm index eb0750c8b..7f49715b9 100644 --- a/FS/FS/svc_circuit.pm +++ b/FS/FS/svc_circuit.pm @@ -201,6 +201,7 @@ sub check { || $self->ut_textn('vendor_order_status') || $self->ut_ipn('endpoint_ip_addr') || $self->ut_textn('endpoint_mac_addr') + || $self->ut_textn('internal_circuit_id') ; # no canonical values yet for vendor_order_status or _type diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 5416ff565..8bc0c6ef3 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -2335,7 +2335,15 @@ EOF } +sub _upgrade_data { + my $class = shift; + my $sql = "UPDATE tax_rate SET data_vendor = 'compliance_solutions' WHERE data_vendor = 'compliance solutions'"; + + my $sth = dbh->prepare($sql) or die $DBI::errstr; + $sth->execute() or die $sth->errstr; + +} =back diff --git a/FS/FS/tax_rate_location.pm b/FS/FS/tax_rate_location.pm index d9646e4bc..e33859123 100644 --- a/FS/FS/tax_rate_location.pm +++ b/FS/FS/tax_rate_location.pm @@ -111,6 +111,7 @@ sub check { $self->ut_numbern('taxratelocationnum') || $self->ut_textn('data_vendor') || $self->ut_alpha('geocode') + || $self->ut_textn('district') || $self->ut_textn('city') || $self->ut_textn('county') || $self->ut_textn('state') @@ -118,16 +119,12 @@ sub check { ; return $error if $error; - my $t; - $t = qsearchs( 'tax_rate_location', - { disabled => '', - ( map { $_ => $self->$_ } qw( data_vendor geocode ) ), - }, - ) + my $t = ''; + $t = $self->existing_search unless $self->disabled; $t = $self->by_key( $self->taxratelocationnum ) - if ( !$t && $self->taxratelocationnum ); + if !$t && $self->taxratelocationnum; return "geocode ". $self->geocode. " already in use for this vendor" if ( $t && $t->taxratelocationnum != $self->taxratelocationnum ); @@ -153,11 +150,7 @@ record. sub find_or_insert { my $self = shift; - my $existing = qsearchs('tax_rate_location', { - disabled => '', - data_vendor => $self->data_vendor, - geocode => $self->geocode - }); + my $existing = $self->existing_search; if ($existing) { my $update = 0; foreach (qw(city county state country)) { @@ -176,6 +169,16 @@ sub find_or_insert { } } +sub existing_search { + my $self = shift; + + qsearchs( 'tax_rate_location', + { disabled => '', + map { $_ => $self->$_ } qw( data_vendor geocode ) + } + ); +} + =back =head1 CLASS METHODS @@ -392,6 +395,17 @@ sub batch_import { } +sub _upgrade_data { +#actually no, we want to leave those records behind now that they're giving us +# geo_state etc. +# my $class = shift; +# +# my $sql = "UPDATE tax_rate_location SET data_vendor = 'compliance_solutions' WHERE data_vendor = 'compliance solutions'"; +# +# my $sth = dbh->prepare($sql) or die $DBI::errstr; +# $sth->execute() or die $sth->errstr; +} + =head1 BUGS Currently somewhat specific to CCH supplied data. diff --git a/FS/MANIFEST b/FS/MANIFEST index f6a640066..81087dea7 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -510,6 +510,7 @@ t/class_Common.t FS/category_Common.pm t/category_Common.t FS/contact.pm +FS/contact/Import.pm t/contact.t FS/contact_phone.pm t/contact_phone.t @@ -872,3 +873,7 @@ FS/saved_search.pm t/saved_search.t FS/sector_coverage.pm t/sector_coverage.t +FS/access_user_session_log.pm +t/access_user_session_log.t +FS/access_user_session_log.pm +t/access_user_session_log.t diff --git a/FS/bin/freeside-voipinnovations-cdrimport b/FS/bin/freeside-voipinnovations-cdrimport index 23ea6bbdc..d64c8708f 100755 --- a/FS/bin/freeside-voipinnovations-cdrimport +++ b/FS/bin/freeside-voipinnovations-cdrimport @@ -4,7 +4,8 @@ use strict; use Getopt::Std; use Date::Format; use File::Temp 'tempdir'; -use Net::FTP; +use Net::SSLGlue::FTP; #at least until the Deb 9 transition is done, then + # regular Net::FTP has SSL support use FS::UID qw(adminsuidsetup datasrc dbh); use FS::cdr; use FS::cdr_batch; @@ -39,11 +40,14 @@ my $tempdir = tempdir( CLEANUP => !$opt_v ); my $format = 'voip_innovations'; my $hostname = 'customercdr.voipinnovations.com'; -my $ftp = Net::FTP->new($hostname, Debug => $opt_d) +my $ftp = Net::FTP->new($hostname, Passive => 1, Debug => $opt_d) or die "Can't connect to $hostname: $@\n"; +$ftp->starttls() + or die "TLS initialization failed: ". $ftp->message. "\n"; + $ftp->login($login, $password) - or die "Login failed: ".$ftp->message."\n"; + or die "Login failed: ". $ftp->message. "\n"; ### # get the file list @@ -51,7 +55,7 @@ $ftp->login($login, $password) warn "Retrieving directory listing\n" if $opt_v; -$ftp->cwd('/'); +#$ftp->cwd('/'); my @dirs = $ftp->ls(); warn scalar(@dirs)." directories found.\n" if $opt_v; # apply date range diff --git a/FS/t/access_user_session_log.t b/FS/t/access_user_session_log.t new file mode 100644 index 000000000..630637474 --- /dev/null +++ b/FS/t/access_user_session_log.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_user_session_log; +$loaded=1; +print "ok 1\n"; |