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