File: //usr/share/perl5/vendor_perl/Amavis/Lookup/SQLfield.pm
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::Lookup::SQLfield;
use strict;
use re 'taint';
use warnings;
use warnings FATAL => qw(utf8 void);
no warnings 'uninitialized';
# use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.412';
@ISA = qw(Exporter);
}
use Amavis::Conf qw($trim_trailing_space_in_lookup_result_fields);
use Amavis::Util qw(ll do_log);
sub new($$$;$$) {
my($class, $sql_query, $fieldname, $fieldtype, $implied_args) = @_;
my $self =
bless { fieldname => $fieldname, fieldtype => $fieldtype }, $class;
$self->{sql_query} = $sql_query if defined $sql_query;
$self->{args} = ref($implied_args) eq 'ARRAY' ? [@$implied_args] # copy
: [$implied_args] if defined $implied_args;
$self;
}
# fieldtype: B=boolean, N=numeric, S=string,
# N-: numeric, nonexistent field returns undef without complaint
# S-: string, nonexistent field returns undef without complaint
# B-: boolean, nonexistent field returns undef without complaint
# B0: boolean, nonexistent field treated as false
# B1: boolean, nonexistent field treated as true
sub lookup_sql_field($$$%) {
my($self, $addr, $get_all, %options) = @_;
my(@result, @matchingkey, $sql_query, $field);
if ($self) { $sql_query = $self->{sql_query}; $field = $self->{fieldname} }
$sql_query = $Amavis::sql_lookups if !defined $sql_query; # global default
if (!defined $self) {
do_log(5, 'lookup_sql_field - no field query object, "%s" no match',$addr);
} elsif (!defined $field || $field eq '') {
do_log(5, 'lookup_sql_field() - no field name, "%s" no match', $addr);
} elsif (!defined $sql_query) {
do_log(5, 'lookup_sql_field(%s) - no sql_lookups object, "%s" no match',
$field, $addr);
} else {
my(@result_attr_names) = !ref $field ? ( $field )
: ref $field eq 'ARRAY' ? @$field
: ref $field eq 'HASH' ? keys %$field : ();
my(%attr_name_to_sqlfield_name) =
ref $field eq 'HASH' ? %$field
: map( ($_,$_), @result_attr_names);
my $fieldtype = $self->{fieldtype};
$fieldtype = 'S-' if !defined $fieldtype;
my($res_ref,$mk_ref) = $sql_query->lookup_sql($addr,1, %options,
!exists($self->{args}) ? () : (ExtraArguments => $self->{args}));
if (!defined $res_ref || !@$res_ref) {
ll(5) && do_log(5, 'lookup_sql_field(%s), "%s" no matching records',
join(',', map(lc($_) eq lc($attr_name_to_sqlfield_name{$_}) ? $_
: $_ . '/' . $attr_name_to_sqlfield_name{$_},
@result_attr_names)), $addr);
} else {
my %nosuchfield;
for my $ind (0 .. $#$res_ref) {
my($any_field_matches, @match_values_by_ind);
my $h_ref = $res_ref->[$ind]; my $mk = $mk_ref->[$ind];
for my $result_attr_ind (0 .. $#result_attr_names) {
my $result_attr_name = $result_attr_names[$result_attr_ind];
next if !defined $result_attr_name;
my $fieldname = $attr_name_to_sqlfield_name{$result_attr_name};
next if !defined $fieldname || $fieldname eq '';
my $match;
if (!exists($h_ref->{$fieldname})) {
$nosuchfield{$fieldname} = 1;
# record found, but no field with that name in the table
# fieldtype: B0: boolean, nonexistent field treated as false,
# B1: boolean, nonexistent field treated as true
if ($fieldtype =~ /^.-/s) { # allowed to not exist
# this type is almost universally in use now, continue searching
} elsif ($fieldtype =~ /^B1/) { # defaults to true
# only used for the 'local' field
$match = 1; # nonexistent field treated as 1
} elsif ($fieldtype =~ /^B0/) { # boolean, defaults to false
# no longer in use
$match = 0; # nonexistent field treated as 0
} else {
# treated as 'no match', returns undef
}
} else { # field exists
# fieldtype: B=boolean, N=numeric, S=string
$match = $h_ref->{$fieldname};
if (!defined $match) {
# NULL field values represented as undef
} elsif ($fieldtype =~ /^B/) { # boolean
# convert values 'N', 'F', '0', ' ' and "\000" to 0
# to allow value to be used directly as a Perl boolean
$match = 0 if $match =~ /^([NnFf ]|0+|\000+)\ *\z/;
} elsif ($fieldtype =~ /^N/) { # numeric
$match = $match + 0; # convert string into a number
} elsif ($fieldtype =~ /^S/) { # string
$match =~ s/ +\z// # trim trailing spaces
if $trim_trailing_space_in_lookup_result_fields;
}
}
$match_values_by_ind[$result_attr_ind] = $match;
$any_field_matches = 1 if defined $match;
}
ll(5) && do_log(5, 'lookup_sql_field(%s) rec=%d, "%s" result: %s',
join(',', map(lc($_) eq lc($attr_name_to_sqlfield_name{$_}) ? $_
: $_ . '/' . $attr_name_to_sqlfield_name{$_},
@result_attr_names)),
$ind, $addr,
join(', ', map(defined $_ ? '"'.$_.'"' : 'undef',
@match_values_by_ind)) );
if ($any_field_matches) {
push(@matchingkey, $mk);
push(@result, !ref $field ? $match_values_by_ind[0] :
{ map( ($result_attr_names[$_], $match_values_by_ind[$_]),
grep(defined $match_values_by_ind[$_],
(0 .. $#result_attr_names) )) } );
last if !$get_all;
}
}
do_log(5, 'lookup_sql_field, no such fields: %s',
join(', ', keys %nosuchfield)) if ll(5) && %nosuchfield;
}
}
if (!$get_all) { !wantarray ? $result[0] : ($result[0], $matchingkey[0]) }
else { !wantarray ? \@result : (\@result, \@matchingkey) }
}
1;