1# Vend::Scan - Prepare searches for Interchange
2#
3# $Id: Scan.pm,v 2.34 2007-08-09 13:40:54 pajamian Exp $
4#
5# Copyright (C) 2002-2007 Interchange Development Group
6# Copyright (C) 1996-2002 Red Hat, Inc.
7#
8# This program is free software; you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation; either version 2 of the License, or
11# (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16# GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public
19# License along with this program; if not, write to the Free
20# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
21# MA  02110-1301  USA.
22
23package Vend::Scan;
24require Exporter;
25@ISA = qw(Exporter);
26@EXPORT = qw(
27			create_last_search
28			finish_search
29			find_search_params
30			perform_search
31			);
32
33$VERSION = substr(q$Revision: 2.34 $, 10);
34
35use strict;
36no warnings qw(uninitialized numeric);
37use Vend::Util;
38use Vend::File;
39use Vend::SQL_Parser;
40use Vend::Interpolate;
41use Vend::Data qw(product_code_exists_ref column_index);
42use Vend::TextSearch;
43use Vend::DbSearch;
44use Vend::RefSearch;
45
46my @Order = ( qw(
47	mv_dict_look
48	mv_searchspec
49	mv_search_file
50	mv_base_directory
51	mv_field_names
52	mv_field_file
53	mv_verbatim_columns
54	mv_range_look
55	mv_cache_key
56	mv_profile
57	mv_case
58	mv_negate
59	mv_numeric
60	mv_column_op
61	mv_begin_string
62	mv_coordinate
63	mv_nextpage
64	mv_dict_end
65	mv_dict_fold
66	mv_dict_limit
67	mv_dict_order
68	mv_failpage
69	mv_first_match
70	mv_all_chars
71	mv_return_all
72	mv_exact_match
73	mv_head_skip
74	mv_index_delim
75	mv_list_only
76	mv_matchlimit
77	mv_more_alpha
78	mv_more_alpha_chars
79	mv_more_decade
80	mv_more_id
81	mv_min_string
82	mv_max_matches
83	mv_no_hide
84	mv_orsearch
85	mv_range_min
86	mv_range_max
87	mv_range_alpha
88	mv_record_delim
89	mv_return_delim
90	mv_return_fields
91	mv_return_file_name
92	mv_return_reference
93	mv_substring_match
94	mv_small_data
95	mv_start_match
96	mv_return_spec
97	mv_spelling_errors
98	mv_like_field
99	mv_like_spec
100	mv_search_field
101	mv_search_group
102	mv_search_label
103	mv_search_page
104	mv_search_relate
105	mv_sort_field
106	mv_sort_option
107	mv_searchtype
108	mv_unique
109	mv_more_matches
110	mv_value
111	mv_no_more
112	mv_next_search
113	mv_search_reference
114	mv_more_permanent
115	prefix
116));
117
118## Place marker, not used in search specs but is reserved
119##  rt  mv_real_table
120##  hf  mv_header_fields
121##
122my %Scan = ( qw(
123	ac  mv_all_chars
124	bd  mv_base_directory
125	bs  mv_begin_string
126	ck  mv_cache_key
127	co  mv_coordinate
128	cs  mv_case
129	cv  mv_verbatim_columns
130	de  mv_dict_end
131	df  mv_dict_fold
132	di  mv_dict_limit
133	dl  mv_dict_look
134	DL  mv_raw_dict_look
135	do  mv_dict_order
136	dr  mv_record_delim
137	em  mv_exact_match
138	er  mv_spelling_errors
139	ff  mv_field_file
140	fi  mv_search_file
141	ft  mv_field_title
142	fm  mv_first_match
143	fn  mv_field_names
144	hs  mv_head_skip
145	ix  mv_index_delim
146	lb  mv_search_label
147	lf  mv_like_field
148	lo  mv_list_only
149	lr  mv_search_line_return
150	ls  mv_like_spec
151	ma  mv_more_alpha
152	mc  mv_more_alpha_chars
153	md  mv_more_decade
154	mi  mv_more_id
155	ml  mv_matchlimit
156	mm  mv_max_matches
157	MM  mv_more_matches
158	mp  mv_profile
159	ms  mv_min_string
160	ne  mv_negate
161	ng  mv_negate
162	nh  mv_no_hide
163	nm  mv_no_more
164	np  mv_nextpage
165	ns  mv_next_search
166	nu  mv_numeric
167	op  mv_column_op
168	os  mv_orsearch
169	pf  prefix
170	pm  mv_more_permanent
171	ra  mv_return_all
172	rd  mv_return_delim
173	re	mv_search_reference
174	rf  mv_return_fields
175	rg  mv_range_alpha
176	rl  mv_range_look
177	rm  mv_range_min
178	rn  mv_return_file_name
179	rr  mv_return_reference
180	rs  mv_return_spec
181	rx  mv_range_max
182	sd  mv_small_data
183	se  mv_searchspec
184	sf  mv_search_field
185	sg  mv_search_group
186	si  mv_search_immediate
187	sm  mv_start_match
188	sp  mv_search_page
189	sq  mv_sql_query
190	sr  mv_search_relate
191	st  mv_searchtype
192	su  mv_substring_match
193	tf  mv_sort_field
194	to  mv_sort_option
195	un  mv_unique
196	va  mv_value
197) );
198
199my @ScanKeys = keys %Scan;
200my %RevScan;
201%RevScan = reverse %Scan;
202
203my %Parse = (
204	mv_search_group         =>  \&_array,
205	mv_search_field         =>  \&_array,
206	mv_all_chars            =>  \&_yes_array,
207	mv_begin_string         =>  \&_yes_array,
208	mv_case                 =>  \&_yes_array,
209	mv_negate               =>  \&_yes_array,
210	mv_numeric              =>  \&_yes_array,
211	mv_orsearch             =>  \&_yes_array,
212	mv_substring_match      =>  \&_yes_array,
213	mv_column_op            =>  \&_array,
214	mv_coordinate           =>  \&_yes,
215	mv_no_hide              =>  \&_yes,
216	mv_no_more              =>  \&_yes,
217	mv_field_names          =>	\&_array,
218	mv_spelling_errors      => 	sub { my $n = int($_[1]); $n < 8 ? $n : 1; },
219	mv_dict_limit           =>  \&_dict_limit,
220	mv_exact_match          =>  \&_yes,
221	mv_head_skip            =>  \&_number,
222	mv_matchlimit           =>  \&_matchlimit,
223	mv_max_matches          =>  sub { $_[1] =~ /(\d+)/ ? $1 : -1 },
224	mv_min_string           =>  sub { $_[1] =~ /(\d+)/ ? $1 : 1 },
225	mv_profile              =>  \&parse_profile,
226	mv_range_alpha          =>  \&_array,
227	mv_range_look           =>  \&_array,
228	mv_range_max            =>  \&_array,
229	mv_range_min            =>  \&_array,
230	mv_return_all           =>  \&_yes,
231	mv_return_fields        =>  \&_array,
232	mv_return_file_name     =>  \&_yes,
233	mv_save_context         =>  \&_array,
234	mv_searchspec           =>  \&_verbatim_array,
235	mv_like_field           =>  \&_array,
236	mv_like_spec            =>  \&_verbatim_array,
237	mv_sort_field           =>  \&_array,
238	mv_sort_option          =>  \&_opt,
239	mv_unique               =>  \&_yes,
240	mv_value                =>  \&_value,
241	mv_sql_query			=>  sub {
242								my($ref, $val) = @_;
243								my $p = Vend::Interpolate::escape_scan($val, $ref);
244								find_search_params($ref, $p);
245								return $val;
246							},
247	base_directory      	=> 	\&_dir_security_scalar,
248	mv_field_file          => 	\&_file_security_scalar,
249	mv_search_file         => 	\&_file_security,
250	mv_more_alpha           =>  \&_yes,
251	mv_more_alpha_chars     =>   sub { $_[1] =~ /(\d+)/ ? $1 : 3 },
252);
253
254sub create_last_search {
255	my ($ref) = @_;
256	my @out;
257	my @val;
258	my ($key, $val);
259	while( ($key, $val) = each %$ref) {
260		next unless defined $RevScan{$key};
261		@val = split /\0/, $val;
262		for(@val) {
263			s!/!__SLASH__!g;
264			s!(\W)!sprintf '%%%02x', ord($1)!eg;
265			s!__SLASH__!::!g;
266			push @out, "$RevScan{$key}=$_";
267		}
268	}
269
270	# Make repeatable for permanent store
271	@out = sort @out;
272
273	$Vend::Session->{last_search} = join "/", 'scan', @out;
274}
275
276sub find_search_params {
277	my($c,$param) = @_;
278	my(@args);
279	if($param) {
280		$param =~ s/-_NULL_-/\0/g;
281		@args = split m:/:, $param;
282	}
283
284	my($var,$val);
285
286	for(@args) {
287		($var,$val) = split /=/, $_, 2;
288		next unless defined $Scan{$var};
289		$val =~ s!::!/!g;
290		$c->{$Scan{$var}} = defined $c->{$Scan{$var}}
291							? ($c->{$Scan{$var}} . "\0$val" )
292							: $val;
293	}
294#::logDebug("find_search_params: " . ::uneval($c));
295	return $c;
296}
297
298my %Save;
299
300sub parse_map {
301	my($ref,$map) = @_;
302	$map = delete $ref->{mv_search_map} unless $map;
303	use strict;
304	return undef unless defined $map;
305	my($params);
306	if(index($map, "\n") != -1) {
307		$params = $map;
308	}
309	elsif(defined $Vend::Cfg->{SearchProfileName}->{$map}) {
310		$map = $Vend::Cfg->{SearchProfileName}->{$map};
311		$params = $Vend::Cfg->{SearchProfile}->[$map];
312	}
313	elsif($map =~ /^\d+$/) {
314		$params = $Vend::Cfg->{SearchProfile}->[$map];
315	}
316	elsif(defined $::Scratch->{$map}) {
317		$params = $::Scratch->{$map};
318	}
319
320	return undef unless $params;
321
322	if ( $params =~ m{\[} or $params =~ /__/) {
323		$params = interpolate_html($params);
324	}
325
326	my($ary, $var,$source, $i);
327
328	$params =~ s/^\s+//mg;
329	$params =~ s/\s+$//mg;
330	my(@param) = grep $_, split /[\r\n]+/, $params;
331	for(@param) {
332		($var,$source) = split /[\s=]+/, $_, 2;
333		$ref->{$var} = [] unless defined $ref->{$var};
334		$ref->{$source} = '' if ! defined $ref->{$source};
335		$ref->{$source} =~ s/\0/|/g;
336		push @{$ref->{$var}}, ($ref->{$source});
337	}
338	return 1;
339}
340
341sub parse_profile_ref {
342	my ($ref, $profile) = @_;
343	my ($var, $p);
344	foreach $p (keys %$profile) {
345		next unless
346			$var = $Scan{$p}
347					or
348			(defined $RevScan{$p} and $var = $p);
349		$ref->{$var} = $profile->{$p}, next
350			if ref $profile->{$p} || ! defined $Parse{$var};
351		$ref->{$var} = &{$Parse{$var}}($ref,$profile->{$p});
352	}
353	return;
354}
355
356sub parse_profile {
357	my($ref,$profile) = @_;
358	return undef unless defined $profile;
359	my($params);
360	if(defined $Vend::Cfg->{SearchProfileName}->{$profile}) {
361		$profile = $Vend::Cfg->{SearchProfileName}->{$profile};
362		$params = $Vend::Cfg->{SearchProfile}->[$profile];
363	}
364	elsif($profile =~ /^\d+$/) {
365		$params = $Vend::Cfg->{SearchProfile}->[$profile];
366	}
367	elsif(defined $::Scratch->{$profile}) {
368		$params = $::Scratch->{$profile};
369	}
370
371	return undef unless $params;
372
373	if ( index($params, '[') != -1 or index($params, '__') != -1) {
374		$params = ::interpolate_html($params);
375	}
376
377	my($p, $var,$val);
378	my $status = $profile;
379	undef %Save;
380	$params =~ s/^\s+//mg;
381	$params =~ s/\s+$//mg;
382	my(@param) = grep $_, split /[\r\n]+/, $params;
383	for(@param) {
384		($var,$val) = split /[\s=]+/, $_, 2;
385		$status = -1 if $var eq 'mv_last';
386		next unless defined $RevScan{$var} or $var = $Scan{$var};
387		$val =~ s/&#(\d+);/chr($1)/ge;
388		$Save{$p} = $val;
389		$val = &{$Parse{$var}}($ref,$val,$ref->{$var} || undef)
390				if defined $Parse{$var};
391		$ref->{$var} = $val if defined $val;
392	}
393
394	return $status;
395}
396
397sub finish_search {
398	my($q) = @_;
399#::logDebug("finishing up search spec=" . ::uneval($q));
400	my $matches = $q->{'matches'};
401	$::Values->{mv_search_match_count}    = $matches;
402	delete $::Values->{mv_search_error};
403	$::Values->{mv_search_error} = $q->{mv_search_error}
404		if $q->{mv_search_error};
405	$::Values->{mv_matchlimit}     = $q->{mv_matchlimit};
406	$::Values->{mv_first_match}    = $q->{mv_first_match}
407			if defined $q->{mv_first_match};
408	$::Values->{mv_searchspec} 	   = $q->{mv_searchspec};
409	$::Values->{mv_raw_dict_look}  = $q->{mv_raw_dict_look}  || undef;
410	$::Values->{mv_dict_look}      = $q->{mv_dict_look} || undef;
411}
412
413# Search for an item with glimpse or text engine
414sub perform_search {
415	my($c,$more_matches,$pre_made) = @_;
416#::logDebug('searching....');
417	if (!$c) {
418#::logDebug("No search object");
419		return undef unless $Vend::Session->{search_params};
420		($c, $more_matches) = @{$Vend::Session->{search_params}};
421		unless($c->{mv_cache_key}) {
422#::logDebug("No cache key");
423			Vend::Scan::create_last_search($c);
424			$c->{mv_cache_key} = generate_key($Vend::Session->{last_search});
425		}
426#::logDebug("Found search object=" . ::uneval($c));
427	}
428	elsif ($c->{mv_search_immediate}) {
429		unless($c->{mv_cache_key}) {
430			undef $c->{mv_search_immediate};
431			Vend::Scan::create_last_search($c);
432			$c->{mv_cache_key} = generate_key($Vend::Session->{last_search});
433		}
434	}
435
436	my($v) = $::Values;
437	my($param);
438	my(@fields);
439	my(@specs);
440	my($out);
441	my ($p, $q, $matches);
442
443	my %options;
444	$options{mv_session_id} = $c->{mv_session_id} || $Vend::SessionID;
445	if($c->{mv_more_matches}) {
446#::logDebug("Found search object=" . ::uneval($c));
447		@options{qw/mv_cache_key mv_next_pointer mv_last_pointer mv_matchlimit mv_more_permanent/}
448			= split /:/, $c->{mv_more_matches};
449		$options{mv_more_id} = $c->{mv_more_id}
450			if $c->{mv_more_id};
451		my $s = new Vend::Search %options;
452#::logDebug("resulting search object=" . ::uneval($s));
453		$q = $s->more_matches();
454		finish_search($q);
455		return $q;
456	}
457
458
459	# A text or glimpse search from here
460
461	parse_map($c) if defined $c->{mv_search_map};
462
463	if(defined $c->{mv_sql_query}) {
464#::logDebug("found sql query in perform_search");
465		my $params = Vend::Interpolate::escape_scan(delete $c->{mv_sql_query}, \%CGI::values);
466		find_search_params($c, $params);
467	}
468
469	if($pre_made) {
470		parse_profile_ref(\%options,$c);
471	}
472	else {
473		foreach $p ( grep defined $c->{$_}, @ScanKeys) {
474			$c->{$Scan{$p}} = $c->{$p}
475				if ! defined $c->{$Scan{$p}};
476		}
477		foreach $p ( grep defined $c->{$_}, @Order) {
478#::logDebug("Parsing $p mv_search_file");
479			if(defined $Parse{$p}) {
480				$options{$p} = &{$Parse{$p}}(\%options, $c->{$p})
481			}
482			else {
483				$options{$p} = $c->{$p};
484			}
485			last if $options{$p} eq '-1' and $p eq 'mv_profile';
486		}
487	}
488
489#::logDebug("Cache key: $options{mv_cache_key}");
490	if(! $options{mv_cache_key}) {
491		$options{mv_cache_key} = $c->{mv_search_label} ||
492								 generate_key(
493									@{$options{mv_searchspec}},
494									@{$options{mv_search_field}},
495									@{$options{mv_search_file}},
496								);
497#::logDebug("generated cache key: $options{mv_cache_key}");
498	}
499
500#::logDebug("Options after parse: " . ::uneval(\%options));
501
502# GLIMPSE
503	if (defined $options{mv_searchtype} && $options{mv_searchtype} eq 'glimpse') {
504		undef $options{mv_searchtype} if ! $Vend::Cfg->{Glimpse};
505	}
506# END GLIMPSE
507
508	SEARCH: {
509		$options{mv_return_all} = 1
510			if $options{mv_dict_look} and ! $options{mv_searchspec};
511
512		if (defined $pre_made) {
513			$q = $pre_made;
514			@{$q}{keys %options} = (values %options);
515		}
516		elsif (
517				! $options{mv_searchtype} && $::Variable->{MV_DEFAULT_SEARCH_DB}
518				or $options{mv_searchtype} =~ /db|sql/i
519			)
520		{
521			$q = new Vend::DbSearch %options;
522		}
523		elsif (! $options{mv_searchtype} or $options{mv_searchtype} eq 'text') {
524			$q = new Vend::TextSearch %options;
525		}
526		elsif ( $options{mv_searchtype} eq 'ref'){
527			$q = new Vend::RefSearch %options;
528		}
529# GLIMPSE
530		elsif ( $options{mv_searchtype} eq 'glimpse'){
531			$q = new Vend::Glimpse %options;
532		}
533# END GLIMPSE
534		else  {
535			eval {
536				no strict 'refs';
537				$q = "$Global::Variable->{$options{mv_searchtype}}"->new(%options);
538			};
539			if ($@) {
540				::logError("Search initialization for search type %s failed: %s",
541						   $options{mv_searchtype}, $@);
542
543				::display_special_page(
544					find_special_page('badsearch'),
545					errmsg('Search initialization failed')
546					);
547				return 0;
548			}
549		}
550
551		if(defined $options{mv_return_spec}) {
552			$q->{matches} = scalar @{$q->{mv_searchspec}};
553			$q->{mv_results} = [ map { [ $_ ] } @{$q->{mv_searchspec}} ];
554			last SEARCH;
555		}
556
557#::logDebug(::uneval($q));
558		$out = $q->search();
559	} # last SEARCH
560
561	if($q->{mv_list_only}) {
562		return $q->{mv_results};
563	}
564
565	finish_search($q);
566
567	return $q;
568
569}
570
571my %scalar = (qw/ st 1 ra 1 co 1 os 1 sr 1 ml 1 ms 1/);
572
573sub push_spec {
574	my ($parm, $val, $ary, $hash) = @_;
575	push(@$ary, "$parm=$val"), return
576		if $ary;
577	$hash->{$parm} = $val, return
578		if $scalar{$parm};
579	$hash->{$parm} = []
580		if ! defined $hash->{$parm};
581	push @{$hash->{$parm}}, $val;
582	return;
583}
584
585sub sql_statement {
586	my($text, $ref, $table) = @_;
587#::logDebug("sql_statement input=$text");
588	my $ary;
589	my $hash;
590
591	if(wantarray) {
592		$hash = {};
593		$ary = '';
594	}
595	else {
596		$ary = [];
597		$hash = '';
598	}
599
600	if ($table) {
601		push_spec('fi', $table, $ary, $hash), push_spec('rt', $table, $ary, $hash)
602# GLIMPSE
603			unless "\L$table" eq 'glimpse';
604# END GLIMPSE
605	}
606
607	# Strip possible leading stuff
608	$text =~ s/^\s*sq\s*=//;
609	my $stmt;
610	eval {
611		$stmt = Vend::SQL_Parser->new($text, $ref);
612	};
613	if($@ and $text =~ s/^\s*sq\s*=(.*)//m) {
614#::logDebug("failed first query, error=$@");
615		my $query = $1;
616		push @$ary, $text if $ary;
617		eval {
618			$stmt = Vend::SQL_Parser->new($text, $ref);
619		};
620	}
621	if($@) {
622		my $msg = ::errmsg("Bad SQL statement: %s\nQuery was: %s", $@, $text);
623		logError($msg) unless $Vend::Try;
624		Carp::croak($msg);
625	}
626
627	my $nuhash;
628	my $codename;
629
630#::logDebug("SQL statement=" . ::uneval($stmt));
631
632	my $update = $stmt->command();
633#::logDebug("SQL command=$update");
634	undef $update if $update eq 'SELECT';
635
636	for($stmt->tables()) {
637		my $t = $_->name();
638		if($ref->{table_only}) {
639			return $t;
640		}
641#::logDebug("found table=$t");
642
643		my $codename;
644		my $db = Vend::Data::database_exists_ref($t);
645		if($db) {
646			$codename = $db->config('KEY') || 'code';
647			# Only for first table, what else can we do?
648			$nuhash ||= $db->config('NUMERIC') || undef;
649			push_spec( 'fi', $db->config('file'), $ary, $hash);
650			push_spec( 'rt', $t, $ary, $hash);
651			$stmt->verbatim_fields(1)
652				if $db->config('VERBATIM_FIELDS');
653		}
654# GLIMPSE
655		elsif ("\L$t" eq 'glimpse') {
656			$codename = 'code';
657			undef $nuhash;
658			push_spec('st', 'glimpse', $ary, $hash);
659		}
660# END GLIMPSE
661		else {
662			push_spec('fi', $t, $ary, $hash);
663			push_spec('rt', $t, $ary, $hash);
664		}
665#::logDebug("t=$t obj=$_ db=$db nuhash=" . ::uneval($nuhash));
666	}
667
668	if(my $l = $stmt->limit()) {
669#::logDebug("found limit=" . $l->limit());
670		push_spec('ml', $l->limit(), $ary, $hash);
671		if(my $fm = $l->offset()) {
672#::logDebug("found offset=$fm");
673			push_spec('fm', $fm, $ary, $hash);
674		}
675	}
676
677	my $distincted;
678	for($stmt->columns()) {
679		my $name = $_->name();
680#::logDebug("found column=$name");
681		push_spec('un', 1, $ary, $hash) if $_->distinct() and ! $distincted++;
682		push_spec('rf', $name, $ary, $hash);
683		push_spec('hf', $_->as(), $ary, $hash);
684		last if $name eq '*';
685#::logDebug("column name=" . $_->name() . " table=" . $_->table());
686	}
687
688	for my $v ($stmt->params()) {
689		my $val = $v->value();
690		my $type = $v->type();
691#::logDebug(qq{found value="$val" type=$type});
692		push_spec('vv', $val, $ary, $hash);
693		push_spec('vt', $type, $ary, $hash);
694	}
695
696	my @order;
697
698	@order = $stmt->order();
699	for(@order) {
700		my $c = $_->column();
701#::logDebug("found order column=$c");
702		push_spec('tf', $c, $ary, $hash);
703		my $d = $_->desc() ? 'fr' : 'f';
704		$d =~ s/f/n/ if exists $nuhash->{$c};
705#::logDebug("found order sense=$d");
706		push_spec('to', $d, $ary, $hash);
707	}
708
709#::logDebug("ary spec to this point=" . ::uneval($ary));
710#::logDebug("hash spec to this point=" . ::uneval($hash));
711	my @where;
712	@where = $stmt->where();
713#::logDebug("where returned=" . ::uneval(\@where));
714	if(@where) {
715		## In a SQL query, we never want to drop out on empty string
716		push_spec('ms', 0, $ary, $hash);
717		for(@where) {
718			push_spec( @$_, $ary, $hash );
719		}
720	}
721	else {
722		push_spec('ra', 'yes', $ary, $hash);
723	}
724
725	if($hash->{sg} and ! $hash->{sr}) {
726		delete $hash->{sg};
727	}
728#::logDebug("sql_statement output=" . Vend::Util::uneval_it($hash)) if $hash;
729	return ($hash, $stmt) if $hash;
730
731	my $string = join "\n", @$ary;
732#::logDebug("sql_statement output=$string");
733	return $string;
734}
735
736sub _value {
737	my($ref, $in) = @_;
738	return unless $in;
739	my (@in) = split /\0/, $in;
740	for(@in) {
741		my($var,$val) = split /=/, $_, 2;
742		$::Values->{$var} = $val;
743	}
744	return;
745}
746
747sub _opt {
748	return ($_[2] || []) unless $_[1];
749	my @fields = grep $_, split /\s*[,\0]\s*/, $_[1];
750	unshift(@fields, @{$_[2]}) if $_[2];
751	my $col;
752	for(@fields) {
753		$_ = 'none' unless $_;
754	}
755	\@fields;
756}
757
758sub _column_opt {
759	return ($_[2] || []) unless length($_[1]);
760	my @fields = grep /\S/, split /\s*[,\0]\s*/, $_[1];
761	unshift(@fields, @{$_[2]}) if $_[2];
762	my $col;
763	for(@fields) {
764		s/:.*//;
765		next if /^\d+$/;
766		if (! $_[0]->{mv_search_file} and defined ($col = column_index($_)) ) {
767			$_ = $col + 1;
768		}
769		elsif ( $col = _find_field($_[0], $_) or defined $col ) {
770			$_ = $col;
771		}
772		else {
773			::logError( "Bad search column '%s=$col'" , $_ );
774		}
775	}
776	\@fields;
777}
778
779sub _column {
780	return ($_[2] || []) unless length $_[1];
781	my @fields = split /\s*[,\0]\s*/, $_[1];
782	unshift(@fields, @{$_[2]}) if $_[2];
783	my $col;
784	for(@fields) {
785		next if /^\d+$/;
786		next if $_[0]->{mv_verbatim_columns};
787		next if /:/;
788		if (! defined $_[0]->{mv_search_file} and defined ($col = column_index($_)) ) {
789			$_ = $col + 1;
790		}
791		elsif ( $col = _find_field($_[0], $_) or defined $col ) {
792			$_ = $col;
793		}
794		else {
795			logError( "Bad search column '%s'" , $_ );
796		}
797	}
798	\@fields;
799}
800
801sub _find_field {
802	my($s, $field) = @_;
803	my ($file, $i, $line, @fields);
804
805	if($s->{mv_field_names}) {
806		@fields = @{$s->{mv_field_names}};
807	}
808	elsif(! defined $s->{mv_search_file}) {
809		return undef;
810	}
811	elsif(ref $s->{mv_search_file}) {
812		$file = $s->{mv_search_file}->[0];
813	}
814	elsif($s->{mv_search_file}) {
815		$file = $s->{mv_search_file};
816	}
817	else {
818		return undef;
819	}
820
821	if(defined $file) {
822		my $dir = $s->{mv_base_directory} || $Vend::Cfg->{ProductDir};
823		open (Vend::Scan::FIELDS, "< $dir/$file")
824			or return undef;
825		chomp($line = <Vend::Scan::FIELDS>);
826		my $delim;
827		$line = /([^-\w])/;
828		$delim = quotemeta $1;
829		@fields = split /$delim/, $line;
830		close(Vend::Scan::FIELDS);
831		$s->{mv_field_names} = \@fields;
832	}
833	$i = 0;
834	for(@fields) {
835		return $i if $_ eq $field;
836		$i++;
837	}
838	return undef;
839}
840
841sub _command {
842	return undef unless defined $_[1];
843	return undef unless $_[1] =~ m{^\S+$};
844	return $_[1];
845}
846
847sub _verbatim_array {
848	return ($_[2] || undef) unless defined $_[1];
849	my @fields;
850#::logDebug("receiving verbatim_array: " . ::uneval (\@_));
851	@fields = ref $_[1] ? @{$_[1]} : split /\0/, $_[1], -1;
852	@fields = ('') if ! @fields;
853	unshift(@fields, @{$_[2]}) if $_[2];
854	return \@fields;
855}
856
857sub _array {
858	return ($_[2] || undef) unless defined $_[1];
859	my @fields;
860	@fields = ref $_[1] ? @{$_[1]} : split /\s*[,\0]\s*/, $_[1], -1;
861	unshift(@fields, @{$_[2]}) if $_[2];
862	return \@fields;
863}
864
865sub _yes {
866	return( defined($_[1]) && ($_[1] =~ /^[yYtT1]/));
867}
868
869sub _number {
870	defined $_[1] ? $_[1] : 0;
871}
872
873sub _scalar {
874	defined $_[1] ? $_[1] : '';
875}
876
877sub _file_security {
878	my ($junk, $param, $passed) = @_;
879	$passed = [] unless $passed;
880	my(@files) = grep /\S/, split /\s*[,\0]\s*/, $param, -1;
881	for(@files) {
882		my $ok = allowed_file($_);
883		if(!$ok) {
884			$ok = 1 if $_ eq $::Variable->{MV_SEARCH_FILE};
885			$ok = 1 if $::Scratch->{$_};
886		}
887		if(/^\w+$/ and ! $::Variable->{MV_DEFAULT_SEARCH_DB}) {
888			$_ = $Vend::Cfg->{Database}{$_}{file}
889				if defined $Vend::Cfg->{Database}{$_};
890		}
891		if ($ok and $Vend::Cfg->{NoSearch} and /$Vend::Cfg->{NoSearch}/) {
892			::logError("Search of '%s' denied by NoSearch directive", $_);
893			$ok = 0;
894		}
895		push @$passed, $_ if $ok;
896	}
897	return $passed if @$passed;
898	return [];
899}
900
901sub _dir_security_scalar {
902	return undef if ! -d $_->[0];
903	return $_->[0];
904}
905
906sub _file_security_scalar {
907	my $result = _file_security(@_);
908	return $result->[0];
909}
910
911sub _scalar_or_array {
912	my(@fields) = split /\s*[,\0]\s*/, $_[1], -1;
913	my $arg;
914	if($arg = $_[2]) {
915		$arg = [ $arg ] unless ref $arg;
916		unshift(@fields, @{$arg});
917	}
918	scalar @fields > 1 ? \@fields : (defined $fields[0] ? $fields[0] : '');
919}
920
921sub _yes_array {
922#::logDebug("_yes_array input=" . ::uneval(\@_));
923	my(@fields) = split /\s*[,\0]\s*/, $_[1];
924	if(defined $_[2]) {
925		unshift(@fields, ref $_[2] ? @{$_[2]} : $_[2]);
926	}
927	map { $_ = _yes('',$_) } @fields;
928#::logDebug("_yes_array fields=" . ::uneval(\@fields));
929	return \@fields;
930}
931
932sub _dict_limit {
933	my ($ref,$limit) = @_;
934	return undef unless	defined $ref->{mv_dict_look};
935	$limit = -1 if $limit =~ /^[^-0-9]/;
936	$ref->{mv_dict_end} = $ref->{mv_dict_look};
937	substr($ref->{mv_dict_end},$limit,1) =~ s/(.)/chr(ord($1) + 1)/e;
938	return $_[1];
939}
940
941sub _matchlimit {
942	shift;
943	my $val = lc(shift);
944	return -1 if $val eq 'none' or $val eq 'all';
945	return int($val) || $::Variable->{MV_DEFAULT_MATCHLIMIT} || 50;
946}
947
9481;
949__END__
950