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

Last change on this file since 21 was 21, checked in by peter, 20 years ago

added !group and !field directive to the language to allow for horizontal groups of input fields
moving to a new representation of the parsed formspec based on lines as opposed to fields

File size: 4.2 KB
RevLine 
[21]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}
[1]23
[21]24form_spec: (list_def | description_def | group_def | line)(s)
[1]25    {
26        $return = {
27            title    => $title,
28            author   => $author,
[14]29            description => $description,
[1]30            lists    => \%lists,
31            patterns => \%patterns,
[11]32            headings => \@headings,
[1]33            fields   => \@fields,
[21]34            lines    => \@lines,
35            groups   => \%groups,
[1]36        }
37    }
38
[16]39list_def: '!list' var_name (static_list | dynamic_list)
40    { $lists{$item{var_name}} = [ @options ]; @options = () }
[1]41
[10]42static_list: '{' option(s /,\s*/) /,?/ '}'
43
44dynamic_list: '&' <perl_codeblock>
45    {
46        my @results = (eval $item[2]);
47        if (ref $results[0] eq 'HASH') {
48            @options = @results;
49        } else {   
50            @options = map { { $_ => $_ } } @results;
51        }
52    }
53
[14]54description_def: '!description' <perl_codeblock>
55    { warn "[Text::FormBuilder] Description redefined at input text line $thisline\n" if defined $description;
56   
57    $description = $item[2];
58    $description =~ s/^{\s*|\s*}$//g;
59    }
60
[21]61group_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    }
[1]67
[21]68field_line: <skip:'[ \t]*'> ( field | comment | blank ) "\n"
69line: <skip:'[ \t]*'> ( title | author | pattern_def | heading | group_field | unknown_directive | field | comment | blank ) "\n"
70
[1]71title: '!title' /.*/
72    { warn "[Text::Formbuilder] Title redefined at input text line $thisline\n" if defined $title;
73    $title = $item[2] }
74
75author: '!author' /.*/
76    { $author = $item[2] }
77
[16]78pattern_def: '!pattern' var_name pattern
79    { $patterns{$item{var_name}} = $item{pattern} }
[1]80
81pattern: /.*/
82
[11]83heading: '!head' /.*/
[21]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    }
[11]89
[21]90group_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
95group_name: /%[A-Z_]+/
96
[1]97field: name field_size(?) label(?) hint(?) type(?) default(?) option_list(?) validate(?)
98    {
99        my $field = {
100            name     => $item{name},
101            label    => $item{'label(?)'}[0],
102            comment  => $item{'hint(?)'}[0],
103            type     => $item{'type(?)'}[0],
104            value    => $item{'default(?)'}[0],
105            list     => $list_var,
106            validate => $item{'validate(?)'}[0],
107        };
108       
109        $$field{options} = [ @options ] if @options;
110       
111        $$field{rows} = $rows if defined $rows;
112        $$field{cols} = $cols if defined $cols;
113        $$field{size} = $size if defined $size;
114       
[21]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        }
[1]122       
123        $type = undef;
124        $list_var = undef;
125        $size = undef;
126        $rows = undef;
127        $cols = undef;
128        @options = ();
129       
130    }
131   
132name: identifier
133
[16]134var_name: /[A-Z_]+/
135
[1]136field_size: '[' ( row_col | size ) ']'
137
138size: /\d+/
139    { $size = $item[1] }
140
141row_col: /\d+/ /,\s*/ /\d+/
142    { $rows = $item[1]; $cols = $item[3] }
143
[21]144#TODO: zero width labels
145label: '|' /[^:\[\{\/\n]*/i { $item[2] }
[1]146
147hint: '[' /[^\]]+/ ']'    { $item[2] }
148
149type: ':' /textarea|text|password|file|checkbox|radio|select|hidden|static/
150
151default: '=' /[^\@\{\s]+/
152
153option_list: options | list_var
154   
155options: '{' option(s /,\s*/) '}'
156
157list_var: /@[A-Z_]+/ { $list_var = $item[1] }
158
159option: value display_text(?)
160    { push @options, { $item{value} => $item{'display_text(?)'}[0] } }
161
162value: identifier
163
164display_text: '[' /[^\]]+/i ']'    { $item[2] }
165
166validate: '//' value
167
168comment: '#' /.*/
169blank:
170
171identifier: /\w+/
[16]172
173# skip unknown directives with a warning
174unknown_directive: /\!\S*/ /.*/
175    { warn "[Text::Formbuilder] Skipping unknown directive '$item[1]' at input text line $thisline\n"; }
Note: See TracBrowser for help on using the repository browser.