source: text-formbuilder/trunk/lib/Text/FormBuilder/grammar @ 70

Last change on this file since 70 was 68, checked in by peichman, 20 years ago

BUGFIX: option list items had an inadvertant minimum length of 2
cleaned up 'required' option handling

File size: 7.0 KB
RevLine 
[66]1{
2    #$::RD_TRACE = 1;
[21]3    my (
4        $context,      # line or group
[29]5        @sections,     # master data structure
6        $section_head,
7        $section_id,
8        @lines,        # lines in each section
[21]9        $title,
10        $author,
11        $description,
12        %lists,
13        %patterns,
[39]14        %subs,         # validation subs
[21]15        @group,        # current group
16        %groups,       # stored groups of fields
17        $type,
18        @options,
[24]19        $required,
[21]20        $list_var,
21        $size,
[56]22        $maxlength,
[21]23        $rows,
24        $cols,
25    );
26    $context = 'line';
27}
[1]28
[50]29form_spec: (list_def | description_def | validate_def | group_def | note | line)(s)
[1]30    {
[29]31        # grab the last section, if there is any
32        if (@lines) {
33            push @sections,
34                {
35                    id   => $section_id,
36                    head => $section_head,
37                    lines => [ @lines ],
38                };
39        }
40       
41        $section_id = $item{identifier};
42        $section_head = $item[3];
43        @lines = ();
[1]44        $return = {
45            title    => $title,
46            author   => $author,
[14]47            description => $description,
[28]48            lists    => \%lists,
49            patterns => \%patterns,
[39]50            subs     => \%subs,
[28]51            groups   => \%groups,
[29]52            sections => \@sections,
[1]53        }
54    }
55
[16]56list_def: '!list' var_name (static_list | dynamic_list)
57    { $lists{$item{var_name}} = [ @options ]; @options = () }
[1]58
[66]59static_list: '{' /\s*/ option(s /\s*,\s*/) /,?/ /\s*/ '}'
[10]60
61dynamic_list: '&' <perl_codeblock>
62    {
[64]63        warn "[Text::FormBuilder] Dynamic lists have been removed from the formspec grammar";
[10]64    }
65
[57]66description_def: '!description' block
[64]67    {
68        warn "[Text::FormBuilder] Description redefined at input text line $thisline\n" if defined $description;
69        $description = $item{block};
[14]70    }
71
[39]72validate_def: '!validate' var_name <perl_codeblock>
[42]73    { $subs{$item{var_name}} = eval "sub $item[3]" }
[39]74
[21]75group_def: '!group' { $context = 'group' } var_name '{' field_line(s) '}' { $context = 'line' }
76    {
77        #warn "$item{var_name} group; context $context\n"
78        $groups{$item{var_name}} = [ @group ];
79        @group = ();
80    }
[1]81
[64]82note: '!note' block  { push @lines, [ 'note', $item{block} ]; }
[50]83
[64]84
85#TODO: allow \ escape for [] {} in these blocks
86
[57]87# curly-brace delimited block, that can contain properly
[64]88# nested curly braces, along with any other characters
89# inner blocks return with the '{...}' so that nested
90# blocks get the braces treated as literals
91block: '{' <skip:''> block_content(s) '}' { join('', @{ $item[3] }) }
92inner_block: '{' <skip:''> block_content(s) '}'  { '{' . join('', @{ $item[3] }) . '}' }
93block_content: /[^\{\}]+?/ | inner_block
[50]94
[64]95# square brace delimited block, that can contain properly
96# nested square brackets, along with any other characters
97# inner bracket blocks return with the '[...]' so that nested
98# blocks get the braces treated as literals
99bracket_block: '[' <skip:''> bracket_block_content(s) ']' { join('', @{ $item[3] }) }
100inner_bracket_block: '[' <skip:''> bracket_block_content(s) ']' { '[' . join('', @{ $item[3] }) . ']'; }
101bracket_block_content: /[^\[\]]+?/ | inner_bracket_block
[57]102
103
[64]104# field lines are the subset of lines that are allowed in a !group directive
[21]105field_line: <skip:'[ \t]*'> ( field | comment | blank ) "\n"
[64]106
[63]107line: <skip:'[ \t]*'> ( title | author | pattern_def | section_head | heading | group_field | field_group | unknown_directive | field | comment | blank ) "\n"
[21]108
[1]109title: '!title' /.*/
[28]110    {
[57]111        warn "[Text::FormBuilder] Title redefined at input text line $thisline\n" if defined $title;
[28]112        $title = $item[2];
113    }
[1]114
115author: '!author' /.*/
[28]116    {
[57]117        warn "[Text::FormBuilder] Author redefined at input text line $thisline\n" if defined $author;
[28]118        $author = $item[2];
119    }
[1]120
[16]121pattern_def: '!pattern' var_name pattern
122    { $patterns{$item{var_name}} = $item{pattern} }
[1]123
124pattern: /.*/
125
[29]126section_head: '!section' identifier /.*/
127    {
128        #warn "starting section $item{identifier}\n";
129        #warn "  with heading $item[3]\n" if $item[3];
130       
131        if (@lines) {
132            push @sections,
133                {
134                    id   => $section_id,
135                    head => $section_head,
136                    lines => [ @lines ],
137                };
138        }
139       
140        $section_id = $item{identifier};
141        $section_head = $item[3];
142        @lines = ();
143    }
144
[28]145heading: '!head' /.*/    { push @lines, [ 'head', $item[2] ] }
[11]146
[21]147group_field: '!field' group_name name label(?)
[28]148    {
149        push @lines, [ 'group', { name => $item{name}, label => $item{'label(?)'}[0], group => $item{group_name} } ];
[21]150    }
151
152group_name: /%[A-Z_]+/
153
[63]154field_group: name label(?) group_type
155    {
156        #warn "[$thisline] field $item{name} is $item{group_type}\n";
157        push @lines, [ 'group', { name => $item{name}, label => $item{'label(?)'}[0], group => $item{group_type} } ];
158    }
159
160group_type: ':' var_name
161
[64]162# this is the real heart of the thing
[66]163field: name field_size(?) growable(?) label(?) hint(?) type(?) other(?) default(?) option_list(?) validate(?) comment(?)
[1]164    {
165        my $field = {
166            name     => $item{name},
[66]167            growable => $item{'growable(?)'}[0],
[1]168            label    => $item{'label(?)'}[0],
169            comment  => $item{'hint(?)'}[0],
170            type     => $item{'type(?)'}[0],
[66]171            other    => $item{'other(?)'}[0],
[1]172            value    => $item{'default(?)'}[0],
[63]173            list     => $list_var,
174            validate => $item{'validate(?)'}[0],
[68]175            required => $required,
[1]176        };
177       
178        $$field{options} = [ @options ] if @options;
179       
180        $$field{rows} = $rows if defined $rows;
181        $$field{cols} = $cols if defined $cols;
182        $$field{size} = $size if defined $size;
[56]183        $$field{maxlength} = $maxlength if defined $maxlength;
[1]184       
[28]185        #warn "[$thisline] field $item{name}; context $context\n";
[21]186        if ($context eq 'group') {
187            push @group, $field;
188        } else {
189            push @lines, [ 'field', $field ];
190        }
[1]191       
192        $type = undef;
[68]193        $required = undef;
[1]194        $list_var = undef;
195        $size = undef;
196        $rows = undef;
197        $cols = undef;
[56]198        $maxlength = undef;
[1]199        @options = ();
[63]200       
[62]201        $field;
[1]202    }
203   
204name: identifier
205
[16]206var_name: /[A-Z_]+/
207
[1]208field_size: '[' ( row_col | size ) ']'
209
[56]210size: /\d+/ bang(?)
211    { $maxlength = $item[1] if $item[2][0]; $size = $item[1] }
[1]212
[56]213bang: '!'
214
[1]215row_col: /\d+/ /,\s*/ /\d+/
216    { $rows = $item[1]; $cols = $item[3] }
217
[66]218growable: '*' limit(?) { $item{'limit(?)'}[0] || 1 }
[61]219
[66]220limit: /\d+/
221
[22]222label: '|' (simple_multiword | quoted_string) { $item[2] }
[1]223
[64]224hint: bracket_block
[1]225
[63]226type: ':' builtin_field
[1]227
[55]228builtin_field: /textarea|text|password|file|checkbox|radio|select|hidden|static/
229
[66]230other: '+' 'other' { 1 }
[55]231
[22]232default: '=' (simple_multiword | quoted_string) { $item[2] }
[1]233
[22]234# for simple multiword values not involving punctuation
[68]235simple_multiword: <skip:''> /\w[\w\t ]*/ { $item[2] }
[22]236
237# my attempt at a single-quoted, non-interpolating string
238# where the backslash can escape literal single quotes
239quoted_string: <skip:''> "'" /(\\'|[^'])*/ "'"
240    { $item[3] =~ s/\\'/'/g; $item[3] }
241
[1]242option_list: options | list_var
243   
[66]244options: '{' option(s /,/) '}'
[1]245
246list_var: /@[A-Z_]+/ { $list_var = $item[1] }
247
[66]248option: (simple_multiword | quoted_string) display_text(?)
[23]249    { push @options, { $item[1] => $item{'display_text(?)'}[0] } }
[1]250
251value: identifier
252
[64]253display_text: bracket_block
[1]254
[59]255
[64]256validate: '//' (optional_pattern | required_pattern)
[59]257
[64]258optional_pattern: var_name '?'  { $required = 0; $item[1] }
[1]259
[64]260required_pattern: var_name { $required = 1; $item[1] }
[24]261
[1]262comment: '#' /.*/
263blank:
264
265identifier: /\w+/
[16]266
267# skip unknown directives with a warning
268unknown_directive: /\!\S*/ /.*/
269    { warn "[Text::Formbuilder] Skipping unknown directive '$item[1]' at input text line $thisline\n"; }
Note: See TracBrowser for help on using the repository browser.