summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
authorIvan Kohler <ivan@freeside.biz>2016-10-16 15:12:35 -0700
committerIvan Kohler <ivan@freeside.biz>2016-10-16 15:12:35 -0700
commite322fbb08d0f837be3f3f8e7c92a4a5bc75030ad (patch)
tree9ee34d97abcf6910eede9723996900c35db0db55 /FS
parent1c3dfc13e3eaf4a0d2fc213111dcbf12608ee81c (diff)
parentf81c236b2f3b5fe8777b04ee78b793b301eef9fd (diff)
Merge branch 'master' of git.freeside.biz:/home/git/freeside
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/Conf.pm23
-rw-r--r--FS/FS/Daemon.pm99
-rw-r--r--FS/FS/Mason.pm1
-rw-r--r--FS/FS/Schema.pm47
-rw-r--r--FS/FS/Upgrade.pm8
-rw-r--r--FS/FS/addr_status.pm103
-rw-r--r--FS/FS/cust_main.pm8
-rw-r--r--FS/FS/cust_main/Billing_Realtime.pm342
-rw-r--r--FS/FS/cust_main_note.pm8
-rw-r--r--FS/FS/cust_payby.pm65
-rw-r--r--FS/FS/hardware_type.pm3
-rw-r--r--FS/FS/log_context.pm1
-rw-r--r--FS/FS/part_event.pm63
-rw-r--r--FS/FS/part_export/tower_towercoverage.pm420
-rw-r--r--FS/FS/part_pkg/flat.pm33
-rw-r--r--FS/FS/part_pkg/prorate_calendar.pm6
-rw-r--r--FS/FS/part_pkg/recur_Common.pm13
-rw-r--r--FS/FS/part_pkg/subscription.pm5
-rw-r--r--FS/FS/payinfo_Mixin.pm3
-rw-r--r--FS/FS/sector_coverage.pm133
-rw-r--r--FS/FS/svc_IP_Mixin.pm37
-rw-r--r--FS/FS/tower.pm23
-rw-r--r--FS/FS/tower_sector.pm173
-rw-r--r--FS/MANIFEST2
-rw-r--r--FS/bin/freeside-pingd135
-rw-r--r--FS/t/addr_status.t5
-rw-r--r--FS/t/sector_coverage.t5
-rwxr-xr-xFS/t/suite/05-prorate_sync_same_day.t15
-rwxr-xr-xFS/t/suite/10-prorate_sync_same_hour.t102
-rwxr-xr-xFS/t/suite/11-prorate_sync_single_pkg.t89
30 files changed, 1766 insertions, 204 deletions
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index ef2a9388a..a48125d09 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -3073,6 +3073,23 @@ and customer address. Include units.',
},
{
+ 'key' => 'pingd-interval',
+ 'section' => 'network_monitoring',
+ 'description' => 'Run ping scans of broadband services at this interval.',
+ 'type' => 'select',
+ 'select_hash' => [ '' => '',
+ 60 => '1 min',
+ 300 => '5 min',
+ 600 => '10 min',
+ 1800 => '30 min',
+ 3600 => '1 hour',
+ 14400 => '4 hours',
+ 28800 => '8 hours',
+ 86400 => '1 day',
+ ],
+ },
+
+ {
'key' => 'ticket_system-default_queueid',
'section' => 'ticketing',
'description' => 'Default queue used when creating new customer tickets.',
@@ -5402,11 +5419,7 @@ and customer address. Include units.',
'section' => 'customer_fields',
'description' => 'Use customer note classes',
'type' => 'select',
- 'select_hash' => [
- 0 => 'Disabled',
- 1 => 'Enabled',
- 2 => 'Enabled, with tabs',
- ],
+ 'select_enum' => [ '', 'Enabled', 'Required' ],
},
{
diff --git a/FS/FS/Daemon.pm b/FS/FS/Daemon.pm
index b58cde49f..4ecd80e98 100644
--- a/FS/FS/Daemon.pm
+++ b/FS/FS/Daemon.pm
@@ -9,6 +9,7 @@ use IO::File;
use File::Basename;
use File::Slurp qw(slurp);
use Date::Format;
+use FS::UID qw( forksuidsetup );
#this is a simple refactoring of the stuff from freeside-queued, just to
#avoid duplicate code. eventually this should use something from CPAN.
@@ -16,6 +17,7 @@ use Date::Format;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
daemonize1 drop_root daemonize2 myexit logfile sigint sigterm
+ daemon_fork daemon_wait daemon_reconnect
);
%EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
@@ -24,6 +26,10 @@ $pid_dir = '/var/run';
$NOSIG = 0;
$PID_NEWSTYLE = 0;
+our $MAX_KIDS = 10; # for daemon_fork
+our $kids = 0;
+our %kids;
+
sub daemonize1 {
$me = shift;
@@ -57,6 +63,13 @@ sub daemonize1 {
$SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; };
$SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; };
}
+
+ # set the logfile sensibly
+ if (!$logfile) {
+ my $logname = $me;
+ $logname =~ s/^freeside-//;
+ logfile("%%%FREESIDE_LOG%%%/$logname-log.$FS::UID::datasrc");
+ }
}
sub drop_root {
@@ -117,4 +130,90 @@ sub _logmsg {
close $log;
}
+=item daemon_fork CODEREF[, ARGS ]
+
+Executes CODEREF in a child process, with its own $FS::UID::dbh handle. If
+the number of child processes is >= $FS::Daemon::MAX_KIDS then this will
+block until some of the child processes are finished. ARGS will be passed
+to the coderef.
+
+If the fork fails, this will throw an exception containing $!. Otherwise
+it returns the PID of the child, like fork() does.
+
+=cut
+
+sub daemon_fork {
+ $FS::UID::dbh->{AutoInactiveDestroy} = 1;
+ # wait until there's a lane open
+ daemon_wait($MAX_KIDS - 1);
+
+ my ($code, @args) = @_;
+
+ my $user = $FS::CurrentUser::CurrentUser->username;
+
+ my $pid = fork;
+ if (!defined($pid)) {
+
+ warn "WARNING: can't fork: $!\n";
+ die "$!\n";
+
+ } elsif ( $pid > 0 ) {
+
+ $kids{ $pid } = 1;
+ $kids++;
+ return $pid;
+
+ } else { # kid
+ forksuidsetup( $user );
+ &{$code}(@args);
+ exit;
+
+ }
+}
+
+=item daemon_wait [ MAX ]
+
+Waits until there are at most MAX daemon_fork() child processes running,
+reaps the ones that are finished, and continues. MAX defaults to zero, i.e.
+wait for everything to finish.
+
+=cut
+
+sub daemon_wait {
+ my $max = shift || 0;
+ while ($kids > $max) {
+ foreach my $pid (keys %kids) {
+ my $kid = waitpid($pid, WNOHANG);
+ if ( $kid > 0 ) {
+ $kids--;
+ delete $kids{$kid};
+ }
+ }
+ sleep(1);
+ }
+}
+
+=item daemon_reconnect
+
+Checks whether the database connection is live, and reconnects if not.
+
+=cut
+
+sub daemon_reconnect {
+ my $dbh = $FS::UID::dbh;
+ unless ($dbh && $dbh->ping) {
+ warn "WARNING: connection to database lost, reconnecting...\n";
+
+ eval { $FS::UID::dbh = myconnect(); };
+
+ unless ( !$@ && $FS::UID::dbh && $FS::UID::dbh->ping ) {
+ warn "WARNING: still no connection to database, sleeping for retry...\n";
+ sleep 10;
+ next;
+ } else {
+ warn "WARNING: reconnected to database\n";
+ }
+ }
+}
+
1;
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index ee87b2de4..041b76c10 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -416,6 +416,7 @@ if ( -e $addl_handler_use_file ) {
use FS::commission_schedule;
use FS::commission_rate;
use FS::saved_search;
+ use FS::sector_coverage;
# Sammath Naur
if ( $FS::Mason::addl_handler_use ) {
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index f66cb36d5..f8b82f454 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -203,6 +203,7 @@ sub dbdef_dist {
&& ! /^log(_context)?$/
&& ! /^(legacy_cust_history|cacti_page|template_image|access_user_log)$/
&& ( ! /^queue(_arg|_depend|_stat)?$/ || ! $opt->{'queue-no_history'} )
+ && ! /^addr_status$/
&& ! $tables_hashref_torrus->{$_}
}
$dbdef->tables
@@ -1640,6 +1641,7 @@ sub tables_hashref {
'accountcode_cdr', 'char', 'NULL', 1, '', '',
'billday', 'int', 'NULL', '', '', '',
'prorate_day', 'int', 'NULL', '', '', '',
+ 'force_prorate_day', 'char', 'NULL', 1, '', '',
'edit_subject', 'char', 'NULL', 1, '', '',
'locale', 'varchar', 'NULL', 16, '', '',
'calling_list_exempt', 'char', 'NULL', 1, '', '',
@@ -4138,6 +4140,7 @@ sub tables_hashref {
'classnum', 'int', '', '', '', '',
'model', 'varchar', '', $char_d, '', '',
'revision','varchar', 'NULL', $char_d, '', '',
+ 'title', 'varchar', 'NULL', $char_d, '', '', # external id
],
'primary_key' => 'typenum',
'unique' => [ [ 'classnum', 'model', 'revision' ] ],
@@ -4885,12 +4888,19 @@ sub tables_hashref {
'sector_range', 'decimal', 'NULL', '', '', '', #?
'downtilt', 'decimal', 'NULL', '', '', '',
'v_width', 'int', 'NULL', '', '', '',
- 'margin', 'decimal', 'NULL', '', '', '',
+ 'power', 'decimal', 'NULL', '', '', '',
+ 'line_loss', 'decimal', 'NULL', '', '', '',
+ 'antenna_gain', 'decimal', 'NULL', '', '', '',
+ 'hardware_typenum', 'int', 'NULL', '', '', '',
+ 'db_high', 'int', 'NULL', '', '', '',
+ 'db_low', 'int', 'NULL', '', '', '',
'image', 'blob', 'NULL', '', '', '',
'west', 'decimal', 'NULL', '10,7', '', '',
'east', 'decimal', 'NULL', '10,7', '', '',
'south', 'decimal', 'NULL', '10,7', '', '',
'north', 'decimal', 'NULL', '10,7', '', '',
+
+ 'title', 'varchar', 'NULL', $char_d,'', '',
],
'primary_key' => 'sectornum',
'unique' => [ [ 'towernum', 'sectorname' ], [ 'ip_addr' ], ],
@@ -4899,6 +4909,27 @@ sub tables_hashref {
{ columns => [ 'towernum' ],
table => 'tower',
},
+ { columns => [ 'hardware_typenum' ],
+ table => 'hardware_type',
+ references => [ 'typenum' ],
+ },
+ ],
+ },
+
+ 'sector_coverage' => {
+ 'columns' => [
+ 'coveragenum', 'serial', '', '', '', '',
+ 'sectornum', 'int', '', '', '', '',
+ 'db_loss', 'int', '', '', '', '',
+ 'geometry', 'text', 'NULL', '', '', '',
+ ],
+ 'primary_key' => 'coveragenum',
+ 'unique' => [],
+ 'index' => [],
+ 'foreign_keys' => [
+ { columns => [ 'sectornum' ],
+ table => 'tower_sector'
+ },
],
},
@@ -7509,6 +7540,20 @@ sub tables_hashref {
],
},
+ 'addr_status' => {
+ 'columns' => [
+ 'addrnum', 'serial', '', '', '', '',
+ 'ip_addr', 'varchar', 'NULL', 40, '', '',
+ '_date', @date_type, '', '',
+ 'up', 'char', 'NULL', 1, '', '',
+ 'delay', 'int', 'NULL', '', '', '',
+ ],
+ 'primary_key' => 'addrnum',
+ 'unique' => [ [ 'ip_addr' ] ],
+ 'index' => [ [ '_date' ] ],
+ 'foreign_keys' => [],
+ },
+
# name type nullability length default local
#'new_table' => {
diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm
index c959ba947..1c1095e37 100644
--- a/FS/FS/Upgrade.pm
+++ b/FS/FS/Upgrade.pm
@@ -178,6 +178,14 @@ If you need to continue using the old Form 477 report, turn on the
$conf->set('cust-fields',$cust_fields);
}
+ #repurposed
+ $conf->set('note-classes','Enabled')
+ if $conf->exists('note-classes')
+ and grep {$_ eq $conf->config('note-classes')} ('1','2');
+ $conf->set('note-classes','')
+ if $conf->exists('note-classes')
+ and '0' eq $conf->config('note-classes');
+
enable_banned_pay_pad() unless length($conf->config('banned_pay-pad'));
# if translate-auto-insert is enabled for a locale, ensure that invoice
diff --git a/FS/FS/addr_status.pm b/FS/FS/addr_status.pm
new file mode 100644
index 000000000..7928d3ae5
--- /dev/null
+++ b/FS/FS/addr_status.pm
@@ -0,0 +1,103 @@
+package FS::addr_status;
+use base qw( FS::Record );
+
+use strict;
+
+=head1 NAME
+
+FS::addr_status;
+
+=head1 SYNOPSIS
+
+ use FS::addr_status;
+
+ $record = new FS::addr_status \%hash;
+ $record = new FS::addr_status { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::addr_status object represents the last known status (up or down, and
+the latency) of an IP address monitored by freeside-pingd. FS::addr_status
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item addrnum - primary key
+
+=item ip_addr - the IP address (unique)
+
+=item _date - the time the address was last scanned
+
+=item up - 'Y' if the address responded to a ping
+
+=item delay - the latency, in milliseconds
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new status record. To add the record to the database, see
+L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to. You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'addr_status'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+=item replace OLD_RECORD
+
+=item check
+
+Checks all fields to make sure this is a valid status record. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('addrnum')
+ || $self->ut_ip('ip_addr')
+ || $self->ut_number('_date')
+ || $self->ut_flag('up')
+ || $self->ut_numbern('delay')
+ ;
+
+ $self->SUPER::check;
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<FS::Record>
+
+=cut
+
+1;
+
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 2f05af69a..9c8e37499 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -1775,6 +1775,7 @@ sub check {
|| $self->ut_floatn('credit_limit')
|| $self->ut_numbern('billday')
|| $self->ut_numbern('prorate_day')
+ || $self->ut_flag('force_prorate_day')
|| $self->ut_flag('edit_subject')
|| $self->ut_flag('calling_list_exempt')
|| $self->ut_flag('invoice_noemail')
@@ -4443,6 +4444,10 @@ CHEK only
CHEK only
+=item saved_cust_payby
+
+scalar reference, for returning saved object
+
=back
=cut
@@ -4639,6 +4644,9 @@ PAYBYLOOP:
return $error;
}
+ ${$opt{'saved_cust_payby'}} = $new
+ if $opt{'saved_cust_payby'};
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm
index cb7299bbb..81b00aa72 100644
--- a/FS/FS/cust_main/Billing_Realtime.pm
+++ b/FS/FS/cust_main/Billing_Realtime.pm
@@ -111,6 +111,8 @@ I<depend_jobnum> allows payment capture to unlock export jobs
=cut
+# Currently only used by ClientAPI
+# NOT 4.x COMPATIBLE (see below)
sub realtime_collect {
my( $self, %options ) = @_;
@@ -124,6 +126,7 @@ sub realtime_collect {
$options{amount} = $self->balance unless exists( $options{amount} );
return '' unless $options{amount} > 0;
+ #### NOT 4.x COMPATIBLE
$options{method} = FS::payby->payby2bop($self->payby)
unless exists( $options{method} );
@@ -137,16 +140,14 @@ Runs a realtime credit card or ACH (electronic check) transaction
via a Business::OnlinePayment realtime gateway. See
L<http://420.am/business-onlinepayment> for supported gateways.
-Required arguments in the hashref are I<method>, and I<amount>
+Required arguments in the hashref are I<amount> and either
+I<cust_payby> or I<method>, I<payinfo> and (as applicable for method)
+I<payname>, I<address1>, I<address2>, I<city>, I<state>, I<zip> and I<paydate>.
Available methods are: I<CC>, I<ECHECK>, or I<PAYPAL>
Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
-The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
-I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
-if set, will override the value from the customer record.
-
I<description> is a free-text field passed to the gateway. It defaults to
the value defined by the business-onlinepayment-description configuration
option, or "Internet services" if that is unset.
@@ -279,11 +280,6 @@ sub _bop_defaults {
}
}
- unless ( exists( $options->{'payinfo'} ) ) {
- $options->{'payinfo'} = $self->payinfo;
- $options->{'paymask'} = $self->paymask;
- }
-
# Default invoice number if the customer has exactly one open invoice.
unless ( $options->{'invnum'} || $options->{'no_invnum'} ) {
$options->{'invnum'} = '';
@@ -291,14 +287,50 @@ sub _bop_defaults {
$options->{'invnum'} = $open[0]->invnum if scalar(@open) == 1;
}
- $options->{payname} = $self->payname unless exists( $options->{payname} );
+}
+
+sub _bop_cust_payby_options {
+ my ($self,$options) = @_;
+ my $cust_payby = $options->{'cust_payby'};
+ if ($cust_payby) {
+
+ $options->{'method'} = FS::payby->payby2bop( $cust_payby->payby );
+
+ if ($cust_payby->payby =~ /^(CARD|DCRD)$/) {
+ # false laziness with cust_payby->check
+ # which might not have been run yet
+ my( $m, $y );
+ if ( $cust_payby->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
+ ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
+ } elsif ( $cust_payby->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
+ ( $m, $y ) = ( $2, "19$1" );
+ } elsif ( $cust_payby->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
+ ( $m, $y ) = ( $3, "20$2" );
+ } else {
+ return "Illegal expiration date: ". $cust_payby->paydate;
+ }
+ $m = sprintf('%02d',$m);
+ $options->{paydate} = "$y-$m-01";
+ } else {
+ $options->{paydate} = '';
+ }
+
+ $options->{$_} = $cust_payby->$_()
+ for qw( payinfo paycvv paymask paystart_month paystart_year
+ payissue payname paystate paytype payip );
+
+ if ( $cust_payby->locationnum ) {
+ my $cust_location = $cust_payby->cust_location;
+ $options->{$_} = $cust_location->$_() for qw( address1 address2 city state zip );
+ }
+ }
}
sub _bop_content {
my ($self, $options) = @_;
my %content = ();
- my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
+ my $payip = $options->{'payip'};
$content{customer_ip} = $payip if length($payip);
$content{invoice_number} = $options->{'invnum'}
@@ -325,26 +357,14 @@ sub _bop_content {
$content{name} = $payname;
- $content{address} = exists($options->{'address1'})
- ? $options->{'address1'}
- : $self->address1;
- my $address2 = exists($options->{'address2'})
- ? $options->{'address2'}
- : $self->address2;
+ $content{address} = $options->{'address1'};
+ my $address2 = $options->{'address2'};
$content{address} .= ", ". $address2 if length($address2);
- $content{city} = exists($options->{city})
- ? $options->{city}
- : $self->city;
- $content{state} = exists($options->{state})
- ? $options->{state}
- : $self->state;
- $content{zip} = exists($options->{zip})
- ? $options->{'zip'}
- : $self->zip;
- $content{country} = exists($options->{country})
- ? $options->{country}
- : $self->country;
+ $content{city} = $options->{'city'};
+ $content{state} = $options->{'state'};
+ $content{zip} = $options->{'zip'};
+ $content{country} = $options->{'country'};
$content{phone} = $self->daytime || $self->night;
@@ -356,28 +376,24 @@ sub _bop_content {
}
sub _tokenize_card {
- my ($self,$transaction,$payinfo,$log) = @_;
+ my ($self,$transaction,$cust_payby,$log,%opt) = @_;
- if ( $transaction->can('card_token')
+ if ( $cust_payby
+ and $transaction->can('card_token')
and $transaction->card_token
- and $payinfo !~ /^99\d{14}$/ #not already tokenized
+ and $cust_payby->payinfo !~ /^99\d{14}$/ #not already tokenized
) {
- my @cust_payby = $self->cust_payby('CARD','DCRD');
- @cust_payby = grep { $payinfo == $_->payinfo } @cust_payby;
- if (@cust_payby > 1) {
- $log->error('Multiple matching card numbers for cust '.$self->custnum.', could not tokenize card');
- } elsif (@cust_payby) {
- my $cust_payby = $cust_payby[0];
- $cust_payby->payinfo($transaction->card_token);
- my $error = $cust_payby->replace;
- if ( $error ) {
- $log->error('Error storing token for cust '.$self->custnum.', cust_payby '.$cust_payby->custpaybynum.': '.$error);
- } else {
- $log->debug('Tokenized card for cust '.$self->custnum.', cust_payby '.$cust_payby->custpaybynum);
- }
+ $cust_payby->payinfo($transaction->card_token);
+
+ my $error;
+ $error = $cust_payby->replace if $opt{'replace'};
+ if ( $error ) {
+ $log->error('Error storing token for cust '.$self->custnum.', cust_payby '.$cust_payby->custpaybynum.': '.$error);
+ return $error;
} else {
- $log->debug('No matching card numbers for cust '.$self->custnum.', could not tokenize card');
+ $log->debug('Tokenized card for cust '.$self->custnum.', cust_payby '.$cust_payby->custpaybynum);
+ return '';
}
}
@@ -411,6 +427,8 @@ sub realtime_bop {
$options{amount} = $amount;
}
+ # set fields from passed cust_payby
+ $self->_bop_cust_payby_options(\%options);
###
# optional credit card surcharge
@@ -450,6 +468,9 @@ sub realtime_bop {
$self->_bop_defaults(\%options);
+ return "Missing payinfo"
+ unless $options{'payinfo'};
+
###
# set trans_is_recur based on invnum if there is one
###
@@ -535,29 +556,19 @@ sub realtime_bop {
if ( $options{method} eq 'CC' ) {
$content{card_number} = $options{payinfo};
- $paydate = exists($options{'paydate'})
- ? $options{'paydate'}
- : $self->paydate;
+ $paydate = $options{'paydate'};
$paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
$content{expiration} = "$2/$1";
$content{cvv2} = $options{'paycvv'}
if length($options{'paycvv'});
- my $paystart_month = exists($options{'paystart_month'})
- ? $options{'paystart_month'}
- : $self->paystart_month;
-
- my $paystart_year = exists($options{'paystart_year'})
- ? $options{'paystart_year'}
- : $self->paystart_year;
-
+ my $paystart_month = $options{'paystart_month'};
+ my $paystart_year = $options{'paystart_year'};
$content{card_start} = "$paystart_month/$paystart_year"
if $paystart_month && $paystart_year;
- my $payissue = exists($options{'payissue'})
- ? $options{'payissue'}
- : $self->payissue;
+ my $payissue = $options{'payissue'};
$content{issue_number} = $payissue if $payissue;
if ( $self->_bop_recurring_billing(
@@ -576,13 +587,8 @@ sub realtime_bop {
( $content{account_number}, $content{routing_code} ) =
split('@', $options{payinfo});
$content{bank_name} = $options{payname};
- $content{bank_state} = exists($options{'paystate'})
- ? $options{'paystate'}
- : $self->getfield('paystate');
- $content{account_type}=
- (exists($options{'paytype'}) && $options{'paytype'})
- ? uc($options{'paytype'})
- : uc($self->getfield('paytype')) || 'PERSONAL CHECKING';
+ $content{bank_state} = $options{'paystate'};
+ $content{account_type}= uc($options{'paytype'}) || 'PERSONAL CHECKING';
$content{company} = $self->company if $self->company;
@@ -805,7 +811,8 @@ sub realtime_bop {
# Tokenize
###
- $self->_tokenize_card($transaction,$options{'payinfo'},$log);
+ my $error = $self->_tokenize_card($transaction,$options{'cust_payby'},$log,'replace' => 1);
+ return $error if $error;
###
# result handling
@@ -1721,21 +1728,14 @@ successful, immediatly reverses the authorization).
Returns the empty string if the authorization was sucessful, or an error
message otherwise.
-I<payinfo>
+Option I<cust_payby> should be passed, even if it's not yet been inserted.
+Object will be tokenized if possible, but that change will not be
+updated in database (must be inserted/replaced afterwards.)
-I<payname>
-
-I<paydate> specifies the expiration date for a credit card overriding the
-value from the customer record or the payment record. Specified as yyyy-mm-dd
-
-#The additional options I<address1>, I<address2>, I<city>, I<state>,
-#I<zip> are also available. Any of these options,
-#if set, will override the value from the customer record.
+Currently only succeeds for Business::OnlinePayment CC transactions.
=cut
-#Available methods are: I<CC> or I<ECHECK>
-
#some false laziness w/realtime_bop and realtime_refund_bop, not enough to make
#it worth merging but some useful small subs should be pulled out
sub realtime_verify_bop {
@@ -1756,6 +1756,10 @@ sub realtime_verify_bop {
warn " $_ => $options{$_}\n" foreach keys %options;
}
+ # set fields from passed cust_payby
+ return "No cust_payby" unless $options{'cust_payby'};
+ $self->_bop_cust_payby_options(\%options);
+
###
# select a gateway
###
@@ -1802,43 +1806,33 @@ sub realtime_verify_bop {
if ( $options{method} eq 'CC' ) {
$content{card_number} = $options{payinfo};
- $paydate = exists($options{'paydate'})
- ? $options{'paydate'}
- : $self->paydate;
+ $paydate = $options{'paydate'};
$paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
$content{expiration} = "$2/$1";
$content{cvv2} = $options{'paycvv'}
if length($options{'paycvv'});
- my $paystart_month = exists($options{'paystart_month'})
- ? $options{'paystart_month'}
- : $self->paystart_month;
-
- my $paystart_year = exists($options{'paystart_year'})
- ? $options{'paystart_year'}
- : $self->paystart_year;
+ my $paystart_month = $options{'paystart_month'};
+ my $paystart_year = $options{'paystart_year'};
$content{card_start} = "$paystart_month/$paystart_year"
if $paystart_month && $paystart_year;
- my $payissue = exists($options{'payissue'})
- ? $options{'payissue'}
- : $self->payissue;
+ my $payissue = $options{'payissue'};
$content{issue_number} = $payissue if $payissue;
} elsif ( $options{method} eq 'ECHECK' ){
-
- #nop for checks (though it shouldn't be called...)
-
+ #cannot verify, move along (though it shouldn't be called...)
+ return '';
} else {
- die "unknown method ". $options{method};
+ return "unknown method ". $options{method};
}
-
} elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
- #move along
+ #cannot verify, move along
+ return '';
} else {
- die "unknown namespace $namespace";
+ return "unknown namespace $namespace";
}
###
@@ -1847,6 +1841,7 @@ sub realtime_verify_bop {
my $error;
my $transaction; #need this back so we can do _tokenize_card
+
# don't mutex the customer here, because they might be uncommitted. and
# this is only verification. it doesn't matter if they have other
# unfinished verifications.
@@ -1859,12 +1854,10 @@ sub realtime_verify_bop {
'payinfo' => $options{payinfo},
'paymask' => $options{paymask},
'paydate' => $paydate,
- #'recurring_billing' => $content{recurring_billing},
'pkgnum' => $options{'pkgnum'},
'status' => 'new',
'gatewaynum' => $payment_gateway->gatewaynum || '',
'session_id' => $options{session_id} || '',
- #'jobnum' => $options{depend_jobnum} || '',
};
$cust_pay_pending->payunique( $options{payunique} )
if defined($options{payunique}) && length($options{payunique});
@@ -1905,12 +1898,9 @@ sub realtime_verify_bop {
'action' => 'Authorization Only',
'description' => $options{'description'},
'amount' => '1.00',
- #'invoice_number' => $options{'invnum'},
'customer_id' => $self->custnum,
%$bop_content,
'reference' => $cust_pay_pending->paypendingnum, #for now
- 'callback_url' => $payment_gateway->gateway_callback_url,
- 'cancel_url' => $payment_gateway->gateway_cancel_url,
'email' => $email,
%content, #after
);
@@ -2123,7 +2113,9 @@ sub realtime_verify_bop {
# Tokenize
###
- $self->_tokenize_card($transaction,$options{'payinfo'},$log);
+ #important that we not pass replace option here,
+ #because cust_payby->replace uses realtime_verify_bop!
+ $self->_tokenize_card($transaction,$options{'cust_payby'},$log);
###
# result handling
@@ -2135,6 +2127,144 @@ sub realtime_verify_bop {
}
+=item realtime_tokenize [ OPTION => VALUE ... ]
+
+If possible, runs a tokenize transaction.
+In order to be possible, a credit card cust_payby record
+must be passed and a Business::OnlinePayment gateway capable
+of Tokenize transactions must be configured for this user.
+
+Returns the empty string if the authorization was sucessful
+or was not possible (thus allowing this to be safely called with
+non-tokenizable records/gateways, without having to perform separate tests),
+or an error message otherwise.
+
+Option I<cust_payby> should be passed, even if it's not yet been inserted.
+Object will be tokenized if possible, but that change will not be
+updated in database (must be inserted/replaced afterwards.)
+
+=cut
+
+sub realtime_tokenize {
+ my $self = shift;
+
+ local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
+ my $log = FS::Log->new('FS::cust_main::Billing_Realtime::realtime_tokenize');
+
+ my %options = ();
+ if (ref($_[0]) eq 'HASH') {
+ %options = %{$_[0]};
+ } else {
+ %options = @_;
+ }
+
+ # set fields from passed cust_payby
+ return "No cust_payby" unless $options{'cust_payby'};
+ $self->_bop_cust_payby_options(\%options);
+ return '' unless $options{method} eq 'CC';
+ return '' if $options{payinfo} =~ /^99\d{14}$/; #already tokenized
+
+ ###
+ # select a gateway
+ ###
+
+ $options{'nofatal'} = 1;
+ my $payment_gateway = $self->_payment_gateway( \%options );
+ return '' unless $payment_gateway;
+ my $namespace = $payment_gateway->gateway_namespace;
+ return '' unless $namespace eq 'Business::OnlinePayment';
+
+ eval "use $namespace";
+ return $@ if $@;
+
+ ###
+ # check for tokenize ability
+ ###
+
+ # just create transaction now, so it loads gateway_module
+ my $transaction = new $namespace( $payment_gateway->gateway_module,
+ $self->_bop_options(\%options),
+ );
+
+ my %supported_actions = $transaction->info('supported_actions');
+ return '' unless $supported_actions{'CC'} and grep(/^Tokenize$/,@{$supported_actions{'CC'}});
+
+ ###
+ # check for banned credit card/ACH
+ ###
+
+ my $ban = FS::banned_pay->ban_search(
+ 'payby' => $bop_method2payby{'CC'},
+ 'payinfo' => $options{payinfo},
+ );
+ return "Banned credit card" if $ban && $ban->bantype ne 'warn';
+
+ ###
+ # massage data
+ ###
+
+ my $bop_content = $self->_bop_content(\%options);
+ return $bop_content unless ref($bop_content);
+
+ my $paydate = '';
+ my %content = ();
+
+ $content{card_number} = $options{payinfo};
+ $paydate = $options{'paydate'};
+ $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ $content{expiration} = "$2/$1";
+
+ $content{cvv2} = $options{'paycvv'}
+ if length($options{'paycvv'});
+
+ my $paystart_month = $options{'paystart_month'};
+ my $paystart_year = $options{'paystart_year'};
+
+ $content{card_start} = "$paystart_month/$paystart_year"
+ if $paystart_month && $paystart_year;
+
+ my $payissue = $options{'payissue'};
+ $content{issue_number} = $payissue if $payissue;
+
+ ###
+ # run transaction
+ ###
+
+ my $error;
+
+ # no cust_pay_pending---this is not a financial transaction
+
+ $transaction->content(
+ 'type' => 'CC',
+ $self->_bop_auth(\%options),
+ 'action' => 'Tokenize',
+ 'description' => $options{'description'},
+ 'customer_id' => $self->custnum,
+ %$bop_content,
+ %content, #after
+ );
+
+ # no $BOP_TESTING handling for this
+ $transaction->test_transaction(1)
+ if $conf->exists('business-onlinepayment-test_transaction');
+ $transaction->submit();
+
+ if ( $transaction->card_token() ) { # no is_success flag
+
+ #important that we not pass replace option here,
+ #because cust_payby->replace uses realtime_tokenize!
+ $self->_tokenize_card($transaction,$options{'cust_payby'},$log);
+
+ } else {
+
+ $error = $transaction->error_message || 'Unknown error';
+
+ }
+
+ return $error;
+
+}
+
=back
=head1 BUGS
diff --git a/FS/FS/cust_main_note.pm b/FS/FS/cust_main_note.pm
index ee63883d2..4c48eb609 100644
--- a/FS/FS/cust_main_note.pm
+++ b/FS/FS/cust_main_note.pm
@@ -4,6 +4,7 @@ use base qw( FS::otaker_Mixin FS::Record );
use strict;
use Carp;
use FS::Record qw( qsearchs ); #qw( qsearch qsearchs );
+use FS::Conf;
=head1 NAME
@@ -116,6 +117,13 @@ sub check {
;
return $error if $error;
+ if (!$self->classnum) {
+ my $conf = new FS::Conf;
+ return 'Note class is required'
+ if $conf->exists('note-classes')
+ and $conf->config('note-classes') eq 'Required';
+ }
+
$self->SUPER::check;
}
diff --git a/FS/FS/cust_payby.pm b/FS/FS/cust_payby.pm
index e4a1d193c..626fc9fe9 100644
--- a/FS/FS/cust_payby.pm
+++ b/FS/FS/cust_payby.pm
@@ -250,8 +250,11 @@ sub replace {
if ( $conf->exists('business-onlinepayment-verification') ) {
$error = $self->verify;
- return $error if $error;
+ } else {
+ $error = $self->tokenize;
}
+ return $error if $error;
+
}
local $SIG{HUP} = 'IGNORE';
@@ -521,9 +524,12 @@ sub check {
}
- if ( ! $self->custpaybynum
- && $conf->exists('business-onlinepayment-verification') ) {
- $error = $self->verify;
+ if ( ! $self->custpaybynum ) {
+ if ($conf->exists('business-onlinepayment-verification')) {
+ $error = $self->verify;
+ } else {
+ $error = $self->tokenize;
+ }
return $error if $error;
}
@@ -638,59 +644,48 @@ sub label {
=item realtime_bop
+Runs a L<realtime_bop|FS::cust_main::Billing_Realtime::realtime_bop> transaction on this card
+
=cut
sub realtime_bop {
my( $self, %opt ) = @_;
- $opt{$_} = $self->$_() for qw( payinfo payname paydate );
-
- if ( $self->locationnum ) {
- my $cust_location = $self->cust_location;
- $opt{$_} = $cust_location->$_() for qw( address1 address2 city state zip );
- }
-
$self->cust_main->realtime_bop({
- 'method' => FS::payby->payby2bop( $self->payby ),
%opt,
+ 'cust_payby' => $self,
});
}
-=item verify
+=item tokenize
+
+Runs a L<realtime_tokenize|FS::cust_main::Billing_Realtime::realtime_tokenize> transaction on this card
=cut
-sub verify {
+sub tokenize {
my $self = shift;
return '' unless $self->payby =~ /^(CARD|DCRD)$/;
- my %opt = ();
+ $self->cust_main->realtime_tokenize({
+ 'cust_payby' => $self,
+ });
- # false laziness with check
- my( $m, $y );
- if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
- ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
- } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $2, "19$1" );
- } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $3, "20$2" );
- } else {
- return "Illegal expiration date: ". $self->paydate;
- }
- $m = sprintf('%02d',$m);
- $opt{paydate} = "$y-$m-01";
+}
- $opt{$_} = $self->$_() for qw( payinfo payname paycvv );
+=item verify
- if ( $self->locationnum ) {
- my $cust_location = $self->cust_location;
- $opt{$_} = $cust_location->$_() for qw( address1 address2 city state zip );
- }
+Runs a L<realtime_verify_bop|FS::cust_main::Billing_Realtime/realtime_verify_bop> transaction on this card
+
+=cut
+
+sub verify {
+ my $self = shift;
+ return '' unless $self->payby =~ /^(CARD|DCRD)$/;
$self->cust_main->realtime_verify_bop({
- 'method' => FS::payby->payby2bop( $self->payby ),
- %opt,
+ 'cust_payby' => $self,
});
}
diff --git a/FS/FS/hardware_type.pm b/FS/FS/hardware_type.pm
index 615c314b0..85473125c 100644
--- a/FS/FS/hardware_type.pm
+++ b/FS/FS/hardware_type.pm
@@ -40,6 +40,8 @@ to which this device type belongs.
=item revision - revision name/number, subordinate to model
+=item title - external ID
+
=back
=head1 METHODS
@@ -104,6 +106,7 @@ sub check {
|| $self->ut_foreign_key('classnum', 'hardware_class', 'classnum')
|| $self->ut_text('model')
|| $self->ut_textn('revision')
+ || $self->ut_textn('title')
;
return $error if $error;
diff --git a/FS/FS/log_context.pm b/FS/FS/log_context.pm
index ee3e413ee..809237d06 100644
--- a/FS/FS/log_context.pm
+++ b/FS/FS/log_context.pm
@@ -9,6 +9,7 @@ my @contexts = ( qw(
FS::cust_main::Billing::bill_and_collect
FS::cust_main::Billing::bill
FS::cust_main::Billing_Realtime::realtime_bop
+ FS::cust_main::Billing_Realtime::realtime_tokenize
FS::cust_main::Billing_Realtime::realtime_verify_bop
FS::pay_batch::import_from_gateway
FS::part_pkg
diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm
index 58e01271c..1c2389989 100644
--- a/FS/FS/part_event.pm
+++ b/FS/FS/part_event.pm
@@ -6,6 +6,7 @@ use vars qw( $DEBUG );
use Carp qw(confess);
use FS::Record qw( dbh qsearch qsearchs );
use FS::Conf;
+use FS::Cursor;
use FS::part_event_option;
use FS::part_event_condition;
use FS::cust_event;
@@ -251,10 +252,28 @@ but can be useful when configuring events.
=cut
-sub targets {
+sub targets { # may want to cursor this also
my $self = shift;
my %opt = @_;
- my $time = $opt{'time'} || time;
+ my $time = $opt{'time'} ||= time;
+
+ my $query = $self->_target_query(%opt);
+ my @objects = qsearch($query);
+ my @tested_objects;
+ foreach my $object ( @objects ) {
+ my $cust_event = $self->new_cust_event($object, 'time' => $time);
+ next unless $cust_event->test_conditions;
+
+ $object->set('cust_event', $cust_event);
+ push @tested_objects, $object;
+ }
+ @tested_objects;
+}
+
+sub _target_query {
+ my $self = shift;
+ my %opt = @_;
+ my $time = $opt{'time'};
my $eventpart = $self->eventpart;
$eventpart =~ /^\d+$/ or die "bad eventpart $eventpart";
@@ -285,23 +304,15 @@ sub targets {
# and don't enforce disabled because we want to be able to see targets
# for a disabled event
- my @objects = qsearch({
+ {
table => $eventtable,
hashref => {},
addl_from => $join,
extra_sql => "WHERE $where",
- });
- my @tested_objects;
- foreach my $object ( @objects ) {
- my $cust_event = $self->new_cust_event($object, 'time' => $time);
- next unless $cust_event->test_conditions;
-
- $object->set('cust_event', $cust_event);
- push @tested_objects, $object;
- }
- @tested_objects;
+ };
}
+
=item initialize PARAMS
Identify all objects eligible for this event and create L<FS::cust_event>
@@ -323,26 +334,26 @@ sub initialize {
my $self = shift;
my $error;
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
+ my $time = time;
+
+ local $FS::UID::AutoCommit = 1;
+ my $cursor = FS::Cursor->new( $self->_target_query('time' => $time) );
+ while (my $object = $cursor->fetch) {
+
+ my $cust_event = $self->new_cust_event($object, 'time' => $time);
+ next unless $cust_event->test_conditions;
- my @objects = $self->targets;
- foreach my $object ( @objects ) {
- my $cust_event = $object->get('cust_event');
$cust_event->status('initial');
$error = $cust_event->insert;
- last if $error;
+ die $error if $error;
}
- if ( !$error and $self->disabled ) {
+
+ # on successful completion only, re-enable the event
+ if ( $self->disabled ) {
$self->disabled('');
$error = $self->replace;
+ die $error if $error;
}
- if ( $error ) {
- $dbh->rollback;
- return $error;
- }
- $dbh->commit if $oldAutoCommit;
return;
}
diff --git a/FS/FS/part_export/tower_towercoverage.pm b/FS/FS/part_export/tower_towercoverage.pm
new file mode 100644
index 000000000..5d3f8351a
--- /dev/null
+++ b/FS/FS/part_export/tower_towercoverage.pm
@@ -0,0 +1,420 @@
+package FS::part_export::tower_towercoverage;
+
+use strict;
+use base qw( FS::part_export );
+use FS::Record qw(qsearch qsearchs dbh);
+use FS::hardware_class;
+use FS::hardware_type;
+
+use vars qw( %options %info
+ %frequency_id %antenna_type_id );
+
+use Color::Scheme;
+use LWP::UserAgent;
+use XML::LibXML::Simple qw(XMLin);
+use Data::Dumper;
+
+# note this is not https
+our $base_url = 'http://api.towercoverage.com/towercoverage.asmx/';
+
+our $DEBUG = 0;
+our $me = '[towercoverage.com]';
+
+sub debug {
+ warn "$me ".join("\n",@_)."\n"
+ if $DEBUG;
+}
+
+# hardware class to use for antenna defs
+my $classname = 'TowerCoverage.com antenna';
+
+tie %options, 'Tie::IxHash', (
+ 'debug' => { label => 'Enable debugging', type => 'checkbox' },
+
+ 'Account' => { label => 'Account ID' },
+ 'key' => { label => 'API key' },
+ 'use_coverage' => { label => 'Enable coverage maps', type => 'checkbox' },
+ 'FrequencyID' => { label => 'Frequency band',
+ type => 'select',
+ options => [ keys(%frequency_id) ],
+ option_labels => \%frequency_id,
+ },
+ 'MaximumRange' => { label => 'Maximum range (miles)', default => '10' },
+ '1' => { type => 'title', label => 'Client equipment' },
+ 'ClientAverageAntennaHeight' => { label => 'Typical antenna height (feet)' },
+ 'ClientAntennaGain' => { label => 'Antenna gain (dB)' },
+ 'RxLineLoss' => { label => 'Line loss (dB)',
+ default => 0,
+ },
+ '2' => { type => 'title', label => 'Performance requirements' },
+ 'WeakRxThreshold' => { label => 'Low quality (dBm)', },
+ 'StrongRxThreshold' => { label => 'High quality (dBm)', },
+ 'RequiredReliability' => { label => 'Reliability %',
+ default => 70
+ },
+);
+
+%info = (
+ 'svc' => [qw( tower_sector )],
+ 'desc' => 'TowerCoverage.com coverage mapping and site qualification',
+ 'options' => \%options,
+ 'no_machine' => 1,
+ 'notes' => <<'END',
+Export tower/sector configurations to TowerCoverage.com for coverage map
+generation.
+END
+);
+
+sub insert {
+ my $self = shift;
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+
+ my $error = $self->SUPER::insert(@_);
+ return $error if $error;
+
+ my $hwclass = _hardware_class();
+ if (!$hwclass) {
+
+ $hwclass = FS::hardware_class->new({ classname => $classname });
+ $error = $hwclass->insert;
+ if ($error) {
+ dbh->rollback if $oldAutoCommit;
+ return "error creating hardware class for antenna types: $error";
+ }
+
+ foreach my $id (keys %antenna_type_id) {
+ my $name = $antenna_type_id{$id};
+ my $hardware_type = FS::hardware_type->new({
+ classnum => $hwclass->classnum,
+ model => $name,
+ title => $id,
+ });
+ $error = $hardware_type->insert;
+ if ($error) {
+ dbh->rollback if $oldAutoCommit;
+ return "error creating hardware class for antenna types: $error";
+ }
+ }
+ }
+ dbh->commit if $oldAutoCommit;
+ '';
+}
+
+sub export_insert {
+ my ($self, $sector) = @_;
+
+ return unless $self->option('use_coverage');
+ local $DEBUG = $self->option('debug') ? 1 : 0;
+
+ my $tower = $sector->tower;
+ my $height_m = sprintf('%.0f', ($sector->height || $tower->height) / 3.28);
+ my $clientheight_m = sprintf('%.0f', $self->option('ClientAverageAntennaHeight') / 3.28);
+ my $maximumrange_km = sprintf('%.0f', $self->option('MaximumRange') * 1.61);
+ my $strongmargin = $self->option('StrongRxThreshold')
+ - $self->option('WeakRxThreshold');
+
+ my $scheme = Color::Scheme->new->from_hex($tower->color || '00FF00');
+
+ my $antenna = qsearchs('hardware_type', {
+ typenum => $sector->hardware_typenum
+ });
+ return "antenna type required" unless $antenna;
+
+ # - ALL parameters must be present (or it throws a generic 500 error).
+ # - ONLY Coverageid and TowerSiteid are allowed to be empty.
+ # - ALL parameter names are case sensitive.
+ # - ALL numeric parameters are required to be integers, except for the
+ # coordinates, line loss factors, and center frequency.
+ # - Export options (like RxLineLoss) have a problem where if they're set
+ # to numeric zero, they get removed; make sure we actually send zero.
+ my $data = [
+ 'Account' => $self->option('Account'),
+ 'key' => $self->option('key'),
+ 'Coverageid' => $sector->title,
+ 'Coveragename' => $sector->description,
+ 'TowerSiteid' => '',
+ 'Latitude' => $tower->latitude,
+ 'Longitude' => $tower->longitude,
+ 'AntennaHeight' => $height_m,
+ 'ClientAverageAntennaHeight' => $clientheight_m,
+ 'ClientAntennaGain' => $self->option('ClientAntennaGain'),
+ 'RxLineLoss' => sprintf('%.1f', $self->option('RxLineLoss')),
+ 'AntennaType' => $antenna->title,
+ 'AntennaAzimuth' => int($sector->direction),
+ # note that TowerCoverage bases their coverage map on the antenna
+ # radiation pattern, not on this number.
+ 'BeamwidthFilter' => $sector->width,
+ 'AntennaTilt' => int($sector->downtilt),
+ 'AntennaGain' => int($sector->antenna_gain),
+ 'Frequency' => $self->option('FrequencyID'),
+ 'ExactCenterFrequency' => $sector->freq_mhz,
+ 'TXPower' => int($sector->power),
+ 'TxLineLoss' => sprintf('%.1f', $sector->line_loss),
+ 'RxThreshold' => $self->option('WeakRxThreshold'),
+ 'RequiredReliability' => $self->option('RequiredReliability'),
+ 'StrongSignalMargin' => $strongmargin,
+ 'StrongSignalColor' => ($scheme->colors)[0],
+ 'WeakSignalColor' => ($scheme->colors)[2],
+ 'Opacity' => 50,
+ 'MaximumRange' => $maximumrange_km,
+ # this could be selectable but there's no reason to do that
+ 'RenderingQuality' => 3,
+ 'UseLandCover' => 1,
+ 'UseTwoRays' => 1,
+ 'CreateViewshed' => 0,
+ ];
+ debug Dumper($data);
+ $self->http_queue(
+ 'action' => 'insert',
+ 'path' => 'CoverageAPI',
+ 'sectornum' => $sector->sectornum,
+ 'data' => $data
+ );
+
+}
+
+sub export_replace { # do the same thing as insert
+ my $self = shift;
+ $self->export_insert(@_);
+}
+
+sub export_delete { '' }
+
+=item http_queue
+
+Queue a job to send an API request.
+Takes arguments:
+'action' => what we're doing (for triggering after_* callback)
+'path' => the path under TowerCoverage.asmx/
+'sectornum' => the sectornum
+'data' => arrayref/hashref of params to send
+to which it will add
+'exportnum' => the exportnum
+
+=cut
+
+sub http_queue {
+ my $self = shift;
+ my $queue = new FS::queue { 'job' => "FS::part_export::tower_towercoverage::http" };
+ return $queue->insert(
+ exportnum => $self->exportnum,
+ @_
+ );
+}
+
+sub http {
+ my %params = @_;
+ my $self = FS::part_export->by_key($params{'exportnum'});
+ local $DEBUG = $self->option('debug') ? 1 : 0;
+
+ local $FS::tower_sector::noexport_hack = 1; # avoid recursion
+
+ my $url = $base_url . $params{'path'};
+
+ my $ua = LWP::UserAgent->new;
+
+ # URL is the same for insert and replace.
+ my $req = HTTP::Request::Common::POST( $url, $params{'data'} );
+ debug("sending $url", $req->content);
+ my $response = $ua->request($req);
+
+ die $response->error_as_HTML if $response->is_error;
+ debug "received ".$response->decoded_content;
+
+ # throws exception on parse error
+ my $response_data = XMLin($response->decoded_content);
+ my $method = "after_" . $params{action};
+ if ($self->can($method)) {
+ # should be some kind of event handler, that would be sweet
+ my $sector = FS::tower_sector->by_key($params{'sectornum'});
+ $self->$method($sector, $response_data);
+ }
+}
+
+sub after_insert {
+ my ($self, $sector, $data) = @_;
+ my ($png_path, $kml_path) = split("\n", $data->{content});
+ die "$me no coverage map paths in response\n" unless $png_path;
+ if ( $png_path =~ /(\d+).png$/ ) {
+ $sector->set('title', $1);
+ my $error = $sector->replace;
+ die $error if $error;
+ } else {
+ die "$me can't parse map path '$png_path'\n";
+ }
+}
+
+sub _hardware_class {
+ qsearchs( 'hardware_class', { classname => $classname });
+}
+
+sub get_antenna_types {
+ my $hardware_class = _hardware_class() or return;
+ # return hardware typenums, not TowerCoverage IDs.
+ tie my %t, 'Tie::IxHash';
+
+ foreach my $type (qsearch({
+ table => 'hardware_type',
+ hashref => { 'classnum' => $hardware_class->classnum },
+ order_by => ' order by title::integer'
+ })) {
+ $t{$type->typenum} = $type->model;
+ }
+
+ return \%t;
+}
+
+sub export_links {
+ my $self = shift;
+ my ($sector, $arrayref) = @_;
+ if ( $sector->title =~ /^\d+$/ ) {
+ my $link = "http://www.towercoverage.com/En-US/Dashboard/editcoverages/".
+ $sector->title;
+ push @$arrayref, qq!<a href="$link" target="_blank">TowerCoverage map</a>!;
+ }
+}
+
+# we can query this from them, but that requires the account id and key...
+# XXX do some jquery magic in the UI to grab the account ID and key from
+# those fields, and then look it up right there
+
+BEGIN {
+ tie our %frequency_id, 'Tie::IxHash', (
+ 1 => "2400 MHz",
+ 2 => "5700 MHz",
+ 3 => "5300 MHz",
+ 4 => "900 MHz",
+ 5 => "3650 MHz",
+ 12 => "584 MHz",
+ 13 => "24000 MHz",
+ 14 => "11000 MHz Licensed",
+ 15 => "815 MHz",
+ 16 => "860 MHz",
+ 17 => "1800 MHz CDMA 3G",
+ 18 => "18000 MHz Licensed",
+ 19 => "1700 MHz",
+ 20 => "2100 MHz AWS",
+ 21 => "2500-2700 MHz EBS/BRS",
+ 22 => "6000 MHz Licensed",
+ 23 => "476 MHz",
+ 24 => "4900 MHz - Public Safety",
+ 25 => "2300 MHz",
+ 28 => "7000 MHz 4PSK",
+ 29 => "12000 MHz 4PSK",
+ 30 => "60 MHz",
+ 31 => "260 MHz",
+ 32 => "70 MHz",
+ 34 => "155 MHz",
+ 35 => "365 MHz",
+ 36 => "435 MHz",
+ 38 => "3500 MHz",
+ 39 => "750 MHz",
+ 40 => "27 MHz",
+ 41 => "10000 MHz",
+ 42 => "10250 Mhz",
+ 43 => "10250 Mhz",
+ 44 => "160 MHz",
+ 45 => "700 MHz",
+ 46 => "722 MHz",
+ 47 => "38000 Mhz",
+ 49 => "551 MHz",
+ 50 => "600 MHz",
+ 51 => "2300 MHz",
+ 52 => "5100 MHz",
+ 53 => "1900Mhz",
+ );
+
+ # there has to be a better way to handle this. load it during upgrade?
+ # provide a proxy method like get_dids?
+
+ tie our %antenna_type_id, 'Tie::IxHash', (
+ 1 => 'Generic - Omni',
+ 5 => 'Generic - 120 Degree',
+ 8 => 'Generic - 45 Degree Panel',
+ 9 => 'Generic - 60 Degree Panel',
+ 10 => 'Generic - 60 Degree x 8 Sectors',
+ 11 => 'Generic - 90 Degree',
+ 12 => 'Alvarion 3.65 WiMax Base Satation',
+ 24 => 'Tranzeo - 3.5 GHz 17db 60 Sector',
+ 31 => 'Alpha - 2.3 2033 Omni',
+ 32 => "PMP450 - 60&deg; Sector",
+ 33 => "PMP450 - 90&deg; Sector",
+ 34 => 'PMP450 - SM Panel',
+ 36 => 'KPPA - 2GHZDP90S-45 17 dBi',
+ 37 => 'KPPA - 2GHZDP120S-45 14.2 dBi',
+ 38 => 'KPPA - 3GHZDP60S-45 16.3 dBi',
+ 39 => 'KPPA - 3GHZDP90S-45 16.7 dBi',
+ 40 => 'KPPA - 3GHZDP120S-45 14.8 dBi',
+ 41 => 'KPPA - 5GHZDP40S-17 18.2 dBi',
+ 42 => 'KPPA - 5GHZDP60S 17.7 dBi',
+ 43 => 'KPPA - 5GHZDP60S-17 18.2 dBi',
+ 44 => 'KPPA - 5GHZDP90S 17 dBi',
+ 45 => 'KPPA - 5GHZDP120S 16.3 dBi',
+ 46 => 'KPPA - OMNI-DP-2 13 dBi',
+ 47 => 'KPPA - OMNI-DP-2.4-45 10.7 dBi',
+ 48 => 'KPPA - OMNI-DP-3 13 dBi',
+ 49 => 'KPPA - OMNI-DP-3-45 11 dBi',
+ 51 => 'KPPA - OMNI-DP-5 14 dBi',
+ 53 => 'Telrad - 65 Degree 3.65 Ghz',
+ 54 => 'KPPA - 2GHZDP60S-17-45 15.1 dBi',
+ 55 => 'KPPA - 2GHZDP60S-45 17.9 dBi',
+ 56 => 'UBNT - AG-2G20',
+ 57 => 'UBNT - AG-5G23',
+ 58 => 'UBNT - AG-5G27',
+ 59 => 'UBNT - AM-2G15-120',
+ 60 => 'UBNT - AM-2G16-90',
+ 61 => 'UBNT - AM-3G18-120',
+ 62 => 'UBNT - AM-5G16-120',
+ 63 => 'UBNT - AM-5G17-90',
+ 64 => 'UBNT - AM-5G19-120',
+ 65 => 'UBNT - AM-5G20-90',
+ 66 => 'UBNT - AM-9G15-90',
+ 67 => 'UBNT - AMO-2G10',
+ 68 => 'UBNT - AMO-2G13',
+ 69 => 'UBNT - AMO-5G10',
+ 70 => 'UBNT - AMO-5G13',
+ 71 => 'UBNT - AMY-9M16',
+ 72 => 'UBNT - LOCOM2',
+ 73 => 'UBNT - LOCOM5',
+ 74 => 'UBNT - LOCOM9',
+ 75 => 'UBNT - NB-2G18',
+ 76 => 'UBNT - NB-5G22',
+ 77 => 'UBNT - NB-5G25',
+ 78 => 'UBNT - NBM3',
+ 79 => 'UBNT - NBM9',
+ 80 => 'UBNT - NSM2',
+ 81 => 'UBNT - NSM3',
+ 82 => 'UBNT - NSM5',
+ 83 => 'UBNT - NSM9',
+ 84 => 'UBNT - PBM3',
+ 85 => 'UBNT - PBM5',
+ 86 => 'UBNT - PBM10',
+ 87 => 'UBNT - RD-2G23',
+ 88 => 'UBNT - RD-3G25',
+ 89 => 'UBNT - RD-5G30',
+ 90 => 'UBNT - RD-5G34',
+ 92 => 'TerraWave - 2.3-2.7 18db 65-Degree Panel',
+ 93 => 'UBNT - AM-M521-60-AC',
+ 94 => 'UBNT - AM-M522-45-AC',
+ 101 => 'RF Elements - SH-TP-5-30',
+ 104 => 'RF Elements - SH-TP-5-40',
+ 105 => 'RF Elements - SH-TP-5-50',
+ 106 => 'RF Elements - SH-TP-5-60',
+ 107 => 'RF Elements - SH-TP-5-70',
+ 108 => 'RF Elements - SH-TP-5-80',
+ 109 => 'RF Elements - SH-TP-5-90',
+ 110 => 'UBNT - Test',
+ 111 => '60 Titanium',
+ 112 => '3.65GHz - 6x6',
+ 113 => 'AW3015-t0-c4(EOS)',
+ 114 => 'AW3035 (EOS)',
+ 122 => 'RF Elements - SEC-CC-5-20',
+ 135 => 'RF Elements - SEC-CC-2-14',
+ 137 => 'RF Elements - SEC-CC-5-17',
+ 168 => 'KPPA - Mimosa - 5GHZZHV4P65S-17',
+ );
+}
+
+1;
diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm
index 97d4363da..6fd9c7d08 100644
--- a/FS/FS/part_pkg/flat.pm
+++ b/FS/FS/part_pkg/flat.pm
@@ -15,6 +15,7 @@ use Tie::IxHash;
use List::Util qw( min );
use FS::UI::bytecount;
use FS::Conf;
+use Time::Local 'timelocal';
#ask FS::UID to run this stuff for us later
FS::UID->install_callback( sub {
@@ -173,16 +174,36 @@ sub calc_recur {
sub cutoff_day {
my $self = shift;
my $cust_pkg = shift;
+ my $cust_main = $cust_pkg->cust_main;
+ # force it to act like a prorate package, is what this means
+ # because we made a distinction once between prorate and flat packages
+ if ( $cust_main->force_prorate_day and $cust_main->prorate_day ) {
+ return ( $cust_main->prorate_day );
+ }
if ( $self->option('sync_bill_date',1) ) {
my $next_bill = $cust_pkg->cust_main->next_bill_date;
if ( $next_bill ) {
- # careful here. if the prorate calculation is going to round to
- # the nearest day, this needs to always return the same result
- if ( $self->option('prorate_round_day', 1) ) {
- my $hour = (localtime($next_bill))[2];
- $next_bill += 64800 if $hour >= 12;
- }
return (localtime($next_bill))[3];
+ } else {
+ # This is the customer's only active package and hasn't been billed
+ # yet, so set the cutoff day to either today or tomorrow, whichever
+ # would result in a full period after rounding.
+ my $setup = $cust_pkg->setup; # because it's "now"
+ my $rounding_mode = $self->option('prorate_round_day',1);
+ return () if !$setup or !$rounding_mode;
+ my ($sec, $min, $hour, $mday, $mon, $year) = localtime($setup);
+
+ if ( ( $rounding_mode == 1 and $hour >= 12 )
+ or ( $rounding_mode == 3 and ( $sec > 0 or $min > 0 or $hour > 0 ))
+ ) {
+ # then the prorate period will be rounded down to start from
+ # midnight tomorrow, so the cutoff day should be the current day +
+ # 1.
+ $setup = timelocal(59,59,23,$mday,$mon,$year) + 1;
+ $mday = (localtime($setup))[3];
+ }
+ # otherwise, it will be rounded up, so leave the cutoff day at today.
+ return $mday;
}
}
return ();
diff --git a/FS/FS/part_pkg/prorate_calendar.pm b/FS/FS/part_pkg/prorate_calendar.pm
index c50cae0d7..a8ed8f942 100644
--- a/FS/FS/part_pkg/prorate_calendar.pm
+++ b/FS/FS/part_pkg/prorate_calendar.pm
@@ -72,7 +72,11 @@ sub check {
sub cutoff_day {
my( $self, $cust_pkg ) = @_;
my @periods = @{ $freq_cutoff_days{$self->freq} };
- my @cutoffs = ($self->option('cutoff_day') || 1); # Jan 1 = 1
+ my $prorate_day = $cust_pkg->cust_main->prorate_day
+ || $self->option('cutoff_day')
+ || 1;
+
+ my @cutoffs = ($prorate_day);
pop @periods; # we don't care about the last one
foreach (@periods) {
push @cutoffs, $cutoffs[-1] + $_;
diff --git a/FS/FS/part_pkg/recur_Common.pm b/FS/FS/part_pkg/recur_Common.pm
index b73c62c25..4ed83a46b 100644
--- a/FS/FS/part_pkg/recur_Common.pm
+++ b/FS/FS/part_pkg/recur_Common.pm
@@ -41,13 +41,14 @@ sub cutoff_day {
# prorate/subscription only; we don't support sync_bill_date here
my( $self, $cust_pkg ) = @_;
my $recur_method = $self->option('recur_method',1) || 'anniversary';
- return () unless $recur_method eq 'prorate'
- || $recur_method eq 'subscription';
+ my $cust_main = $cust_pkg->cust_main;
- #false laziness w/prorate.pm::cutoff_day
- my $prorate_day = $cust_pkg->cust_main->prorate_day;
- $prorate_day ? ( $prorate_day )
- : split(/\s*,\s*/, $self->option('cutoff_day', 1) || '1');
+ 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 split(/\s*,\s*/, $self->option('cutoff_day', 1) || '1');
+ }
}
sub calc_recur_Common {
diff --git a/FS/FS/part_pkg/subscription.pm b/FS/FS/part_pkg/subscription.pm
index 0dfe049fe..bf644d48c 100644
--- a/FS/FS/part_pkg/subscription.pm
+++ b/FS/FS/part_pkg/subscription.pm
@@ -88,6 +88,11 @@ use FS::part_pkg::flat;
sub calc_recur {
my($self, $cust_pkg, $sdate, $details, $param ) = @_;
my $cutoff_day = $self->option('cutoff_day', 1) || 1;
+ my $cust_main = $cust_pkg->cust_main;
+ if ( $cust_main->force_prorate_day and $cust_main->prorate_day ) {
+ $cutoff_day = $cust_main->prorate_day;
+ }
+
my $mnow = $$sdate;
my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($mnow) )[0,1,2,3,4,5];
diff --git a/FS/FS/payinfo_Mixin.pm b/FS/FS/payinfo_Mixin.pm
index 5f7ce3550..3a32ad5b2 100644
--- a/FS/FS/payinfo_Mixin.pm
+++ b/FS/FS/payinfo_Mixin.pm
@@ -67,8 +67,9 @@ sub payinfo {
my($self,$payinfo) = @_;
if ( defined($payinfo) ) {
+ $self->paymask($self->mask_payinfo) unless $self->payinfo =~ /^99\d{14}$/; #make sure old mask is set
$self->setfield('payinfo', $payinfo);
- $self->paymask($self->mask_payinfo) unless $payinfo =~ /^99\d{14}$/; #token
+ $self->paymask($self->mask_payinfo) unless $payinfo =~ /^99\d{14}$/; #remask unless tokenizing
} else {
$self->getfield('payinfo');
}
diff --git a/FS/FS/sector_coverage.pm b/FS/FS/sector_coverage.pm
new file mode 100644
index 000000000..fa6a9e154
--- /dev/null
+++ b/FS/FS/sector_coverage.pm
@@ -0,0 +1,133 @@
+package FS::sector_coverage;
+use base qw( FS::Record );
+
+use strict;
+use FS::Record qw( qsearch qsearchs );
+use Cpanel::JSON::XS;
+
+=head1 NAME
+
+FS::sector_coverage - Object methods for sector_coverage records
+
+=head1 SYNOPSIS
+
+ use FS::sector_coverage;
+
+ $record = new FS::sector_coverage \%hash;
+ $record = new FS::sector_coverage { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::sector_coverage object represents a coverage map for a sector at
+a specific signal strength level. FS::sector_coverage inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item coveragenum
+
+primary key
+
+=item sectornum
+
+L<FS::tower_sector> foreign key
+
+=item db_loss
+
+The maximum path loss shown on this map, in dB.
+
+=item geometry
+
+A GeoJSON Geometry object for the area covered at this level.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new map. To add the example to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to. You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'sector_coverage'; }
+
+=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.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('coveragenum')
+ || $self->ut_number('sectornum')
+ || $self->ut_number('db_loss')
+ ;
+ return $error if $error;
+
+ if ( length($self->geometry) ) {
+ # make sure it parses at least
+ local $@;
+ my $data = eval { decode_json($self->geometry) };
+ if ( $@ ) {
+ # limit the length, in case it decides to return a large chunk of data
+ return "Error parsing coverage geometry: ".substr($@, 0, 100);
+ }
+ }
+
+ $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>
+
+=cut
+
+1;
+
diff --git a/FS/FS/svc_IP_Mixin.pm b/FS/FS/svc_IP_Mixin.pm
index 8b2b5f17e..c89245fe2 100644
--- a/FS/FS/svc_IP_Mixin.pm
+++ b/FS/FS/svc_IP_Mixin.pm
@@ -222,4 +222,41 @@ sub replace_check {
ref($err_or_ref) ? '' : $err_or_ref;
}
+=item addr_status
+
+Returns the ping status record for this service's address, if there
+is one.
+
+=cut
+
+sub addr_status {
+ my $self = shift;
+ my $addr = $self->ip_addr or return;
+ qsearchs('addr_status', { 'ip_addr' => $addr });
+}
+
+=item addr_status_color
+
+Returns the CSS color for the ping status of this service.
+
+=cut
+
+# subject to change; should also show high/low latency (yellow?) and
+# staleness of data (probably means the daemon is not running) and packet
+# loss (once we measure that)
+
+sub addr_status_color {
+ my $self = shift;
+ if ( my $addr_status = $self->addr_status ) {
+ if ( $addr_status->up ) {
+ return 'green';
+ } else {
+ return 'red';
+ }
+ } else {
+ return 'gray';
+ }
+}
+
+
1;
diff --git a/FS/FS/tower.pm b/FS/FS/tower.pm
index f371ec9c7..18b43fe7d 100644
--- a/FS/FS/tower.pm
+++ b/FS/FS/tower.pm
@@ -75,6 +75,27 @@ Delete this record from the database.
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
+=cut
+
+sub replace {
+ my $self = shift;
+ my $old = shift || $self->replace_old;
+ # editing the tower location needs to regenerate coverage on its sectors
+ my $regen_coverage = 0;
+ foreach (qw(latitude longitude height)) {
+ $regen_coverage = 1 if $self->get($_) != $old->get($_);
+ }
+
+ my $error = $self->SUPER::replace($old);
+ return $error if $error;
+
+ if ($regen_coverage) {
+ foreach my $sector ($self->tower_sector) {
+ $sector->queue_generate_coverage;
+ }
+ }
+}
+
=item check
Checks all fields to make sure this is a valid tower. If there is
@@ -143,7 +164,7 @@ default sector.
sub process_o2m {
my $self = shift;
my %opt = @_;
- my $params = $opt{params};
+ my $params = +{ %{$opt{params}} };
# Adjust to make sure our default sector is in the list.
my $default_sector = $self->default_sector
diff --git a/FS/FS/tower_sector.pm b/FS/FS/tower_sector.pm
index 3fadc8685..2e9232307 100644
--- a/FS/FS/tower_sector.pm
+++ b/FS/FS/tower_sector.pm
@@ -1,12 +1,16 @@
package FS::tower_sector;
use base qw( FS::Record );
+use FS::Record qw(dbh qsearch);
use Class::Load qw(load_class);
use File::Path qw(make_path);
use Data::Dumper;
+use Cpanel::JSON::XS;
use strict;
+our $noexport_hack = 0;
+
=head1 NAME
FS::tower_sector - Object methods for tower_sector records
@@ -75,10 +79,13 @@ The antenna beam elevation in degrees below horizontal.
The -3dB vertical beamwidth in degrees.
-=item margin
+=item db_high
+
+The signal loss margin to treat as "high quality".
-The signal loss margin allowed on the sector, in dB. This is normally
-transmitter EIRP minus receiver sensitivity.
+=item db_low
+
+The signal loss margin to treat as "low quality".
=item image
@@ -110,6 +117,73 @@ sub table { 'tower_sector'; }
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
+=cut
+
+sub insert {
+ my $self = shift;
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::insert;
+ return $error if $error;
+
+ unless ($noexport_hack) {
+ foreach my $part_export ($self->part_export) {
+ my $error = $part_export->export_insert($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ".$part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
+ # XXX exportify
+ if (scalar($self->need_fields_for_coverage) == 0) {
+ $self->queue_generate_coverage;
+ }
+}
+
+sub replace {
+ my $self = shift;
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $old = shift || $self->replace_old;
+ my $error = $self->SUPER::replace($old);
+ return $error if $error;
+
+ unless ( $noexport_hack ) {
+ foreach my $part_export ($self->part_export) {
+ my $error = $part_export->export_replace($self, $old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ".$part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
+ #XXX exportify
+ my $regen_coverage = 0;
+ if ( !$self->get('no_regen') ) {
+ foreach (qw(height freq_mhz direction width downtilt
+ v_width db_high db_low))
+ {
+ $regen_coverage = 1 if ($self->get($_) ne $old->get($_));
+ }
+ }
+
+
+ if ($regen_coverage) {
+ $self->queue_generate_coverage;
+ }
+}
+
=item delete
Delete this record from the database.
@@ -119,11 +193,31 @@ Delete this record from the database.
sub delete {
my $self = shift;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
#not the most efficient, not not awful, and its not like deleting a sector
# with customers is a common operation
return "Can't delete a sector with customers" if $self->svc_broadband;
- $self->SUPER::delete;
+ unless ($noexport_hack) {
+ foreach my $part_export ($self->part_export) {
+ my $error = $part_export->export_delete($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ".$part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
+ my $error = $self->SUPER::delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
}
=item check
@@ -149,12 +243,19 @@ sub check {
|| $self->ut_numbern('v_width')
|| $self->ut_numbern('downtilt')
|| $self->ut_floatn('sector_range')
- || $self->ut_numbern('margin')
+ || $self->ut_decimaln('power')
+ || $self->ut_decimaln('line_loss')
+ || $self->ut_decimaln('antenna_gain')
+ || $self->ut_numbern('hardware_typenum')
+ || $self->ut_textn('title')
+ # all of these might get relocated as part of coverage refactoring
|| $self->ut_anything('image')
|| $self->ut_sfloatn('west')
|| $self->ut_sfloatn('east')
|| $self->ut_sfloatn('south')
|| $self->ut_sfloatn('north')
+ || $self->ut_numbern('db_high')
+ || $self->ut_numbern('db_low')
;
return $error if $error;
@@ -192,6 +293,7 @@ Returns a list of required fields for the coverage map that aren't yet filled.
=cut
sub need_fields_for_coverage {
+ # for now assume exports require all of this
my $self = shift;
my $tower = $self->tower;
my %fields = (
@@ -201,7 +303,8 @@ sub need_fields_for_coverage {
downtilt => 'Downtilt',
width => 'Horiz. width',
v_width => 'Vert. width',
- margin => 'Signal margin',
+ db_high => 'High quality signal margin',
+ db_low => 'Low quality signal margin',
latitude => 'Latitude',
longitude => 'Longitude',
);
@@ -220,8 +323,13 @@ Starts a job to recalculate the coverage map.
=cut
+# XXX move to an export
+
sub queue_generate_coverage {
my $self = shift;
+ my $need_fields = join(',', $self->need_fields_for_coverage);
+ return "$need_fields required" if $need_fields;
+ $self->set('no_regen', 1); # avoid recursion
if ( length($self->image) > 0 ) {
foreach (qw(image west south east north)) {
$self->set($_, '');
@@ -237,6 +345,28 @@ sub queue_generate_coverage {
=back
+=head1 CLASS METHODS
+
+=over 4
+
+=item part_export
+
+Returns all sector exports. Eventually this may be refined to the level
+of enabling exports on specific sectors.
+
+=cut
+
+sub part_export {
+ my $info = $FS::part_export::exports{'tower_sector'} 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
=over 4
@@ -258,9 +388,11 @@ sub process_generate_coverage {
my $sectornum = $param->{sectornum};
my $sector = FS::tower_sector->by_key($sectornum)
or die "sector $sectornum does not exist";
+ $sector->set('no_regen', 1); # avoid recursion
my $tower = $sector->tower;
load_class('Map::Splat');
+
# since this is still experimental, put it somewhere we can find later
my $workdir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc/" .
"generate_coverage/sector$sectornum-". time;
@@ -274,9 +406,9 @@ sub process_generate_coverage {
h_width => $sector->width,
tilt => $sector->downtilt,
v_width => $sector->v_width,
- max_loss => $sector->margin,
- min_loss => $sector->margin - 80,
+ db_levels => [ $sector->db_low, $sector->db_high ],
dir => $workdir,
+ #simplify => 0.0004, # remove stairstepping in SRTM3 data?
);
$splat->calculate;
@@ -284,11 +416,30 @@ sub process_generate_coverage {
foreach (qw(west east south north)) {
$sector->set($_, $box->{$_});
}
- $sector->set('image', $splat->mask);
- # mask returns a PNG where everything below max_loss is solid colored,
- # and everything above it is transparent. More useful for our purposes.
+ $sector->set('image', $splat->png);
my $error = $sector->replace;
die $error if $error;
+
+ foreach ($sector->sector_coverage) {
+ $error = $_->delete;
+ die $error if $error;
+ }
+ # XXX undecided whether Map::Splat should even do this operation
+ # or how to store it
+ # or anything else
+ $DB::single = 1;
+ my $data = decode_json( $splat->polygonize_json );
+ for my $feature (@{ $data->{features} }) {
+ my $db = $feature->{properties}{level};
+ my $coverage = FS::sector_coverage->new({
+ sectornum => $sectornum,
+ db_loss => $db,
+ geometry => encode_json($feature->{geometry})
+ });
+ $error = $coverage->insert;
+ }
+
+ die $error if $error;
}
=head1 BUGS
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 73a740f63..10dda5948 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -876,3 +876,5 @@ FS/commission_rate.pm
t/commission_rate.t
FS/saved_search.pm
t/saved_search.t
+FS/sector_coverage.pm
+t/sector_coverage.t
diff --git a/FS/bin/freeside-pingd b/FS/bin/freeside-pingd
new file mode 100644
index 000000000..fc9f8a378
--- /dev/null
+++ b/FS/bin/freeside-pingd
@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+
+use strict;
+use FS::Daemon ':all';
+use FS::UID qw(dbh adminsuidsetup);
+use FS::Record qw( dbh qsearch qsearchs );
+use FS::addr_status;
+use FS::Conf;
+use Getopt::Std;
+use Net::Ping;
+
+my @TARGETS = (
+ 'tower_sector',
+ 'svc_broadband',
+ # could add others here
+);
+
+my $timeout = 5.0; # seconds
+
+# useful opts: scan interval, timeout, verbose, max forks
+# maybe useful opts: interface, protocol, packet size, no-fork
+
+my $interval;
+
+our %opt;
+getopts('vxi:', \%opt);
+my $user = shift or die usage();
+
+if (!$opt{x}) {
+ daemonize1('freeside-pingd');
+ drop_root();
+ daemonize2();
+}
+
+if ($opt{i}) {
+ $interval = $opt{i};
+}
+
+sub debug {
+ warn(@_, "\n") if $opt{v};
+}
+
+adminsuidsetup($user);
+$FS::UID::AutoCommit = 1;
+
+if ( !$interval ) {
+ my $conf = FS::Conf->new;
+ $interval = $conf->config('pingd-interval');
+ if ( !$interval ) {
+ debug("no pingd-interval configured; exiting");
+ exit(0);
+ }
+}
+
+while(1) {
+ daemon_reconnect();
+ my @addrs_to_scan;
+ foreach my $table (@TARGETS) {
+ # find addresses that need to be scanned (haven't been yet, or are
+ # expired)
+ my $expired = time - $interval;
+ debug("checking addresses from $table");
+
+ my $statement = "SELECT ip_addr FROM $table
+ LEFT JOIN addr_status USING (ip_addr)
+ WHERE $table.ip_addr IS NOT NULL
+ AND (addr_status.ip_addr IS NULL OR addr_status._date <= ?)
+ ORDER BY COALESCE(addr_status._date, 0)";
+ my $addrs = dbh->selectcol_arrayref($statement, {}, $expired);
+ die dbh->errstr if !defined $addrs;
+ debug("found ".scalar(@$addrs));
+ push @addrs_to_scan, @$addrs;
+ }
+
+ # fork to handle this since we're going to spend most of our time
+ # waiting for remote machines to respond
+ foreach my $addr (@addrs_to_scan) {
+ daemon_fork( \&scan, $addr );
+ }
+
+ debug("waiting for scan to complete");
+ # wait until finished
+ daemon_wait();
+
+ # sleep until there's more work to do:
+ # the oldest record that still has an expire time in the future
+ # (as opposed to records for dead addresses, which will not be rescanned)
+ my $next_expire = FS::Record->scalar_sql(
+ 'SELECT MIN(_date) FROM addr_status WHERE _date + ? > ?',
+ $interval, time
+ ) || time;
+ my $delay = $next_expire + $interval - time;
+ # but at least scan every $interval seconds, to pick up new addresses
+ $delay = $interval if $delay > $interval;
+
+ if ( $delay > 0 ) {
+ debug("it is now ".time."; sleeping for $delay");
+ sleep($delay);
+ } else {
+ debug("it is now ".time."; continuing");
+ }
+
+} # main loop
+
+sub scan {
+ # currently just sends a single ping; it might be more useful to send
+ # several of them and estimate packet loss.
+
+ my $addr = shift;
+ my $addr_status = qsearchs('addr_status', { 'ip_addr' => $addr })
+ || FS::addr_status->new({ 'ip_addr' => $addr });
+
+ $addr_status->select_for_update if $addr_status->addrnum;
+ my $ping = Net::Ping->new;
+ $ping->hires;
+ debug "pinging $addr";
+ my ($result, $latency) = $ping->ping($addr, $timeout);
+ debug "status $result, delay $latency";
+ $addr_status->set('up', $result ? 'Y' : '');
+ $addr_status->set('delay', int($latency * 1000));
+ $addr_status->set('_date', time);
+ my $error = $addr_status->addrnum ?
+ $addr_status->replace :
+ $addr_status->insert;
+ if ( $error ) {
+ die "ERROR: could not update status for $addr\n$error\n";
+ }
+}
+
+sub usage {
+ "Usage:
+ freeside-pingd [ -i INTERVAL ] [ -v ] [ -x ] <username>
+";
+}
+
diff --git a/FS/t/addr_status.t b/FS/t/addr_status.t
new file mode 100644
index 000000000..ece424b9e
--- /dev/null
+++ b/FS/t/addr_status.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::addr_status;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/sector_coverage.t b/FS/t/sector_coverage.t
new file mode 100644
index 000000000..b30415888
--- /dev/null
+++ b/FS/t/sector_coverage.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::sector_coverage;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/suite/05-prorate_sync_same_day.t b/FS/t/suite/05-prorate_sync_same_day.t
index 91a8efa74..d08752ef1 100755
--- a/FS/t/suite/05-prorate_sync_same_day.t
+++ b/FS/t/suite/05-prorate_sync_same_day.t
@@ -5,10 +5,15 @@
Tests the effect of ordering and activating two sync_bill_date packages on
the same day. Ref RT#42108.
-Correct: If the packages have prorate_round_day = 1 (round nearest), or 3
-(round down) then the second package should be prorated one day short. If
-they have prorate_round_day = 2 (round up), they should be billed
-for the same amount. In both cases they should have the same next bill date.
+Formerly correct: If the packages have prorate_round_day = 1 (round
+nearest), or 3 (round down) then the second package should be prorated one
+day short. If they have prorate_round_day = 2 (round up), they should be
+billed for the same amount. In both cases they should have the same next
+bill date.
+
+Revised RT#72928: The second package should be prorated one day short only
+if the rounding mode is 1 (round nearest), as the nearest day is different
+for the two packages.
=cut
@@ -81,7 +86,7 @@ foreach my $prorate_mode (1, 2, 3) {
$error = $cust->bill_and_collect;
# Check the amount billed.
- if ( $prorate_mode == 1 or $prorate_mode == 3 ) {
+ if ( $prorate_mode == 1 ) {
# it should be one day short, in March
$recur = sprintf('%.2f', $recur * 30/31);
}
diff --git a/FS/t/suite/10-prorate_sync_same_hour.t b/FS/t/suite/10-prorate_sync_same_hour.t
new file mode 100755
index 000000000..f1e31851a
--- /dev/null
+++ b/FS/t/suite/10-prorate_sync_same_hour.t
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+
+=head2 DESCRIPTION
+
+Tests the effect of ordering and activating two sync_bill_date packages
+either both before or both after noon, less than an hour apart. Ref RT#42108
+and #72928.
+
+Correct: The packages should always end up with the same next bill date,
+and should be billed for a full period, except in the case where the first
+package starts at midnight and the rounding mode is "always round down".
+
+=cut
+
+use strict;
+use Test::More tests => 27;
+use FS::Test;
+use Date::Parse 'str2time';
+use Date::Format 'time2str';
+use Test::MockTime qw(set_fixed_time);
+use FS::cust_main;
+use FS::cust_pkg;
+use FS::Conf;
+my $FS= FS::Test->new;
+
+foreach my $prorate_mode (1, 2, 3) {
+ diag("prorate_round_day = $prorate_mode");
+ # Create a package def with the sync_bill_date option.
+ my $error;
+ my $old_part_pkg = $FS->qsearchs('part_pkg', { pkgpart => 5 });
+ my $part_pkg = $old_part_pkg->clone;
+ BAIL_OUT("existing pkgpart 5 is not a flat monthly package")
+ unless $part_pkg->freq eq '1' and $part_pkg->plan eq 'flat';
+ $error = $part_pkg->insert(
+ options => { $old_part_pkg->options,
+ 'sync_bill_date' => 1,
+ 'prorate_round_day' => $prorate_mode, }
+ );
+
+ BAIL_OUT("can't configure package: $error") if $error;
+
+ my $pkgpart = $part_pkg->pkgpart;
+ # Create a clean customer with no other packages.
+ foreach my $hour (0, 8, 16) {
+ diag("$hour:00");
+ my $location = FS::cust_location->new({
+ address1 => '123 Example Street',
+ city => 'Sacramento',
+ state => 'CA',
+ country => 'US',
+ zip => '94901',
+ });
+ my $cust = FS::cust_main->new({
+ agentnum => 1,
+ refnum => 1,
+ last => 'Customer',
+ first => 'Sync bill date',
+ invoice_email => 'newcustomer@fake.freeside.biz',
+ payby => 'BILL',
+ bill_location => $location,
+ ship_location => $location,
+ });
+ $error = $cust->insert;
+ BAIL_OUT("can't create test customer: $error") if $error;
+
+ my @pkgs;
+ # Create and bill the first package.
+ set_fixed_time(str2time("2016-03-10 $hour:00"));
+ $pkgs[0] = FS::cust_pkg->new({ pkgpart => $pkgpart });
+ $error = $cust->order_pkg({ 'cust_pkg' => $pkgs[0] });
+ BAIL_OUT("can't order package: $error") if $error;
+ $error = $cust->bill_and_collect;
+ # Check the amount billed.
+ my ($cust_bill_pkg) = $pkgs[0]->cust_bill_pkg;
+ my $recur = $part_pkg->base_recur;
+ ok( $cust_bill_pkg->recur == $recur, "first package recur is $recur" )
+ or diag("first package recur is ".$cust_bill_pkg->recur);
+
+ # Create and bill the second package.
+ set_fixed_time(str2time("2016-03-10 $hour:01"));
+ $pkgs[1] = FS::cust_pkg->new({ pkgpart => $pkgpart });
+ $error = $cust->order_pkg({ 'cust_pkg' => $pkgs[1] });
+ BAIL_OUT("can't order package: $error") if $error;
+ $error = $cust->bill_and_collect;
+
+ # Check the amount billed.
+ if ( $prorate_mode == 3 and $hour == 0 ) {
+ # special case: a start date of midnight won't be rounded down but any
+ # later start date will, so the second package will be one day short.
+ $recur = sprintf('%.2f', $recur * 30/31);
+ }
+ ($cust_bill_pkg) = $pkgs[1]->cust_bill_pkg;
+ ok( $cust_bill_pkg->recur == $recur, "second package recur is $recur" )
+ or diag("second package recur is ".$cust_bill_pkg->recur);
+
+ my @next_bill = map { time2str('%Y-%m-%d', $_->replace_old->get('bill')) } @pkgs;
+
+ ok( $next_bill[0] eq $next_bill[1],
+ "both packages will bill again on $next_bill[0]" )
+ or diag("first package bill date is $next_bill[0], second package is $next_bill[1]");
+ }
+}
diff --git a/FS/t/suite/11-prorate_sync_single_pkg.t b/FS/t/suite/11-prorate_sync_single_pkg.t
new file mode 100755
index 000000000..83308f5f8
--- /dev/null
+++ b/FS/t/suite/11-prorate_sync_single_pkg.t
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+
+=head2 DESCRIPTION
+
+Tests the effect of ordering a sync_bill_date package either before or
+after noon and billing it for two consecutive cycles, in all three prorate
+rounding modes (round nearest, round up, and round down). Ref RT#34622.
+
+Correct: It should be charged full price in both cycles regardless of
+the prorate rounding mode, as long as prorate rounding is enabled.
+
+=cut
+
+use strict;
+use Test::More tests => 18;
+use FS::Test;
+use Date::Parse 'str2time';
+use Date::Format 'time2str';
+use Test::MockTime qw(set_fixed_time);
+use FS::cust_main;
+use FS::cust_pkg;
+use FS::Conf;
+my $FS= FS::Test->new;
+
+foreach my $prorate_mode (1, 2, 3) {
+ diag("prorate_round_day = $prorate_mode");
+ # Create a package def with the sync_bill_date option.
+ my $error;
+ my $old_part_pkg = $FS->qsearchs('part_pkg', { pkgpart => 5 });
+ my $part_pkg = $old_part_pkg->clone;
+ BAIL_OUT("existing pkgpart 5 is not a flat monthly package")
+ unless $part_pkg->freq eq '1' and $part_pkg->plan eq 'flat';
+ $error = $part_pkg->insert(
+ options => { $old_part_pkg->options,
+ 'sync_bill_date' => 1,
+ 'prorate_round_day' => $prorate_mode, }
+ );
+
+ BAIL_OUT("can't configure package: $error") if $error;
+
+ my $pkgpart = $part_pkg->pkgpart;
+ # Create a clean customer with no other packages.
+ foreach my $hour (0, 8, 16) {
+ diag("$hour:00");
+ my $location = FS::cust_location->new({
+ address1 => '123 Example Street',
+ city => 'Sacramento',
+ state => 'CA',
+ country => 'US',
+ zip => '94901',
+ });
+ my $cust = FS::cust_main->new({
+ agentnum => 1,
+ refnum => 1,
+ last => 'Customer',
+ first => 'Sync bill date',
+ invoice_email => 'newcustomer@fake.freeside.biz',
+ payby => 'BILL',
+ bill_location => $location,
+ ship_location => $location,
+ });
+ $error = $cust->insert;
+ BAIL_OUT("can't create test customer: $error") if $error;
+
+ my $pkg;
+ # Create and bill the package.
+ set_fixed_time(str2time("2016-03-10 $hour:00"));
+ $pkg = FS::cust_pkg->new({ pkgpart => $pkgpart });
+ $error = $cust->order_pkg({ 'cust_pkg' => $pkg });
+ BAIL_OUT("can't order package: $error") if $error;
+ $error = $cust->bill_and_collect;
+ BAIL_OUT("can't bill package: $error") if $error;
+
+ # Bill it a second time.
+ $pkg = $pkg->replace_old;
+ set_fixed_time($pkg->bill);
+ $error = $cust->bill_and_collect;
+ BAIL_OUT("can't bill package: $error") if $error;
+
+ # Check the amount billed.
+ my $recur = $part_pkg->base_recur;
+ my @cust_bill = $cust->cust_bill;
+ ok( $cust_bill[0]->charged == $recur, "first bill is $recur" )
+ or diag("first bill is ".$cust_bill[0]->charged);
+ ok( $cust_bill[1]->charged == $recur, "second bill is $recur" )
+ or diag("second bill is ".$cust_bill[1]->charged);
+
+ }
+}
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-14 09:06:18 +0000