lib/Vend/Scan.pm

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