Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
964 lines (877 sloc) 22.6 KB
# Vend::Scan - Prepare searches for Interchange
#
# Copyright (C) 2002-2007 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program; if not, write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301 USA.
package Vend::Scan;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
create_last_search
finish_search
find_search_params
perform_search
);
$VERSION = '2.35';
use strict;
no warnings qw(uninitialized numeric);
use Vend::Util;
use Vend::File;
use Vend::SQL_Parser;
use Vend::Interpolate;
use Vend::Data qw(product_code_exists_ref column_index);
use Vend::TextSearch;
use Vend::DbSearch;
use Vend::RefSearch;
my @Order = ( qw(
mv_dict_look
mv_searchspec
mv_search_file
mv_base_directory
mv_field_names
mv_field_file
mv_verbatim_columns
mv_range_look
mv_cache_key
mv_profile
mv_case
mv_negate
mv_numeric
mv_column_op
mv_begin_string
mv_force_coordinate
mv_coordinate
mv_nextpage
mv_dict_end
mv_dict_fold
mv_dict_limit
mv_dict_order
mv_failpage
mv_first_match
mv_all_chars
mv_return_all
mv_exact_match
mv_head_skip
mv_index_delim
mv_list_only
mv_matchlimit
mv_more_alpha
mv_more_alpha_chars
mv_more_decade
mv_more_id
mv_min_string
mv_max_matches
mv_no_hide
mv_orsearch
mv_range_min
mv_range_max
mv_range_alpha
mv_record_delim
mv_return_delim
mv_return_fields
mv_return_file_name
mv_return_reference
mv_substring_match
mv_small_data
mv_start_match
mv_return_spec
mv_spelling_errors
mv_like_field
mv_like_spec
mv_search_field
mv_search_group
mv_search_label
mv_search_page
mv_search_relate
mv_sort_field
mv_sort_option
mv_searchtype
mv_unique
mv_more_matches
mv_value
mv_no_more
mv_next_search
mv_search_reference
mv_more_permanent
prefix
));
## Place marker, not used in search specs but is reserved
## rt mv_real_table
## hf mv_header_fields
##
my %Scan = ( qw(
ac mv_all_chars
bd mv_base_directory
bs mv_begin_string
ck mv_cache_key
co mv_coordinate
cs mv_case
cv mv_verbatim_columns
de mv_dict_end
df mv_dict_fold
di mv_dict_limit
dl mv_dict_look
DL mv_raw_dict_look
do mv_dict_order
dr mv_record_delim
em mv_exact_match
er mv_spelling_errors
fc mv_force_coordinate
ff mv_field_file
fi mv_search_file
ft mv_field_title
fm mv_first_match
fn mv_field_names
hs mv_head_skip
ix mv_index_delim
lb mv_search_label
lf mv_like_field
lo mv_list_only
lr mv_search_line_return
ls mv_like_spec
ma mv_more_alpha
mc mv_more_alpha_chars
md mv_more_decade
mi mv_more_id
ml mv_matchlimit
mm mv_max_matches
MM mv_more_matches
mp mv_profile
ms mv_min_string
ne mv_negate
ng mv_negate
nh mv_no_hide
nm mv_no_more
np mv_nextpage
ns mv_next_search
nu mv_numeric
op mv_column_op
os mv_orsearch
pf prefix
pm mv_more_permanent
ra mv_return_all
rd mv_return_delim
re mv_search_reference
rf mv_return_fields
rg mv_range_alpha
rl mv_range_look
rm mv_range_min
rn mv_return_file_name
rr mv_return_reference
rs mv_return_spec
rx mv_range_max
sd mv_small_data
se mv_searchspec
sf mv_search_field
sg mv_search_group
si mv_search_immediate
sm mv_start_match
sp mv_search_page
sq mv_sql_query
sr mv_search_relate
st mv_searchtype
su mv_substring_match
tf mv_sort_field
to mv_sort_option
un mv_unique
va mv_value
) );
my @ScanKeys = keys %Scan;
my %RevScan;
%RevScan = reverse %Scan;
my %Parse = (
mv_search_group => \&_array,
mv_search_field => \&_array,
mv_all_chars => \&_yes_array,
mv_begin_string => \&_yes_array,
mv_case => \&_yes_array,
mv_negate => \&_yes_array,
mv_numeric => \&_yes_array,
mv_orsearch => \&_yes_array,
mv_substring_match => \&_yes_array,
mv_column_op => \&_array,
mv_coordinate => \&_yes,
mv_no_hide => \&_yes,
mv_no_more => \&_yes,
mv_field_names => \&_array,
mv_spelling_errors => sub { my $n = int($_[1]); $n < 8 ? $n : 1; },
mv_dict_limit => \&_dict_limit,
mv_exact_match => \&_yes,
mv_head_skip => \&_number,
mv_matchlimit => \&_matchlimit,
mv_max_matches => sub { $_[1] =~ /(\d+)/ ? $1 : -1 },
mv_min_string => sub { $_[1] =~ /(\d+)/ ? $1 : 1 },
mv_profile => \&parse_profile,
mv_range_alpha => \&_array,
mv_range_look => \&_array,
mv_range_max => \&_array,
mv_range_min => \&_array,
mv_return_all => \&_yes,
mv_return_fields => \&_array,
mv_return_file_name => \&_yes,
mv_save_context => \&_array,
mv_searchspec => \&_verbatim_array,
mv_like_field => \&_array,
mv_like_spec => \&_verbatim_array,
mv_sort_field => \&_array,
mv_sort_option => \&_opt,
mv_unique => \&_yes,
mv_value => \&_value,
mv_sql_query => sub {
my($ref, $val) = @_;
my $p = Vend::Interpolate::escape_scan($val, $ref);
find_search_params($ref, $p);
return $val;
},
base_directory => \&_dir_security_scalar,
mv_field_file => \&_file_security_scalar,
mv_search_file => \&_file_security,
mv_more_alpha => \&_yes,
mv_more_alpha_chars => sub { $_[1] =~ /(\d+)/ ? $1 : 3 },
);
sub create_last_search {
my ($ref) = @_;
my @out;
my @val;
my ($key, $val);
while( ($key, $val) = each %$ref) {
if($key eq 'mv_search_map') {
my @keys = grep /\w/, split /[\s,\0]+/, $ref->{$key};
for(@keys) {
s/.*=//;
s/\s+$//;
}
for my $k (@keys) {
my $val = $ref->{$k};
$val =~ s!/!__SLASH__!g;
$val =~ s!(\W)!sprintf '%%%02x', ord($1)!eg;
$val =~ s!__SLASH__!::!g;
push @out, "$k=$val";
}
}
next unless defined $RevScan{$key};
@val = split /\0/, $val;
for(@val) {
s!/!__SLASH__!g;
s!(\W)!sprintf '%%%02x', ord($1)!eg;
s!__SLASH__!::!g;
push @out, "$RevScan{$key}=$_";
}
}
# Make repeatable for permanent store
@out = sort @out;
$Vend::Session->{last_search} = join "/", 'scan', @out;
}
sub find_search_params {
my($c,$param) = @_;
my(@args);
if($param) {
$param =~ s/-_NULL_-/\0/g;
@args = split m:/:, $param;
}
my($var,$val);
for(@args) {
($var,$val) = split /=/, $_, 2;
next unless defined $Scan{$var};
$val =~ s!::!/!g;
$c->{$Scan{$var}} = defined $c->{$Scan{$var}}
? ($c->{$Scan{$var}} . "\0$val" )
: $val;
}
#::logDebug("find_search_params: " . ::uneval($c));
return $c;
}
my %Save;
sub parse_map {
my($ref,$map) = @_;
$map = delete $ref->{mv_search_map} unless $map;
use strict;
return undef unless defined $map;
my($params);
if(index($map, "\n") != -1) {
$params = $map;
}
elsif(defined $Vend::Cfg->{SearchProfileName}->{$map}) {
$map = $Vend::Cfg->{SearchProfileName}->{$map};
$params = $Vend::Cfg->{SearchProfile}->[$map];
}
elsif($map =~ /^\d+$/) {
$params = $Vend::Cfg->{SearchProfile}->[$map];
}
elsif(defined $::Scratch->{$map}) {
$params = $::Scratch->{$map};
}
return undef unless $params;
if ( $params =~ m{\[} or $params =~ /__/) {
$params = interpolate_html($params);
}
my($ary, $var,$source, $i);
$params =~ s/^\s+//mg;
$params =~ s/\s+$//mg;
my(@param) = grep $_, split /[\r\n]+/, $params;
for(@param) {
($var,$source) = split /[\s=]+/, $_, 2;
$ref->{$var} = [] unless $ref->{$var} and ref $ref->{$var} eq 'ARRAY';
$ref->{$source} = '' if ! defined $ref->{$source};
$ref->{$source} =~ s/\0/|/g;
push @{$ref->{$var}}, ($ref->{$source});
}
return 1;
}
sub parse_profile_ref {
my ($ref, $profile) = @_;
my ($var, $p);
foreach $p (keys %$profile) {
next unless
$var = $Scan{$p}
or
(defined $RevScan{$p} and $var = $p);
$ref->{$var} = $profile->{$p}, next
if ref $profile->{$p} || ! defined $Parse{$var};
$ref->{$var} = &{$Parse{$var}}($ref,$profile->{$p});
}
return;
}
sub parse_profile {
my($ref,$profile) = @_;
return undef unless defined $profile;
my($params);
if(defined $Vend::Cfg->{SearchProfileName}->{$profile}) {
$profile = $Vend::Cfg->{SearchProfileName}->{$profile};
$params = $Vend::Cfg->{SearchProfile}->[$profile];
}
elsif($profile =~ /^\d+$/) {
$params = $Vend::Cfg->{SearchProfile}->[$profile];
}
elsif(defined $::Scratch->{$profile}) {
$params = $::Scratch->{$profile};
}
return undef unless $params;
if ( index($params, '[') != -1 or index($params, '__') != -1) {
$params = ::interpolate_html($params);
}
my($p, $var,$val);
my $status = $profile;
undef %Save;
$params =~ s/^\s+//mg;
$params =~ s/\s+$//mg;
my(@param) = grep $_, split /[\r\n]+/, $params;
for(@param) {
($var,$val) = split /[\s=]+/, $_, 2;
$status = -1 if $var eq 'mv_last';
next unless defined $RevScan{$var} or $var = $Scan{$var};
$val =~ s/&#(\d+);/chr($1)/ge;
$Save{$p} = $val;
$val = &{$Parse{$var}}($ref,$val,$ref->{$var} || undef)
if defined $Parse{$var};
$ref->{$var} = $val if defined $val;
}
return $status;
}
sub finish_search {
my($q) = @_;
#::logDebug("finishing up search spec=" . ::uneval($q));
my $matches = $q->{'matches'};
$::Values->{mv_search_match_count} = $matches;
delete $::Values->{mv_search_error};
$::Values->{mv_search_error} = $q->{mv_search_error}
if $q->{mv_search_error};
$::Values->{mv_matchlimit} = $q->{mv_matchlimit};
$::Values->{mv_first_match} = $q->{mv_first_match}
if defined $q->{mv_first_match};
$::Values->{mv_searchspec} = $q->{mv_searchspec};
$::Values->{mv_raw_dict_look} = $q->{mv_raw_dict_look} || undef;
$::Values->{mv_dict_look} = $q->{mv_dict_look} || undef;
}
# Search for an item with glimpse or text engine
sub perform_search {
my($c,$more_matches,$pre_made) = @_;
#::logDebug('searching....');
if (!$c) {
#::logDebug("No search object");
return undef unless $Vend::Session->{search_params};
($c, $more_matches) = @{$Vend::Session->{search_params}};
unless($c->{mv_cache_key}) {
#::logDebug("No cache key");
Vend::Scan::create_last_search($c);
$c->{mv_cache_key} = generate_key($Vend::Session->{last_search});
}
#::logDebug("Found search object=" . ::uneval($c));
}
elsif ($c->{mv_search_immediate}) {
unless($c->{mv_cache_key}) {
undef $c->{mv_search_immediate};
Vend::Scan::create_last_search($c);
$c->{mv_cache_key} = generate_key($Vend::Session->{last_search});
}
}
my($v) = $::Values;
my($param);
my(@fields);
my(@specs);
my($out);
my ($p, $q, $matches);
my %options;
$options{mv_session_id} = $c->{mv_session_id} || $Vend::SessionID;
if($c->{mv_more_matches}) {
#::logDebug("Found search object=" . ::uneval($c));
@options{qw/mv_cache_key mv_next_pointer mv_last_pointer mv_matchlimit mv_more_permanent/}
= split /:/, $c->{mv_more_matches};
$options{mv_more_id} = $c->{mv_more_id}
if $c->{mv_more_id};
my $s = new Vend::Search %options;
#::logDebug("resulting search object=" . ::uneval($s));
$q = $s->more_matches();
finish_search($q);
return $q;
}
# A text or glimpse search from here
parse_map($c) if defined $c->{mv_search_map};
if(defined $c->{mv_sql_query}) {
#::logDebug("found sql query in perform_search");
my $params = Vend::Interpolate::escape_scan(delete $c->{mv_sql_query}, \%CGI::values);
find_search_params($c, $params);
}
if($pre_made) {
parse_profile_ref(\%options,$c);
}
else {
foreach $p ( grep defined $c->{$_}, @ScanKeys) {
$c->{$Scan{$p}} = $c->{$p}
if ! defined $c->{$Scan{$p}};
}
foreach $p ( grep defined $c->{$_}, @Order) {
#::logDebug("Parsing $p mv_search_file");
if(defined $Parse{$p}) {
$options{$p} = &{$Parse{$p}}(\%options, $c->{$p})
}
else {
$options{$p} = $c->{$p};
}
last if $options{$p} eq '-1' and $p eq 'mv_profile';
}
}
#::logDebug("Cache key: $options{mv_cache_key}");
if(! $options{mv_cache_key}) {
$options{mv_cache_key} = $c->{mv_search_label} ||
generate_key(
@{$options{mv_searchspec}},
@{$options{mv_search_field}},
@{$options{mv_search_file}},
);
#::logDebug("generated cache key: $options{mv_cache_key}");
}
#::logDebug("Options after parse: " . ::uneval(\%options));
# GLIMPSE
if (defined $options{mv_searchtype} && $options{mv_searchtype} eq 'glimpse') {
undef $options{mv_searchtype} if ! $Vend::Cfg->{Glimpse};
}
# END GLIMPSE
SEARCH: {
$options{mv_return_all} = 1
if $options{mv_dict_look} and ! $options{mv_searchspec};
if (defined $pre_made) {
$q = $pre_made;
@{$q}{keys %options} = (values %options);
}
elsif (
! $options{mv_searchtype} && $::Variable->{MV_DEFAULT_SEARCH_DB}
or $options{mv_searchtype} =~ /db|sql/i
)
{
$q = new Vend::DbSearch %options;
}
elsif (! $options{mv_searchtype} or $options{mv_searchtype} eq 'text') {
$q = new Vend::TextSearch %options;
}
elsif ( $options{mv_searchtype} eq 'ref'){
$q = new Vend::RefSearch %options;
}
# GLIMPSE
elsif ( $options{mv_searchtype} eq 'glimpse'){
$q = new Vend::Glimpse %options;
}
# END GLIMPSE
else {
eval {
no strict 'refs';
$q = "$Global::Variable->{$options{mv_searchtype}}"->new(%options);
};
if ($@) {
::logError("Search initialization for search type %s failed: %s",
$options{mv_searchtype}, $@);
::display_special_page(
find_special_page('badsearch'),
errmsg('Search initialization failed')
);
return 0;
}
}
if(defined $options{mv_return_spec}) {
$q->{matches} = scalar @{$q->{mv_searchspec}};
$q->{mv_results} = [ map { [ $_ ] } @{$q->{mv_searchspec}} ];
last SEARCH;
}
#::logDebug(::uneval($q));
$out = $q->search();
} # last SEARCH
if($q->{mv_list_only}) {
return $q->{mv_results};
}
finish_search($q);
return $q;
}
my %scalar = (qw/ st 1 ra 1 co 1 os 1 sr 1 ml 1 ms 1/);
sub push_spec {
my ($parm, $val, $ary, $hash) = @_;
push(@$ary, "$parm=$val"), return
if $ary;
$hash->{$parm} = $val, return
if $scalar{$parm};
$hash->{$parm} = []
if ! defined $hash->{$parm};
push @{$hash->{$parm}}, $val;
return;
}
sub sql_statement {
my($text, $ref, $table) = @_;
#::logDebug("sql_statement input=$text");
my $ary;
my $hash;
if(wantarray) {
$hash = {};
$ary = '';
}
else {
$ary = [];
$hash = '';
}
if ($table) {
push_spec('fi', $table, $ary, $hash), push_spec('rt', $table, $ary, $hash)
# GLIMPSE
unless "\L$table" eq 'glimpse';
# END GLIMPSE
}
# Strip possible leading stuff
$text =~ s/^\s*sq\s*=//;
my $stmt;
eval {
$stmt = Vend::SQL_Parser->new($text, $ref);
};
if($@ and $text =~ s/^\s*sq\s*=(.*)//m) {
#::logDebug("failed first query, error=$@");
my $query = $1;
push @$ary, $text if $ary;
eval {
$stmt = Vend::SQL_Parser->new($text, $ref);
};
}
if($@) {
my $msg = ::errmsg("Bad SQL statement: %s\nQuery was: %s", $@, $text);
logError($msg) unless $Vend::Try;
Carp::croak($msg);
}
my $nuhash;
my $codename;
#::logDebug("SQL statement=" . ::uneval($stmt));
my $update = $stmt->command();
#::logDebug("SQL command=$update");
undef $update if $update eq 'SELECT';
for($stmt->tables()) {
my $t = $_->name();
if($ref->{table_only}) {
return $t;
}
#::logDebug("found table=$t");
my $codename;
my $db = Vend::Data::database_exists_ref($t);
if($db) {
$codename = $db->config('KEY') || 'code';
# Only for first table, what else can we do?
$nuhash ||= $db->config('NUMERIC') || undef;
push_spec( 'fi', $db->config('file'), $ary, $hash);
push_spec( 'rt', $t, $ary, $hash);
$stmt->verbatim_fields(1)
if $db->config('VERBATIM_FIELDS');
}
# GLIMPSE
elsif ("\L$t" eq 'glimpse') {
$codename = 'code';
undef $nuhash;
push_spec('st', 'glimpse', $ary, $hash);
}
# END GLIMPSE
else {
push_spec('fi', $t, $ary, $hash);
push_spec('rt', $t, $ary, $hash);
}
#::logDebug("t=$t obj=$_ db=$db nuhash=" . ::uneval($nuhash));
}
if(my $l = $stmt->limit()) {
#::logDebug("found limit=" . $l->limit());
push_spec('ml', $l->limit(), $ary, $hash);
if(my $fm = $l->offset()) {
#::logDebug("found offset=$fm");
push_spec('fm', $fm, $ary, $hash);
}
}
my $distincted;
for($stmt->columns()) {
my $name = $_->name();
#::logDebug("found column=$name");
push_spec('un', 1, $ary, $hash) if $_->distinct() and ! $distincted++;
push_spec('rf', $name, $ary, $hash);
push_spec('hf', $_->as(), $ary, $hash);
last if $name eq '*';
#::logDebug("column name=" . $_->name() . " table=" . $_->table());
}
for my $v ($stmt->params()) {
my $val = $v->value();
my $type = $v->type();
#::logDebug(qq{found value="$val" type=$type});
push_spec('vv', $val, $ary, $hash);
push_spec('vt', $type, $ary, $hash);
}
my @order;
@order = $stmt->order();
for(@order) {
my $c = $_->column();
#::logDebug("found order column=$c");
push_spec('tf', $c, $ary, $hash);
my $d = $_->desc() ? 'fr' : 'f';
$d =~ s/f/n/ if exists $nuhash->{$c};
#::logDebug("found order sense=$d");
push_spec('to', $d, $ary, $hash);
}
#::logDebug("ary spec to this point=" . ::uneval($ary));
#::logDebug("hash spec to this point=" . ::uneval($hash));
my @where;
@where = $stmt->where();
#::logDebug("where returned=" . ::uneval(\@where));
if(@where) {
## In a SQL query, we never want to drop out on empty string
push_spec('ms', 0, $ary, $hash);
for(@where) {
push_spec( @$_, $ary, $hash );
}
}
else {
push_spec('ra', 'yes', $ary, $hash);
}
if($hash->{sg} and ! $hash->{sr}) {
delete $hash->{sg};
}
#::logDebug("sql_statement output=" . Vend::Util::uneval_it($hash)) if $hash;
return ($hash, $stmt) if $hash;
my $string = join "\n", @$ary;
#::logDebug("sql_statement output=$string");
return $string;
}
sub _value {
my($ref, $in) = @_;
return unless $in;
my (@in) = split /\0/, $in;
for(@in) {
my($var,$val) = split /=/, $_, 2;
$::Values->{$var} = $val;
}
return;
}
sub _opt {
return ($_[2] || []) unless $_[1];
my @fields = grep $_, split /\s*[,\0]\s*/, $_[1];
unshift(@fields, @{$_[2]}) if $_[2];
my $col;
for(@fields) {
$_ = 'none' unless $_;
}
\@fields;
}
sub _column_opt {
return ($_[2] || []) unless length($_[1]);
my @fields = grep /\S/, split /\s*[,\0]\s*/, $_[1];
unshift(@fields, @{$_[2]}) if $_[2];
my $col;
for(@fields) {
s/:.*//;
next if /^\d+$/;
if (! $_[0]->{mv_search_file} and defined ($col = column_index($_)) ) {
$_ = $col + 1;
}
elsif ( $col = _find_field($_[0], $_) or defined $col ) {
$_ = $col;
}
else {
::logError( "Bad search column '%s=$col'" , $_ );
}
}
\@fields;
}
sub _column {
return ($_[2] || []) unless length $_[1];
my @fields = split /\s*[,\0]\s*/, $_[1];
unshift(@fields, @{$_[2]}) if $_[2];
my $col;
for(@fields) {
next if /^\d+$/;
next if $_[0]->{mv_verbatim_columns};
next if /:/;
if (! defined $_[0]->{mv_search_file} and defined ($col = column_index($_)) ) {
$_ = $col + 1;
}
elsif ( $col = _find_field($_[0], $_) or defined $col ) {
$_ = $col;
}
else {
logError( "Bad search column '%s'" , $_ );
}
}
\@fields;
}
sub _find_field {
my($s, $field) = @_;
my ($file, $i, $line, @fields);
if($s->{mv_field_names}) {
@fields = @{$s->{mv_field_names}};
}
elsif(! defined $s->{mv_search_file}) {
return undef;
}
elsif(ref $s->{mv_search_file}) {
$file = $s->{mv_search_file}->[0];
}
elsif($s->{mv_search_file}) {
$file = $s->{mv_search_file};
}
else {
return undef;
}
if(defined $file) {
my $dir = $s->{mv_base_directory} || $Vend::Cfg->{ProductDir};
open (Vend::Scan::FIELDS, "< $dir/$file")
or return undef;
chomp($line = <Vend::Scan::FIELDS>);
my $delim;
$line = /([^-\w])/;
$delim = quotemeta $1;
@fields = split /$delim/, $line;
close(Vend::Scan::FIELDS);
$s->{mv_field_names} = \@fields;
}
$i = 0;
for(@fields) {
return $i if $_ eq $field;
$i++;
}
return undef;
}
sub _command {
return undef unless defined $_[1];
return undef unless $_[1] =~ m{^\S+$};
return $_[1];
}
sub _verbatim_array {
return ($_[2] || undef) unless defined $_[1];
my @fields;
#::logDebug("receiving verbatim_array: " . ::uneval (\@_));
@fields = ref $_[1] ? @{$_[1]} : split /\0/, $_[1], -1;
@fields = ('') if ! @fields;
unshift(@fields, @{$_[2]}) if $_[2];
return \@fields;
}
sub _array {
return ($_[2] || undef) unless defined $_[1];
my @fields;
@fields = ref $_[1] ? @{$_[1]} : split /\s*[,\0]\s*/, $_[1], -1;
unshift(@fields, @{$_[2]}) if $_[2];
return \@fields;
}
sub _yes {
return( defined($_[1]) && ($_[1] =~ /^[yYtT1]/));
}
sub _number {
defined $_[1] ? $_[1] : 0;
}
sub _scalar {
defined $_[1] ? $_[1] : '';
}
sub _file_security {
my ($junk, $param, $passed) = @_;
$passed = [] unless $passed;
my(@files) = grep /\S/, split /\s*[,\0]\s*/, $param, -1;
for(@files) {
my $ok = allowed_file($_);
if(!$ok) {
$ok = 1 if $_ eq $::Variable->{MV_SEARCH_FILE};
$ok = 1 if $::Scratch->{$_};
}
if(/^\w+$/ and ! $::Variable->{MV_DEFAULT_SEARCH_DB}) {
$_ = $Vend::Cfg->{Database}{$_}{file}
if defined $Vend::Cfg->{Database}{$_};
}
if ($ok and $Vend::Cfg->{NoSearch} and /$Vend::Cfg->{NoSearch}/) {
::logError("Search of '%s' denied by NoSearch directive", $_);
$ok = 0;
}
push @$passed, $_ if $ok;
}
return $passed if @$passed;
return [];
}
sub _dir_security_scalar {
return undef if ! -d $_->[0];
return $_->[0];
}
sub _file_security_scalar {
my $result = _file_security(@_);
return $result->[0];
}
sub _scalar_or_array {
my(@fields) = split /\s*[,\0]\s*/, $_[1], -1;
my $arg;
if($arg = $_[2]) {
$arg = [ $arg ] unless ref $arg;
unshift(@fields, @{$arg});
}
scalar @fields > 1 ? \@fields : (defined $fields[0] ? $fields[0] : '');
}
sub _yes_array {
#::logDebug("_yes_array input=" . ::uneval(\@_));
my(@fields) = split /\s*[,\0]\s*/, $_[1];
if(defined $_[2]) {
unshift(@fields, ref $_[2] ? @{$_[2]} : $_[2]);
}
map { $_ = _yes('',$_) } @fields;
#::logDebug("_yes_array fields=" . ::uneval(\@fields));
return \@fields;
}
sub _dict_limit {
my ($ref,$limit) = @_;
return undef unless defined $ref->{mv_dict_look};
$limit = -1 if $limit =~ /^[^-0-9]/;
$ref->{mv_dict_end} = $ref->{mv_dict_look};
substr($ref->{mv_dict_end},$limit,1) =~ s/(.)/chr(ord($1) + 1)/e;
return $_[1];
}
sub _matchlimit {
shift;
my $val = lc(shift);
return -1 if $val eq 'none' or $val eq 'all';
return int($val) || $::Variable->{MV_DEFAULT_MATCHLIMIT} || 50;
}
1;
__END__
You can’t perform that action at this time.