Changeset 21 in text-formbuilder for trunk/lib/Text
- Timestamp:
- 11/12/04 16:54:23 (20 years ago)
- Location:
- trunk/lib/Text
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/lib/Text/FormBuilder.pm
r19 r21 6 6 use vars qw($VERSION); 7 7 8 $VERSION = '0.0 5';8 $VERSION = '0.06'; 9 9 10 10 use Carp; … … 87 87 delete $$_{validate} unless $$_{validate}; 88 88 } 89 90 # expand groups 91 my %groups = %{ $self->{form_spec}{groups} }; 92 foreach (grep { $$_[0] eq 'group' } @{ $self->{form_spec}{lines} }) { 93 $$_[1]{group} =~ s/^\%//; # strip leading % from group var name 94 95 if (exists $groups{$$_[1]{group}}) { 96 my @fields; # fields in the group 97 push @fields, { %$_ } foreach @{ $groups{$$_[1]{group}} }; 98 for my $field (@fields) { 99 $$field{label} ||= ucfirst $$field{name}; 100 $$field{name} = "$$_[1]{name}_$$field{name}"; 101 } 102 $_ = [ 'group', { label => $$_[1]{label} || ucfirst(join(' ',split('_',$$_[1]{name}))), group => \@fields } ]; 103 } 104 } 105 106 $self->{form_spec}{fields} = []; 107 for my $line (@{ $self->{form_spec}{lines} }) { 108 if ($$line[0] eq 'group') { 109 push @{ $self->{form_spec}{fields} }, $_ foreach @{ $$line[1]{group} }; 110 } elsif ($$line[0] eq 'field') { 111 push @{ $self->{form_spec}{fields} }, $$line[1]; 112 } 113 } 114 89 115 90 116 # substitute in list names … … 105 131 } 106 132 } 107 133 134 135 136 137 138 # TODO: use lines instead of fields 139 # TODO: change template to do groups 140 108 141 # TODO: configurable threshold for this 109 142 foreach (@{ $self->{form_spec}{fields} }) { … … 116 149 keepextras => 1, 117 150 title => $self->{form_spec}{title}, 118 fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ],151 #fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ], 119 152 template => { 120 153 type => 'Text', … … 125 158 }, 126 159 data => { 160 lines => $self->{form_spec}{lines}, 127 161 headings => $self->{form_spec}{headings}, 128 162 author => $self->{form_spec}{author}, … … 137 171 $self->{built} = 1; 138 172 173 # TEMP: dump @lines structure 174 use YAML; 175 warn YAML::Dump($self->{form_spec}->{lines}), "\n"; 176 139 177 return $self; 140 178 } … … 182 220 my $source = $options{form_only} ? $self->_form_template : $self->_template; 183 221 184 delete $options{fo mr_only};222 delete $options{form_only}; 185 223 186 224 my $form_options = keys %options > 0 ? Data::Dumper->Dump([$self->{build_options}],['*options']) : ''; … … 262 300 <% $start %> 263 301 <table> 264 <% my $i; foreach(@fields) { 265 $OUT .= qq[ <tr><th class="sectionhead" colspan="2"><h2>$headings[$i]</h2></th></tr>\n] if $headings[$i]; 266 $OUT .= $$_{invalid} ? qq[ <tr class="invalid">] : qq[ <tr>]; 267 $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>'; 268 if ($$_{invalid}) { 269 $OUT .= qq[<td>$$_{field} $$_{comment} Missing or invalid value.</td></tr>\n]; 270 } else { 271 $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n]; 272 } 273 $i++; 302 303 <% for my $line (@lines) { 304 305 if ($$line[0] eq 'head') { 306 $OUT .= qq[ <tr><th class="sectionhead" colspan="2"><h2>$$line[1]</h2></th></tr>\n] 307 } elsif ($$line[0] eq 'field') { 308 #TODO: we only need the field names, not the full field spec in the lines strucutre 309 local $_ = $field{$$line[1]{name}}; 310 $OUT .= $$_{invalid} ? qq[ <tr class="invalid">] : qq[ <tr>]; 311 $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>'; 312 if ($$_{invalid}) { 313 $OUT .= qq[<td>$$_{field} $$_{comment} Missing or invalid value.</td></tr>\n]; 314 } else { 315 $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n]; 316 } 317 } elsif ($$line[0] eq 'group') { 318 my @field_names = map { $$_{name} } @{ $$line[1]{group} }; 319 my @group_fields = map { $field{$_} } @field_names; 320 $OUT .= (grep { $$_{invalid} } @group_fields) ? qq[ <tr class="invalid">\n] : qq[ <tr>\n]; 321 322 323 #TODO: validated but not required fields 324 # in a form spec: //EMAIL? 325 326 #TODO: this doesn't seem to be working; all groups are getting marked as required 327 $OUT .= ' <th class="label">'; 328 $OUT .= (grep { $$_{required} } @group_fields) ? qq[<strong class="required">$$line[1]{label}:</strong>] : "$$line[1]{label}:"; 329 $OUT .= qq[</th>\n]; 330 331 $OUT .= qq[ <td>]; 332 $OUT .= join(' ', map { qq[<small class="sublabel">$$_{label}</small> $$_{field} $$_{comment}] } @group_fields); 333 $OUT .= qq[ </td>\n]; 334 $OUT .= qq[ </tr>\n]; 335 } 336 337 274 338 } %> 275 339 <tr><th></th><td style="padding-top: 1em;"><% $submit %></td></tr> … … 290 354 th.label { font-weight: normal; text-align: right; vertical-align: top; } 291 355 td ul { list-style: none; padding-left: 0; margin-left: 0; } 356 .sublabel { color: #999; } 292 357 </style> 293 358 </head> … … 321 386 =head1 NAME 322 387 323 Text::FormBuilder - Parser for a minilanguage for generating web forms388 Text::FormBuilder - Create CGI::FormBuilder objects from simple text descriptions 324 389 325 390 =head1 SYNOPSIS … … 536 601 static 537 602 538 This example also shows how you can list multiple values for the input types 539 that take multiple values (C<select>, C<radio>, and C<checkbox>). Values are 540 in a comma-separated list inside curly braces. Whitespace between values is 541 irrelevant, although there cannot be any whitespace within a value. 603 To change the size of the input field, add a bracketed subscript after the 604 field name (but before the descriptive label): 605 606 # for a single line field, sets size="40" 607 title[40]:text 608 609 # for a multiline field, sets rows="4" and cols="30" 610 description[4,30]:textarea 611 612 For the input types that can have options (C<select>, C<radio>, and 613 C<checkbox>), here's how you do it: 614 615 color|Favorite color:select{red,blue,green} 616 617 Values are in a comma-separated list inside curly braces. Whitespace 618 between values is irrelevant, although there cannot be any whitespace 619 within a value. 542 620 543 621 To add more descriptive display text to a vlaue in a list, add a square-bracketed … … 566 644 The code inside the C<&{ ... }> is C<eval>ed by C<build>, and the results 567 645 are stuffed into the list. The C<eval>ed code can either return a simple 568 list, as the example does, or the fancier C< ( { value1 => 'Description 1'},569 { value2 => 'Description 2}, ... )> form.646 list, as the example does, or the fancier C<< ( { value1 => 'Description 1'}, 647 { value2 => 'Description 2}, ... ) >> form. 570 648 571 649 B<NOTE:> This feature of the language may go away unless I find a compelling … … 583 661 email|Email address//EMAIL 584 662 585 Valid validation types include any of the builtin defaults from CGI::FormBuilder,663 Valid validation types include any of the builtin defaults from L<CGI::FormBuilder>, 586 664 or the name of a pattern that you define with the C<!pattern> directive elsewhere 587 665 in your form spec: -
trunk/lib/Text/FormBuilder/grammar
r16 r21 1 { my ($title, $author, $description, %lists, %patterns, @fields, @headings, $type, @options, $list_var, $size, $rows, $cols); } 1 { 2 my ( 3 $context, # line or group 4 @lines, # master data structure 5 $title, 6 $author, 7 $description, 8 %lists, 9 %patterns, 10 @fields, 11 @group, # current group 12 %groups, # stored groups of fields 13 @headings, 14 $type, 15 @options, 16 $list_var, 17 $size, 18 $rows, 19 $cols, 20 ); 21 $context = 'line'; 22 } 2 23 3 form_spec: (list_def | description_def | line)(s)24 form_spec: (list_def | description_def | group_def | line)(s) 4 25 { 5 26 $return = { … … 11 32 headings => \@headings, 12 33 fields => \@fields, 34 lines => \@lines, 35 groups => \%groups, 13 36 } 14 37 } … … 36 59 } 37 60 38 line: <skip:'[ \t]*'> ( title | author | pattern_def | heading | unknown_directive | field | comment | blank ) "\n" 61 group_def: '!group' { $context = 'group' } var_name '{' field_line(s) '}' { $context = 'line' } 62 { 63 #warn "$item{var_name} group; context $context\n" 64 $groups{$item{var_name}} = [ @group ]; 65 @group = (); 66 } 67 68 field_line: <skip:'[ \t]*'> ( field | comment | blank ) "\n" 69 line: <skip:'[ \t]*'> ( title | author | pattern_def | heading | group_field | unknown_directive | field | comment | blank ) "\n" 39 70 40 71 title: '!title' /.*/ … … 51 82 52 83 heading: '!head' /.*/ 53 { warn "[Text::FormBuilder] Header before field " . scalar(@fields) . " redefined at input text line $thisline\n" if defined $headings[@fields]; 54 $headings[@fields] = $item[2] } 84 { 85 warn "[Text::FormBuilder] Header before field " . scalar(@fields) . " redefined at input text line $thisline\n" if defined $headings[@fields]; 86 $headings[@fields] = $item[2]; 87 push @lines, [ 'head', $item[2] ]; 88 } 89 90 group_field: '!field' group_name name label(?) 91 { #warn "[$thisline] $item{group_name}\n"; 92 push @lines, [ 'group', { name => $item{name}, label => $item{'label(?)'}[0], group => $item{group_name} } ]; 93 } 94 95 group_name: /%[A-Z_]+/ 55 96 56 97 field: name field_size(?) label(?) hint(?) type(?) default(?) option_list(?) validate(?) … … 72 113 $$field{size} = $size if defined $size; 73 114 74 push @fields, $field; 115 #warn "[$thisline] field $item{name}; context $context\n"; 116 if ($context eq 'group') { 117 push @group, $field; 118 } else { 119 push @fields, $field; 120 push @lines, [ 'field', $field ]; 121 } 75 122 76 123 $type = undef; … … 95 142 { $rows = $item[1]; $cols = $item[3] } 96 143 97 label: '|' /[^:\[\{\/]+/i 144 #TODO: zero width labels 145 label: '|' /[^:\[\{\/\n]*/i { $item[2] } 98 146 99 147 hint: '[' /[^\]]+/ ']' { $item[2] }
Note: See TracChangeset
for help on using the changeset viewer.