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

Last change on this file since 73 was 73, checked in by peichman, 19 years ago

updated Changes file
can have a hint comment on group fields (displayed after all the subfields)
'#' comments can appear at the end of lines in group field lines

File size: 7.1 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
[73]154field_group: name label(?) hint(?) group_type comment(?)
155    {
156        warn "[$thisline] comment = $item{'hint(?)'}[0]\n" if $item{'hint(?)'}[0];
[63]157        #warn "[$thisline] field $item{name} is $item{group_type}\n";
[73]158        push @lines, [ 'group', {
159            name    => $item{name},
160            label   => $item{'label(?)'}[0],
161            comment => $item{'hint(?)'}[0],
162            group   => $item{group_type},
163        } ];
[63]164    }
165
166group_type: ':' var_name
167
[64]168# this is the real heart of the thing
[66]169field: name field_size(?) growable(?) label(?) hint(?) type(?) other(?) default(?) option_list(?) validate(?) comment(?)
[1]170    {
171        my $field = {
172            name     => $item{name},
[66]173            growable => $item{'growable(?)'}[0],
[1]174            label    => $item{'label(?)'}[0],
175            comment  => $item{'hint(?)'}[0],
176            type     => $item{'type(?)'}[0],
[66]177            other    => $item{'other(?)'}[0],
[1]178            value    => $item{'default(?)'}[0],
[63]179            list     => $list_var,
180            validate => $item{'validate(?)'}[0],
[68]181            required => $required,
[1]182        };
183       
184        $$field{options} = [ @options ] if @options;
185       
186        $$field{rows} = $rows if defined $rows;
187        $$field{cols} = $cols if defined $cols;
188        $$field{size} = $size if defined $size;
[56]189        $$field{maxlength} = $maxlength if defined $maxlength;
[1]190       
[28]191        #warn "[$thisline] field $item{name}; context $context\n";
[21]192        if ($context eq 'group') {
193            push @group, $field;
194        } else {
195            push @lines, [ 'field', $field ];
196        }
[1]197       
198        $type = undef;
[68]199        $required = undef;
[1]200        $list_var = undef;
201        $size = undef;
202        $rows = undef;
203        $cols = undef;
[56]204        $maxlength = undef;
[1]205        @options = ();
[63]206       
[62]207        $field;
[1]208    }
209   
210name: identifier
211
[16]212var_name: /[A-Z_]+/
213
[1]214field_size: '[' ( row_col | size ) ']'
215
[56]216size: /\d+/ bang(?)
217    { $maxlength = $item[1] if $item[2][0]; $size = $item[1] }
[1]218
[56]219bang: '!'
220
[1]221row_col: /\d+/ /,\s*/ /\d+/
222    { $rows = $item[1]; $cols = $item[3] }
223
[66]224growable: '*' limit(?) { $item{'limit(?)'}[0] || 1 }
[61]225
[66]226limit: /\d+/
227
[22]228label: '|' (simple_multiword | quoted_string) { $item[2] }
[1]229
[64]230hint: bracket_block
[1]231
[63]232type: ':' builtin_field
[1]233
[55]234builtin_field: /textarea|text|password|file|checkbox|radio|select|hidden|static/
235
[66]236other: '+' 'other' { 1 }
[55]237
[22]238default: '=' (simple_multiword | quoted_string) { $item[2] }
[1]239
[22]240# for simple multiword values not involving punctuation
[68]241simple_multiword: <skip:''> /\w[\w\t ]*/ { $item[2] }
[22]242
243# my attempt at a single-quoted, non-interpolating string
244# where the backslash can escape literal single quotes
245quoted_string: <skip:''> "'" /(\\'|[^'])*/ "'"
246    { $item[3] =~ s/\\'/'/g; $item[3] }
247
[1]248option_list: options | list_var
249   
[66]250options: '{' option(s /,/) '}'
[1]251
252list_var: /@[A-Z_]+/ { $list_var = $item[1] }
253
[66]254option: (simple_multiword | quoted_string) display_text(?)
[23]255    { push @options, { $item[1] => $item{'display_text(?)'}[0] } }
[1]256
257value: identifier
258
[64]259display_text: bracket_block
[1]260
[59]261
[64]262validate: '//' (optional_pattern | required_pattern)
[59]263
[64]264optional_pattern: var_name '?'  { $required = 0; $item[1] }
[1]265
[64]266required_pattern: var_name { $required = 1; $item[1] }
[24]267
[1]268comment: '#' /.*/
269blank:
270
271identifier: /\w+/
[16]272
273# skip unknown directives with a warning
274unknown_directive: /\!\S*/ /.*/
275    { warn "[Text::Formbuilder] Skipping unknown directive '$item[1]' at input text line $thisline\n"; }
Note: See TracBrowser for help on using the repository browser.