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

Last change on this file since 65 was 64, checked in by peichman, 20 years ago

fixed grammar so that outer {} and [] are no longer included in the (bracket_)block values
using bracket_block instead of hardcoded pattern for matching hints in formspec
removed dynamic lists from the grammar
some general code cleanup and tidying, in FormBuilder.pm and grammar
added fb.pl to the MANIFEST
bumped back FB version requirement to 3.0 (Makefile.PL)
test for FB3.02 for using growable fields; warn and ignore if verison isn't high enough

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