summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/ClientAPI/MyAccount.pm125
-rw-r--r--FS/FS/IP_Mixin.pm4
-rw-r--r--FS/FS/Record.pm26
-rw-r--r--FS/FS/Schema.pm1
-rw-r--r--FS/FS/cust_main/Search.pm3
-rw-r--r--FS/FS/log.pm22
-rw-r--r--FS/FS/log_email.pm4
-rw-r--r--FS/FS/part_event/Action/bill_sales_credit.pm2
8 files changed, 49 insertions, 138 deletions
diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm
index ba698bd8e..9e1a4adc4 100644
--- a/FS/FS/ClientAPI/MyAccount.pm
+++ b/FS/FS/ClientAPI/MyAccount.pm
@@ -1016,9 +1016,6 @@ sub validate_payment {
my $payinfo2 = $1;
$payinfo = $payinfo1. '@'. $payinfo2;
- $payinfo = $cust_main->payinfo
- if $cust_main->paymask eq $payinfo;
-
my $achonfile = 0;
if ( $cust_main->paymask eq $payinfo ) {
$payinfo = $cust_main->payinfo;
@@ -1655,128 +1652,6 @@ sub payment_receipt {
};
}
-sub list_payby {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- return {
- 'payby' => [ map {
- my $cust_payby = $_;
- +{
- map { $_ => $cust_payby->$_ }
- qw( custpaybynum weight payby paymask paydate
- payname paystate paytype
- )
- };
- }
- $cust_main->cust_payby
- ],
- };
-}
-
-sub insert_payby {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- #XXX payinfo1 + payinfo2 for CHEK?
- #or take the opportunity to use separate, more well- named fields?
- # my $payinfo;
- # $p->{'payinfo1'} =~ /^([\dx]+)$/
- # or return { 'error' => "illegal account number ". $p->{'payinfo1'} };
- # my $payinfo1 = $1;
- # $p->{'payinfo2'} =~ /^([\dx\.]+)$/ # . turned on by echeck-country CA ?
- # or return { 'error' => "illegal ABA/routing number ". $p->{'payinfo2'} };
- # my $payinfo2 = $1;
- # $payinfo = $payinfo1. '@'. $payinfo2;
-
- my $cust_payby = new FS::cust_payby {
- 'custnum' => $custnum,
- map { $_ => $p->{$_} } qw( weight payby payinfo paycvv paydate payname
- paystate paytype payip
- ),
- };
-
- my $error = $cust_payby->insert;
- if ( $error ) {
- return { 'error' => $error };
- } else {
- return { 'custpaybynum' => $cust_payby->custpaybynum };
- }
-
-}
-
-sub update_payby {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $cust_payby = qsearchs('cust_payby', {
- 'custnum' => $custnum,
- 'custpaybynum' => $p->{'custpaybynum'},
- })
- or return { 'error' => 'unknown custpaybynum '. $p->{'custpaybynum'} };
-
- foreach my $field (
- qw( weight payby payinfo paycvv paydate payname paystate paytype payip )
- ) {
- next unless exists($p->{$field});
- $cust_payby->set($field,$p->{$field});
- }
-
- my $error = $cust_payby->replace;
- if ( $error ) {
- return { 'error' => $error };
- } else {
- return { 'custpaybynum' => $cust_payby->custpaybynum };
- }
-
-}
-
-sub verify_payby {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $cust_payby = qsearchs('cust_payby', {
- 'custnum' => $custnum,
- 'custpaybynum' => $p->{'custpaybynum'},
- })
- or return { 'error' => 'unknown custpaybynum '. $p->{'custpaybynum'} };
-
- return { 'error' => $cust_payby->verify };
-
-}
-
-sub delete_payby {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $cust_payby = qsearchs('cust_payby', {
- 'custnum' => $custnum,
- 'custpaybynum' => $p->{'custpaybynum'},
- })
- or return { 'error' => 'unknown custpaybynum '. $p->{'custpaybynum'} };
-
- my $conf = new FS::Conf;
- if (($cust_payby->payby eq "DCHK" || $cust_payby->payby eq "CHEK") && $conf->exists('selfservice-ACH_info_readonly')) {
- return { 'error' => "Sorry you do not have permission to delete bank information." };
- }
- else {
- return { 'error' => $cust_payby->delete };
- }
-}
-
sub cancel {
my $p = shift;
my $session = _cache->get($p->{'session_id'})
diff --git a/FS/FS/IP_Mixin.pm b/FS/FS/IP_Mixin.pm
index 3ec769313..8920cebc5 100644
--- a/FS/FS/IP_Mixin.pm
+++ b/FS/FS/IP_Mixin.pm
@@ -94,6 +94,10 @@ sub ip_check {
$self->ip_addr('');
}
+ # Will strip extraneous leading zeros from ip adddresses
+ # e.g. 10.0.022.220 corrected to 10.0.22.220
+ $self->ut_ip46n('ip_addr');
+
if ( $self->ip_addr
and !$self->router
and $self->conf->exists('auto_router') ) {
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 89957cb47..fe8fad969 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -289,6 +289,11 @@ the individual PARAMS_HASHREF queries
#regular FS::TABLE methods
#on it.
+C<$FS::Record::qsearch_qualify_columns> package global is disabled by default.
+When enabled, the WHERE clause generated from the 'hashref' parameter has
+the table name prepended to each column name. WHERE column = 'value' becomes
+WHERE table.coumn = 'value'
+
=cut
my %TYPE = (); #for debugging
@@ -2671,7 +2676,7 @@ sub ut_ip {
$self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
or return "Illegal (IP address) $field: ". $self->getfield($field);
for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; }
- $self->setfield($field, "$1.$2.$3.$4");
+ $self->setfield( $field, $self->_ut_ip_strip_leading_zeros( "$1.$2.$3.$4" ));
'';
}
@@ -2700,8 +2705,9 @@ Check/untaint IPv4 or IPv6 address.
sub ut_ip46 {
my( $self, $field ) = @_;
- my $ip = NetAddr::IP->new($self->getfield($field))
- or return "Illegal (IP address) $field: ".$self->getfield($field);
+ my $ip = NetAddr::IP->new(
+ $self->_ut_ip_strip_leading_zeros( $self->getfield($field) )
+ ) or return "Illegal (IP address) $field: ".$self->getfield($field);
$self->setfield($field, lc($ip->addr));
return '';
}
@@ -2721,6 +2727,20 @@ sub ut_ip46n {
$self->ut_ip46($field);
}
+sub _ut_ip_strip_leading_zeros {
+ # strip user-entered leading 0's from IP addresses
+ # so parsers like NetAddr::IP don't mangle the address
+ # e.g. NetAddr::IP converts 10.0.022.220 into 10.0.18.220
+
+ my ( $self, $ip ) = @_;
+
+ return join '.', map int, split /\./, $ip
+ if $ip
+ && $ip =~ /\./
+ && $ip =~ /[\.^]0/;
+ $ip;
+}
+
=item ut_coord COLUMN [ LOWER [ UPPER ] ]
Check/untaint coordinates.
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index ecd071e49..2168c4c39 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -4665,6 +4665,7 @@ sub tables_hashref {
'min_level', 'int', 'NULL', '', '', '',
'msgnum', 'int', '', '', '', '',
'to_addr', 'varchar', 'NULL', 255, '', '',
+ 'context_height', 'int', 'NULL', '', '', '',
],
'primary_key' => 'logemailnum',
'unique' => [],
diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm
index 1a19ea343..58bdd8835 100644
--- a/FS/FS/cust_main/Search.pm
+++ b/FS/FS/cust_main/Search.pm
@@ -1049,8 +1049,9 @@ sub search {
if ( @tagnums ) {
if ( $params->{'all_tags'} ) {
+ my $exists = $params->{'all_tags'} eq 'all' ? 'exists' : 'not exists';
foreach ( @tagnums ) {
- push @where, 'exists(select 1 from cust_tag where '.
+ push @where, $exists.'(select 1 from cust_tag where '.
'cust_tag.custnum = cust_main.custnum and tagnum = '.
$_ . ')';
}
diff --git a/FS/FS/log.pm b/FS/FS/log.pm
index 75e17c847..64d036e4d 100644
--- a/FS/FS/log.pm
+++ b/FS/FS/log.pm
@@ -4,6 +4,7 @@ use strict;
use base qw( FS::Record );
use FS::Record qw( qsearch qsearchs dbdef );
use FS::UID qw( dbh driver_name );
+use FS::Log;
use FS::log_context;
use FS::log_email;
use FS::upgrade_journal;
@@ -81,18 +82,22 @@ Will send emails according to the conditions in L<FS::log_email>.
sub insert {
# not using process_o2m for this, because we don't have a web interface
my $self = shift;
+
my $error = $self->SUPER::insert;
return $error if $error;
- my $contexts = {}; #for quick checks when sending emails
- foreach ( @_ ) {
+
+ my $contexts = {};
+ my $context_height = @_;
+ foreach ( @_ ) { # ordered from least to most specific
my $context = FS::log_context->new({
'lognum' => $self->lognum,
'context' => $_
});
$error = $context->insert;
return $error if $error;
- $contexts->{$_} = 1;
+ $contexts->{$_} = $context_height--;
}
+
foreach my $log_email (
qsearch('log_email',
{
@@ -104,19 +109,20 @@ sub insert {
}
)
) {
- # shouldn't be a lot of these, so not packing this into the qsearch
+ # shouldn't be a lot of log_email records, so not packing these checks into the qsearch
next if $log_email->context && !$contexts->{$log_email->context};
+ next if $log_email->context_height && ($contexts->{$log_email->context} > $log_email->context_height);
my $msg_template = qsearchs('msg_template',{ 'msgnum' => $log_email->msgnum });
unless ($msg_template) {
warn "Could not send email when logging, could not load message template for logemailnum " . $log_email->logemailnum;
next;
}
my $emailerror = $msg_template->send(
- 'msgtype' => 'admin',
- 'to' => $log_email->to_addr,
+ 'msgtype' => 'admin',
+ 'to' => $log_email->to_addr,
'substitutions' => {
- 'loglevel' => $FS::Log::LEVELS{$self->level}, # which has hopefully been loaded...
- 'logcontext' => $log_email->context, # use the one that triggered the email
+ 'loglevel' => $FS::Log::LEVELS{$self->level} || 'unknown',
+ 'logcontext' => join(', ', keys( %$contexts )) || 'unknown',
'logmessage' => $self->message,
},
);
diff --git a/FS/FS/log_email.pm b/FS/FS/log_email.pm
index 9c53c230a..a055cb4c6 100644
--- a/FS/FS/log_email.pm
+++ b/FS/FS/log_email.pm
@@ -42,6 +42,9 @@ The following fields are currently supported:
=item to_addr - who the email will be sent to (in addition to any bcc on the template)
+=item context_height - number of context stack levels to match against
+(0 or null matches against full stack, 1 only matches lowest level context, 2 matches lowest two levels, etc.)
+
=back
=head1 METHODS
@@ -88,6 +91,7 @@ sub check {
|| $self->ut_number('min_level')
|| $self->ut_foreign_key('msgnum', 'msg_template', 'msgnum')
|| $self->ut_textn('to_addr')
+ || $self->ut_numbern('context_height')
;
return $error if $error;
diff --git a/FS/FS/part_event/Action/bill_sales_credit.pm b/FS/FS/part_event/Action/bill_sales_credit.pm
index ab69375e2..e1474300a 100644
--- a/FS/FS/part_event/Action/bill_sales_credit.pm
+++ b/FS/FS/part_event/Action/bill_sales_credit.pm
@@ -72,7 +72,7 @@ sub do_action {
my $reasonnum = $self->option('reasonnum');
- my $desc = 'from invoice #'. $cust_bill->display_invnum .
+ my $desc = ' for customer #'.$cust_main->display_custnum.': '.$cust_main->name.' from invoice #'. $cust_bill->display_invnum .
' ('. time2str($date_format, $cust_bill->_date) . ')';
# could also show custnum and pkgnums here?
my $error = $sales_cust_main->credit(
generated by cgit v1.2.1 (git 2.18.0) at 2025-10-28 22:28:28 +0000