1 rizwank 1.1 # Module of TWiki Collaboration Platform, http://TWiki.org/
2 #
3 # Copyright (C) 2001-2004 Peter Thoeny, peter@thoeny.com
4 #
5 # For licensing info read license.txt file in the TWiki root.
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License
8 # as published by the Free Software Foundation; either version 2
9 # of the License, or (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details, published at
15 # http://www.gnu.org/copyleft/gpl.html
16 #
17 # Written by John Talintyre, jet@cheerful.com, Jul 2001.
18
19 =begin twiki
20
21 ---+ TWiki::Form Module
22 rizwank 1.1
23 This module handles the encoding and decoding of %TWIKIWEB%.TWikiForms
24
25 =cut
26
27 package TWiki::Form;
28
29 use strict;
30
31
32 # ============================
33 # Get definition from supplied topic text
34 # Returns array of arrays
35 # 1st - list fields
36 # 2nd - name, title, type, size, vals, tooltip, setting
37 =pod
38
39 ---++ sub getFormDefinition ( $text )
40
41 Not yet documented.
42
43 rizwank 1.1 =cut
44
45 sub getFormDefinition
46 {
47 my( $text ) = @_;
48
49 my @fields = ();
50 my $inBlock = 0;
51 $text =~ s/\\\r?\n//go; # remove trailing '\' and join continuation lines
52
53 # | *Name:* | *Type:* | *Size:* | *Value:* | *Tooltip message:* | *Attributes:* |
54 # Tooltip and attributes are optional
55 foreach( split( /\n/, $text ) ) {
56 if( /^\s*\|.*Name[^|]*\|.*Type[^|]*\|.*Size[^|]*\|/ ) {
57 $inBlock = 1;
58 } else {
59 # Only insist on first field being present FIXME - use oops page instead?
60 if( $inBlock && s/^\s*\|//o ) {
61 my( $title, $type, $size, $vals, $tooltip, $attributes ) = split( /\|/ );
62 $title =~ s/^\s*//go;
63 $title =~ s/\s*$//go;
64 rizwank 1.1 my $name = _cleanField( $title );
65 $type = lc $type;
66 $attributes =~ s/\s*//go;
67 $attributes = "" if( ! $attributes );
68 $type =~ s/^\s*//go;
69 $type =~ s/\s*$//go;
70 $type = "text" if( ! $type );
71 $size = _cleanField( $size );
72 if( ! $size ) {
73 if( $type eq "text" ) {
74 $size = 20;
75 } elsif( $type eq "textarea" ) {
76 $size = "40x5";
77 } else {
78 $size = 1;
79 }
80 }
81 $size = 1 if( ! $size );
82 $vals =~ s/^\s*//go;
83 $vals =~ s/\s*$//go;
84 $vals =~ s/"//go; # " would break parsing off META variables
85 rizwank 1.1 if( $vals eq '$users' ) {
86 $vals = $TWiki::mainWebname . "." . join( ", ${TWiki::mainWebname}.", ( TWiki::Store::getTopicNames( $TWiki::mainWebname ) ) );
87 }
88 $tooltip =~ s/^\s*//go;
89 $tooltip =~ s/\s*$//go;
90 # FIXME object if too short
91 push @fields, [ $name, $title, $type, $size, $vals, $tooltip, $attributes ];
92 } else {
93 $inBlock = 0;
94 }
95 }
96 }
97
98 return @fields;
99 }
100
101
102 # ============================
103 =pod
104
105 ---++ sub _cleanField ( $text )
106 rizwank 1.1
107 Not yet documented.
108
109 =cut
110
111 sub _cleanField
112 {
113 my( $text ) = @_;
114 $text = "" if( ! $text );
115 $text =~ s/[^A-Za-z0-9_\.]//go; # Need do for web.topic
116 return $text;
117 }
118
119
120 # ============================
121 # Possible field values for select, checkbox, radio from supplied topic text
122 =pod
123
124 ---++ sub getPossibleFieldValues ( $text )
125
126 Not yet documented.
127 rizwank 1.1
128 =cut
129
130 sub getPossibleFieldValues
131 {
132 my( $text ) = @_;
133
134 my @defn = ();
135
136 my $inBlock = 0;
137
138 foreach( split( /\n/, $text ) ) {
139 if( /^\s*\|.*Name[^|]*\|/ ) {
140 $inBlock = 1;
141 } else {
142 if( /^\s*\|\s*([^|]*)\s*\|/ ) {
143 my $item = $1;
144 $item =~ s/\s+$//go;
145 $item =~ s/^\s+//go;
146 if( $inBlock ) {
147 push @defn, $item;
148 rizwank 1.1 }
149 } else {
150 $inBlock = 0;
151 }
152 }
153 }
154
155 return @defn;
156 }
157
158
159 # ============================
160 # Get array of field definition, given form name
161 # If form contains Web this overrides webName
162 =pod
163
164 ---++ sub getFormDef ( $webName, $form )
165
166 Not yet documented.
167
168 =cut
169 rizwank 1.1
170 sub getFormDef
171 {
172 my( $webName, $form ) = @_;
173
174 if( $form =~ /^(.*)\.(.*)$/ ) {
175 $webName = $1;
176 $form = $2;
177 }
178
179 my @fieldDefs = ();
180
181 # Read topic that defines the form
182 if( &TWiki::Store::topicExists( $webName, $form ) ) {
183 my( $meta, $text ) = &TWiki::Store::readTopic( $webName, $form );
184 @fieldDefs = getFormDefinition( $text );
185 } else {
186 # FIXME - do what if there is an error?
187 }
188
189 my @fieldsInfo = ();
190 rizwank 1.1
191 # Get each field definition
192 foreach my $fieldDefP ( @fieldDefs ) {
193 my @fieldDef = @$fieldDefP;
194 my( $name, $title, $type, $size, $posValuesS, $tooltip, $attributes ) = @fieldDef;
195 my @posValues = ();
196 if( $posValuesS ) {
197 @posValues = split( /,\s*/, $posValuesS );
198 }
199
200 if( ( ! @posValues ) && &TWiki::Store::topicExists( $webName, $name ) ) {
201 my( $meta, $text ) = &TWiki::Store::readTopic( $webName, $name );
202 @posValues = getPossibleFieldValues( $text );
203 if( ! $type ) {
204 $type = "select"; #FIXME keep?
205 }
206 } else {
207 # FIXME no list matters for some types
208 }
209 push @fieldsInfo, [ ( $name, $title, $type, $size, $tooltip, $attributes, @posValues ) ];
210 }
211 rizwank 1.1
212 return @fieldsInfo;
213 }
214
215
216 # ============================
217 =pod
218
219 ---++ sub _link ( $web, $name, $tooltip, $heading, $align, $span, $extra )
220
221 Not yet documented.
222
223 =cut
224
225 sub _link
226 {
227 my( $web, $name, $tooltip, $heading, $align, $span, $extra ) = @_;
228
229 $name =~ s/[\[\]]//go;
230
231 my $cell = "td";
232 rizwank 1.1 my $attr = "";
233 if( $heading ) {
234 $cell = "th";
235 $attr = ' bgcolor="#99CCCC"';
236 }
237
238 if( !$align ) {
239 $align = "";
240 } else {
241 $align = " align=\"$align\"";
242 }
243
244 if( $span ) {
245 $span = " colspan=\"$span\"";
246 } else {
247 $span = "";
248 }
249
250 my $link = "$name";
251
252 if( &TWiki::Store::topicExists( $web, $name ) ) {
253 rizwank 1.1 ( $web, $name ) = &TWiki::Store::normalizeWebTopicName( $web, $name );
254 if( ! $tooltip ) {
255 $tooltip = "Click to see details in separate window";
256 }
257 $link = "<a target=\"$name\" " .
258 "onclick=\"return launchWindow('$web','$name')\" " .
259 "title=\"$tooltip\" " .
260 "href=\"$TWiki::scriptUrlPath/view$TWiki::scriptSuffix/$web/$name\">$name</a>";
261 } elsif ( $tooltip ) {
262 $link = "<span title=\"$tooltip\">$name</span>";
263 }
264
265 my $html = "<$cell$attr$span$align>$link $extra</$cell>";
266 return $html;
267 }
268
269 =pod
270
271 ---++ sub chooseFormButton ( $text )
272
273 Not yet documented.
274 rizwank 1.1
275 =cut
276
277 sub chooseFormButton
278 {
279 my( $text ) = @_;
280
281 return "<input type=\"submit\" name=\"submitChangeForm\" value=\"$text\" class=\"twikiChangeFormButton twikiSubmit \" />";
282 }
283
284
285 # ============================
286 # Render form information
287 =pod
288
289 ---++ sub renderForEdit ( $web, $topic, $form, $meta, $query, $getValuesFromFormTopic, @fieldsInfo )
290
291 Not yet documented.
292
293 =cut
294
295 rizwank 1.1 sub renderForEdit
296 {
297 my( $web, $topic, $form, $meta, $query, $getValuesFromFormTopic, @fieldsInfo ) = @_;
298
299 my $chooseForm = "";
300 if( TWiki::Prefs::getPreferencesValue( "WEBFORMS", "$web" ) ) {
301 $chooseForm = chooseFormButton( "Replace form..." );
302 }
303
304 # FIXME could do with some of this being in template
305 my $text = "<div class=\"twikiForm twikiEditForm\"><table border=\"1\" cellspacing=\"0\" cellpadding=\"0\">\n <tr>" .
306 _link( $web, $form, "", "h", "", 2, $chooseForm ) . "</tr>\n";
307
308 fieldVars2Meta( $web, $query, $meta, "override" );
309
310 foreach my $c ( @fieldsInfo ) {
311 my @fieldInfo = @$c;
312 my $fieldName = shift @fieldInfo;
313 my $name = $fieldName;
314 my $title = shift @fieldInfo;
315 my $type = shift @fieldInfo;
316 rizwank 1.1 my $size = shift @fieldInfo;
317 my $tooltip = shift @fieldInfo;
318 my $attributes = shift @fieldInfo;
319
320 my %field = $meta->findOne( "FIELD", $fieldName );
321 my $value = $field{"value"};
322 if( ! defined( $value ) && $attributes =~ /S/ ) {
323 # Allow initialisation based on a preference
324 $value = &TWiki::Prefs::getPreferencesValue($fieldName);
325 }
326 if( ($getValuesFromFormTopic ) ) {
327 my $tmp = $fieldInfo[0] || "";
328 $value = &TWiki::handleCommonTags( $tmp, $topic );
329 }
330 $value = "" unless defined $value; # allow "0" values
331 my $extra = "";
332
333 $tooltip =~ s/&/&\;/g;
334 $tooltip =~ s/"/"\;/g;
335 $tooltip =~ s/</<\;/g;
336 $tooltip =~ s/>/>\;/g;
337 rizwank 1.1
338 my $output = TWiki::Plugins::renderFormFieldForEditHandler( $name, $type, $size, $value, $attributes, \@fieldInfo );
339 if( $output ) {
340 $value = $output;
341 } elsif( $type eq "text" ) {
342 $value =~ s/&/&\;/go;
343 $value =~ s/"/"\;/go; # Make sure double quote don't kill us
344 $value =~ s/</<\;/go;
345 $value =~ s/>/>\;/go;
346 $value = "<input class=\"twikiEditFormTextField\" type=\"text\" name=\"$name\" size=\"$size\" value=\"$value\" />";
347 } elsif( $type eq "label" ) {
348 my $escaped = $value;
349 $escaped =~ s/&/&\;/go;
350 $escaped =~ s/"/"\;/go; # Make sure double quote don't kill us
351 $escaped =~ s/</<\;/go;
352 $escaped =~ s/>/>\;/go;
353 $value = "<input class=\"twikiEditFormLabelField\" type=\"hidden\" name=\"$name\" value=\"$escaped\" />$value";
354 } elsif( $type eq "textarea" ) {
355 my $cols = 40;
356 my $rows = 5;
357 if( $size =~ /([0-9]+)x([0-9]+)/ ) {
358 rizwank 1.1 $cols = $1;
359 $rows = $2;
360 }
361 $value =~ s/&/&\;/go;
362 $value =~ s/"/"\;/go; # Make sure double quote don't kill us
363 $value =~ s/</<\;/go;
364 $value =~ s/>/>\;/go;
365 $value = "<textarea class=\"twikiEditFormTextAreaField\" cols=\"$cols\" rows=\"$rows\" name=\"$name\">$value</textarea>";
366 } elsif( $type eq "select" ) {
367 my $val = "";
368 my $matched = "";
369 my $defaultMarker = "%DEFAULTOPTION%";
370 foreach my $item ( @fieldInfo ) {
371 my $selected = $defaultMarker;
372 if( $item eq $value ) {
373 $selected = ' selected="selected"';
374 $matched = $item;
375 }
376 $defaultMarker = "";
377 $item =~ s/<nop/<\;nop/go;
378 $val .= " <option$selected>$item</option>";
379 rizwank 1.1 }
380 if( ! $matched ) {
381 $val =~ s/%DEFAULTOPTION%/ selected="selected"/go;
382 } else {
383 $val =~ s/%DEFAULTOPTION%//go;
384 }
385 $value = "<select name=\"$name\" size=\"$size\">$val</select>";
386 } elsif( $type =~ "^checkbox" ) {
387 if( $type eq "checkbox+buttons" ) {
388 my $boxes = $#fieldInfo + 1;
389 $extra = "<br />\n<input class=\"twikiEditFormCheckboxButton twikiCheckbox\" type=\"button\" value=\" Set \" onclick=\"checkAll(this, 2, $boxes, true)\" /> \n" .
390 "<input class=\"twikiEditFormCheckboxButton twikiCheckbox\" type=\"button\" value=\"Clear\" onclick=\"checkAll(this, 1, $boxes, false)\" />\n";
391 }
392
393 my $val ="<table cellspacing=\"0\" cellpadding=\"0\"><tr>";
394 my $lines = 0;
395 foreach my $item ( @fieldInfo ) {
396 my $flag = "";
397 my $expandedItem = &TWiki::handleCommonTags( $item, $topic );
398 if( $value =~ /(^|,\s*)\Q$item\E(,|$)/ ) {
399 $flag = ' checked="checked"';
400 rizwank 1.1 }
401 $val .= "\n<td><input class=\"twikiEditFormCheckboxField\" type=\"checkbox\" name=\"$name$item\"$flag />$expandedItem </td>";
402 if( $size > 0 && ($lines % $size == $size - 1 ) ) {
403 $val .= "\n</tr><tr>";
404 }
405 $lines++;
406 }
407 $val =~ s/\n<\/tr><tr>$//;
408 $value = "$val\n</tr></table>\n";
409 } elsif( $type eq "radio" ) {
410 my $val = "<table cellspacing=\"0\" cellpadding=\"0\"><tr>";
411 my $matched = "";
412 my $defaultMarker = "%DEFAULTOPTION%";
413 my $lines = 0;
414 foreach my $item ( @fieldInfo ) {
415 my $selected = $defaultMarker;
416 my $expandedItem = &TWiki::handleCommonTags( $item, $topic );
417 if( $item eq $value ) {
418 $selected = ' checked="checked"';
419 $matched = $item;
420 }
421 rizwank 1.1 $defaultMarker = "";
422 $val .= "\n<td><input class=\"twikiEditFormRadioField twikiRadioButton\" type=\"radio\" name=\"$name\" value=\"$item\" $selected />$expandedItem </td>";
423 if( $size > 0 && ($lines % $size == $size - 1 ) ) {
424 $val .= "\n</tr><tr>";
425 }
426 $lines++;
427 }
428 if( ! $matched ) {
429 $val =~ s/%DEFAULTOPTION%/ checked="checked"/go;
430 } else {
431 $val =~ s/%DEFAULTOPTION%//go;
432 }
433 $val =~ s/\n<\/tr><tr>$//;
434 $value = "$val\n</tr></table>\n";
435 } else {
436 # Treat like test, make it reasonably long
437 #TODO: Sven thinks this should be an error condition - so users know about typo's, and don't loose data when the typo is fixed
438 $value =~ s/&/&\;/go;
439 $value =~ s/"/"\;/go; # Make sure double quote don't kill us
440 $value =~ s/</<\;/go;
441 $value =~ s/>/>\;/go;
442 rizwank 1.1 $value = "<input class=\"twikiEditFormError\" type=\"text\" name=\"$name\" size=\"80\" value=\"$value\" />";
443 }
444 $text .= " <tr> " . _link( $web, $title, $tooltip, "h", "right", "", $extra ) . "<td align=\"left\"> $value </td> </tr>\n";
445 }
446 $text .= "</table></div>\n";
447
448 return $text;
449 }
450
451
452 # =============================
453 =pod
454
455 ---++ sub getFormInfoFromMeta ( $webName, $meta )
456
457 Not yet documented.
458
459 =cut
460
461 sub getFormInfoFromMeta
462 {
463 rizwank 1.1 my( $webName, $meta ) = @_;
464
465 my @fieldsInfo = ();
466
467 my %form = $meta->findOne( "FORM" );
468 if( %form ) {
469 @fieldsInfo = getFormDef( $webName, $form{"name"} );
470 }
471
472 return @fieldsInfo;
473 }
474
475
476 # =============================
477 # Form parameters to meta
478 # Note that existing meta information for fields is removed unless $justOverride is true
479 =pod
480
481 ---++ sub fieldVars2Meta ( $webName, $query, $meta, $justOverride )
482
483 Not yet documented.
484 rizwank 1.1
485 =cut
486
487 sub fieldVars2Meta
488 {
489 my( $webName, $query, $meta, $justOverride ) = @_;
490
491 $meta->remove( "FIELD" ) if( ! $justOverride );
492
493 #TWiki::writeDebug( "Form::fieldVars2Meta " . $query->query_string );
494
495 my @fieldsInfo = getFormInfoFromMeta( $webName, $meta );
496 foreach my $fieldInfop ( @fieldsInfo ) {
497 my @fieldInfo = @$fieldInfop;
498 my $fieldName = shift @fieldInfo;
499 my $title = shift @fieldInfo;
500 my $type = shift @fieldInfo;
501 my $size = shift @fieldInfo;
502 my $tooltip = shift @fieldInfo;
503 my $attributes = shift @fieldInfo;
504 my $value = $query->param( $fieldName );
505 rizwank 1.1 my $cvalue = "";
506
507 if( ! $value && $type =~ "^checkbox" ) {
508 foreach my $name ( @fieldInfo ) {
509 my $cleanName = $name;
510 $cleanName =~ s/<nop>//g;
511 $cvalue = $query->param( "$fieldName" . "$cleanName" );
512 if( defined( $cvalue ) ) {
513 if( ! $value ) {
514 $value = "";
515 } else {
516 $value .= ", " if( $cvalue );
517 }
518 $value .= "$name" if( $cvalue );
519 }
520 }
521 }
522
523 if( defined( $value ) ) {
524 $value = TWiki::Meta::restoreValue( $value );
525 }
526 rizwank 1.1
527 # Have title and name stored so that topic can be viewed without reading in form definition
528 $value = "" if( ! defined( $value ) && ! $justOverride );
529 if( defined( $value ) ) {
530 my @args = ( "name" => $fieldName,
531 "title" => $title,
532 "value" => $value );
533 push @args, ( "attributes" => $attributes ) if( $attributes );
534
535 $meta->put( "FIELD", @args );
536 }
537 }
538
539 return $meta;
540 }
541
542
543 # =============================
544 =pod
545
546 ---++ sub getFieldParams ( $meta )
547 rizwank 1.1
548 Not yet documented.
549
550 =cut
551
552 sub getFieldParams
553 {
554 my( $meta ) = @_;
555
556 my $params = "";
557
558 my @fields = $meta->find( "FIELD" );
559 foreach my $field ( @fields ) {
560 my $args = $2;
561 my $name = $field->{"name"};
562 my $value = $field->{"value"};
563 #TWiki::writeDebug( "Form::getFieldParams " . $name . ", " . $value );
564 $value = TWiki::Meta::cleanValue( $value );
565 $value =~ s/&/&\;/go;
566 $value =~ s/</<\;/go;
567 $value =~ s/>/>\;/go;
568 rizwank 1.1 $params .= "<input type=\"hidden\" name=\"$name\" value=\"$value\" />\n";
569 }
570
571 return $params;
572
573 }
574
575 # =============================
576 # Called by script to change the form for a topic
577 =pod
578
579 ---++ sub changeForm ( $theWeb, $theTopic, $theQuery )
580
581 Not yet documented.
582
583 =cut
584
585 sub changeForm
586 {
587 my( $theWeb, $theTopic, $theQuery ) = @_;
588
589 rizwank 1.1 my $tmpl = &TWiki::Store::readTemplate( "changeform" );
590 &TWiki::writeHeader( $theQuery );
591 $tmpl = &TWiki::handleCommonTags( $tmpl, $theTopic );
592 $tmpl = &TWiki::Render::getRenderedVersion( $tmpl );
593 my $text = $theQuery->param( 'text' );
594 $text = &TWiki::Render::encodeSpecialChars( $text );
595 $tmpl =~ s/%TEXT%/$text/go;
596
597 my $listForms = TWiki::Prefs::getPreferencesValue( "WEBFORMS", "$theWeb" );
598 $listForms =~ s/^\s*//go;
599 $listForms =~ s/\s*$//go;
600 my @forms = split( /\s*,\s*/, $listForms );
601 unshift @forms, "";
602 my( $metat, $tmp ) = &TWiki::Store::readTopic( $theWeb, $theTopic );
603 my $formName = $theQuery->param( 'formtemplate' ) || "";
604 if( ! $formName ) {
605 my %form = $metat->findOne( "FORM" );
606 $formName = $form{"name"};
607 }
608 $formName = "" if( !$formName || $formName eq "none" );
609
610 rizwank 1.1 my $formList = "";
611 foreach my $form ( @forms ) {
612 my $selected = ( $form eq $formName ) ? 'checked="checked"' : "";
613 $formList .= "\n<br />" if( $formList );
614 my $show = $form ? $form : "<none>";
615 my $value = $form ? $form : "none";
616 $formList .= "<input type=\"radio\" name=\"formtemplate\" value=\"$value\" $selected /> $show";
617 }
618 $tmpl =~ s/%FORMLIST%/$formList/go;
619
620 my $parent = $theQuery->param( 'topicparent' ) || "";
621 $tmpl =~ s/%TOPICPARENT%/$parent/go;
622
623 $tmpl =~ s|</*nop/*>||goi;
624
625 print $tmpl;
626 }
627
628
629 # ============================
630 # load old style category table item
631 rizwank 1.1 =pod
632
633 ---++ sub upgradeCategoryItem ( $catitems, $ctext )
634
635 Not yet documented.
636
637 =cut
638
639 sub upgradeCategoryItem
640 {
641 my ( $catitems, $ctext ) = @_;
642 my $catname = "";
643 my $scatname = "";
644 my $catmodifier = "";
645 my $catvalue = "";
646 my @cmd = split( /\|/, $catitems );
647 my $src = "";
648 my $len = @cmd;
649 if( $len < "2" ) {
650 # FIXME
651 return ( $catname, $catmodifier, $catvalue )
652 rizwank 1.1 }
653 my $svalue = "";
654
655 my $i;
656 my $itemsPerLine;
657
658 # check for CategoryName=CategoryValue parameter
659 my $paramCmd = "";
660 my $cvalue = ""; # was$query->param( $cmd[1] );
661 if( $cvalue ) {
662 $src = "<!---->$cvalue<!---->";
663 } elsif( $ctext ) {
664 foreach( split( /\n/, $ctext ) ) {
665 if( /$cmd[1]/ ) {
666 $src = $_;
667 last;
668 }
669 }
670 }
671
672 if( $cmd[0] eq "select" || $cmd[0] eq "radio") {
673 rizwank 1.1 $catname = $cmd[1];
674 $scatname = $catname;
675 #$scatname =~ s/[^a-zA-Z0-9]//g;
676 my $size = $cmd[2];
677 for( $i = 3; $i < $len; $i++ ) {
678 my $value = $cmd[$i];
679 my $svalue = $value;
680 if( $src =~ /$value/ ) {
681 $catvalue = "$svalue";
682 }
683 }
684
685 } elsif( $cmd[0] eq "checkbox" ) {
686 $catname = $cmd[1];
687 $scatname = $catname;
688 #$scatname =~ s/[^a-zA-Z0-9]//g;
689 if( $cmd[2] eq "true" || $cmd[2] eq "1" ) {
690 $i = $len - 4;
691 $catmodifier = 1;
692 }
693 $itemsPerLine = $cmd[3];
694 rizwank 1.1 for( $i = 4; $i < $len; $i++ ) {
695 my $value = $cmd[$i];
696 my $svalue = $value;
697 if( $src =~ /$value[^a-zA-Z0-9\.]/ ) {
698 $catvalue .= ", " if( $catvalue );
699 $catvalue .= $svalue;
700 }
701 }
702
703 } elsif( $cmd[0] eq "text" ) {
704 $catname = $cmd[1];
705 $scatname = $catname;
706 #$scatname =~ s/[^a-zA-Z0-9]//g;
707 $src =~ /<!---->(.*)<!---->/;
708 if( $1 ) {
709 $src = $1;
710 } else {
711 $src = "";
712 }
713 $catvalue = $src;
714 }
715 rizwank 1.1
716 return ( $catname, $catmodifier, $catvalue )
717 }
718
719
720
721 # ============================
722 # load old style category table
723 =pod
724
725 ---++ sub upgradeCategoryTable ( $web, $topic, $meta, $text )
726
727 Not yet documented.
728
729 =cut
730
731 sub upgradeCategoryTable
732 {
733 my( $web, $topic, $meta, $text ) = @_;
734
735 my $icat = &TWiki::Store::readTemplate( "twikicatitems" );
736 rizwank 1.1
737 if( $icat ) {
738 my @items = ();
739
740 # extract category section and build category form elements
741 my( $before, $ctext, $after) = split( /<!--TWikiCat-->/, $text );
742 # cut TWikiCat part
743 $text = $before || "";
744 $text .= $after if( $after );
745 $ctext = "" if( ! $ctext );
746
747 my $ttext = "";
748 foreach( split( /\n/, $icat ) ) {
749 my( $catname, $catmod, $catvalue ) = upgradeCategoryItem( $_, $ctext );
750 #TWiki::writeDebug( "Form: name, mod, value: $catname, $catmod, $catvalue" );
751 if( $catname ) {
752 push @items, ( [$catname, $catmod, $catvalue] );
753 }
754 }
755
756 my $listForms = TWiki::Prefs::getPreferencesValue( "WEBFORMS", "$web" );
757 rizwank 1.1 $listForms =~ s/^\s*//go;
758 $listForms =~ s/\s*$//go;
759 my @formTemplates = split( /\s*,\s*/, $listForms );
760 my $defaultFormTemplate = "";
761 $defaultFormTemplate = $formTemplates[0] if ( @formTemplates );
762
763 if( ! $defaultFormTemplate ) {
764 &TWiki::writeWarning( "Form: can't get form definition to convert category table " .
765 " for topic $web.$topic" );
766
767 foreach my $oldCat ( @items ) {
768 my $name = $oldCat->[0];
769 my $value = $oldCat->[2];
770 $meta->put( "FORM", ( "name" => "" ) );
771 $meta->put( "FIELD", ( "name" => $name, "title" => $name, "value" => $value ) );
772 }
773
774 return;
775 }
776
777 my @fieldsInfo = getFormDef( $web, $defaultFormTemplate );
778 rizwank 1.1 $meta->put( "FORM", ( name => $defaultFormTemplate ) );
779
780 foreach my $catInfop ( @fieldsInfo ) {
781 my @catInfo = @$catInfop;
782 my $fieldName = shift @catInfo;
783 my $title = shift @catInfo;
784 my $value = "";
785 foreach my $oldCatP ( @items ) {
786 my @oldCat = @$oldCatP;
787 if( _cleanField( $oldCat[0] ) eq $fieldName ) {
788 $value = $oldCat[2];
789 last;
790 }
791 }
792 my @args = ( "name" => $fieldName,
793 "title" => $title,
794 "value" => $value );
795 $meta->put( "FIELD", @args );
796 }
797
798 } else {
799 rizwank 1.1 &TWiki::writeWarning( "Form: get find category template twikicatitems for Web $web" );
800 }
801
802 return $text;
803 }
804
805 1;
|
Return to
Form.pm
CVS log
Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki