- Timestamp:
- 03/10/05 16:40:27 (20 years ago)
- Location:
- trunk/lib/Text
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/lib/Text/FormBuilder.pm
r63 r64 7 7 use vars qw($VERSION @EXPORT); 8 8 9 $VERSION = '0.09 _02';9 $VERSION = '0.09'; 10 10 @EXPORT = qw(create_form); 11 11 … … 235 235 236 236 # remove extraneous undefined values 237 # also check for approriate version of CGI::FormBuilder 238 # for some advanced options 239 my $FB_version = CGI::FormBuilder->VERSION; 237 240 for my $field (@{ $self->{form_spec}{fields} }) { 238 241 defined $$field{$_} or delete $$field{$_} foreach keys %{ $field }; 239 } 242 243 unless ($FB_version >= '3.002') { 244 if ($$field{growable}) { 245 warn '[' . (caller(0))[3] . "] growable fields not supported by FB $FB_version (requires 3.002)"; 246 delete $$field{growable}; 247 } 248 } 249 } 240 250 241 251 # remove false $$_{required} params because this messes up things at … … 243 253 # based on the existance of a 'required' param, not whether it is 244 254 # true or defined 255 # TODO: check if this is still needed 245 256 $$_{required} or delete $$_{required} foreach @{ $self->{form_spec}{fields} }; 246 257 258 # assign the field names to the sections 247 259 foreach (@{ $self->{form_spec}{sections} }) { 248 #for my $line (grep { $$_[0] eq 'field' } @{ $$_{lines} }) {249 260 for my $line (@{ $$_{lines} }) { 250 261 if ($$line[0] eq 'field') { 251 262 $$line[1] = $$line[1]{name}; 252 ## $_ eq 'name' or delete $$line[1]{$_} foreach keys %{ $$line[1] };253 ## } elsif ($$line[0] eq 'group') {254 ## $$line[1] = [ map { $$_{name} } @{ $$line[1]{group} } ];255 263 } 256 264 } … … 353 361 my %module_subs; 354 362 my $d = Data::Dumper->new([ \%options ], [ '*options' ]); 355 356 use B::Deparse;357 my $deparse = B::Deparse->new;358 ##359 ## #TODO: need a workaround/better solution since Data::Dumper doesn't like dumping coderefs360 ## foreach (@{ $self->{form_spec}{fields} }) {361 ## if (ref $$_{validate} eq 'CODE') {362 ## my $body = $deparse->coderef2text($$_{validate});363 ## #$d->Seen({ "*_validate_$$_{name}" => $$_{validate} });364 ## #$module_subs{$$_{name}} = "sub _validate_$$_{name} $$_{validate}";365 ## }366 ## }367 ## my $sub_code = join("\n", each %module_subs);368 363 369 364 my $form_options = keys %options > 0 ? $d->Dump : ''; … … 1058 1053 given). Growable fields have a button that allows the user to add a 1059 1054 copy of the field input. Currently, this only works for C<text> and 1060 C<file> fields . Growable fields also require JavaScript to function1061 correctly.1055 C<file> fields, and you must have L<CGI::FormBuilder> 3.02 or higher. 1056 Growable fields also require JavaScript to function correctly. 1062 1057 1063 1058 # you can have as many people as you like … … 1088 1083 1089 1084 month:select@MONTHS 1090 1091 There is another form of the C<!list> directive: the dynamic list:1092 1093 !list RANDOM &{ map { rand } (0..5) }1094 1095 The code inside the C<&{ ... }> is C<eval>ed by C<build>, and the results1096 are stuffed into the list. The C<eval>ed code can either return a simple1097 list, as the example does, or the fancier C<< ( { value1 => 'Description 1'},1098 { value2 => 'Description 2}, ... ) >> form.1099 1100 I<B<NOTE:> This feature of the language may go away unless I find a compelling1101 reason for it in the next few versions. What I really wanted was lists that1102 were filled in at run-time (e.g. from a database), and that can be done easily1103 enough with the CGI::FormBuilder object directly.>1104 1085 1105 1086 If you want to have a single checkbox (e.g. for a field that says ``I want to … … 1181 1162 Document the commmand line tool 1182 1163 1164 Document use of the parser as a standalone module 1165 1183 1166 Allow renaming of the submit button; allow renaming and inclusion of a 1184 1167 reset button -
trunk/lib/Text/FormBuilder/grammar
r63 r64 60 60 dynamic_list: '&' <perl_codeblock> 61 61 { 62 my @results = (eval $item[2]); 63 if (ref $results[0] eq 'HASH') { 64 @options = @results; 65 } else { 66 @options = map { { $_ => $_ } } @results; 67 } 62 warn "[Text::FormBuilder] Dynamic lists have been removed from the formspec grammar"; 68 63 } 69 64 70 65 description_def: '!description' block 71 { warn "[Text::FormBuilder] Description redefined at input text line $thisline\n" if defined $description; 72 73 $description = $item[2]; 74 $description =~ s/^{\s*|\s*}$//g; 66 { 67 warn "[Text::FormBuilder] Description redefined at input text line $thisline\n" if defined $description; 68 $description = $item{block}; 75 69 } 76 70 … … 85 79 } 86 80 87 note: '!note' block 88 { 89 (my $note = $item[2]) =~ s/^{\s*|\s*}$//g; 90 push @lines, [ 'note', $note ]; 91 } 81 note: '!note' block { push @lines, [ 'note', $item{block} ]; } 82 83 84 #TODO: allow \ escape for [] {} in these blocks 92 85 93 86 # curly-brace delimited block, that can contain properly 94 # nested curly brackets, along with any other characters 95 # return with the '{...}' so that nested blocks get the 96 # brackets treated as literals 97 block: '{' <skip:''> block_content(s) '}' 98 { 99 '{' . join('', @{ $item[3] }) . '}'; 100 } 101 102 block_content: /[^\{\}]+?/ | block 103 104 87 # nested curly braces, along with any other characters 88 # inner blocks return with the '{...}' so that nested 89 # blocks get the braces treated as literals 90 block: '{' <skip:''> block_content(s) '}' { join('', @{ $item[3] }) } 91 inner_block: '{' <skip:''> block_content(s) '}' { '{' . join('', @{ $item[3] }) . '}' } 92 block_content: /[^\{\}]+?/ | inner_block 93 94 # square brace delimited block, that can contain properly 95 # nested square brackets, along with any other characters 96 # inner bracket blocks return with the '[...]' so that nested 97 # blocks get the braces treated as literals 98 bracket_block: '[' <skip:''> bracket_block_content(s) ']' { join('', @{ $item[3] }) } 99 inner_bracket_block: '[' <skip:''> bracket_block_content(s) ']' { '[' . join('', @{ $item[3] }) . ']'; } 100 bracket_block_content: /[^\[\]]+?/ | inner_bracket_block 101 102 103 # field lines are the subset of lines that are allowed in a !group directive 105 104 field_line: <skip:'[ \t]*'> ( field | comment | blank ) "\n" 105 106 106 line: <skip:'[ \t]*'> ( title | author | pattern_def | section_head | heading | group_field | field_group | unknown_directive | field | comment | blank ) "\n" 107 107 … … 159 159 group_type: ':' var_name 160 160 161 # this is the real heart of the thing 161 162 field: name field_size(?) growable(?) label(?) hint(?) type(?) default(?) option_list(?) validate(?) 162 163 { … … 217 218 label: '|' (simple_multiword | quoted_string) { $item[2] } 218 219 219 hint: '[' /[^\]]+/ ']' { $item[2] }220 hint: bracket_block 220 221 221 222 type: ':' builtin_field … … 245 246 value: identifier 246 247 247 display_text: brace_block 248 { (my $text = $item[1]) =~ s/^\[\s*|\s*\]$//g; $text } 249 250 # square brace delimited block, that can contain properly 251 # nested square braces, along with any other characters 252 # return with the '[...]' so that nested blocks get the 253 # braces treated as literals 254 brace_block: '[' <skip:''> brace_block_content(s) ']' 255 { 256 '[' . join('', @{ $item[3] }) . ']'; 257 } 258 brace_block_content: /[^\[\]]+?/ | brace_block 259 260 261 validate: '//' (optional_pattern | required_pattern) { $item[2] } 262 263 optional_pattern: /[A-Z_]+/ '?' { $required = 0; $item[1] } 264 265 required_pattern: /[A-Z_]+/ { $required = 1; $item[1] } 248 display_text: bracket_block 249 250 251 validate: '//' (optional_pattern | required_pattern) 252 253 optional_pattern: var_name '?' { $required = 0; $item[1] } 254 255 required_pattern: var_name { $required = 1; $item[1] } 266 256 267 257 comment: '#' /.*/
Note: See TracChangeset
for help on using the changeset viewer.