/[gedafe]/trunk/lib/perl/Gedafe/GUI.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/lib/perl/Gedafe/GUI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Mon Feb 14 18:52:26 2005 UTC (19 years, 1 month ago) by dpavlin
File size: 41301 byte(s)
import of Gedafe 1.2.2

1 # Gedafe, the Generic Database Frontend
2 # copyright (c) 2000-2003 ETH Zurich
3 # see http://isg.ee.ethz.ch/tools/gedafe/
4
5 # released under the GNU General Public License
6
7 package Gedafe::GUI;
8
9 use strict;
10
11 use Gedafe::Global qw(%g);
12 use Gedafe::DB qw(
13 DB_GetNumRecords
14 DB_FetchList
15 DB_GetRecord
16 DB_AddRecord
17 DB_UpdateRecord
18 DB_GetCombo
19 DB_DeleteRecord
20 DB_GetDefault
21 DB_ParseWidget
22 DB_ID2HID
23 DB_HID2ID
24 DB_RawField
25 DB_DumpTable
26 );
27
28 use Gedafe::Util qw(
29 ConnectToTicketsDaemon
30 MakeURL
31 MyURL
32 Template
33 DropUnique
34 UniqueFormStart
35 FormStart
36 UniqueFormEnd
37 FormEnd
38 NextRefresh
39 );
40
41 use POSIX;
42
43 use vars qw(@ISA @EXPORT_OK);
44 require Exporter;
45 @ISA = qw(Exporter);
46 @EXPORT_OK = qw(
47 GUI_Entry
48 GUI_List
49 GUI_CheckFormID
50 GUI_PostEdit
51 GUI_Edit
52 GUI_Delete
53 GUI_Export
54 GUI_DumpTable
55 GUI_Pearl
56 GUI_WidgetRead
57 );
58
59 sub GUI_AppletParam($$);
60 sub GUI_CheckFormID($$);
61 sub GUI_Delete($$$);
62 sub GUI_DeleteLink($$$$);
63 sub GUI_DumpTable($$$);
64 sub GUI_Edit($$$);
65 sub GUI_EditLink($$$$);
66 sub GUI_Edit_Error($$$$$$);
67 sub GUI_Entry($$$);
68 sub GUI_Export($$$);
69 sub GUI_ExportData($$);
70 sub GUI_FilterFirst($$$$);
71 sub GUI_Footer($);
72 sub GUI_HTMLMarkup($);
73 sub GUI_Hash2Str($);
74 sub GUI_Header($$);
75 sub GUI_InitTemplateArgs($$);
76 sub GUI_List($$$);
77 sub GUI_ListButtons($$$$);
78 sub GUI_ListTable($$$);
79 sub GUI_MakeCombo($$$$);
80 sub GUI_MakeISearch($$$$$$);
81 sub GUI_PostEdit($$$);
82 sub GUI_Search($$$);
83 sub GUI_Str2Hash($$);
84 sub GUI_URL_Decode($);
85 sub GUI_URL_Encode($);
86 sub GUI_WidgetRead($$$);
87 sub GUI_WidgetWrite($$$$);
88 sub GUI_WidgetWrite_Date($$$);
89
90 my %numeric_types = (
91 time => 1,
92 timestamp => 1,
93 int2 => 1,
94 int4 => 1,
95 int8 => 1,
96 numeric => 1,
97 float4 => 1,
98 float8 => 1,
99 );
100
101 # setup for GUI_Export
102 my ($csv, @exp_fmt_choices, %exp_fmt_choices);
103 BEGIN {
104 eval {
105 # load modules necessary for formatting exported data:
106 # if they don't load (aren't installed), no biggie- will fallback
107 require Text::CSV_XS;
108 $csv = Text::CSV_XS->new({binary => 1});
109 push(@exp_fmt_choices, 'csv');
110 $exp_fmt_choices{'csv'} = "Comma-separated (CSV)";
111 };
112 # add default (built-in) export format: tab-separated
113 push(@exp_fmt_choices, 'tsv');
114 $exp_fmt_choices{'tsv'} = "Tab-separated (TSV)";
115 }
116
117 sub GUI_HTMLMarkup($)
118 {
119 my $str = shift;
120
121 # e-mail addresses
122 my $emaddrchars = '\w.:/~-';
123 $str =~ s,([^\@$emaddrchars]|\A)([$emaddrchars]+\@(?:[\w-]+\.)+[\w-]+)([^\@$emaddrchars]|\Z),$1<A HREF="mailto:$2">$2</A>$3,gi;
124
125 my $urlchars = '\w.:/?~%&=\@\#-';
126
127 # http addresses with explicit "http://" or "https://"
128 $str =~ s,([^$urlchars]|\A)(https?://[$urlchars]+)([^$urlchars]|\Z),$1<A HREF="$2" TARGET="refwindow">$2</A>$3,gi;
129
130 # http addresses beginning with "www."
131 $str =~ s,([^$urlchars]|\A)(www\.[\w.:/?~%&=\#-]+)([^$urlchars]|\Z),$1<A HREF="http://$2" TARGET="refwindow">$2</A>$3,gi;
132
133 # http addresses ending in a common top-level domain
134 my $tlds = 'ac|ad|ae|af|ag|ai|al|am|an|ao|aq|ar|as|at|au|aw|az|ba|bb|bd|be|bf|bg|bh|bi|bj|bm|bn|bo|br|bs|bt|bv|bw|by|bz|ca|cc|cd|cf|cg|ch|ci|ck|cl|cm|cn|co|cr|cu|cv|cx|cy|cz|de|dj|dk|dm|do|dz|ec|ee|eg|eh|er|es|et|fi|fj|fk|fm|fo|fr|ga|gd|ge|gf|gg|gh|gi|gl|gm|gn|gp|gq|gr|gs|gt|gu|gw|gy|hk|hm|hn|hr|ht|hu|id|ie|il|im|in|io|iq|ir|is|it|je|jm|jo|jp|ke|kg|kh|ki|km|kn|kp|kr|kw|ky|kz|la|lb|lc|li|lk|lr|ls|lt|lu|lv|ly|ma|mc|md|mg|mh|mk|ml|mm|mn|mo|mp|mq|mr|ms|mt|mu|mv|mw|mx|my|mz|na|nc|ne|nf|ng|ni|nl|no|np|nr|nu|nz|om|pa|pe|pf|pg|ph|pk|pl|pm|pn|pr|ps|pt|pw|py|qa|re|ro|ru|rw|sa|sb|sc|sd|se|sg|sh|si|sj|sk|sl|sm|sn|so|sr|st|sv|sy|sz|tc|td|tf|tg|th|tj|tk|tm|tn|to|tp|tr|tt|tv|tw|tz|ua|ug|uk|um|us|uy|uz|va|vc|ve|vg|vi|vn|vu|wf|ws|ye|yt|yu|za|zm|zw|aero|biz|com|coop|info|museum|name|org|pro|gov|edu|mil|int';
135
136 $str =~ s,([^$urlchars]|\A)([\w.-]+\.)($tlds)(:\d+)?(/[\w./?~%&=\#-]*)?([^$urlchars]|\Z),$1<A HREF="http://$2$3$4$5" TARGET="refwindow">$2$3$4$5</A>$6,gi;
137
138 return $str;
139 }
140
141 sub GUI_InitTemplateArgs($$)
142 {
143 my ($s, $args) = @_;
144 my $q = $s->{cgi};
145
146 my $refresh = NextRefresh();
147
148 $args->{DATABASE_DESC}=$g{db_database}{desc};
149
150 $args->{DOCUMENTATION_URL}=$g{conf}{documentation_url};
151 $args->{THEME}=$q->url_param('theme');
152
153 my $stripped_url = MakeURL($s->{url}, {
154 filterfirst_button => '',
155 search_button => '',
156 });
157 $args->{BOOKMARK_URL}=MakeURL($stripped_url, {
158 refresh => '',
159 });
160 $args->{REFRESH_URL}=MakeURL($stripped_url, {
161 refresh => $refresh,
162 });
163
164 my $logout_url = MakeURL($stripped_url, {
165 logout => 1,
166 refresh => '',
167 });
168 $args->{LOGOUT_URL}=$logout_url;
169
170 my $entry_url = MakeURL($stripped_url, {
171 id => '',
172 action => '',
173 orderby => '',
174 table => '',
175 offset => '',
176 filterfirst => '',
177 combo_filterfirst => '',
178 descending => '',
179 search_field => '',
180 search_value => '',
181 reedit_action => '',
182 reedit_data => '',
183 pearl=>'',
184 });
185 $args->{ENTRY_URL}=$entry_url;
186 $args->{REFRESH_ENTRY_URL}=MakeURL($entry_url, {
187 refresh => $refresh,
188 });
189 }
190
191 sub GUI_Header($$)
192 {
193 my ($s, $args) = @_;
194
195 $args->{ELEMENT}='header';
196 print Template($args);
197
198 $args->{ELEMENT}='header_table';
199 my $user = $args->{USER};
200
201 my $save_table = $args->{TABLE};
202
203 foreach my $t (@{$g{db_tables_list}}) {
204 next if $g{db_tables}{$t}{hide};
205 next if $g{db_tables}{$t}{report};
206 if(defined $g{db_tables}{$t}{acls}{$user} and
207 $g{db_tables}{$t}{acls}{$user} !~ /r/) { next; }
208 my $desc = $g{db_tables}{$t}{desc};
209 $desc =~ s/ /&nbsp;/g;
210 $args->{TABLE_TABLE}=$t;
211 $args->{TABLE_DESC}=$desc;
212 $args->{TABLE_URL}=MakeURL($args->{REFRESH_ENTRY_URL}, {
213 action => 'list',
214 table => $t,
215 });
216 print Template($args);
217 }
218 delete $args->{TABLE_DESC};
219 delete $args->{TABLE_URL};
220 $args->{TABLE} = $save_table;
221
222 $args->{ELEMENT}='header2';
223 print Template($args);
224
225 delete $args->{ELEMENT};
226
227 $s->{header_sent}=1;
228 }
229
230 sub GUI_Footer($)
231 {
232 my ($args) = @_;
233 $args->{ELEMENT}='footer';
234 print Template($args);
235 delete $args->{ELEMENT};
236 }
237
238
239 sub GUI_Edit_Error($$$$$$)
240 {
241 my ($s, $user, $str, $form_url, $data, $action) = @_;
242 my $q = $s->{cgi};
243
244 my %template_args = (
245 PAGE => 'edit_error',
246 USER => $user,
247 TITLE => 'Database Error',
248 ERROR => $str,
249 REEDIT_URL => MakeURL($form_url, {
250 action => 'reedit',
251 reedit_action => $action,
252 reedit_data => $data,
253 }),
254 );
255
256 GUI_InitTemplateArgs($s, \%template_args);
257 GUI_Header($s, \%template_args);
258
259 $template_args{ELEMENT}='edit_error';
260 print Template(\%template_args);
261
262 GUI_Footer(\%template_args);
263 exit;
264 }
265
266 sub GUI_CheckFormID($$)
267 {
268 my ($s, $user) = @_;
269 my $q = $s->{cgi};
270
271 my $next_url = $q->param('next_url');
272 my %template_args = (
273 PAGE => 'doubleform',
274 USER => $user,
275 TITLE => "Duplicate Form",
276 NEXT_URL => $next_url,
277 );
278
279 if(!DropUnique($s, $q->param('form_id'))) {
280 print $q->header;
281 GUI_InitTemplateArgs($s, \%template_args);
282 GUI_Header($s, \%template_args);
283 $template_args{ELEMENT}='doubleform';
284 print Template(\%template_args);
285 GUI_Footer(\%template_args);
286 exit;
287 }
288 }
289
290 sub GUI_Entry($$$)
291 {
292 my ($s, $user, $dbh) = @_;
293 my $q = $s->{cgi};
294
295 my $refresh = NextRefresh();
296
297 my %template_args = (
298 USER => $user,
299 TITLE => 'Entry',
300 PAGE => 'entry',
301 );
302
303 GUI_InitTemplateArgs($s, \%template_args);
304 GUI_Header($s, \%template_args);
305
306 $template_args{ELEMENT}='tables_list_header',
307 print Template(\%template_args);
308
309 $template_args{ELEMENT}='entrytable';
310 foreach my $t (@{$g{db_tables_list}}) {
311 next if $g{db_tables}{$t}{hide};
312 next if $g{db_tables}{$t}{report};
313 if(defined $g{db_tables}{$t}{acls}{$user} and
314 $g{db_tables}{$t}{acls}{$user} !~ /r/) { next; }
315 my $desc = $g{db_tables}{$t}{desc};
316 $desc =~ s/ /&nbsp;/g;
317 $template_args{TABLE_DESC}=$desc;
318 $template_args{TABLE_URL}= MakeURL($s->{url}, {
319 action => 'list',
320 table => $t,
321 refresh => $refresh,
322 });
323 print Template(\%template_args);
324 }
325 delete $template_args{TABLE_DESC};
326 delete $template_args{TABLE_URL};
327
328 $template_args{ELEMENT}='reports_list_header';
329 print Template(\%template_args);
330
331 $template_args{ELEMENT}='entrytable';
332 foreach my $t (@{$g{db_tables_list}}) {
333 next if $g{db_tables}{$t}{hide};
334 next unless $g{db_tables}{$t}{report};
335 if(defined $g{db_tables}{$t}{acls}{$user} and
336 $g{db_tables}{$t}{acls}{$user} !~ /r/) { next; }
337 my $desc = $g{db_tables}{$t}{desc};
338 $desc =~ s/ /&nbsp;/g;
339 $template_args{TABLE_DESC}=$desc;
340 $template_args{TABLE_URL}= MakeURL($s->{url}, {
341 action => 'list',
342 table => $t,
343 refresh => $refresh,
344 });
345 $template_args{REPORT}=1;
346 print Template(\%template_args);
347 }
348
349 if(defined $g{pearls} and scalar %{$g{pearls}}) {
350 $template_args{ELEMENT}='pearls_list_header';
351 print Template(\%template_args);
352
353 $template_args{ELEMENT}='entrytable';
354 foreach my $t (sort {$a cmp $b} keys %{$g{pearls}}) {
355 if (ref $g{pearls}{$t}) {
356 @template_args{qw(TABLE_DESC TABLE_INFO)}=($g{pearls}{$t}->info);
357 $template_args{TABLE_URL}= MakeURL($s->{url}, {
358 action => 'configpearl',
359 pearl=> $t,
360 table => undef,
361 refresh => $refresh,
362 });
363 } else {
364 $template_args{REPORT}=1;
365 @template_args{qw(TABLE_DESC TABLE_INFO)}=($t,$g{pearls}{$t});
366 $template_args{TABLE_URL}= MakeURL($s->{url}, {
367 action => 'entry',
368 pearl=> $t,
369 table => undef,
370 refresh => $refresh,
371 });
372 $template_args{REPORT}=1;
373 }
374 print Template(\%template_args);
375 }
376 }
377
378 GUI_Footer(\%template_args);
379 }
380
381 sub GUI_FilterFirst($$$$)
382 {
383 my $s = shift;
384 my $q = $s->{cgi};
385 my $dbh = shift;
386 my $view = shift;
387 my $template_args = shift;
388 my $myurl = MyURL($q);
389 my $ff_field = $g{db_tables}{$view}{meta}{filterfirst};
390 my $ff_value = $q->url_param('filterfirst') ||
391 $q->url_param('combo_filterfirst') || '';
392
393 defined $ff_field or return undef;
394
395 my $ff_ref = $g{db_fields}{$view}{$ff_field}{reference};
396 my $ff_combo_name = "${ff_ref}_combo" unless not defined $ff_ref;
397
398 if(!defined $ff_ref or !defined $g{db_tables}{$ff_combo_name}) {
399 die "combo not found for $ff_field (reference: ${ff_ref})";
400 }
401
402 my $ff_combo = GUI_MakeCombo($dbh, $ff_combo_name, "combo_filterfirst", $ff_value);
403
404 # ID->HID: if referenced table has a hid, assume the hid is shown in
405 # this view and search that instead. In Gedafe 1.0 mode, the
406 # combo-boxes always referenced the hid, so it is already done
407 if($g{conf}{gedafe_compat} ne '1.0') {
408 if(defined $g{db_fields}{$ff_ref}{"${ff_ref}_hid"}) {
409 $ff_value = DB_ID2HID($dbh,$ff_ref,$ff_value);
410 }
411 }
412
413 my $ff_hidden = '';
414 foreach($q->url_param) {
415 next if /^filterfirst/;
416 next if /button$/;
417 $ff_hidden .= "<INPUT TYPE=\"hidden\" NAME=\"$_\" VALUE=\"".$q->url_param($_)."\">\n";
418 }
419 $template_args->{ELEMENT}='filterfirst';
420 $template_args->{FILTERFIRST_FIELD}=$ff_field;
421 $template_args->{FILTERFIRST_FIELD_DESC}=$g{db_fields}{$view}{$ff_field}{desc};
422 $template_args->{FILTERFIRST_COMBO}=$ff_combo;
423 $template_args->{FILTERFIRST_HIDDEN}=$ff_hidden;
424 $template_args->{FILTERFIRST_ACTION}=$q->url;
425 print Template($template_args);
426 delete $template_args->{ELEMENT};
427 delete $template_args->{FILTERFIRST_FIELD};
428 delete $template_args->{FILTERFIRST_FIELD_DESC};
429 delete $template_args->{FILTERFIRST_COMBO};
430 delete $template_args->{FILTERFIRST_HIDDEN};
431 delete $template_args->{FILTERFIRST_ACTION};
432
433 if($ff_value eq '') { $ff_value = undef; }
434
435 return ($ff_field, $ff_value);
436 }
437
438 sub GUI_Search($$$)
439 {
440 my $s = shift;
441 my $q = $s->{cgi};
442 my $view = shift;
443 my $template_args = shift;
444 my $search_field = $q->url_param('search_field') || '';
445 my $search_value = $q->url_param('search_value') || '';
446
447 $search_field =~ s/^\s*//; $search_field =~ s/\s*$//;
448 $search_value =~ s/^\s*//; $search_value =~ s/\s*$//;
449 my $fields = $g{db_fields}{$view};
450 my $search_combo = "<SELECT name=\"search_field\" SIZE=\"1\">\n";
451 foreach(@{$g{db_fields_list}{$view}}) {
452 next if /${view}_id/;
453 if(/^$search_field$/) {
454 $search_combo .= "<OPTION SELECTED VALUE=\"$_\">$fields->{$_}{desc}</OPTION>\n";
455 }
456 else {
457 $search_combo .= "<OPTION VALUE=\"$_\">$fields->{$_}{desc}</OPTION>\n";
458 }
459 }
460 $search_combo .= "</SELECT>\n";
461 my $search_hidden = '';
462 foreach($q->url_param) {
463 next if /^search/;
464 next if /^button/;
465 next if /^offset$/;
466 $search_hidden .= "<INPUT TYPE=\"hidden\" NAME=\"$_\" VALUE=\"".$q->url_param($_)."\">\n";
467 }
468 $template_args->{ELEMENT} = 'search';
469 $template_args->{SEARCH_ACTION} = $q->url;
470 $template_args->{SEARCH_COMBO} = $search_combo;
471 $template_args->{SEARCH_HIDDEN} = $search_hidden;
472 $template_args->{SEARCH_VALUE} = $search_value;
473 $template_args->{SEARCH_SHOWALL} = MakeURL(MyURL($q), { search_value=>'', search_button=>'', search_field=>'' });
474 print Template($template_args);
475 delete $template_args->{ELEMENT};
476 delete $template_args->{SEARCH_ACTION};
477 delete $template_args->{SEARCH_COMBO};
478 delete $template_args->{SEARCH_HIDDEN};
479 delete $template_args->{SEARCH_VALUE};
480 delete $template_args->{SEARCH_SHOWALL};
481
482 # search date = TODAY
483 if($search_field ne '') {
484 if($g{db_fields}{$view}{$search_field}{type} eq 'date') {
485 if($search_value =~ /^today$/i) {
486 $search_value = POSIX::strftime("%Y-%m-%d", localtime);
487 }
488 elsif($search_value =~ /^yesterday$/i) {
489 my $time = time;
490 $time -= 3600 * 24;
491 $search_value = POSIX::strftime("%Y-%m-%d", localtime($time));
492 }
493 }
494 }
495
496 return ($search_field, $search_value);
497 }
498
499 sub GUI_EditLink($$$$)
500 {
501 my ($s, $template_args, $list, $row) = @_;
502 my $edit_url;
503 $edit_url = MakeURL($s->{url}, {
504 action=>'edit',
505 id=>$row->[0],
506 refresh=>NextRefresh,
507 });
508 $template_args->{ELEMENT}='td_edit';
509 $template_args->{EDIT_URL}=$edit_url;
510 print Template($template_args);
511 delete $template_args->{EDIT_URL};
512 }
513
514 sub GUI_DeleteLink($$$$)
515 {
516 my ($s, $template_args, $list, $row) = @_;
517 my $delete_url;
518 $delete_url = MakeURL($s->{url}, {
519 action=>'delete',
520 id=>$row->[0],
521 refresh=>NextRefresh,
522 });
523 $template_args->{ELEMENT}='td_delete';
524 $template_args->{DELETE_URL}=$delete_url;
525 print Template($template_args);
526 delete $template_args->{DELETE_URL};
527 }
528
529 sub GUI_ListTable($$$)
530 {
531 my ($s, $list, $page) = @_;
532
533 # user can edit only if they have sql UPDATE privilege, and
534 # this table is a real table, not a report (view)
535 my $can_edit = ($list->{acl} =~ /w/ and !$list->{is_report});
536 my $can_delete = $can_edit;
537
538 my %template_args = (
539 USER => $s->{user},
540 PAGE => $page,
541 URL => $s->{url},
542 TABLE => $list->{spec}{view},
543 TITLE => "$g{db_tables}{$list->{spec}{table}}{desc}",
544 ORDERBY => $list->{spec}{orderby},
545 );
546
547 # <TABLE>
548 $template_args{ELEMENT}='table';
549
550 # total number of records in result set
551 $template_args{NUM_RECORDS} = $list->{totalrecords}
552 if $g{conf}{show_row_count};
553
554 print Template(\%template_args);
555 $s->{in_table}=1; # die will put a </TABLE>
556
557 # header
558 $template_args{ELEMENT}='tr';
559 print Template(\%template_args);
560 for my $c (@{$list->{columns}}) {
561 next if $c->{hide_list};
562 my $sort_url;
563 if($list->{spec}{orderby} eq $c->{field}) {
564 my $d = $list->{spec}{descending} ? '' : 1;
565 $sort_url = MakeURL($s->{url}, { descending => $d });
566 }
567 else {
568 $sort_url = MakeURL($s->{url}, { orderby => "$c->{field}", descending=>'' });
569 }
570
571 $template_args{ELEMENT}='th';
572 $template_args{DATA}=$c->{desc};
573 $template_args{FIELD}=$c->{field};
574 $template_args{SORT_URL}=$sort_url;
575 print Template(\%template_args);
576 }
577 delete $template_args{DATA};
578 delete $template_args{FIELD};
579 delete $template_args{SORT_URL};
580 if($can_edit) {
581 $template_args{ELEMENT}='th_edit';
582 print Template(\%template_args);
583 }
584 if($can_delete) {
585 $template_args{ELEMENT}='th_delete';
586 print Template(\%template_args);
587 }
588 $template_args{ELEMENT}='xtr';
589 print Template(\%template_args);
590
591 # data
592 $list->{displayed_recs} = 0;
593 for my $row (@{$list->{data}}) {
594 $list->{displayed_recs}++;
595 if($list->{displayed_recs}%2) { $template_args{EVENROW}=1; }
596 else { $template_args{ODDROW}=1; }
597
598 $template_args{ELEMENT}='tr';
599 print Template(\%template_args);
600 my $column_number = 0;
601 for my $d (@{$row->[1]}) {
602 my $c = $list->{columns}[$column_number];
603 $column_number++;
604 next if $c->{hide_list};
605 if($c->{type} eq 'bytea' && $d ne '&nbsp;'){
606 my $bloburl = MakeURL($s->{url}, {
607 table => $list->{spec}{view},
608 action => 'dumpblob',
609 id => $row->[0],
610 field => $c->{field},
611 });
612 $d = qq{<A HREF="$bloburl" TARGET="_blank">$d</A>};
613 }
614 my $align = $c->{align};
615 defined $align or $align = $numeric_types{$c->{type}} ?
616 '"RIGHT" NOWRAP' : '"LEFT"' unless defined $align;
617 $template_args{ALIGN}=$align;
618 $template_args{ELEMENT}='td';
619 $template_args{DATA}=$d;
620 $template_args{MARKUP}=GUI_HTMLMarkup($d) if $d and $c->{markup};
621 print Template(\%template_args);
622 }
623 delete $template_args{DATA};
624 delete $template_args{ALIGN};
625 delete $template_args{MARKUP};
626
627 $template_args{ID} = $row->[0];
628 GUI_EditLink($s, \%template_args, $list, $row) if $can_edit;
629 GUI_DeleteLink($s, \%template_args, $list, $row) if $can_delete;
630 delete $template_args{ID};
631
632 $template_args{ELEMENT}='xtr';
633 print Template(\%template_args);
634
635 if($list->{displayed_recs}%2) {delete $template_args{EVENROW};}
636 else {delete $template_args{ODDROW};}
637 }
638
639 # </TABLE>
640 $template_args{ELEMENT}='xtable';
641 print Template(\%template_args);
642 $s->{in_table}=0;
643 }
644
645 sub GUI_ListButtons($$$$)
646 {
647 my ($s, $list, $page, $position) = @_;
648
649 my %template_args = (
650 USER => $s->{user},
651 PAGE => $page,
652 URL => $s->{url},
653 TABLE => $list->{spec}{view},
654 TITLE => "$g{db_tables}{$list->{spec}{table}}{desc}",
655 TOP => $position eq 'top',
656 BOTTOM => $position eq 'bottom',
657 IS_REPORT => $list->{is_report}
658 );
659
660 my $next_refresh = NextRefresh;
661
662 my $nextoffset = $list->{spec}{offset}+$list->{spec}{limit};
663 my $prevoffset = $list->{spec}{offset}-$list->{spec}{limit};
664 $prevoffset > 0 or $prevoffset = '';
665
666 my $can_add = ($list->{acl} =~ /a/);
667 my $add_url = $can_add ? MakeURL($s->{url}, {
668 action => 'add',
669 refresh => $next_refresh,
670 }) : undef;
671
672 my $prev_url = $list->{spec}{offset} != 0 ? MakeURL($s->{url},
673 { offset => $prevoffset }) : undef;
674 my $next_url = $list->{end} ? undef :
675 MakeURL($s->{url}, { offset => $nextoffset });
676
677 $template_args{ELEMENT}='buttons';
678 $template_args{ADD_URL}=$add_url;
679 $template_args{PREV_URL}=$prev_url;
680 $template_args{NEXT_URL}=$next_url;
681
682 # calculate correct offset for last page of results
683 if ($g{conf}{show_row_count}) {
684 my $totalrecs = $template_args{NUM_RECORDS} = $list->{totalrecords};
685 my $lastoffset =
686 ($totalrecs % $list->{spec}{limit} == 0
687 ? $totalrecs - $list->{spec}{limit}
688 : $totalrecs - ($totalrecs % $list->{spec}{limit}));
689 my $first_url =
690 ($prev_url && $prevoffset ne ''
691 ? MakeURL($s->{url}, { offset => '' }) : undef);
692 my $last_url =
693 ($next_url && $nextoffset != $lastoffset
694 ? MakeURL($s->{url}, { offset => $lastoffset }) : undef);
695 $template_args{START_RECNUM}=
696 ($list->{spec}{offset}+1 > $totalrecs
697 ? $totalrecs
698 : $list->{spec}{offset}+1);
699 $template_args{END_RECNUM}=
700 ($list->{spec}{offset}+$#{$list->{data}}+1 > $totalrecs
701 ? $totalrecs
702 : $list->{spec}{offset}+$#{$list->{data}}+1);
703 $template_args{FIRST_URL}=$first_url;
704 $template_args{LAST_URL}=$last_url;
705 }
706
707 print Template(\%template_args);
708 }
709
710 sub GUI_List($$$)
711 {
712 my ($s, $user, $dbh) = @_;
713 my $q = $s->{cgi};
714 my $table = $q->url_param('table');
715
716 my %template_args = (
717 USER => $user,
718 PAGE => 'list',
719 URL => $s->{url},
720 TABLE => $table,
721 TITLE => "$g{db_tables}{$table}{desc}",
722 EXPORT_AS_CHOICE => $#exp_fmt_choices > 0,
723 EXPORT_CHOICES => "<SELECT NAME=\"export_format\">\n".join("\n", map { "<OPTION VALUE=\"$_\">$exp_fmt_choices{$_}</OPTION>" } @exp_fmt_choices).'</SELECT>',
724 EXPORT_URL => MakeURL(MyURL($q), { action => 'export' }),
725 );
726
727 # header
728 GUI_InitTemplateArgs($s, \%template_args);
729 GUI_Header($s, \%template_args);
730
731 # build list-spec
732 my %spec = (
733 table => $table,
734 view => defined $g{db_tables}{"${table}_list"} ?
735 "${table}_list" : $table,
736 offset => $q->url_param('offset') || 0,
737 limit => $q->url_param('list_rows') || $g{conf}{list_rows},
738 orderby => $q->url_param('orderby') || '',
739 descending => $q->url_param('descending') || 0,
740 );
741
742 # filterfirst
743 ($spec{filter_field}, $spec{filter_value}) =
744 GUI_FilterFirst($s, $dbh, $spec{view}, \%template_args);
745
746 # search
747 ($spec{search_field}, $spec{search_value}) =
748 GUI_Search($s, $spec{view}, \%template_args);
749
750 # fetch list
751 my $list = DB_FetchList($s, \%spec);
752
753 # get total number of records for this search set
754 $list->{totalrecords} = DB_GetNumRecords($s, \%spec)
755 if $g{conf}{show_row_count};
756
757 # is it a report (read-only)?
758 $list->{is_report} = 1 if $g{db_tables}{$table}{report};
759
760 my $list_buttons = $g{conf}{list_buttons} || 'both';
761
762 # top buttons
763 if($list_buttons eq 'top' or $list_buttons eq 'both'){
764 GUI_ListButtons($s, $list, 'list', 'top');
765 }
766
767 # display table
768 GUI_ListTable($s, $list, 'list');
769
770 # bottom buttons
771 if($list_buttons eq 'bottom' or $list_buttons eq 'both'){
772 GUI_ListButtons($s, $list, 'list', 'bottom');
773 }
774 delete $list->{displayed_recs};
775 delete $list->{totalrecords} if $g{conf}{show_row_count};
776
777 # footer
778 GUI_Footer(\%template_args);
779 }
780
781 sub GUI_ExportData($$)
782 {
783 my ($s, $list) = @_;
784 my $q = $s->{cgi};
785
786 # decide what export format to use: 'csv' only if Text::CSV_XS loaded
787 my $exp_fmt = ref $csv && $q->param('export_format') eq 'csv' ? 'csv' : 'tsv';
788
789 # print HTTP Content-type header
790 if ($exp_fmt eq 'csv') {
791 print $q->header(-type=>'text/csv',
792 -attachment=>$list->{spec}{table}.'.csv',
793 -expires=>'-1d');
794 } else {
795 print $q->header(-type=>'text/tab-separated-values',
796 -attachment=>$list->{spec}{table}.'.tsv',
797 -expires=>'-1d');
798 }
799
800 # fields
801 my $fields = $g{db_fields}{$list->{spec}{view}};
802 if ($exp_fmt eq 'csv') {
803 my $status = $csv->combine(map {$fields->{$_}{desc}} @{$list->{fields}});
804 print $csv->string(). "\n";
805 } else {
806 print join("\t", map {$fields->{$_}{desc}} @{$list->{fields}})."\n";
807 }
808
809 # data
810 for my $row (@{$list->{data}}) {
811 # if correct module is loaded and user selected 'CSV'
812 if ($exp_fmt eq 'csv') {
813 my $status = $csv->combine(@{$row->[1]});
814 print $csv->string() . "\n";
815 } else {
816 print join("\t", map {
817 my $str = defined $_ ? $_ : '';
818 $str=~s/\t/ /g;
819 $str=~s/\n/\r/g;
820 $str;
821 } @{$row->[1]})."\n";
822 }
823 }
824 }
825
826 sub GUI_Export($$$)
827 {
828 my ($s, $user, $dbh) = @_;
829 my $q = $s->{cgi};
830 my $table = $q->url_param('table');
831
832 my %template_args = (
833 USER => $user,
834 PAGE => 'export',
835 URL => $s->{url},
836 TABLE => $table,
837 TITLE => "$g{db_tables}{$table}{desc}",
838 );
839
840 # build list-spec
841 my %spec = (
842 table => $table,
843 view => defined $g{db_tables}{"${table}_list"} ?
844 "${table}_list" : $table,
845 orderby => $q->url_param('orderby') || '',
846 descending => $q->url_param('descending') || 0,
847 export => 1,
848 );
849
850 # get search params
851 $spec{search_field} = $q->url_param('search_field') || '';
852 $spec{search_value} = $q->url_param('search_value') || '';
853 $spec{search_field} =~ s/^\s*//; $spec{search_field} =~ s/\s*$//;
854 $spec{search_value} =~ s/^\s*//; $spec{search_value} =~ s/\s*$//;
855
856 # fetch list
857 my $list = DB_FetchList($s, \%spec);
858
859 GUI_ExportData($s, $list);
860 }
861
862 # CGI.pm already encodes/decodes parameters, but we want to do it ourselves
863 # since we need to differentiate for example in reedit_data between a comma
864 # as value and a comma as separator. Therefore we use the escape '!' instead
865 # of '%'.
866 sub GUI_URL_Encode($)
867 {
868 my ($str) = @_;
869 defined $str or $str = '';
870 $str =~ s/!/gedafe_PROTECTED_eXclamatiOn/g;
871 $str =~ s/\W/'!'.sprintf('%2X',ord($&))/eg;
872 $str =~ s/gedafe_PROTECTED_eXclamatiOn/'!'.sprintf('%2X',ord('!'))/eg;
873 return $str;
874 }
875
876 sub GUI_URL_Decode($)
877 {
878 my ($str) = @_;
879 $str =~ s/!([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
880 return $str;
881 }
882
883 sub GUI_Hash2Str($)
884 {
885 my ($record) = @_;
886 my @data = ();
887 for my $f (keys %$record) {
888 my $d = GUI_URL_Encode($record->{$f});
889 push @data, "$f:$d";
890 }
891 return join(',', @data);
892 }
893
894 sub GUI_Str2Hash($$)
895 {
896 my ($str, $hash) = @_;
897 for my $s (split(/,/, $str)) {
898 if($s =~ /^(.*?):(.*)$/) {
899 $hash->{$1} = GUI_URL_Decode($2);
900 }
901 }
902 }
903
904 sub GUI_WidgetRead($$$)
905 {
906 my ($s, $input_name, $widget) = @_;
907 my $q = $s->{cgi};
908 my $dbh = $s->{dbh};
909
910 my ($w, $warg) = DB_ParseWidget($widget);
911
912 my $value = $q->param($input_name);
913
914 if($w eq 'file'){
915 my $file = $value;
916 my $deletefile = $q->param("file_delete_$input_name");
917 if($deletefile) {
918 $value="";
919 }
920 else {
921 if($file) {
922 my $filename = scalar $file;
923 $filename =~ s/ /_/g;
924 $filename =~ /([\w\d\.]+$)/;
925 $filename = $1;
926 my $mimetype = $q->uploadInfo($file)->{'Content-Type'};
927 my $blob=$filename.' '.$mimetype.'#';
928 my $buffer;
929 while(read($file,$buffer,1024)){
930 $blob .=$buffer;
931 }
932 #note that value is set to a reference to the large blob
933 $value=\$blob;
934 }
935 else {
936 #when we are here the file field has not been set
937 $value = undef;
938 }
939 }
940 }
941 if($w eq 'hid' or $w eq 'hidcombo' or $w eq 'hidisearch') {
942 if(defined $value and $value !~ /^\s*$/) {
943 $value=DB_HID2ID($dbh,$warg->{'ref'},$value);
944 }
945 }
946 # if it's a combo and no value was specified in the text field...
947 if($w eq 'idcombo' or $w eq 'hidcombo' or $w eq 'combo') {
948 if(not defined $value or $value =~ /^\s*$/) {
949 $value = $q->param("${input_name}_combo");
950 if($w eq 'hidcombo' and $g{conf}{gedafe_compat} eq '1.0')
951 {
952 # hidcombos in 1.0 had to put the HID as key...
953 $value = DB_HID2ID($dbh,$warg->{'ref'},$value);
954 }
955 }
956 }
957
958 return $value;
959 }
960
961 sub GUI_PostEdit($$$)
962 {
963 my ($s, $user, $dbh) = @_;
964 my $q = $s->{cgi};
965 my $action = $q->param('post_action');
966 if(not defined $action) { return; }
967
968 if(defined $q->param('button_cancel')) { return; }
969
970 my $table = $q->url_param('table');
971
972 ## delete
973 if($action eq 'delete') {
974 if(!DB_DeleteRecord($dbh,$table,$q->param('id'))) {
975 my %template_args = (
976 PAGE => 'db_error',
977 USER => $user,
978 TITLE => 'Database Error'
979 );
980 GUI_InitTemplateArgs($s, \%template_args);
981 GUI_Header($s, \%template_args);
982 $template_args{ELEMENT}='db_error';
983 $template_args{ERROR}=$g{db_error};
984 $template_args{NEXT_URL}=MyURL($q);
985 print Template(\%template_args);
986 GUI_Footer(\%template_args);
987 exit;
988 }
989 }
990
991
992 ## add or edit:
993 my %record;
994 if($action eq 'add' || $action eq 'edit'){
995 for my $field (@{$g{db_fields_list}{$table}}) {
996 my $value = GUI_WidgetRead($s, "field_$field", $g{db_fields}{$table}{$field}{widget});
997 if(defined $value) {
998 $record{$field} = $value;
999 }
1000 }
1001 }
1002 if($action eq 'add') {
1003 if(!DB_AddRecord($dbh,$table,\%record)) {
1004 my $data = GUI_Hash2Str(\%record);
1005 GUI_Edit_Error($s, $user, $g{db_error},
1006 $q->param('form_url'), $data, $action);
1007 }
1008 }
1009 elsif($action eq 'edit') {
1010 $record{id} = $q->param('id');
1011 if(!DB_UpdateRecord($dbh,$table,\%record)) {
1012 my $data = GUI_Hash2Str(\%record);
1013 GUI_Edit_Error($s, $user, $g{db_error},
1014 $q->param('form_url'), $data, $action);
1015 }
1016 }
1017 }
1018
1019 sub GUI_Edit($$$)
1020 {
1021 my ($s, $user, $dbh) = @_;
1022 my $q = $s->{cgi};
1023 my $action = $q->url_param('action');
1024 my $table = $q->url_param('table');
1025 my $id = $q->url_param('id');
1026
1027 my $reedit = undef;
1028 if($action eq 'reedit') {
1029 $reedit = 1;
1030 $action = $q->url_param('reedit_action');
1031 }
1032
1033 if(not exists $g{db_tables}{$table}) {
1034 die "Error: no such table ($table)";
1035 }
1036
1037 my $title = $g{db_tables}{$table}{desc};
1038 $title =~ s/s\s*$//; # very rough :-)
1039 $title =~ s/^. //;
1040 my %template_args = (
1041 USER => $user,
1042 PAGE => 'edit',
1043 TABLE => $table,
1044 TITLE => $action eq 'add' ? "New $title" : "Edit $title",
1045 ACTION => $action,
1046 ID => $id,
1047 REEDIT => $reedit,
1048 );
1049
1050 my $form_url = MakeURL($s->{url}, { refresh => NextRefresh() });
1051 my $next_url;
1052 my $cancel_url = MakeURL($form_url, {
1053 action => 'list',
1054 id => '',
1055 reedit_action => '',
1056 reedit_data => '',
1057 });
1058 if($action eq 'add') {
1059 $next_url = MakeURL($form_url, {
1060 action => $action,
1061 reedit_action => '',
1062 reedit_data => '',
1063 });
1064 }
1065 else {
1066 $next_url = $cancel_url;
1067 }
1068
1069 GUI_InitTemplateArgs($s, \%template_args);
1070 GUI_Header($s, \%template_args);
1071
1072 # FORM
1073 UniqueFormStart($s, $next_url);
1074 print "<INPUT TYPE=\"hidden\" NAME=\"post_action\" VALUE=\"$action\">\n";
1075
1076 # Initialise values
1077 my $fields = $g{db_fields}{$table};
1078 my @fields_list = @{$g{db_fields_list}{$table}};
1079 my %values = ();
1080 if($reedit) {
1081 GUI_Str2Hash($q->param('reedit_data'), \%values);
1082 }
1083 elsif($action eq 'edit') {
1084 my %record = ();
1085 DB_GetRecord($dbh,$table,$id,\%values);
1086 }
1087 elsif($action eq 'add') {
1088 # take filterfirst value if set
1089 my $ff_field = $g{db_tables}{$table}{meta}{filterfirst};
1090 my $ff_value = $q->url_param('filterfirst') || $q->url_param('combo_filterfirst') || '';
1091 if(defined $ff_value and defined $ff_field) {
1092 if(defined $g{db_fields}{$table}{$ff_field}{ref_hid}) {
1093 # convert ID reference to HID
1094 $values{$ff_field} = DB_ID2HID($dbh, $g{db_fields}{$table}{$ff_field}{reference}, $ff_value);
1095 }
1096 }
1097 # copy fields from previous add form
1098 for my $field (@fields_list) {
1099 if($g{db_fields}{$table}{$field}{copy}) {
1100 # FIXME: find out how this works with files.
1101 # I think we don't want to copy a file.
1102 my $v = GUI_WidgetRead($s, "field_$field", $g{db_fields}{$table}{$field}{widget});
1103 $values{$field} = $v if defined $v;
1104 }
1105 }
1106 }
1107
1108 if($action eq 'edit') {
1109 print "<INPUT TYPE=\"hidden\" NAME=\"id\" VALUE=\"$id\">\n";
1110 }
1111
1112 # Fields
1113 $template_args{ELEMENT} = 'editform_header';
1114 print Template(\%template_args);
1115
1116 my $field;
1117 my $n=0;
1118 foreach $field (@fields_list) {
1119 if($field eq "${table}_id") { next; }
1120
1121 my $value = exists $values{$field} ? $values{$field} : '';
1122 # get default from DB
1123 if(not defined $value or $value eq '') {
1124 $value = DB_GetDefault($dbh,$table,$field);
1125 }
1126
1127 my $inputelem = GUI_WidgetWrite($s, "field_$field", $fields->{$field}{widget},$value);
1128
1129 $template_args{ELEMENT} = 'editfield';
1130 $template_args{FIELD} = $field;
1131 $template_args{LABEL} = $fields->{$field}{desc};
1132 $template_args{INPUT} = $inputelem,
1133 $template_args{TWOCOL} = $n%2;
1134 print Template(\%template_args);
1135 $n++;
1136 }
1137 delete $template_args{FIELD};
1138 delete $template_args{LABEL};
1139 delete $template_args{INPUT};
1140
1141 # Fields
1142 $template_args{ELEMENT} = 'editform_footer';
1143 print Template(\%template_args);
1144
1145 # Buttons
1146 $template_args{ELEMENT} = 'buttons';
1147 $template_args{CANCEL_URL} = $cancel_url;
1148 print Template(\%template_args);
1149
1150 UniqueFormEnd($s, $form_url, $next_url);
1151 GUI_Footer(\%template_args);
1152 }
1153
1154 sub GUI_Pearl($)
1155 {
1156 my $s = shift;
1157 my $dbh = $s->{dbh};
1158 my $user = $s->{user};
1159 my $q = $s->{cgi};
1160 my $pearl = $q->url_param('pearl');
1161
1162 if(not exists $g{pearls}{$pearl}) {
1163 die "Error: pearl named $pearl is known";
1164 }
1165 my $p = $g{pearls}{$pearl};
1166
1167 my $title = ($p->info())[0];
1168 my %template_args = (
1169 USER => $user,
1170 PAGE => 'edit',
1171 TABLE => '',
1172 TITLE => "Configure $title",
1173 BUTTON_LABEL => 'Run Report',
1174 );
1175
1176 my $form_url = MakeURL(MyURL($q),{});
1177 my $cancel_url = MakeURL($form_url, {
1178 action => 'entry'});
1179
1180 my $next_url = $form_url;
1181
1182 GUI_InitTemplateArgs($s, \%template_args);
1183 GUI_Header($s, \%template_args);
1184
1185 # FORM
1186 FormStart($s, $next_url);
1187 print "<INPUT TYPE=\"hidden\" NAME=\"action\" VALUE=\"runpearl\">\n";
1188 print "<INPUT TYPE=\"hidden\" NAME=\"pearl\" VALUE=\"$pearl\">\n";
1189 # Fields
1190 $template_args{ELEMENT} = 'editform_header';
1191 print Template(\%template_args);
1192
1193 my $field;
1194 my $n;
1195 for (@{$g{pearls}{$pearl}->template()}){
1196 my ($field,$label,$widget,$value,$test) = @$_;
1197 my $inputelem = GUI_WidgetWrite($s,"field_$field",$widget,$value);
1198
1199 $template_args{ELEMENT} = 'editfield';
1200 $template_args{FIELD} = $field;
1201 $template_args{LABEL} = $label;
1202 $template_args{INPUT} = $inputelem,
1203 $template_args{TWOCOL} = $n%2;
1204 print Template(\%template_args);
1205 $n++;
1206 }
1207 delete $template_args{FIELD};
1208 delete $template_args{LABEL};
1209 delete $template_args{INPUT};
1210
1211 # Fields
1212 $template_args{ELEMENT} = 'editform_footer';
1213 print Template(\%template_args);
1214
1215 # Buttons
1216 $template_args{ELEMENT} = 'buttons';
1217 $template_args{CANCEL_URL} = $cancel_url;
1218 print Template(\%template_args);
1219
1220 FormEnd($s);
1221 GUI_Footer(\%template_args);
1222 }
1223
1224 sub GUI_MakeCombo($$$$)
1225 {
1226 my ($dbh, $combo_view, $name, $value) = @_;
1227
1228 $value =~ s/^\s+//;
1229 $value =~ s/\s+$//;
1230
1231 my $str;
1232
1233 my @combo;
1234 if(not defined DB_GetCombo($dbh,$combo_view,\@combo)) {
1235 return undef;
1236 }
1237
1238 $str = "<SELECT SIZE=\"1\" name=\"$name\">\n";
1239 # the empty option must not be empty! else the MORE ... disapears off screen
1240 $str .= "<OPTION VALUE=\"\">Make your Choice ...</OPTION>\n";
1241 foreach(@combo) {
1242 my $id = $_->[0];
1243 $id=~s/^\s+//; $id=~s/\s+$//;
1244 #my $text = "$_->[0] -- $_->[1]";
1245 my $text = $_->[1];
1246 if($value eq $id) {
1247 $str .= "<OPTION SELECTED VALUE=\"$id\">$text</OPTION>\n";
1248 }
1249 else {
1250 $str .= "<OPTION VALUE=\"$id\">$text</OPTION>\n";
1251 }
1252 }
1253 $str .= "</SELECT>\n";
1254 return $str;
1255 }
1256
1257 sub GUI_MakeISearch($$$$$$)
1258 {
1259 my $ref_target = shift;
1260 my $input_name = shift;
1261 my $ticket = shift;
1262 my $myurl = shift;
1263 my $value = shift;
1264 my $hidisearch = shift;
1265
1266 $value =~ s/^\s+//;
1267 $value =~ s/\s+$//;
1268
1269
1270 my $targeturl = MakeURL($myurl,{action=>'dumptable',table=>$ref_target,ticket=>$ticket});
1271
1272 my $html;
1273 $html .= "<input type=\"button\" onclick=\"";
1274 $html .= "document.editform.$input_name.value=document.isearch_$input_name.getID('$value')";
1275 $html .= ";\" value=\"I-Search\">&nbsp;";
1276 $html .= "<applet id=\"isearch_$input_name\" name=\"isearch_$input_name\"";
1277 $html .= ' code="ISearch.class" width="70" height="20" archive="'.$g{conf}{isearch}.'">'."\n";
1278 $html .= GUI_AppletParam("url",$targeturl);
1279 if($hidisearch){
1280 $html .= GUI_AppletParam("hid","true");
1281 }
1282 $html .= "</applet>\n";
1283
1284 return $html
1285 }
1286
1287 sub GUI_AppletParam($$){
1288 my $name=shift;
1289 my $value=shift;
1290 return "<param name=\"$name\" value=\"$value\">\n";
1291 }
1292
1293
1294
1295 sub GUI_WidgetWrite($$$$)
1296 {
1297 my ($s, $input_name, $widget, $value) = @_;
1298
1299 my $q = $s->{cgi};
1300 my $dbh = $s->{dbh};
1301 my $myurl = MyURL($q);
1302
1303 if(not defined $value) { $value = ''; }
1304
1305 my ($w, $warg) = DB_ParseWidget($widget);
1306
1307 my $escval = $value;
1308 $escval =~ s/\"/&quot;/g;
1309
1310 if($w eq 'readonly') {
1311 return $value || '&nbsp;';
1312 }
1313 elsif($w eq 'text') {
1314 my $size = defined $warg->{size} ? $warg->{size} : '20';
1315 return "<INPUT TYPE=\"text\" NAME=\"$input_name\" SIZE=\"$size\" VALUE=\"".$escval."\">";
1316 }
1317 elsif($w eq 'area') {
1318 my $rows = defined $warg->{rows} ? $warg->{rows} : '4';
1319 my $cols = defined $warg->{cols} ? $warg->{cols} : '60';
1320 return "<TEXTAREA NAME=\"$input_name\" ROWS=\"$rows\" COLS=\"$cols\" WRAP=\"virtual\">".$value."</TEXTAREA>";
1321 }
1322 elsif($w eq 'varchar') {
1323 my $size = defined $warg->{size} ? $warg->{size} : '20';
1324 my $maxlength = defined $warg->{maxlength} ? $warg->{maxlength} : '100';
1325 return "<INPUT TYPE=\"text\" NAME=\"$input_name\" SIZE=\"$size\" MAXLENGTH=\"$maxlength\" VALUE=\"$escval\">";
1326 }
1327 elsif($w eq 'checkbox') {
1328 return "<INPUT TYPE=\"checkbox\" NAME=\"$input_name\" VALUE=\"1\"".($value ? 'CHECKED' : '').">";
1329 }
1330 elsif($w eq 'hid') {
1331 return "<INPUT TYPE=\"text\" NAME=\"$input_name\" SIZE=\"10\" VALUE=\"".$escval."\">";
1332 }
1333 elsif($w eq 'isearch' or $w eq 'hidisearch') {
1334 my $out;
1335 my $hidisearch;
1336 $hidisearch = 0;
1337 if($w eq 'hidisearch') {
1338 # replace value with HID if 'hidcombo'
1339 $value = DB_ID2HID($dbh,$warg->{'ref'},$value);
1340 $hidisearch=1;
1341 }
1342
1343 my $combo = GUI_MakeISearch($warg->{'ref'}, $input_name,
1344 $s->{ticket_value}, $myurl, $value, $hidisearch);
1345
1346 $out.="<INPUT TYPE=\"text\" NAME=\"$input_name\" SIZE=10";
1347 $out .= " VALUE=\"$value\"";
1348 $out .= ">\n$combo";
1349 return $out;
1350 }
1351 elsif($w eq 'idcombo' or $w eq 'hidcombo') {
1352 my $out;
1353 my $combo;
1354
1355 if($g{conf}{gedafe_compat} eq '1.0') {
1356 $value = DB_ID2HID($dbh,$warg->{'ref'},$value) if $w eq 'hidcombo';
1357 $combo = GUI_MakeCombo($dbh, $warg->{'combo'}, "${input_name}_combo", $value);
1358 }
1359 else {
1360 $combo = GUI_MakeCombo($dbh, $warg->{'combo'}, "${input_name}_combo", $value);
1361 $value = DB_ID2HID($dbh,$warg->{'ref'},$value) if $w eq 'hidcombo';
1362 }
1363 $out .= "<INPUT TYPE=\"text\" NAME=\"$input_name\" SIZE=10";
1364 if($combo !~ /SELECTED/ and defined $value) {
1365 $out .= " VALUE=\"$value\"";
1366 }
1367 $out .= ">\n$combo";
1368 return $out;
1369 }
1370 elsif($w eq 'combo') {
1371 return GUI_MakeCombo($dbh, $warg->{'combo'}, "${input_name}_combo", $value);
1372 }
1373 elsif($w eq 'file'){
1374 my $filename = $value ne '' ? $value : "(none)";
1375 my $out = "Current file: <b>$filename</b>";
1376 if($value ne ''){
1377 $out .= "<br>Delete file?: <INPUT TYPE=\"checkbox\" NAME=\"file_delete_$input_name\">";
1378 }
1379 $out .= "<br>Enter filename to update.<br><INPUT TYPE=\"file\" NAME=\"$input_name\">";
1380 return $out;
1381 }
1382 elsif($w eq 'date') {
1383 return GUI_WidgetWrite_Date($input_name, $warg, $value);
1384 }
1385
1386 return "Unknown widget: $w";
1387 }
1388
1389 sub GUI_WidgetWrite_Date($$$)
1390 {
1391 my ($input_name, $warg, $value) = @_;
1392 my ($value_y, $value_m, $value_d) = (0, 0, 0);
1393 my $escval = $value; $escval =~ s/\"/&quot;/g;
1394
1395 my @months;
1396 if($warg->{short}) {
1397 @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
1398 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
1399 }
1400 else {
1401 @months = ("January", "February", "March", "April",
1402 "May", "June", "July", "August", "September",
1403 "October", "November", "December");
1404 }
1405
1406 my $yearselect = "<option>(year)</option>\n";
1407 my $dayselect = "<option>(day)</option>\n";
1408 my $monthselect = "<option>(month)</option>\n";
1409
1410 if($value =~ /(\d+)-(\d+)-(\d+)/) {
1411 ($value_y, $value_m, $value_d) = ($1, $2, $3);
1412 }
1413
1414 for my $y (($warg->{from})..($warg->{to})) {
1415 if ($y == $value_y) {
1416 $yearselect .= "<option selected>$y</option>\n";
1417 }
1418 else {
1419 $yearselect .= "<option>$y</option>\n";
1420 }
1421 }
1422 for my $m (0..11) {
1423 if ($m+1 == $value_m) {
1424 $monthselect .= "<option selected>$months[$m]</option>\n";
1425 }
1426 else {
1427 $monthselect .= "<option>$months[$m]</option>\n";
1428 }
1429 }
1430 for my $d (1..31) {
1431 if ($d == $value_d) {
1432 $dayselect .= "<option selected>$d</option>\n";
1433 }
1434 else {
1435 $dayselect .= "<option>$d</option>\n";
1436 }
1437 }
1438
1439 my $yearinput = $input_name.'_1';
1440 my $monthinput = $input_name.'_2';
1441 my $dayinput = $input_name.'_3';
1442 my $functionname = $input_name.'_validate';
1443 my $out =<<end;
1444 <SCRIPT LANGUAGE="JavaScript">
1445 <!--
1446 function $functionname(){
1447 var leap = 0;
1448
1449 //get variables from form
1450 var year = document.editform.$yearinput.selectedIndex;
1451 var month = document.editform.$monthinput.selectedIndex;
1452 var day = document.editform.$dayinput.selectedIndex;
1453
1454 // if year month or date are on the (first) empty field
1455 // then the date is invalid. Clear the field to reflect that.
1456 if(year == 0 || month == 0 || day == 0){
1457 document.editform.$input_name.value = "";
1458 return;
1459 }
1460
1461 year = $warg->{from} + year - 1;
1462
1463 // is this a leap year?
1464 if ((year % 4 == 0) && ((year % 100 != 0) || (year % 400 == 0))){
1465 leap = 1;
1466 }
1467
1468
1469 //update form to reflect corretions on date
1470 if ((month == 2) && (leap == 1) && (day > 29)){
1471 document.editform.$dayinput.selectedIndex = 29;
1472 day = 29;
1473 }
1474
1475 if ((month == 2) && (leap != 1) && (day > 28)){
1476 document.editform.$dayinput.selectedIndex = 28;
1477 day = 28;
1478 }
1479
1480 if ((day > 30) && ((month == 4) || (month == 6) || (month == 9) || (month == 11))){
1481 document.editform.$dayinput.selectedIndex = 30;
1482 day = 30;
1483 }
1484
1485
1486 var date = year + "-" + month + "-" + day;
1487
1488
1489 document.editform.$input_name.value = date;
1490 }
1491 // -->
1492 </script>
1493
1494 <select NAME="$yearinput" onChange="$functionname()">
1495 $yearselect</select>
1496
1497 <select NAME="$monthinput" onChange="$functionname()">
1498 $monthselect</select>
1499
1500 <select NAME="$dayinput" onChange="$functionname()">
1501 $dayselect</select>
1502
1503 <input TYPE="hidden" NAME="$input_name" VALUE="$escval">
1504 end
1505 return $out;
1506 }
1507
1508 sub GUI_Delete($$$)
1509 {
1510 my ($s, $user, $dbh) = @_;
1511 my $q = $s->{cgi};
1512 my $table = $q->url_param('table');
1513 my $id = $q->url_param('id');
1514 my $next_url = MakeURL($s->{url}, { action=>'list', id=>'' });
1515
1516 my %template_args = (
1517 PAGE => 'delete',
1518 USER => $user,
1519 TITLE => "Delete Record",
1520 TABLE => $table,
1521 ID => $id,
1522 NEXT_URL => $next_url,
1523 );
1524
1525 GUI_InitTemplateArgs($s, \%template_args);
1526 GUI_Header($s, \%template_args);
1527 UniqueFormStart($s, $next_url);
1528
1529 $template_args{ELEMENT}='delete';
1530 print Template(\%template_args);
1531
1532 print "<INPUT TYPE=\"hidden\" NAME=\"post_action\" VALUE=\"delete\">\n";
1533 print "<INPUT TYPE=\"hidden\" NAME=\"id\" VALUE=\"$id\">\n";
1534 UniqueFormEnd($s, $next_url, $next_url);
1535 GUI_Footer(\%template_args);
1536 }
1537
1538 sub GUI_DumpTable($$$){
1539 my $s = shift;
1540 my $q = $s->{cgi};
1541 my $user = shift;
1542 my $dbh = shift;
1543 my $myurl = MyURL($q);
1544 my $table = $q->url_param('table');
1545
1546 my %atribs;
1547 foreach($q->param) {
1548 if(/^field_(.*)/) {
1549 $atribs{$1} = $q->param($_);
1550 }
1551 }
1552 my $data;
1553 my $first = 1;
1554
1555 my $view = defined $g{db_tables}{"${table}_list"} ?
1556 "${table}_list" : $table;
1557
1558 my @fields_list = @{$g{db_fields_list}{$view}};
1559 for (@fields_list){
1560 if(not $first){
1561 $data.="\t";
1562 }
1563 $first = 0;
1564 $data.=$_;
1565 }
1566 $data.="\n";
1567
1568 $data .= DB_DumpTable($dbh,$table,\%atribs);
1569 print $data;
1570 }
1571
1572 1;
1573 # Emacs Configuration
1574 #
1575 # Local Variables:
1576 # mode: cperl
1577 # eval: (cperl-set-style "BSD")
1578 # cperl-indent-level: 8
1579 # mode: flyspell
1580 # mode: flyspell-prog
1581 # End:
1582 #
1583
1584 # vi: tw=0 sw=8

  ViewVC Help
Powered by ViewVC 1.1.26