UserDB: log timestamps to second granularity
[interchange.git] / 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                         my $ms = defined $CGI->{mv_min_string} ? $CGI->{mv_min_string} : 1;
464                         if(length($s) > $ms) {
465                                 $CGI->{ui_text_qualification} .= "se=$s\nsf=$f\nop=$op\n";
466                         }
467                         else {
468                                 $CGI->{ui_text_qualification} .= "se=.\nsf=$f\nop=rn\n";
469                         }
470                         if($op =~ /[<>]/ and $s =~ /^[\d.]+$/) {
471                                 $CGI->{ui_text_qualification} .= "nu=1\n";
472                         }
473                         else {
474                                 $CGI->{ui_text_qualification} .= "nu=0\n";
475                         }
476                 }
477                 if(defined $or) {
478                         $CGI->{ui_text_qualification} .= $or ? "os=1\n" : "os=0\n";
479                 }
480
481                 $out_message = errmsg('Entries matching "%s"', $ui_text_qualification);
482         }
483         elsif ($ui_text_qualification) {
484                 $CGI->{ui_text_qualification} = "se=$CGI->{ui_text_qualification}";
485                 $out_message = errmsg('Entries matching "%s"', $ui_text_qualification);
486                 if($ts->{owner_field}) {
487                         $CGI->{ui_text_qualification} = <<EOF;
488 co=1
489 sf=$ts->{owner_field}
490 se=$Vend::username
491 op=eq
492 sf=:*
493 se=$CGI->{ui_text_qualification}
494 EOF
495                 }
496         }
497         elsif ( $CGI->{mv_like_field} ) {
498                 my @f = split /\0/, $CGI->{mv_like_field};
499                 my @s = split /\0/, $CGI->{mv_like_spec};
500                 my @q = 'ra=yes';
501                 my $found;
502                 for(my $i = 0; $i < @f; $i++) {
503                         next unless length $s[$i];
504                         $found++;
505                         push @q, "lf=$f[$i]";
506                         push @q, "ls=$s[$i]";
507                 }
508                 if($found) {
509                         $CGI->{ui_text_qualification} = join "\n", @q;
510                         my @out;
511                         for(@q) {
512                                 my $thing = $_;
513                                 $thing =~ s/^ls=/mv_like_spec=/;
514                                 $thing =~ s/^lf=/mv_like_field=/;
515                                 push @out, $thing; 
516                         }
517                         $ts->{like_recall} = join "\n", @out;
518                 }
519                 else       { $CGI->{ui_text_qualification} = "" }
520         }
521         elsif($ts->{owner_field}) {
522                 $CGI->{ui_text_qualification} = <<EOF;
523 co=1
524 sf=$ts->{owner_field}
525 se=$Vend::username
526 op=eq
527 EOF
528         }
529         elsif ($ts->{large}) {
530                 my $keylabel = $Tag->display({
531                                                         table => $table,
532                                                         name => 'item_id',
533                                                         column => $ts->{keyname},
534                                                         template => 1,
535                                                 });
536                 $ts->{like_spec} = $CGI->{mv_more_ip} ? 0 : 1;
537                 $CGI->{ui_text_qualification} = "";
538         }
539         else {
540                 $CGI->{ui_text_qualification} = "ra=yes";
541         }
542
543         if($meta->{ui_sort_combined} =~ /\S/) {
544                 $meta->{ui_sort_field} = $meta->{ui_sort_combined};
545                 $meta->{ui_sort_option} = '';
546         }
547
548         $CGI->{ui_sort_field}   ||= $meta->{ui_sort_field}
549                                                         ||  $meta->{lookup}
550                                                         ||  $ts->{keyname};
551         $CGI->{ui_sort_option}  ||= $meta->{ui_sort_option};
552         $CGI->{ui_sort_option}  =~ s/[\0,\s]+//g;
553         $CGI->{ui_list_size} = $opt->{height} || $meta->{height}
554                 if ! $CGI->{ui_list_size};
555
556         if(! $CGI->{ui_show_fields} ) {
557                 $CGI->{ui_show_fields} = 
558                         $CGI->{ui_description_fields}
559                                 = join ",", $ref->columns();
560         }
561         else {
562                 my $i = 0;
563                 my $show = $CGI->{ui_show_fields};
564                 if($filters_done) {
565                         # do nothing
566                 }
567                 else {
568                         if($show =~ s/[\r\n]+/\n/g) {
569                                 $show =~ s/^\s+//;
570                                 $show =~ s/\s+$//;
571                                 my @f = split /\n/, $show;
572                                 my @c;
573                                 for(@f) {
574                                         s/^\s+//;
575                                         s/\s+$//;
576                                         if(s/\s*\((.+)\)\s*$//)  {
577                                                 $filter_show[$i] = $1;
578                                         }
579                                         
580                                         if(/^(\w+)-(\w+)$/) {
581                                                 push @c, $1;
582                                                 $redirect[$i] = $2;
583                                         }
584                                         elsif(/^(\w+)(?:-([^=]+))?(?:=(.*))?/) {
585                                                 push @c, $1;
586                                                 $views[$i] = $2 if $2;
587                                                 $labels[$i] = $3;
588                                         }
589                                         else {
590                                                 push @c, $_;
591                                         }
592                                         $i++;
593                                 }
594                                 $show = join ",", @c;
595                         }
596                         else {
597                                 $show =~ s/(\w+)(?:\((.*?)\))?/ ($filter_show[$i++] = $2), $1/eg;
598                                 $show =~ s/[\0,\s]+/,/g;
599                         }
600                         $CGI->{ui_description_fields} = $show;
601                 }
602         }
603
604         my @cols = split /,/, $CGI->{ui_description_fields};
605
606         @cols = grep $ref->column_exists($_), @cols
607                 unless $spec;
608
609         my %limit_field;
610
611         $CGI->{ui_limit_fields} =~ s/[\0,\s]+/ /g;
612         $CGI->{ui_limit_fields} =~ s/^\s+//;
613         $CGI->{ui_limit_fields} =~ s/\s+$//;
614
615         my (@limit_field) = split " ", $CGI->{ui_limit_fields};
616
617         if(@limit_field) {
618                 @limit_field{@limit_field} = ();
619                 @cols = grep ! exists($limit_field{$_}), @cols;
620         }
621
622         unshift(@cols, $ts->{keyname})
623                 if $cols[0] ne $ts->{keyname};
624
625         $CGI->{ui_description_fields} = join ",", @cols;
626
627         unless ($CGI->{ui_sort_option}) { 
628                  $CGI->{ui_sort_option} = 'n'
629                                 if $ref->numeric($CGI->{ui_sort_field}); 
630         } 
631
632         my $fi = $CGI->{mv_data_table_real} || $CGI->{mv_data_table};
633         $ts->{sparams} = ($ts->{like_spec} || $spec) ? '' : <<EOF;
634
635         fi=$fi
636         st=db
637         $CGI->{ui_text_qualification}
638         su=1
639         ma=$CGI->{ui_more_alpha}
640         md=$CGI->{ui_more_decade}
641         ml=$CGI->{ui_list_size}
642         tf=$CGI->{ui_sort_field}
643         to=$CGI->{ui_sort_option}
644         rf=$CGI->{ui_description_fields}
645         nh=1
646
647 EOF
648         $::Scratch->{page_banner} .= $out_message;
649         $::Scratch->{page_title} .= $out_message;
650
651         my %output;
652 ### Header determination
653
654         my @refkeys = grep ref($opt->{$_}) eq 'HASH', keys %$opt;
655
656         my %default = (
657                 data_cell_class   => '',
658                 data_cell_style   => '',
659                 data_row_class_even   => 'rownorm',
660                 data_row_class_odd   => 'rowalt',
661                 data_row_style_even   => '',
662                 data_row_style_odd   => '',
663                 form_method => 'GET',
664                 explicit_edit => '',
665                 explicit_edit_page => '',
666                 explicit_edit_form => '',
667                 explicit_edit_anchor => '',
668                 no_code_link => '',
669                 group_image   => 'smindex.gif',
670                 group_class   => 'rhead',
671                 group_spacing   => 2,
672                 group_padding   => 0,
673                 group_width   => '100%',
674                 header_link_class   => 'rhead',
675                 header_cell_class   => 'rhead',
676                 header_cell_style   => '',
677                 header_row_class   => 'rhead',
678                 header_row_style   => '',
679                 mv_action => 'back',
680                 meta_image => errmsg('meta.png'),
681                 label => "flex_select_$table",
682                 no_checkbox => 0,
683                 radio_box => 0,
684                 user_merge => 0,
685                 check_uncheck_all => 0,
686                 number_list => 0,
687                 table_border  => 0,
688                 table_class   => 'rseparator',
689                 table_padding => 0,
690                 table_spacing => 1,
691                 table_style   => '',
692                 table_width   => '100%',
693         );
694
695         for(keys %default) {
696                 next if defined $opt->{$_};
697                 if(length $meta->{$_}) {
698                         $opt->{$_} = $meta->{$_};
699                 }
700                 else {
701                         $opt->{$_} = $default{$_};
702                 }
703         }
704
705         $opt->{ui_style} = 1 unless defined $opt->{ui_style};
706         $opt->{no_checkbox} = 1 if $ts->{multikey};
707
708         my $show_meta;
709         my $meta_anchor;
710         if($Tag->if_mm('super') and ! $opt->{no_meta}) {
711                 $show_meta = defined $::Values->{ui_meta_force}
712                                         ? $::Values->{ui_meta_force}
713                                         : $::Variable->{UI_META_SELECT};
714                 if($opt->{meta_image}) {
715                         $meta_anchor = qq{<img src="$opt->{meta_image}" border=0>};
716                 }
717                 else {
718                         $meta_anchor = 'M';
719                 }
720         }
721
722         $opt->{form_name} ||= "fs_$table";
723
724         $output{TOP_OF_TABLE} = <<EOF;
725 <table width="$opt->{table_width}" border="$opt->{table_border}" cellpadding="$opt->{table_padding}" cellspacing="$opt->{table_spacing}" class="$opt->{table_class}">
726 EOF
727
728         my $cwp = $Global::Variable->{MV_PAGE};
729         $opt->{form_href} ||= $CGI->{ui_searchpage} || $cwp;
730         $opt->{form_extra} ||= '';
731         $opt->{form_extra} .= qq{ name="$opt->{form_name}"} if $opt->{form_name};
732         $opt->{form_extra} =~ s/^\s*/ /;
733         my $action = $Tag->process({href => $opt->{form_href}});
734
735         $output{TOP_OF_FORM} = <<EOF;
736 <form action="$action" method="$opt->{form_method}"$opt->{form_extra}>
737 <input type=hidden name=mv_data_table    value="$table">
738 <input type=hidden name=mv_action        value="$opt->{mv_action}">
739 <input type=hidden name=mv_click         value="warn_me_main_form">
740 <input type=hidden name=mv_session_id    value="$Vend::SessionID">
741 EOF
742
743         ### What the heck is going on here?
744         if($CGI->{ui_meta_view}) {
745                 $output{TOP_OF_FORM} .= <<EOF;
746 <input type=hidden name=ui_meta_view         value="$CGI->{ui_meta_view}">
747 EOF
748                 $output{TOP_OF_FORM} .= $Tag->return_to();
749         }
750         else {
751                 $output{TOP_OF_FORM} .= <<EOF;
752         <!-- got no return-to -->
753 <input type=hidden name=ui_meta_specific value="$CGI->{ui_meta_specific}">
754 <input type=hidden name=ui_page_title    value="$CGI->{ui_page_title}">
755 <input type=hidden name=ui_page_banner   value="$CGI->{ui_page_banner}">
756 <input type=hidden name=ui_limit_fields  value="$CGI->{ui_limit_fields}">
757 <input type=hidden name=ui_show_fields   value="$CGI->{ui_show_fields}">
758 <input type=hidden name=ui_return_to     value="$cwp">
759 <input type=hidden name=ui_return_to     value="mv_data_table=$table">
760 EOF
761         }
762
763         my $cc = $ts->{column_meta} ||= {};
764         my $mview = $CGI->{ui_meta_view};
765
766         my $cmeta = sub {
767                 my $col = shift;
768                 return $cc->{$col} if $cc->{$col};
769                 my $m = $Tag->meta_record("${table}::$col", $mview);
770                 for(@refkeys) {
771                         $m->{$_} = $opt->{$_}{$col} if exists $opt->{$_}{$col};
772                 }
773                 $cc->{$col} = $m;
774                 return $m;
775         };
776
777         my $header_cell_style = sub {
778                                 my $col = shift;
779                                 my $m = $cmeta->($col);
780 #::logDebug("meta for header=" . ::uneval($m));
781                                 my $stuff = '';
782                                 for(qw/ class style align valign /) {
783                                         my $tag = "header_cell_$_";
784                                         my $thing;
785                                         if(ref $opt->{$tag}) {
786                                                 $thing = $opt->{$tag}{$col} || $m->{$tag} || $opt->{"all_$tag"}
787                                                         or next;
788                                         }
789                                         else {
790                                                 $thing = $m->{$tag} || $opt->{$tag}
791                                                         or next;
792                                         }
793                                         encode_entities($thing);
794                                         $stuff .= qq{ $_="$thing"};
795                                 }
796                                 return $stuff;
797                         };
798
799         my $data_cell_style = sub {
800                                 my $col = shift;
801                                 my $m = $cmeta->($col);
802                                 my $stuff = '';
803                                 for(qw/ class style align valign /) {
804                                         my $tag = "data_cell_$_";
805                                         my $thing;
806                                         if(ref $opt->{$tag}) {
807                                                 $thing = $opt->{$tag}{$col} || $m->{$tag} || $opt->{"all_$tag"}
808                                                         or next;
809                                         }
810                                         else {
811                                                 $thing = $m->{$tag} || $opt->{$tag}
812                                                         or next;
813                                         }
814                                         encode_entities($thing);
815                                         $stuff .= qq{ $_="$thing"};
816                                 }
817                                 return $stuff;
818                         };
819
820         my @head;
821         my $rc = $opt->{header_row_class};
822         push @head, "<tr ";
823         push @head, qq( class=$opt->{header_row_class}) if $opt->{header_row_class};
824         push @head, qq( style=$opt->{header_row_style}) if $opt->{header_row_style};
825         push @head, ">\n";
826         if(! $opt->{no_checkbox}) {
827                 push @head, "   <td class=rhead>&nbsp;</td>" 
828         }
829         if($opt->{radio_box}) {
830                 push @head, "   <td class=rhead>&nbsp;</td>" 
831         }
832         if($opt->{number_list}) {
833                 push @head, "   <td class=rhead align=right>#&nbsp;</td>" ;
834         }
835         if($opt->{explicit_edit}) {
836                 push @head, "   <td class=rhead>&nbsp;</td>" 
837         }
838
839         my $return = <<EOF;
840 ui_return_to=$cwp
841 ui_return_to=ui_meta_view=$opt->{ui_meta_view}
842 ui_return_to=mv_return_table=$table
843 mv_return_table=$table
844 ui_return_stack=$CGI->{ui_return_stack}
845 start_at=extended.ui_more_alpha
846 EOF
847
848         my %mkey;
849         if($ts->{multikey}) {
850                 for(@{$ts->{key_columns}}) {
851                         $mkey{$_} = 1;
852                 }
853         }
854
855         my @mcol;
856
857         my $idx = 0;
858         foreach my $col (@cols) {
859                 my $mcol = $col;
860                 if($redirect[$idx]) {
861                         $mcol .= "-$redirect[$idx]";
862                 }
863                 my $td_extra = $header_cell_style->($mcol);
864
865                 ## $cc is set in header_cell_class 
866                 my $m = $cc->{$mcol};
867
868                 if($mkey{$col}) {
869                         push @mcol, $idx - 1;
870                 }
871
872                 push @head, <<EOF;
873 <td$td_extra>
874 <table align="left" class="$opt->{group_class}" cellspacing=$opt->{group_spacing} cellpadding=$opt->{group_padding} width="$opt->{group_width}">
875     <tr>
876 EOF
877                 unless($opt->{no_group} || $m->{fs_no_group}) {
878                         my $u = $Tag->area({
879                                                                 href => 'admin/flex_group',
880                                                                 form => qq(
881                                                                                         mv_data_table=$table
882                                                                                         ui_meta_view=$mview
883                                                                                         from_page=$Global::Variable->{MV_PAGE}
884                                                                                         mv_arg=$col
885                                                                                 ),
886                                                         });
887                         my $msg = errmsg('Select group by %s', $col);
888
889                         push @head, <<EOF;
890       <td align="right" valign="center" width=1>
891                 <a href="$u" title="$msg"><img src="$opt->{group_image}" border=0></a>
892       </td>
893 EOF
894
895                 }
896
897                 my $o = '';
898                 my $msg;
899                 my $rmsg;
900                 if($o = $m->{ui_sort_option}) {
901                         my @m;
902                         $msg = "sort by %s (%s)";
903
904                         if($CGI->{ui_sort_field} eq $col) {
905                                 if($CGI->{ui_sort_option} =~ /r/) {
906                                         $o =~ s/r//;
907                                 }
908                                 else {
909                                         $o .= "r";
910                                 }
911                         }
912                         push @m, errmsg('reverse') if $o =~ /r/;
913                         push @m, errmsg('case insensitive') if $o =~ /f/;
914                         push @m, errmsg('numeric') if $o =~ /n/;
915                         $rmsg = join ", ", @m;
916                 }
917                 else {
918                         if ($CGI->{ui_sort_field} eq $col and $CGI->{ui_sort_option} !~ /r/) {
919                                 $o .= 'r';
920                                 $msg = "sort by %s (%s)";
921                                 $rmsg = errmsg('reverse');
922                         }
923                         else {
924                                 $msg = "sort by %s";
925                         }
926                         $o .= 'n' if $ref->numeric($col);
927                 }
928                 my $sort_msg = errmsg($msg, $col, $rmsg);
929                 my $url = $Tag->area( {
930                                                                 href => $cwp,
931                                                                 form => qq(
932                                                                         $ts->{like_recall}
933                                                                         ui_text_qualification=$ui_text_qualification
934                                                                         mv_data_table=$table
935                                                                         ui_meta_view=$mview
936                                                                         ui_sort_field=$col
937                                                                         ui_sort_option=$o
938                                                                         ui_more_alpha=$m->{ui_more_alpha}
939                                                                 ),
940                                                         });
941
942                 my $lab = $labels[$idx] || $m->{label} || $col;
943
944                 # Set up some stuff for the data cells;
945                 $style[$idx] = $data_cell_style->($mcol);
946
947                 $filter_show[$idx] = $filter->{$mcol} if $filter->{$mcol};
948                 $filter_show[$idx] ||= $m->{fs_display_filter} || 'encode_entities';
949                 $filter_show[$idx] .= ' encode_entities'
950                          unless $filter_show[$idx] =~ /\b(?:encode_)?entities\b/;
951                 $style[$idx] .= " $1" while $filter_show[$idx] =~ s/(v?align=\w+)//i;
952
953                 if($views[$idx]) {
954                         my ($page, $parm, $l) = split /:/, $views[$idx];
955                         $m->{fs_link_page} = $page;
956
957                         $parm ||= 'item_id';
958                         my @p = split /[\s,\0]+/, $parm;
959                         my $arg = shift @p;
960                         $m->{fs_link_parm} = $arg;
961                         $m->{fs_link_parm_extra} = join ",", @p;
962                         $m->{fs_link_anchor} = $l;
963                 }
964
965                 if($m->{fs_link_page}) {
966                         $link_page[$idx]                = $m->{fs_link_page};
967                         $link_parm[$idx]                = $m->{fs_link_parm};
968                         if($m->{fs_link_parm_extra}) {
969                                 my @p = grep /\S/, split /[\s,\0]+/, $m->{fs_link_parm_extra};
970                                 $link_parm_extra[$idx]  = \@p;
971                         }
972                         $link_anchor[$idx]      = $m->{fs_link_anchor};
973                 }
974
975                 if(my $prog = $m->{fs_data_calc}) {
976 #::logDebug("looking at calcs=$prog");
977                         $prog =~ s/^\s+//;
978                         $prog =~ s/\s+$//;
979                         if($prog =~ /^\w+$/) {
980                                 $calcs[$idx] = $Vend::Cfg->{Sub}{$prog} || $Global::GlobalSub->{$prog};
981                         }
982                         else {
983                                 $prog =~ s/^\[(calc|perl)(.*?)\]//;
984                                 $prog =~ s{\[/(calc|perl)\]$}{};
985                                 $calcs[$idx] = $prog;
986                         }
987                         if($m->{fs_data_tables}) {
988                                 tag_perl($m->{fs_data_tables}, {});
989                         }
990                 }
991
992                 push @head, <<EOF;
993           <td$td_extra>
994                 <a href="$url" class=$opt->{header_link_class} title="$sort_msg">$lab</a>
995       </td>
996 EOF
997
998                 if($show_meta) {
999                         my $u = $Tag->area({ href=>'admin/meta_editor',
1000                                                                  form => qq(
1001                                                                  item_id=${table}::$mcol
1002                                                                  ui_meta_view=$mview
1003                                                                  $return),
1004                                                                 });
1005                         my $tit = errmsg(
1006                                                         "Edit header meta information for %s::%s",
1007                                                         $table,
1008                                                         $col,
1009                                                 );
1010                         push @head, <<EOF;
1011 <td width=1>
1012 <a href="$u" title="$tit">$meta_anchor</a>
1013 </td>
1014 EOF
1015
1016                 }
1017
1018                 push @head, <<EOF;
1019     </tr>
1020     </table>    
1021         </td>
1022 EOF
1023
1024                 $idx++;
1025         }
1026         push @head, "</tr>";
1027
1028         shift @mcol;
1029
1030         my $ncols = $idx;
1031         $ncols++ if $opt->{explicit_edit};
1032         $ncols++ if $opt->{number_list};
1033         $ncols++ if $opt->{radio_box};
1034         $ncols++ unless $opt->{no_checkbox};
1035
1036         $output{HEADER_AREA} = join "", @head;
1037 ### Row output
1038
1039         my $cb_width = $opt->{checkbox_width} || '30';
1040         my $cb_name = $opt->{checkbox_name} || 'item_id';
1041         my $rb_name = $opt->{radiobox_name} || 'item_radio';
1042         my $edit_page = $opt->{edit_page} || 'admin/flex_editor';
1043         my $edit_parm = $opt->{edit_parm} || 'item_id';
1044         my $edit_extra = <<EOF;
1045 mv_data_table=$table
1046 ui_page_title=$CGI->{ui_page_title}
1047 ui_meta_view=$mview
1048 ui_page_banner=$CGI->{ui_page_banner}
1049 ui_meta_specific=$CGI->{ui_meta_specific}
1050 EOF
1051
1052         
1053         my @rows;
1054
1055         if($ts->{like_spec}) {
1056                 ## Do nothing
1057         }
1058         elsif($body =~ /\S/) {
1059                 my $o = { 
1060                                         label           => $opt->{label},
1061                                         list_prefix     => 'flex',
1062                                         prefix          => 'flex',
1063                                         more            => 1,
1064                                         search          => $ts->{sparams},
1065                                 };
1066                 push @rows, tag_loop_list($o);
1067         }
1068         else {
1069                 my $ary;
1070                 my $search;
1071                 my $params;
1072                 my $c;
1073 #::logDebug("MM=$CGI->{MM}($CGI::values{MM}) mv_more_matches=$CGI->{mv_more_matches}($CGI::values{mv_more_matches})");
1074                 if($CGI->{mv_more_ip}) {
1075                         $search = $::Instance->{SearchObject}{$opt->{label}};
1076                         $search ||= $::Instance->{SearchObject}{''};
1077                         $search ||= perform_search();
1078                         $ary = [ splice(
1079                                                 @{$search->{mv_results}},
1080                                                 $search->{mv_first_match},
1081                                                 $search->{mv_matchlimit},
1082                                                 )] ;
1083 #::logDebug("search first_match=$search->{mv_first_match} length=$search->{mv_matchlimit}");
1084 #::logDebug("Found search=" . ::uneval($search));
1085                 }
1086                 elsif($q) {
1087                         my $db = dbref($table);
1088                         my $o = {
1089                                 ma              => $CGI->{ui_more_alpha},
1090                                 md              => $CGI->{ui_more_decade},
1091                                 ml              => $CGI->{ui_list_size},
1092                                 more    => 1,
1093                                 table   => $fi,
1094                                 query   => $q,
1095                         };
1096                         $ary = $db->query($o);
1097                 }
1098                 else {
1099 #::logDebug("In new search");
1100                         $params = escape_scan($ts->{sparams});
1101                         $c = { mv_search_immediate => 1, mv_search_label => $opt->{label} };
1102                         Vend::Scan::find_search_params($c, $params);
1103                         $search = Vend::Scan::perform_search($c);
1104                         $ary = $search->{mv_results};
1105                 }
1106
1107                 finish_search($search) if $search;
1108                 
1109                 $search ||= {};
1110
1111                 if($CGI->{ui_return_to} and ! $CGI->{ui_return_stack}) {
1112                         $edit_extra .= $Tag->return_to('formlink');     
1113                 }
1114                 else {
1115                         $edit_extra .= "ui_return_to=$cwp";
1116                 }
1117
1118                 my $edit_anchor;
1119                 my $ee_extra;
1120                 if($opt->{explicit_edit}) {
1121                         $edit_anchor = $opt->{explicit_edit_anchor} || errmsg('edit record');
1122                         $edit_anchor =~ s/ /&nbsp;/g;
1123                         $ee_extra = '';
1124                         for(qw/ class style width align valign /) {
1125                                 my $v = $opt->{"explicit_edit_$_"}
1126                                         or next;
1127                                 $ee_extra .= qq{ $_="$v"};
1128                         }
1129                         $ee_extra ||= ' width=30';
1130                 }
1131 #::logDebug("explicit_edit=$opt->{explicit_edit} no_code_link=$opt->{no_code_link}");
1132                 my $j = $search->{mv_first_match} || 0;
1133                 foreach my $line (@$ary) {
1134                         my $code = shift (@$line);
1135                         my $ecode = encode_entities($code);
1136                         my $rc = $j++ % 2
1137                                         ? $opt->{data_row_class_even}
1138                                         : $opt->{data_row_class_odd};
1139                         my $out = qq{<tr class="$rc">\n};
1140
1141                         my $code_pre; my $code_post;
1142                         my $ep_string = '';
1143                         if($opt->{no_code_link} and ! $opt->{explicit_edit}) {
1144                                 $code_pre = $code_post = '';
1145                         }
1146                         else {
1147                                 my @what;
1148                                 push @what, "$edit_parm=$code";
1149                                 if($ts->{multikey}) {
1150                                         unshift @what, 'ui_multi_key=1';
1151                                         for(@mcol) {
1152                                                 push @what, "$edit_parm=$line->[$_]";
1153                                         }
1154
1155                                 }
1156
1157                                 $ep_string = join "\n", @what, $edit_extra;
1158
1159                                 my $edit_url = $Tag->area({
1160                                                                         href => $edit_page,
1161                                                                         form => $ep_string,
1162                                                                 });
1163                                 my $msg = errmsg('edit %s', $ecode);
1164                                 $code_pre = qq{<a href="$edit_url" title="$msg">};
1165                                 $code_post = qq{</a>};
1166                         }
1167
1168                         unless($opt->{no_checkbox}) {
1169                                 $out .= <<EOF;
1170 <td width="$cb_width"><input type=checkbox name=$cb_name value="$ecode"></td>
1171 EOF
1172                         }
1173                         if($opt->{radio_box}) {
1174                                 $out .= <<EOF;
1175 <td width="$cb_width"><input type=radio name=$rb_name value="$ecode"></td>
1176 EOF
1177                         }
1178
1179                         if($opt->{number_list}) {
1180                                 $out .= qq{<td align=right>&nbsp;$j&nbsp;</td>};
1181                         }
1182
1183                         if($opt->{explicit_edit}) {
1184                                 my $form = $opt->{explicit_edit_form} || '';
1185                                 if($form) {
1186                                         $form .= $ecode;
1187                                 }
1188                                 my $url = $Tag->area({
1189                                                                         href => $opt->{explicit_edit_page} || $edit_page,
1190                                                                         form => $form || $ep_string,
1191                                                                 });
1192                                 my $msg = errmsg('process %s', $ecode);
1193                                 my $pre = qq{<a href="$url" title="$msg">};
1194                                 $out .= qq{<td$ee_extra>&nbsp;$pre$edit_anchor$code_post&nbsp;</td>};
1195                         }
1196
1197 #::logDebug("keyname=$ts->{keyname}");
1198                         $out .= "<td" . $data_cell_style->($ts->{keyname}) . ">";
1199                         $ecode = '';
1200                         if ($calcs[0]) {
1201                                 my %item;
1202                                 @item{@cols} = ($code, @$line);
1203                                 if(ref($calcs[0]) eq 'CODE') {
1204                                         $ecode = $calcs[0]->(\%item);
1205                                 }
1206                                 else {
1207                                         $Vend::Interpolate::item = \%item;
1208                                         $ecode = tag_calc($calcs[0]);
1209                                 }
1210                         }
1211                         if ($filter_show[0]) {
1212                                 $ecode = $code unless $ecode;
1213                                 $ecode = $Tag->filter($filter_show[0], $ecode, $cols[0]);
1214                                 $ecode =~ s/\[/&#91;/g;
1215                         }
1216                         $ecode = encode_entities($code) unless $ecode;
1217                         $out .= "$code_pre$ecode$code_post</td>";
1218                         my $i = 1;
1219                         for my $v (@$line) {
1220                                 my $extra = $style[$i];
1221                                 my $pre = '';
1222                                 my $post = '';
1223                                 my $lab;
1224
1225                                 if($link_page[$i]) {
1226                                         my $opt = { $link_parm[$i] => $v, form => 'auto' };
1227                                         if(my $p = $link_parm_extra[$i]) {
1228                                                 for(@$p) {
1229                                                         $opt->{$_} = $CGI->{$_};
1230                                                 }
1231                                         }
1232                                         $opt->{href} = $link_page[$i];
1233
1234                                         $lab = $link_anchor[$i];
1235                                         $lab =~ s/^\s+//;
1236                                         my $url = $Tag->area($opt);
1237                                         my $ev = encode_entities($v);
1238                                         $pre = qq{<a href="$url" title="$ev">};
1239                                         $post = '</a>';
1240                                 }
1241
1242                                 if($calcs[$i]) {
1243 #::logDebug("found a calc");
1244                                         my %item;
1245                                         @item{@cols} = ($code, @$line);
1246                                         if(ref($calcs[$i]) eq 'CODE') {
1247                                                 $lab = $calcs[$i]->(\%item);
1248                                         }
1249                                         else {
1250                                                 $Vend::Interpolate::item = \%item;
1251                                                 $lab = tag_calc($calcs[$i]);
1252                                         }
1253                                 }
1254
1255                                 $lab ||= $v;
1256
1257                                 $lab = $Tag->filter($filter_show[$i], $lab, $cols[$i]);
1258
1259                                 $lab =~ s/\[/&#91;/g;
1260                                 $out .= "<td$extra>$pre$lab$post</td>";
1261
1262                                 $i++;
1263                         }
1264                         $out .= "</tr>\n";
1265                         push @rows, $out;
1266                 }
1267
1268                 unless(@rows) {
1269                         my $nomsg = errmsg('No records');
1270                         push @rows, qq{<tr><td colspan=$ncols><blockquote>$nomsg.</blockquote></td></tr>};
1271                 }
1272                 else {
1273                         my $mmsg = errmsg($opt->{more_message} ||= 'More rows');
1274                         $opt->{more_list} ||= <<EOF;
1275 <tr>
1276 <td colspan={NCOLS} align=center>
1277 $mmsg: [decade-next][/decade-next] [more] [decade-prev][/decade-prev]
1278 </td>
1279 </tr>
1280 EOF
1281                         $opt->{more_list} =~ s/\{NCOLS\}/$ncols/g;
1282                         my $override = { mv_data_table => $table, ui_meta_view => $mview };
1283                         my @forms;
1284                         my @formparms = qw/ mv_data_table ui_meta_view ui_meta_specific /;
1285                         for(@formparms) {
1286                                 my $thing = $override->{$_} || $CGI->{$_};
1287                                 next unless length $thing;
1288                                 push @forms, "$_=$thing";
1289                         }
1290                         my $o = {
1291                                 object => $search,
1292                                 label => $opt->{label},
1293                                 form => join("\n", @forms),
1294                         };
1295                         $output{MORE_LIST} = tag_more_list(
1296                                                                                 $opt->{next_anchor},
1297                                                                                 $opt->{prev_anchor},
1298                                                                                 $opt->{page_anchor},
1299                                                                                 $opt->{more_border},
1300                                                                                 $opt->{more_border_selected},
1301                                                                                 $o,
1302                                                                                 $opt->{more_list},
1303                                                                         );
1304                 }
1305         }
1306
1307         $output{BOTTOM_OF_TABLE} = '</table>';
1308         $output{BOTTOM_OF_FORM} = '</form>';
1309         my $calc_sequence = <<'EOF';
1310 ui_sequence_edit=[calc]
1311         $CGI->{item_id_left} = $CGI->{item_id};
1312         $CGI->{item_id_left} =~ s/\0+/,/g;
1313         if($CGI->{item_id_left} =~ s/^(.*?),//) {
1314                 $CGI->{item_id} = $1;
1315                 return 1;
1316         }
1317         else {
1318                 delete $CGI->{item_id_left};
1319                 return '';
1320         }
1321 [/calc]
1322 EOF
1323         $calc_sequence .= "mv_nextpage=$edit_page\nmv_todo=return";
1324         my $ebutton = $Tag->button(     
1325                                                         {
1326                                                                 text => errmsg('Edit checked records in sequence'),
1327                                                                 extra => $opt->{edit_button_extra} || ' class=s2',
1328                                                         },
1329                                                         $calc_sequence,
1330                                                 );
1331         my $mbutton = '';
1332         my $dbutton = '';
1333         if($Tag->if_mm({ function => 'tables', table => "$table=d"}) ) {
1334                 $opt->{confirm} ||= "Are you sure you want to delete the checked records?";
1335                 my $dtext = qq{
1336 [flag type=write table=$table]
1337 deleterecords=1
1338 mv_click=db_maintenance};
1339                 $dbutton = '&nbsp;';
1340                 $dbutton .= $Tag->button(       
1341                                                         {
1342                                                                 text => errmsg('Delete checked records'),
1343                                                                 extra => $opt->{edit_button_extra} || ' class=s2',
1344                                                                 confirm => errmsg($opt->{confirm}),
1345                                                         },
1346                                                         $dtext,
1347                                                 );
1348                 
1349                 if($opt->{user_merge}) {
1350                         $opt->{confirm_merge} ||= "Are you sure you want to merge the checked users?";
1351                         $mbutton = '&nbsp;';
1352                         $mbutton .= $Tag->button(       
1353                                                                 {
1354                                                                         text => errmsg('Merge checked users'),
1355                                                                         extra => $opt->{merge_button_extra} || ' class=s2',
1356                                                                         confirm => errmsg($opt->{confirm_merge}),
1357                                                                 },
1358                                                                 '[user-merge]',
1359                                                         );
1360                                 
1361                 }
1362         }
1363         my $cboxes = '';
1364
1365         if($meta->{check_uncheck_all}) {
1366                 my $uc_msg = errmsg('Uncheck all');
1367                 my $ch_msg = errmsg('Check all');
1368                 $ch_msg =~ s/\s/&nbsp;/g;
1369                 $uc_msg =~ s/\s/&nbsp;/g;
1370                 $cboxes = <<EOF;
1371 <a href="javascript:checkAll(document.$opt->{form_name}, '$cb_name')">
1372 $ch_msg
1373 </a>&nbsp;&nbsp;
1374 <a href="javascript:checkAll(document.$opt->{form_name}, '$cb_name', 1)">
1375 $uc_msg
1376 </a>&nbsp;&nbsp;
1377 EOF
1378                 $cboxes =~ s/\n//g;
1379         }
1380
1381         if(! $opt->{no_checkbox} and ! $ts->{like_spec}) {
1382                 unless($opt->{no_top} || $opt->{bottom_buttons}) {
1383                         $output{TOP_BUTTONS} = $cboxes;
1384                         $output{TOP_BUTTONS} .= $ebutton;
1385                         if($mbutton) {
1386                                 $output{TOP_BUTTONS} .= '&nbsp;' x 4;
1387                                 $output{TOP_BUTTONS} .= $mbutton;
1388                         }
1389                         if($dbutton) {
1390                                 $output{TOP_BUTTONS} .= '&nbsp;' x 4;
1391                                 $output{TOP_BUTTONS} .= $dbutton;
1392                         }
1393                 }
1394
1395                 unless($opt->{no_bottom} || $opt->{top_buttons}) {
1396                         $output{BOTTOM_BUTTONS} = $cboxes;
1397                         $output{BOTTOM_BUTTONS} .= $ebutton;
1398                         if($mbutton) {
1399                                 $output{BOTTOM_BUTTONS} .= '&nbsp;' x 4;
1400                                 $output{BOTTOM_BUTTONS} .= $mbutton;
1401                         }
1402                         if($dbutton) {
1403                                 $output{BOTTOM_BUTTONS} .= '&nbsp;' x 4;
1404                                 $output{BOTTOM_BUTTONS} .= $dbutton;
1405                         }
1406                 }
1407         }
1408
1409         my %map = qw/
1410                         TOP_OF_FORM                     top_of_form
1411                         BOTTOM_OF_FORM          bottom_of_form
1412                         HIDDEN_FIELDS       hidden_fields
1413                         TOP_BUTTONS         top_buttons
1414                         BOTTOM_BUTTONS          bottom_buttons
1415                         EXTRA_BUTTONS           extra_buttons
1416                 /;
1417
1418         my @areas = qw/
1419                                         TOP_OF_TABLE
1420                                         TOP_OF_FORM
1421                                         HIDDEN_FIELDS
1422                                         TOP_BUTTONS 
1423                                         HEADER_AREA
1424                                         MAIN_BODY
1425                                         MORE_LIST
1426                                         BOTTOM_BUTTONS
1427                                         EXTRA_BUTTONS
1428                                         BOTTOM_OF_FORM
1429                                         BOTTOM_OF_TABLE
1430                                 /;
1431         if($ts->{like_spec}) {
1432                 push @rows, <<EOF;
1433         <tr>
1434         <td>&nbsp;</td>
1435         <td colspan="$ncols" align=left>
1436         [L]Check the box for exact record and enter the record id/key.[/L]
1437         [L]Or enter a query by example to select a set of records.[/L]
1438         [L]Each input will match on the <i>beginning</i> text in the field.[/L]
1439         <p>
1440         <small><input type=checkbox name=ui_exact_record value=1 class=s3> Edit exact record in key column</small>
1441         <br>
1442         &nbsp;
1443         </td>
1444         </tr>
1445         <tr>
1446         <td>&nbsp;</td>
1447         [loop list="[cgi ui_description_fields]"]
1448         <td>
1449                 <input type=hidden name=mv_like_field value="[loop-code]">
1450                 <input type=text name=mv_like_spec size=10>
1451         </td>
1452         [/loop]
1453         </tr>
1454         <tr>
1455         <td>&nbsp;</td>
1456         <td colspan="$ncols" align=left>
1457         &nbsp;
1458         <br>
1459         &nbsp;
1460         <br>
1461         <input type=submit value="[L]Find[/L]">
1462         </td>
1463         </tr>
1464 EOF
1465         }
1466
1467         $output{MAIN_BODY} = join "", @rows;
1468
1469         my @out;
1470         for(@areas) {
1471                 next unless $output{$_};
1472                 if($opt->{ui_style} and $map{$_}) {
1473                         my $op = $map{$_};
1474                         $Tag->output_to($op, { name => $op }, $output{$_} );
1475                 }
1476                 else {
1477                         push @out, $output{$_};
1478                 }
1479         }
1480         return join "", @out;
1481 }
1482 EOR