code/UI_Tag/flex_select.coretag

   1 # Copyright 2002-2007 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: flex_select.coretag,v 1.18 2009-05-01 16:02:50 mheins Exp $
   9
  10 UserTag flex-select Order      table
  11 UserTag flex-select addAttr
  12 UserTag flex-select attrAlias  ml height
  13 UserTag flex-select hasEndTag
  14 UserTag flex-select Version    $Revision: 1.18 $
  15 UserTag flex-select Routine    <<EOR
  16 use vars qw/$CGI $Tmp $Tag/;
  17 my @fs_more = qw/
  18         help_name
  19         icon_name
  20         page_banner
  21         page_title
  22         ui_break_before
  23         ui_description_fields
  24         ui_flex_description
  25         ui_flex_key
  26         ui_show_fields
  27         ui_sort_field
  28         ui_sort_option
  29 /;
  30 sub flex_select_init {
  31         my ($table, $opt) = @_;
  32
  33         my @warnings;
  34         my @errors;
  35
  36 #::logDebug("Entering flex_select init");
  37         if($CGI->{mv_more_ip}) {
  38                 for(@fs_more) {
  39                         $CGI->{$_} = $::Values->{$_};
  40                 }
  41         }
  42
  43         if($CGI->{mv_return_table}) {
  44                 my $rt = delete $CGI->{mv_return_table};
  45                 $rt =~ s/^\0+//;
  46                 $rt =~ s/\0.*//;
  47                 $CGI->{mv_data_table} = $rt if $rt;
  48         }
  49
  50         my $bounce_url;
  51         $::Scratch->{ui_class} = $CGI->{ui_class}
  52                 if $CGI->{ui_class} &&  $CGI->{ui_class} =~ /^\w+$/;
  53
  54         if($opt->{sql_query}) {
  55                 my $spec;
  56                 eval {
  57                         ($table) = Vend::Scan::sql_statement($opt->{sql_query}, { table_only => 1});
  58                 };
  59                 if($@) {
  60                         $Tag->error( {
  61                                                 set => errmsg(
  62                                                                         "flex-select -- bad query %s: %s",
  63                                                                         $opt->{sql_query},
  64                                                                         $@,
  65                                                                 ),
  66                                                 name => 'flex_select',
  67                                                 });
  68                         return undef;
  69                 }
  70         }
  71
  72         if($table =~ s/\.(txt|asc)$/_$1/) {
  73                 $table =~ s:.*/::;
  74         }
  75         my $db = database_exists_ref($table);
  76
  77         $Tmp->{flex_select} ||= {};
  78         my $ts = $Tmp->{flex_select}{$table} = {};
  79
  80         if(! $db) {
  81                 $Tag->error({
  82                                                 name => 'flex_select',
  83                                                 set =>  errmsg('no %s database', $table),
  84                                         });
  85                 my $url = $Tag->area( {
  86                                                         href => $::Variable->{UI_ERROR_PAGE} || 'admin/error',
  87                                                         secure => $::Variable->{UI_SECURE},
  88                                                 });
  89 #::logDebug("delivering error url=$url");
  90                 $Tag->deliver( { location => $url });
  91                 return;
  92         }
  93
  94         if( $::Variable->{UI_LARGE_TABLE} =~ /\b$table\b/ or $db->config('LARGE') ) {
  95                 $ts->{large} = 1;
  96         }
  97
  98         if( $db->config('COMPOSITE_KEY') ) {
  99                 $ts->{multikey} = 1;
 100                 $ts->{key_columns} = $db->config('_Key_columns');
 101         }
 102
 103         DELETE: {
 104                 last DELETE unless $CGI->{item_id};
 105                 last DELETE unless delete $CGI->{deleterecords};
 106                 unless ($Tag->if_mm('tables', '=d')) {
 107                         $Tag->error({
 108                                                         name => 'flex_select',
 109                                                         set => errmsg("no permission to delete records"),
 110                                                 });
 111                         last DELETE;
 112                 };
 113
 114                 $Vend::Cfg->{NoSearch} = '';
 115
 116                 my @ids = split /\0/, $CGI->{item_id};
 117                 for(grep $_, @ids) {
 118                         if($db->delete_record($_)) {
 119                                 push @warnings, errmsg("Deleted record %s", $_);
 120                         }
 121                         else {
 122                                 push @errors, $db->errstr();
 123                         }
 124                 }
 125         }
 126
 127         SEQUENCE: {
 128                 my $dest = $CGI->{ui_sequence_destination} || '__UI_BASE__/flex_editor';
 129 #::logDebug("Entering flex_select sequence edit stuff");
 130                 last SEQUENCE unless $CGI->{ui_sequence_edit};
 131 #::logDebug("doing flex_select sequence edit stuff");
 132                 my $doit;
 133                 if($CGI->{item_id_left} =~ s/^(.*?)[\0]//) {
 134                         $CGI->{ui_sequence_edit} = 1;
 135                         $CGI->{item_id} = $1;
 136                         $doit = 1;
 137                 }
 138                 elsif ($CGI->{item_id_left}) {
 139                         $CGI->{item_id} = delete $CGI->{item_id_left};
 140                         delete $CGI->{ui_sequence_edit};
 141                         $doit = 1;
 142                 }
 143                 else {
 144                         delete $CGI->{item_id};
 145                         delete $CGI->{ui_sequence_edit};
 146                 }
 147                 last SEQUENCE unless $doit;
 148                 my $url = $Tag->area( {
 149                                                                         href => $dest,
 150                                                                         form => qq{
 151                                                                                 mv_data_table=$CGI->{mv_data_table}
 152                                                                                 item_id=$CGI->{item_id}
 153                                                                                 item_id_left=$CGI->{item_id_left}
 154                                                                                 ui_sequence_edit=$CGI->{ui_sequence_edit}
 155                                                                         },
 156                                                                 });
 157 #::logDebug("flex_select sequence developed URL=$url");
 158                 $Tag->deliver( { location => $url } );
 159                 return;
 160         }
 161
 162         $ts->{table_meta} = $Tag->meta_record($table, $CGI->{ui_meta_view}) || {};
 163         my $tm = $ts->{table_meta};
 164
 165         my $extra;
 166         if($tm->{name}) {
 167                 $extra .= "<b>$tm->{name}</br>";
 168         }
 169         if($ts->{help_url}) {
 170                 $extra .= qq{&nbsp;&nbsp;&nbsp;<small><a href="$ts->{help_url}">};
 171                 $extra .= errmsg('help');
 172                 $extra .= "</a></small>";
 173         }
 174         if($ts->{help}) {
 175                 $extra .= "<blockquote>$ts->{help}</blockquote>";
 176         }
 177         $::Scratch->{page_banner} ||= $::Scratch->{page_title};
 178         $::Scratch->{page_banner} .= $extra;
 179
 180         for(@errors) {
 181                 $Tag->error({ name => 'flex_select', set => $_ });
 182         }
 183         for(@warnings) {
 184                 $Tag->warnings($_);
 185         }
 186         return;
 187 }
 188
 189 sub {
 190         my ($table, $opt, $body) = @_;
 191
 192 #::logDebug("Entering flex_select");
 193         my $CGI = \%CGI::values;
 194
 195         $table ||= $CGI->{mv_data_table};
 196
 197         ## Do the initialization
 198         if($opt->{init}) {
 199                 return flex_select_init($table, $opt);
 200         }
 201
 202         my $filter;
 203         if(ref($opt->{filter}) eq 'HASH') {
 204                 $filter = $opt->{filter};
 205         }
 206         $filter ||= {};
 207
 208         my $spec;
 209         my $stmt;
 210         my $q;
 211         if($opt->{sql_query}) {
 212                 $q = $opt->{sql_query};
 213                 if($CGI->{ui_sort_field} =~ s/^(\w+)(:[rfn]+)?$/$1/) {
 214                         my $field = $1;
 215                         my $opt = $2 || $CGI->{ui_sort_option};
 216                         $field .= ' DESC', $CGI->{ui_sort_option} = 'r' if $opt =~ /r/i;
 217                         $q =~ s/
 218                                                 \s+ORDER\s+BY
 219                                                 \s+(\w+(\s+desc\w*)?)
 220                                                 (\s*,\s*\w+(\s+desc\w*)?)*
 221                                                 (\s*$|\s+LIMIT\s+\d+(?:\s*,\s*\d+)?)
 222                                    / ORDER BY $field$5/ix
 223                         or
 224                                 $q =~ s/(\s+LIMIT\s+\d+(?:\s*,\s*\d+)?)/ ORDER BY $field$1/ix
 225                                 or $q .= " ORDER BY $field";
 226                 }
 227
 228                 eval {
 229                         ($spec) = Vend::Scan::sql_statement($q);
 230                 };
 231                 if($@ || ! $spec->{rt}) {
 232                         $Tag->error( {
 233                                                 set => errmsg("flex-select -- bad query %s: %s", $q, $@),
 234                                                 name => 'flex_select',
 235                                                 });
 236                         return undef;
 237                 }
 238                 $table = $spec->{rt}->[0];
 239         }
 240
 241         my $ref = dbref($table)
 242                 or do {
 243                         my $msg = errmsg("%s: table '%s' does not exist", 'flex_select', $table);
 244                         logError($msg);
 245                         $Tag->error({ name => 'flex_select', set => $msg });
 246                         return undef;
 247                 };
 248         my $ts = $Tmp->{flex_select}{$table} ||= {};
 249         my $meta = $ts->{table_meta} ||= $Tag->meta_record($table, $CGI->{ui_meta_view});
 250
 251 #::logDebug("flex_select table=$table");
 252         if($meta->{sql_query}) {
 253                 $q = $meta->{sql_query};
 254                 if($CGI->{ui_sort_field} =~ s/^(\w+)(:[rfn]+)?$/$1/) {
 255                         my $field = $1;
 256                         my $opt = $2 || $CGI->{ui_sort_option};
 257                         $field .= ' DESC', $CGI->{ui_sort_option} = 'r' if $opt =~ /r/i;
 258                         $q =~ s/
 259                                                 \s+ORDER\s+BY
 260                                                 \s+(\w+(\s+desc\w*)?)
 261                                                 (\s*,\s*\w+(\s+desc\w*)?)*
 262                                                 (\s*$|\s+LIMIT\s+\d+(?:\s*,\s*\d+)?)
 263                                    / ORDER BY $field$5/ix
 264                         or
 265                                 $q =~ s/(\s+LIMIT\s+\d+(?:\s*,\s*\d+)?)/ ORDER BY $field$1/ix
 266                                 or $q .= " ORDER BY $field";
 267                 }
 268
 269                 eval {
 270                         ($spec) = Vend::Scan::sql_statement($q);
 271                 };
 272                 if($@ or ! $spec->{rt}) {
 273                         $Tag->error( {
 274                                                 set => errmsg("flex-select -- bad query %s: %s", $q, $@),
 275                                                 name => 'flex_select',
 276                                                 });
 277                         return undef;
 278                 }
 279                 $table = $spec->{rt}->[0];
 280         }
 281
 282         if( $table ne $ref->config('name')) {
 283                 ## Probably transient database
 284                 $CGI->{mv_data_table_real} = $table = $ref->config('name');
 285         }
 286
 287         my @labels;          ## Locally set labels in ui_show_fields
 288         my @views;           ## Locally set view data in ui_show_fields
 289         my @filter_show;     ## Locally set filters in ui_show_fields
 290         my @calcs;           ## Data calculation code (if any) from fs_data_calc
 291         my @redirect;        ## A column with a different metadata from standard
 292         my @extras;          ## A column with a different metadata from standard
 293         my @style;           ## Style for data cell, only have to read once
 294         my @link_page;       ## Locally set filters in ui_show_fields
 295         my @link_parm;       ## Locally set filters in ui_show_fields
 296         my @link_parm_extra; ## Locally set filters in ui_show_fields
 297         my @link_anchor;     ## Locally set filters in ui_show_fields
 298         my $filters_done;    ## Tells us we are done with filters
 299
 300         if(my $show = $CGI->{ui_show_fields} ||= $meta->{ui_show_fields} || $meta->{field}) {
 301                 my $i = 0;
 302                 if($show =~ s/[\r\n]+/\n/g) {
 303                         $show =~ s/^\s+//;
 304                         $show =~ s/\s+$//;
 305                         my @f = split /\n/, $show;
 306                         my @c;
 307                         for(@f) {
 308                                 s/^\s+//;
 309                                 s/\s+$//;
 310                                 if(s/\s*\((.+)\)\s*$//)  {
 311                                         $filter_show[$i] = $1;
 312                                 }
 313
 314                                 if(/^(\w+)-(\w+)$/) {
 315                                         push @c, $1;
 316                                         $redirect[$i] = $2;
 317                                 }
 318                                 elsif(/^(\w+)(?:-([^=]+))?(?:=(.*))?/) {
 319                                         push @c, $1;
 320                                         $views[$i] = $2 if $2;
 321                                         $labels[$i] = $3;
 322                                 }
 323                                 else {
 324                                         push @c, $_;
 325                                 }
 326                                 $i++;
 327                         }
 328                         $show = join ",", @c;
 329                 }
 330                 else {
 331                         $show =~ s/(\w+)(?:\((.*?)\))?/ ($filter_show[$i++] = $2), $1/eg;
 332                         $show =~ s/[\0,\s]+/,/g;
 333                 }
 334                 $CGI->{ui_description_fields} = $show;
 335                 $filters_done = 1;
 336         }
 337
 338         if($spec) {
 339 #::logDebug("flex_select spec=$spec");
 340                 if($spec->{rf} and $spec->{rf}[0] ne '*') {
 341                         my @c;
 342                         my $header;
 343                         for(my $i = 0; $i < @{$spec->{rf}}; $i++) {
 344                                 if($spec->{hf}[$i]) {
 345                                         $header++;
 346                                         push @c, $spec->{rf}[$i] . '=' . $spec->{hf}[$i];
 347                                 }
 348                                 else {
 349                                         push @c, $spec->{rf}[$i];
 350                                 }
 351                         }
 352                         if($header) {
 353                                 $CGI->{ui_show_fields} = join "\n", @c;
 354                         }
 355                         else {
 356                                 $CGI->{ui_show_fields} = join " ", @c;
 357                         }
 358                 }
 359                 if($spec->{tf} and $spec->{tf}[0]) {
 360                         $CGI->{ui_sort_field} = join ",", @{$spec->{tf}};
 361                         $CGI->{ui_sort_option} = join ",", @{$spec->{to}};
 362                 }
 363                 $CGI->{ui_list_size} = $spec->{ml} if $spec->{ml};
 364         }
 365
 366         $meta ||= {};
 367
 368         if($CGI->{ui_flex_key}) {
 369                 $ts->{keypos} = $CGI->{ui_flex_key};
 370         }
 371         else {
 372                 $ts->{keypos} = $ref->config('KEY_INDEX');
 373         }
 374
 375         $ts->{keyname} = $ref->config('KEY');
 376         $ts->{owner_field} = $ref->config('OWNER_FIELD') || $::Scratch->{ui_owner};
 377
 378         if($CGI->{ui_exact_record}) {
 379 #::logDebug("found exact record input");
 380                 undef $CGI->{mv_like_field};
 381                 my $id = $CGI->{mv_like_spec};
 382                 $id =~ s/\0.*//s;
 383                 my $url = $Tag->area({
 384                                                                 href => 'admin/flex_editor',
 385                                                                 form => qq{
 386                                                                         mv_data_table=$CGI->{mv_data_table}
 387                                                                         item_id=$id
 388                                                                         ui_meta_view=$CGI->{ui_meta_view}
 389                                                                 },
 390                                                         });
 391
 392                 $Tag->deliver({ location => $url });
 393 #::logDebug("deliver=$url");
 394                 return;
 395         }
 396
 397         my $sf;
 398         if($sf = $CGI->{ui_sort_field} and $sf =~ s/^(\w+)([,\s\0]+.*)?$/$1/) {
 399                 my $fmeta;
 400                 $fmeta = $Tag->meta_record("${table}::$sf", $CGI->{ui_meta_view})
 401                         and do {
 402                                 $CGI->{ui_more_alpha} = $fmeta->{ui_more_alpha}
 403                                         if length($fmeta->{ui_more_alpha});
 404                                 if (! $CGI->{ui_sort_option} and length($fmeta->{ui_sort_option}) ) {
 405                                         my $o = $fmeta->{ui_sort_option};
 406                                         if($CGI->{ui_sort_option} =~ /r/) {
 407                                                 $o =~ s/^([^r]+)$/$1r/
 408                                                         or $o =~ s/r//;
 409                                         }
 410                                         $CGI->{ui_sort_option} = $o;
 411                                 }
 412                         };
 413         }
 414
 415         for(qw/ui_more_alpha ui_more_decade ui_meta_specific/) {
 416                 $CGI->{$_} = $meta->{$_} unless defined $CGI->{$_};
 417         }
 418         $Vend::Cfg->{NoSearch} = '';
 419         my $out_message = '';
 420         my $ui_text_qualification = $CGI->{ui_text_qualification};
 421
 422         if ($ui_text_qualification and $CGI->{ui_text_qualification} =~ /[<!=>\^]/ ) {
 423                 if($ts->{owner_field}) {
 424                         $CGI->{ui_text_qualification} = <<EOF;
 425 co=1
 426 st=db
 427 sf=$ts->{owner_field}
 428 se=$Vend::username
 429 op=eq
 430 nu=0
 431 os=0
 432 su=0
 433 bs=0
 434 EOF
 435                 }
 436                 else {
 437                         $CGI->{ui_text_qualification} = "co=1\n";
 438                 }
 439
 440                 my @entries = split /\s+(and|or)\s+/i,  $ui_text_qualification;
 441                 my $or;
 442                 for(@entries) {
 443                         if(/^or$/i) {
 444                                 $or = 1;
 445                                 $CGI->{ui_text_qualification} .= "os=1\n";
 446                                 next;
 447                         }
 448                         elsif(/^and$/i) {
 449                                 $or = 0;
 450                                 $CGI->{ui_text_qualification} .= "os=0\n";
 451                                 next;
 452                         }
 453                         my ($f, $op, $s) = split /\s*([<=!>\^]+)\s*/, $_, 2;
 454                         $op = "eq" if $op eq "==";
 455                         $op = "rm" if $op eq "=";
 456                         if($op eq '^') {
 457                                 $op = 'rm';
 458                                 $CGI->{ui_text_qualification} .= "bs=1\nsu=1\n";
 459                         }
 460                         else {
 461                                 $CGI->{ui_text_qualification} .= "bs=0\nsu=0\n";
 462                         }
 463                         if(length($s) > 1) {
 464                                 $CGI->{ui_text_qualification} .= "se=$s\nsf=$f\nop=$op\n";
 465                         }
 466                         else {
 467                                 $CGI->{ui_text_qualification} .= "se=.\nsf=$f\nop=rn\n";
 468                         }
 469                         if($op =~ /[<>]/ and $s =~ /^[\d.]+$/) {
 470                                 $CGI->{ui_text_qualification} .= "nu=1\n";
 471                         }
 472                         else {
 473                                 $CGI->{ui_text_qualification} .= "nu=0\n";
 474                         }
 475                 }
 476                 if(defined $or) {
 477                         $CGI->{ui_text_qualification} .= $or ? "os=1\n" : "os=0\n";
 478                 }
 479
 480                 $out_message = errmsg('Entries matching "%s"', $ui_text_qualification);
 481         }
 482         elsif ($ui_text_qualification) {
 483                 $CGI->{ui_text_qualification} = "se=$CGI->{ui_text_qualification}";
 484                 $out_message = errmsg('Entries matching "%s"', $ui_text_qualification);
 485                 if($ts->{owner_field}) {
 486                         $CGI->{ui_text_qualification} = <<EOF;
 487 co=1
 488 sf=$ts->{owner_field}
 489 se=$Vend::username
 490 op=eq
 491 sf=:*
 492 se=$CGI->{ui_text_qualification}
 493 EOF
 494                 }
 495         }
 496         elsif ( $CGI->{mv_like_field} ) {
 497                 my @f = split /\0/, $CGI->{mv_like_field};
 498                 my @s = split /\0/, $CGI->{mv_like_spec};
 499                 my @q = 'ra=yes';
 500                 my $found;
 501                 for(my $i = 0; $i < @f; $i++) {
 502                         next unless length $s[$i];
 503                         $found++;
 504                         push @q, "lf=$f[$i]";
 505                         push @q, "ls=$s[$i]";
 506                 }
 507                 if($found) {
 508                         $CGI->{ui_text_qualification} = join "\n", @q;
 509                         my @out;
 510                         for(@q) {
 511                                 my $thing = $_;
 512                                 $thing =~ s/^ls=/mv_like_spec=/;
 513                                 $thing =~ s/^lf=/mv_like_field=/;
 514                                 push @out, $thing;
 515                         }
 516                         $ts->{like_recall} = join "\n", @out;
 517                 }
 518                 else       { $CGI->{ui_text_qualification} = "" }
 519         }
 520         elsif($ts->{owner_field}) {
 521                 $CGI->{ui_text_qualification} = <<EOF;
 522 co=1
 523 sf=$ts->{owner_field}
 524 se=$Vend::username
 525 op=eq
 526 EOF
 527         }
 528         elsif ($ts->{large}) {
 529                 my $keylabel = $Tag->display({
 530                                                         table => $table,
 531                                                         name => 'item_id',
 532                                                         column => $ts->{keyname},
 533                                                         template => 1,
 534                                                 });
 535                 $ts->{like_spec} = $CGI->{mv_more_ip} ? 0 : 1;
 536                 $CGI->{ui_text_qualification} = "";
 537         }
 538         else {
 539                 $CGI->{ui_text_qualification} = "ra=yes";
 540         }
 541
 542         if($meta->{ui_sort_combined} =~ /\S/) {
 543                 $meta->{ui_sort_field} = $meta->{ui_sort_combined};
 544                 $meta->{ui_sort_option} = '';
 545         }
 546
 547         $CGI->{ui_sort_field}   ||= $meta->{ui_sort_field}
 548                                                         ||  $meta->{lookup}
 549                                                         ||  $ts->{keyname};
 550         $CGI->{ui_sort_option}  ||= $meta->{ui_sort_option};
 551         $CGI->{ui_sort_option}  =~ s/[\0,\s]+//g;
 552         $CGI->{ui_list_size} = $opt->{height} || $meta->{height}
 553                 if ! $CGI->{ui_list_size};
 554
 555         if(! $CGI->{ui_show_fields} ) {
 556                 $CGI->{ui_show_fields} =
 557                         $CGI->{ui_description_fields}
 558                                 = join ",", $ref->columns();
 559         }
 560         else {
 561                 my $i = 0;
 562                 my $show = $CGI->{ui_show_fields};
 563                 if($filters_done) {
 564                         # do nothing
 565                 }
 566                 else {
 567                         if($show =~ s/[\r\n]+/\n/g) {
 568                                 $show =~ s/^\s+//;
 569                                 $show =~ s/\s+$//;
 570                                 my @f = split /\n/, $show;
 571                                 my @c;
 572                                 for(@f) {
 573                                         s/^\s+//;
 574                                         s/\s+$//;
 575                                         if(s/\s*\((.+)\)\s*$//)  {
 576                                                 $filter_show[$i] = $1;
 577                                         }
 578
 579                                         if(/^(\w+)-(\w+)$/) {
 580                                                 push @c, $1;
 581                                                 $redirect[$i] = $2;
 582                                         }
 583                                         elsif(/^(\w+)(?:-([^=]+))?(?:=(.*))?/) {
 584                                                 push @c, $1;
 585                                                 $views[$i] = $2 if $2;
 586                                                 $labels[$i] = $3;
 587                                         }
 588                                         else {
 589                                                 push @c, $_;
 590                                         }
 591                                         $i++;
 592                                 }
 593                                 $show = join ",", @c;
 594                         }
 595                         else {
 596                                 $show =~ s/(\w+)(?:\((.*?)\))?/ ($filter_show[$i++] = $2), $1/eg;
 597                                 $show =~ s/[\0,\s]+/,/g;
 598                         }
 599                         $CGI->{ui_description_fields} = $show;
 600                 }
 601         }
 602
 603         my @cols = split /,/, $CGI->{ui_description_fields};
 604
 605         @cols = grep $ref->column_exists($_), @cols
 606                 unless $spec;
 607
 608         my %limit_field;
 609
 610         $CGI->{ui_limit_fields} =~ s/[\0,\s]+/ /g;
 611         $CGI->{ui_limit_fields} =~ s/^\s+//;
 612         $CGI->{ui_limit_fields} =~ s/\s+$//;
 613
 614         my (@limit_field) = split " ", $CGI->{ui_limit_fields};
 615
 616         if(@limit_field) {
 617                 @limit_field{@limit_field} = ();
 618                 @cols = grep ! exists($limit_field{$_}), @cols;
 619         }
 620
 621         unshift(@cols, $ts->{keyname})
 622                 if $cols[0] ne $ts->{keyname};
 623
 624         $CGI->{ui_description_fields} = join ",", @cols;
 625
 626         unless ($CGI->{ui_sort_option}) {
 627                  $CGI->{ui_sort_option} = 'n'
 628                                 if $ref->numeric($CGI->{ui_sort_field});
 629         }
 630
 631         my $fi = $CGI->{mv_data_table_real} || $CGI->{mv_data_table};
 632         $ts->{sparams} = ($ts->{like_spec} || $spec) ? '' : <<EOF;
 633
 634         fi=$fi
 635         st=db
 636         $CGI->{ui_text_qualification}
 637         su=1
 638         ma=$CGI->{ui_more_alpha}
 639         md=$CGI->{ui_more_decade}
 640         ml=$CGI->{ui_list_size}
 641         tf=$CGI->{ui_sort_field}
 642         to=$CGI->{ui_sort_option}
 643         rf=$CGI->{ui_description_fields}
 644         nh=1
 645
 646 EOF
 647         $::Scratch->{page_banner} .= $out_message;
 648         $::Scratch->{page_title} .= $out_message;
 649
 650         my %output;
 651 ### Header determination
 652
 653         my @refkeys = grep ref($opt->{$_}) eq 'HASH', keys %$opt;
 654
 655         my %default = (
 656                 data_cell_class   => '',
 657                 data_cell_style   => '',
 658                 data_row_class_even   => 'rownorm',
 659                 data_row_class_odd   => 'rowalt',
 660                 data_row_style_even   => '',
 661                 data_row_style_odd   => '',
 662                 form_method => 'GET',
 663                 explicit_edit => '',
 664                 explicit_edit_page => '',
 665                 explicit_edit_form => '',
 666                 explicit_edit_anchor => '',
 667                 no_code_link => '',
 668                 group_image   => 'smindex.gif',
 669                 group_class   => 'rhead',
 670                 group_spacing   => 2,
 671                 group_padding   => 0,
 672                 group_width   => '100%',
 673                 header_link_class   => 'rhead',
 674                 header_cell_class   => 'rhead',
 675                 header_cell_style   => '',
 676                 header_row_class   => 'rhead',
 677                 header_row_style   => '',
 678                 mv_action => 'back',
 679                 meta_image => errmsg('meta.png'),
 680                 label => "flex_select_$table",
 681                 no_checkbox => 0,
 682                 radio_box => 0,
 683                 user_merge => 0,
 684                 check_uncheck_all => 0,
 685                 number_list => 0,
 686                 table_border  => 0,
 687                 table_class   => 'rseparator',
 688                 table_padding => 0,
 689                 table_spacing => 1,
 690                 table_style   => '',
 691                 table_width   => '100%',
 692         );
 693
 694         for(keys %default) {
 695                 next if defined $opt->{$_};
 696                 if(length $meta->{$_}) {
 697                         $opt->{$_} = $meta->{$_};
 698                 }
 699                 else {
 700                         $opt->{$_} = $default{$_};
 701                 }
 702         }
 703
 704         $opt->{ui_style} = 1 unless defined $opt->{ui_style};
 705         $opt->{no_checkbox} = 1 if $ts->{multikey};
 706
 707         my $show_meta;
 708         my $meta_anchor;
 709         if($Tag->if_mm('super') and ! $opt->{no_meta}) {
 710                 $show_meta = defined $::Values->{ui_meta_force}
 711                                         ? $::Values->{ui_meta_force}
 712                                         : $::Variable->{UI_META_SELECT};
 713                 if($opt->{meta_image}) {
 714                         $meta_anchor = qq{<img src="$opt->{meta_image}" border=0>};
 715                 }
 716                 else {
 717                         $meta_anchor = 'M';
 718                 }
 719         }
 720
 721         $opt->{form_name} ||= "fs_$table";
 722
 723         $output{TOP_OF_TABLE} = <<EOF;
 724 <table width="$opt->{table_width}" border="$opt->{table_border}" cellpadding="$opt->{table_padding}" cellspacing="$opt->{table_spacing}" class="$opt->{table_class}">
 725 EOF
 726
 727         my $cwp = $Global::Variable->{MV_PAGE};
 728         $opt->{form_href} ||= $CGI->{ui_searchpage} || $cwp;
 729         $opt->{form_extra} ||= '';
 730         $opt->{form_extra} .= qq{ name="$opt->{form_name}"} if $opt->{form_name};
 731         $opt->{form_extra} =~ s/^\s*/ /;
 732         my $action = $Tag->process({href => $opt->{form_href}});
 733
 734         $output{TOP_OF_FORM} = <<EOF;
 735 <form action="$action" method="$opt->{form_method}"$opt->{form_extra}>
 736 <input type=hidden name=mv_data_table    value="$table">
 737 <input type=hidden name=mv_action        value="$opt->{mv_action}">
 738 <input type=hidden name=mv_click         value="warn_me_main_form">
 739 <input type=hidden name=mv_session_id    value="$Vend::SessionID">
 740 EOF
 741
 742         ### What the heck is going on here?
 743         if($CGI->{ui_meta_view}) {
 744                 $output{TOP_OF_FORM} .= <<EOF;
 745 <input type=hidden name=ui_meta_view         value="$CGI->{ui_meta_view}">
 746 EOF
 747                 $output{TOP_OF_FORM} .= $Tag->return_to();
 748         }
 749         else {
 750                 $output{TOP_OF_FORM} .= <<EOF;
 751         <!-- got no return-to -->
 752 <input type=hidden name=ui_meta_specific value="$CGI->{ui_meta_specific}">
 753 <input type=hidden name=ui_page_title    value="$CGI->{ui_page_title}">
 754 <input type=hidden name=ui_page_banner   value="$CGI->{ui_page_banner}">
 755 <input type=hidden name=ui_limit_fields  value="$CGI->{ui_limit_fields}">
 756 <input type=hidden name=ui_show_fields   value="$CGI->{ui_show_fields}">
 757 <input type=hidden name=ui_return_to     value="$cwp">
 758 <input type=hidden name=ui_return_to     value="mv_data_table=$table">
 759 EOF
 760         }
 761
 762         my $cc = $ts->{column_meta} ||= {};
 763         my $mview = $CGI->{ui_meta_view};
 764
 765         my $cmeta = sub {
 766                 my $col = shift;
 767                 return $cc->{$col} if $cc->{$col};
 768                 my $m = $Tag->meta_record("${table}::$col", $mview);
 769                 for(@refkeys) {
 770                         $m->{$_} = $opt->{$_}{$col} if exists $opt->{$_}{$col};
 771                 }
 772                 $cc->{$col} = $m;
 773                 return $m;
 774         };
 775
 776         my $header_cell_style = sub {
 777                                 my $col = shift;
 778                                 my $m = $cmeta->($col);
 779 #::logDebug("meta for header=" . ::uneval($m));
 780                                 my $stuff = '';
 781                                 for(qw/ class style align valign /) {
 782                                         my $tag = "header_cell_$_";
 783                                         my $thing;
 784                                         if(ref $opt->{$tag}) {
 785                                                 $thing = $opt->{$tag}{$col} || $m->{$tag} || $opt->{"all_$tag"}
 786                                                         or next;
 787                                         }
 788                                         else {
 789                                                 $thing = $m->{$tag} || $opt->{$tag}
 790                                                         or next;
 791                                         }
 792                                         encode_entities($thing);
 793                                         $stuff .= qq{ $_="$thing"};
 794                                 }
 795                                 return $stuff;
 796                         };
 797
 798         my $data_cell_style = sub {
 799                                 my $col = shift;
 800                                 my $m = $cmeta->($col);
 801                                 my $stuff = '';
 802                                 for(qw/ class style align valign /) {
 803                                         my $tag = "data_cell_$_";
 804                                         my $thing;
 805                                         if(ref $opt->{$tag}) {
 806                                                 $thing = $opt->{$tag}{$col} || $m->{$tag} || $opt->{"all_$tag"}
 807                                                         or next;
 808                                         }
 809                                         else {
 810                                                 $thing = $m->{$tag} || $opt->{$tag}
 811                                                         or next;
 812                                         }
 813                                         encode_entities($thing);
 814                                         $stuff .= qq{ $_="$thing"};
 815                                 }
 816                                 return $stuff;
 817                         };
 818
 819         my @head;
 820         my $rc = $opt->{header_row_class};
 821         push @head, "<tr ";
 822         push @head, qq( class=$opt->{header_row_class}) if $opt->{header_row_class};
 823         push @head, qq( style=$opt->{header_row_style}) if $opt->{header_row_style};
 824         push @head, ">\n";
 825         if(! $opt->{no_checkbox}) {
 826                 push @head, "   <td class=rhead>&nbsp;</td>"
 827         }
 828         if($opt->{radio_box}) {
 829                 push @head, "   <td class=rhead>&nbsp;</td>"
 830         }
 831         if($opt->{number_list}) {
 832                 push @head, "   <td class=rhead align=right>#&nbsp;</td>" ;
 833         }
 834         if($opt->{explicit_edit}) {
 835                 push @head, "   <td class=rhead>&nbsp;</td>"
 836         }
 837
 838         my $return = <<EOF;
 839 ui_return_to=$cwp
 840 ui_return_to=ui_meta_view=$opt->{ui_meta_view}
 841 ui_return_to=mv_return_table=$table
 842 mv_return_table=$table
 843 ui_return_stack=$CGI->{ui_return_stack}
 844 start_at=extended.ui_more_alpha
 845 EOF
 846
 847         my %mkey;
 848         if($ts->{multikey}) {
 849                 for(@{$ts->{key_columns}}) {
 850                         $mkey{$_} = 1;
 851                 }
 852         }
 853
 854         my @mcol;
 855
 856         my $idx = 0;
 857         foreach my $col (@cols) {
 858                 my $mcol = $col;
 859                 if($redirect[$idx]) {
 860                         $mcol .= "-$redirect[$idx]";
 861                 }
 862                 my $td_extra = $header_cell_style->($mcol);
 863
 864                 ## $cc is set in header_cell_class
 865                 my $m = $cc->{$mcol};
 866
 867                 if($mkey{$col}) {
 868                         push @mcol, $idx - 1;
 869                 }
 870
 871                 push @head, <<EOF;
 872 <td$td_extra>
 873 <table align="left" class="$opt->{group_class}" cellspacing=$opt->{group_spacing} cellpadding=$opt->{group_padding} width="$opt->{group_width}">
 874     <tr>
 875 EOF
 876                 unless($opt->{no_group} || $m->{fs_no_group}) {
 877                         my $u = $Tag->area({
 878                                                                 href => 'admin/flex_group',
 879                                                                 form => qq(
 880                                                                                         mv_data_table=$table
 881                                                                                         ui_meta_view=$mview
 882                                                                                         from_page=$Global::Variable->{MV_PAGE}
 883                                                                                         mv_arg=$col
 884                                                                                 ),
 885                                                         });
 886                         my $msg = errmsg('Select group by %s', $col);
 887
 888                         push @head, <<EOF;
 889       <td align="right" valign="center" width=1>
 890                 <a href="$u" title="$msg"><img src="$opt->{group_image}" border=0></a>
 891       </td>
 892 EOF
 893
 894                 }
 895
 896                 my $o = '';
 897                 my $msg;
 898                 my $rmsg;
 899                 if($o = $m->{ui_sort_option}) {
 900                         my @m;
 901                         $msg = "sort by %s (%s)";
 902
 903                         if($CGI->{ui_sort_field} eq $col) {
 904                                 if($CGI->{ui_sort_option} =~ /r/) {
 905                                         $o =~ s/r//;
 906                                 }
 907                                 else {
 908                                         $o .= "r";
 909                                 }
 910                         }
 911                         push @m, errmsg('reverse') if $o =~ /r/;
 912                         push @m, errmsg('case insensitive') if $o =~ /f/;
 913                         push @m, errmsg('numeric') if $o =~ /n/;
 914                         $rmsg = join ", ", @m;
 915                 }
 916                 else {
 917                         if ($CGI->{ui_sort_field} eq $col and $CGI->{ui_sort_option} !~ /r/) {
 918                                 $o .= 'r';
 919                                 $msg = "sort by %s (%s)";
 920                                 $rmsg = errmsg('reverse');
 921                         }
 922                         else {
 923                                 $msg = "sort by %s";
 924                         }
 925                         $o .= 'n' if $ref->numeric($col);
 926                 }
 927                 my $sort_msg = errmsg($msg, $col, $rmsg);
 928                 my $url = $Tag->area( {
 929                                                                 href => $cwp,
 930                                                                 form => qq(
 931                                                                         $ts->{like_recall}
 932                                                                         ui_text_qualification=$ui_text_qualification
 933                                                                         mv_data_table=$table
 934                                                                         ui_meta_view=$mview
 935                                                                         ui_sort_field=$col
 936                                                                         ui_sort_option=$o
 937                                                                         ui_more_alpha=$m->{ui_more_alpha}
 938                                                                 ),
 939                                                         });
 940
 941                 my $lab = $labels[$idx] || $m->{label} || $col;
 942
 943                 # Set up some stuff for the data cells;
 944                 $style[$idx] = $data_cell_style->($mcol);
 945
 946                 $filter_show[$idx] = $filter->{$mcol} if $filter->{$mcol};
 947                 $filter_show[$idx] ||= $m->{fs_display_filter} || 'encode_entities';
 948                 $filter_show[$idx] .= ' encode_entities'
 949                          unless $filter_show[$idx] =~ /\b(?:encode_)?entities\b/;
 950                 $style[$idx] .= " $1" while $filter_show[$idx] =~ s/(v?align=\w+)//i;
 951
 952                 if($views[$idx]) {
 953                         my ($page, $parm, $l) = split /:/, $views[$idx];
 954                         $m->{fs_link_page} = $page;
 955
 956                         $parm ||= 'item_id';
 957                         my @p = split /[\s,\0]+/, $parm;
 958                         my $arg = shift @p;
 959                         $m->{fs_link_parm} = $arg;
 960                         $m->{fs_link_parm_extra} = join ",", @p;
 961                         $m->{fs_link_anchor} = $l;
 962                 }
 963
 964                 if($m->{fs_link_page}) {
 965                         $link_page[$idx]                = $m->{fs_link_page};
 966                         $link_parm[$idx]                = $m->{fs_link_parm};
 967                         if($m->{fs_link_parm_extra}) {
 968                                 my @p = grep /\S/, split /[\s,\0]+/, $m->{fs_link_parm_extra};
 969                                 $link_parm_extra[$idx]  = \@p;
 970                         }
 971                         $link_anchor[$idx]      = $m->{fs_link_anchor};
 972                 }
 973
 974                 if(my $prog = $m->{fs_data_calc}) {
 975 #::logDebug("looking at calcs=$prog");
 976                         $prog =~ s/^\s+//;
 977                         $prog =~ s/\s+$//;
 978                         if($prog =~ /^\w+$/) {
 979                                 $calcs[$idx] = $Vend::Cfg->{Sub}{$prog} || $Global::GlobalSub->{$prog};
 980                         }
 981                         else {
 982                                 $prog =~ s/^\[(calc|perl)(.*?)\]//;
 983                                 $prog =~ s{\[/(calc|perl)\]$}{};
 984                                 $calcs[$idx] = $prog;
 985                         }
 986                         if($m->{fs_data_tables}) {
 987                                 tag_perl($m->{fs_data_tables}, {});
 988                         }
 989                 }
 990
 991                 push @head, <<EOF;
 992           <td$td_extra>
 993                 <a href="$url" class=$opt->{header_link_class} title="$sort_msg">$lab</a>
 994       </td>
 995 EOF
 996
 997                 if($show_meta) {
 998                         my $u = $Tag->area({ href=>'admin/meta_editor',
 999                                                                  form => qq(
1000                                                                  item_id=${table}::$mcol
1001                                                                  ui_meta_view=$mview
1002                                                                  $return),
1003                                                                 });
1004                         my $tit = errmsg(
1005                                                         "Edit header meta information for %s::%s",
1006                                                         $table,
1007                                                         $col,
1008                                                 );
1009                         push @head, <<EOF;
1010 <td width=1>
1011 <a href="$u" title="$tit">$meta_anchor</a>
1012 </td>
1013 EOF
1014
1015                 }
1016
1017                 push @head, <<EOF;
1018     </tr>
1019     </table>
1020         </td>
1021 EOF
1022
1023                 $idx++;
1024         }
1025         push @head, "</tr>";
1026
1027         shift @mcol;
1028
1029         my $ncols = $idx;
1030         $ncols++ if $opt->{explicit_edit};
1031         $ncols++ if $opt->{number_list};
1032         $ncols++ if $opt->{radio_box};
1033         $ncols++ unless $opt->{no_checkbox};
1034
1035         $output{HEADER_AREA} = join "", @head;
1036 ### Row output
1037
1038         my $cb_width = $opt->{checkbox_width} || '30';
1039         my $cb_name = $opt->{checkbox_name} || 'item_id';
1040         my $rb_name = $opt->{radiobox_name} || 'item_radio';
1041         my $edit_page = $opt->{edit_page} || 'admin/flex_editor';
1042         my $edit_parm = $opt->{edit_parm} || 'item_id';
1043         my $edit_extra = <<EOF;
1044 mv_data_table=$table
1045 ui_page_title=$CGI->{ui_page_title}
1046 ui_meta_view=$mview
1047 ui_page_banner=$CGI->{ui_page_banner}
1048 ui_meta_specific=$CGI->{ui_meta_specific}
1049 EOF
1050
1051
1052         my @rows;
1053
1054         if($ts->{like_spec}) {
1055                 ## Do nothing
1056         }
1057         elsif($body =~ /\S/) {
1058                 my $o = {
1059                                         label           => $opt->{label},
1060                                         list_prefix     => 'flex',
1061                                         prefix          => 'flex',
1062                                         more            => 1,
1063                                         search          => $ts->{sparams},
1064                                 };
1065                 push @rows, tag_loop_list($o);
1066         }
1067         else {
1068                 my $ary;
1069                 my $search;
1070                 my $params;
1071                 my $c;
1072 #::logDebug("MM=$CGI->{MM}($CGI::values{MM}) mv_more_matches=$CGI->{mv_more_matches}($CGI::values{mv_more_matches})");
1073                 if($CGI->{mv_more_ip}) {
1074                         $search = $::Instance->{SearchObject}{$opt->{label}};
1075                         $search ||= $::Instance->{SearchObject}{''};
1076                         $search ||= perform_search();
1077                         $ary = [ splice(
1078                                                 @{$search->{mv_results}},
1079                                                 $search->{mv_first_match},
1080                                                 $search->{mv_matchlimit},
1081                                                 )] ;
1082 #::logDebug("search first_match=$search->{mv_first_match} length=$search->{mv_matchlimit}");
1083 #::logDebug("Found search=" . ::uneval($search));
1084                 }
1085                 elsif($q) {
1086                         my $db = dbref($table);
1087                         my $o = {
1088                                 ma              => $CGI->{ui_more_alpha},
1089                                 md              => $CGI->{ui_more_decade},
1090                                 ml              => $CGI->{ui_list_size},
1091                                 more    => 1,
1092                                 table   => $fi,
1093                                 query   => $q,
1094                         };
1095                         $ary = $db->query($o);
1096                 }
1097                 else {
1098 #::logDebug("In new search");
1099                         $params = escape_scan($ts->{sparams});
1100                         $c = { mv_search_immediate => 1, mv_search_label => $opt->{label} };
1101                         Vend::Scan::find_search_params($c, $params);
1102                         $search = Vend::Scan::perform_search($c);
1103                         $ary = $search->{mv_results};
1104                 }
1105
1106                 finish_search($search) if $search;
1107
1108                 $search ||= {};
1109
1110                 if($CGI->{ui_return_to} and ! $CGI->{ui_return_stack}) {
1111                         $edit_extra .= $Tag->return_to('formlink');
1112                 }
1113                 else {
1114                         $edit_extra .= "ui_return_to=$cwp";
1115                 }
1116
1117                 my $edit_anchor;
1118                 my $ee_extra;
1119                 if($opt->{explicit_edit}) {
1120                         $edit_anchor = $opt->{explicit_edit_anchor} || errmsg('edit record');
1121                         $edit_anchor =~ s/ /&nbsp;/g;
1122                         $ee_extra = '';
1123                         for(qw/ class style width align valign /) {
1124                                 my $v = $opt->{"explicit_edit_$_"}
1125                                         or next;
1126                                 $ee_extra .= qq{ $_="$v"};
1127                         }
1128                         $ee_extra ||= ' width=30';
1129                 }
1130 #::logDebug("explicit_edit=$opt->{explicit_edit} no_code_link=$opt->{no_code_link}");
1131                 my $j = $search->{mv_first_match} || 0;
1132                 foreach my $line (@$ary) {
1133                         my $code = shift (@$line);
1134                         my $ecode = encode_entities($code);
1135                         my $rc = $j++ % 2
1136                                         ? $opt->{data_row_class_even}
1137                                         : $opt->{data_row_class_odd};
1138                         my $out = qq{<tr class="$rc">\n};
1139
1140                         my $code_pre; my $code_post;
1141                         my $ep_string = '';
1142                         if($opt->{no_code_link} and ! $opt->{explicit_edit}) {
1143                                 $code_pre = $code_post = '';
1144                         }
1145                         else {
1146                                 my @what;
1147                                 push @what, "$edit_parm=$code";
1148                                 if($ts->{multikey}) {
1149                                         unshift @what, 'ui_multi_key=1';
1150                                         for(@mcol) {
1151                                                 push @what, "$edit_parm=$line->[$_]";
1152                                         }
1153
1154                                 }
1155
1156                                 $ep_string = join "\n", @what, $edit_extra;
1157
1158                                 my $edit_url = $Tag->area({
1159                                                                         href => $edit_page,
1160                                                                         form => $ep_string,
1161                                                                 });
1162                                 my $msg = errmsg('edit %s', $ecode);
1163                                 $code_pre = qq{<a href="$edit_url" title="$msg">};
1164                                 $code_post = qq{</a>};
1165                         }
1166
1167                         unless($opt->{no_checkbox}) {
1168                                 $out .= <<EOF;
1169 <td width="$cb_width"><input type=checkbox name=$cb_name value="$ecode"></td>
1170 EOF
1171                         }
1172                         if($opt->{radio_box}) {
1173                                 $out .= <<EOF;
1174 <td width="$cb_width"><input type=radio name=$rb_name value="$ecode"></td>
1175 EOF
1176                         }
1177
1178                         if($opt->{number_list}) {
1179                                 $out .= qq{<td align=right>&nbsp;$j&nbsp;</td>};
1180                         }
1181
1182                         if($opt->{explicit_edit}) {
1183                                 my $form = $opt->{explicit_edit_form} || '';
1184                                 if($form) {
1185                                         $form .= $ecode;
1186                                 }
1187                                 my $url = $Tag->area({
1188                                                                         href => $opt->{explicit_edit_page} || $edit_page,
1189                                                                         form => $form || $ep_string,
1190                                                                 });
1191                                 my $msg = errmsg('process %s', $ecode);
1192                                 my $pre = qq{<a href="$url" title="$msg">};
1193                                 $out .= qq{<td$ee_extra>&nbsp;$pre$edit_anchor$code_post&nbsp;</td>};
1194                         }
1195
1196 #::logDebug("keyname=$ts->{keyname}");
1197                         $out .= "<td" . $data_cell_style->($ts->{keyname}) . ">";
1198                         $ecode = '';
1199                         if ($calcs[0]) {
1200                                 my %item;
1201                                 @item{@cols} = ($code, @$line);
1202                                 if(ref($calcs[0]) eq 'CODE') {
1203                                         $ecode = $calcs[0]->(\%item);
1204                                 }
1205                                 else {
1206                                         $Vend::Interpolate::item = \%item;
1207                                         $ecode = tag_calc($calcs[0]);
1208                                 }
1209                         }
1210                         if ($filter_show[0]) {
1211                                 $ecode = $code unless $ecode;
1212                                 $ecode = $Tag->filter($filter_show[0], $ecode, $cols[0]);
1213                                 $ecode =~ s/\[/&#91;/g;
1214                         }
1215                         $ecode = encode_entities($code) unless $ecode;
1216                         $out .= "$code_pre$ecode$code_post</td>";
1217                         my $i = 1;
1218                         for my $v (@$line) {
1219                                 my $extra = $style[$i];
1220                                 my $pre = '';
1221                                 my $post = '';
1222                                 my $lab;
1223
1224                                 if($link_page[$i]) {
1225                                         my $opt = { $link_parm[$i] => $v, form => 'auto' };
1226                                         if(my $p = $link_parm_extra[$i]) {
1227                                                 for(@$p) {
1228                                                         $opt->{$_} = $CGI->{$_};
1229                                                 }
1230                                         }
1231                                         $opt->{href} = $link_page[$i];
1232
1233                                         $lab = $link_anchor[$i];
1234                                         $lab =~ s/^\s+//;
1235                                         my $url = $Tag->area($opt);
1236                                         my $ev = encode_entities($v);
1237                                         $pre = qq{<a href="$url" title="$ev">};
1238                                         $post = '</a>';
1239                                 }
1240
1241                                 if($calcs[$i]) {
1242 #::logDebug("found a calc");
1243                                         my %item;
1244                                         @item{@cols} = ($code, @$line);
1245                                         if(ref($calcs[$i]) eq 'CODE') {
1246                                                 $lab = $calcs[$i]->(\%item);
1247                                         }
1248                                         else {
1249                                                 $Vend::Interpolate::item = \%item;
1250                                                 $lab = tag_calc($calcs[$i]);
1251                                         }
1252                                 }
1253
1254                                 $lab ||= $v;
1255
1256                                 $lab = $Tag->filter($filter_show[$i], $lab, $cols[$i]);
1257
1258                                 $lab =~ s/\[/&#91;/g;
1259                                 $out .= "<td$extra>$pre$lab$post</td>";
1260
1261                                 $i++;
1262                         }
1263                         $out .= "</tr>\n";
1264                         push @rows, $out;
1265                 }
1266
1267                 unless(@rows) {
1268                         my $nomsg = errmsg('No records');
1269                         push @rows, qq{<tr><td colspan=$ncols><blockquote>$nomsg.</blockquote></td></tr>};
1270                 }
1271                 else {
1272                         my $mmsg = errmsg($opt->{more_message} ||= 'More rows');
1273                         $opt->{more_list} ||= <<EOF;
1274 <tr>
1275 <td colspan={NCOLS} align=center>
1276 $mmsg: [decade-next][/decade-next] [more] [decade-prev][/decade-prev]
1277 </td>
1278 </tr>
1279 EOF
1280                         $opt->{more_list} =~ s/\{NCOLS\}/$ncols/g;
1281                         my $override = { mv_data_table => $table, ui_meta_view => $mview };
1282                         my @forms;
1283                         my @formparms = qw/ mv_data_table ui_meta_view ui_meta_specific /;
1284                         for(@formparms) {
1285                                 my $thing = $override->{$_} || $CGI->{$_};
1286                                 next unless length $thing;
1287                                 push @forms, "$_=$thing";
1288                         }
1289                         my $o = {
1290                                 object => $search,
1291                                 label => $opt->{label},
1292                                 form => join("\n", @forms),
1293                         };
1294                         $output{MORE_LIST} = tag_more_list(
1295                                                                                 $opt->{next_anchor},
1296                                                                                 $opt->{prev_anchor},
1297                                                                                 $opt->{page_anchor},
1298                                                                                 $opt->{more_border},
1299                                                                                 $opt->{more_border_selected},
1300                                                                                 $o,
1301                                                                                 $opt->{more_list},
1302                                                                         );
1303                 }
1304         }
1305
1306         $output{BOTTOM_OF_TABLE} = '</table>';
1307         $output{BOTTOM_OF_FORM} = '</form>';
1308         my $calc_sequence = <<'EOF';
1309 ui_sequence_edit=[calc]
1310         $CGI->{item_id_left} = $CGI->{item_id};
1311         $CGI->{item_id_left} =~ s/\0+/,/g;
1312         if($CGI->{item_id_left} =~ s/^(.*?),//) {
1313                 $CGI->{item_id} = $1;
1314                 return 1;
1315         }
1316         else {
1317                 delete $CGI->{item_id_left};
1318                 return '';
1319         }
1320 [/calc]
1321 EOF
1322         $calc_sequence .= "mv_nextpage=$edit_page\nmv_todo=return";
1323         my $ebutton = $Tag->button(
1324                                                         {
1325                                                                 text => errmsg('Edit checked records in sequence'),
1326                                                                 extra => $opt->{edit_button_extra} || ' class=s2',
1327                                                         },
1328                                                         $calc_sequence,
1329                                                 );
1330         my $mbutton = '';
1331         my $dbutton = '';
1332         if($Tag->if_mm({ function => 'tables', table => "$table=d"}) ) {
1333                 $opt->{confirm} ||= "Are you sure you want to delete the checked records?";
1334                 my $dtext = qq{
1335 [flag type=write table=$table]
1336 deleterecords=1
1337 mv_click=db_maintenance};
1338                 $dbutton = '&nbsp;';
1339                 $dbutton .= $Tag->button(
1340                                                         {
1341                                                                 text => errmsg('Delete checked records'),
1342                                                                 extra => $opt->{edit_button_extra} || ' class=s2',
1343                                                                 confirm => errmsg($opt->{confirm}),
1344                                                         },
1345                                                         $dtext,
1346                                                 );
1347
1348                 if($opt->{user_merge}) {
1349                         $opt->{confirm_merge} ||= "Are you sure you want to merge the checked users?";
1350                         $mbutton = '&nbsp;';
1351                         $mbutton .= $Tag->button(
1352                                                                 {
1353                                                                         text => errmsg('Merge checked users'),
1354                                                                         extra => $opt->{merge_button_extra} || ' class=s2',
1355                                                                         confirm => errmsg($opt->{confirm_merge}),
1356                                                                 },
1357                                                                 '[user-merge]',
1358                                                         );
1359
1360                 }
1361         }
1362         my $cboxes = '';
1363
1364         if($meta->{check_uncheck_all}) {
1365                 my $uc_msg = errmsg('Uncheck all');
1366                 my $ch_msg = errmsg('Check all');
1367                 $ch_msg =~ s/\s/&nbsp;/g;
1368                 $uc_msg =~ s/\s/&nbsp;/g;
1369                 $cboxes = <<EOF;
1370 <a href="javascript:checkAll(document.$opt->{form_name}, '$cb_name')">
1371 $ch_msg
1372 </a>&nbsp;&nbsp;
1373 <a href="javascript:checkAll(document.$opt->{form_name}, '$cb_name', 1)">
1374 $uc_msg
1375 </a>&nbsp;&nbsp;
1376 EOF
1377                 $cboxes =~ s/\n//g;
1378         }
1379
1380         if(! $opt->{no_checkbox} and ! $ts->{like_spec}) {
1381                 unless($opt->{no_top} || $opt->{bottom_buttons}) {
1382                         $output{TOP_BUTTONS} = $cboxes;
1383                         $output{TOP_BUTTONS} .= $ebutton;
1384                         if($mbutton) {
1385                                 $output{TOP_BUTTONS} .= '&nbsp;' x 4;
1386                                 $output{TOP_BUTTONS} .= $mbutton;
1387                         }
1388                         if($dbutton) {
1389                                 $output{TOP_BUTTONS} .= '&nbsp;' x 4;
1390                                 $output{TOP_BUTTONS} .= $dbutton;
1391                         }
1392                 }
1393
1394                 unless($opt->{no_bottom} || $opt->{top_buttons}) {
1395                         $output{BOTTOM_BUTTONS} = $cboxes;
1396                         $output{BOTTOM_BUTTONS} .= $ebutton;
1397                         if($mbutton) {
1398                                 $output{BOTTOM_BUTTONS} .= '&nbsp;' x 4;
1399                                 $output{BOTTOM_BUTTONS} .= $mbutton;
1400                         }
1401                         if($dbutton) {
1402                                 $output{BOTTOM_BUTTONS} .= '&nbsp;' x 4;
1403                                 $output{BOTTOM_BUTTONS} .= $dbutton;
1404                         }
1405                 }
1406         }
1407
1408         my %map = qw/
1409                         TOP_OF_FORM                     top_of_form
1410                         BOTTOM_OF_FORM          bottom_of_form
1411                         HIDDEN_FIELDS       hidden_fields
1412                         TOP_BUTTONS         top_buttons
1413                         BOTTOM_BUTTONS          bottom_buttons
1414                         EXTRA_BUTTONS           extra_buttons
1415                 /;
1416
1417         my @areas = qw/
1418                                         TOP_OF_TABLE
1419                                         TOP_OF_FORM
1420                                         HIDDEN_FIELDS
1421                                         TOP_BUTTONS
1422                                         HEADER_AREA
1423                                         MAIN_BODY
1424                                         MORE_LIST
1425                                         BOTTOM_BUTTONS
1426                                         EXTRA_BUTTONS
1427                                         BOTTOM_OF_FORM
1428                                         BOTTOM_OF_TABLE
1429                                 /;
1430         if($ts->{like_spec}) {
1431                 push @rows, <<EOF;
1432         <tr>
1433         <td>&nbsp;</td>
1434         <td colspan="$ncols" align=left>
1435         [L]Check the box for exact record and enter the record id/key.[/L]
1436         [L]Or enter a query by example to select a set of records.[/L]
1437         [L]Each input will match on the <i>beginning</i> text in the field.[/L]
1438         <p>
1439         <small><input type=checkbox name=ui_exact_record value=1 class=s3> Edit exact record in key column</small>
1440         <br>
1441         &nbsp;
1442         </td>
1443         </tr>
1444         <tr>
1445         <td>&nbsp;</td>
1446         [loop list="[cgi ui_description_fields]"]
1447         <td>
1448                 <input type=hidden name=mv_like_field value="[loop-code]">
1449                 <input type=text name=mv_like_spec size=10>
1450         </td>
1451         [/loop]
1452         </tr>
1453         <tr>
1454         <td>&nbsp;</td>
1455         <td colspan="$ncols" align=left>
1456         &nbsp;
1457         <br>
1458         &nbsp;
1459         <br>
1460         <input type=submit value="[L]Find[/L]">
1461         </td>
1462         </tr>
1463 EOF
1464         }
1465
1466         $output{MAIN_BODY} = join "", @rows;
1467
1468         my @out;
1469         for(@areas) {
1470                 next unless $output{$_};
1471                 if($opt->{ui_style} and $map{$_}) {
1472                         my $op = $map{$_};
1473                         $Tag->output_to($op, { name => $op }, $output{$_} );
1474                 }
1475                 else {
1476                         push @out, $output{$_};
1477                 }
1478         }
1479         return join "", @out;
1480 }
1481 EOR