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

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

added single-quoted strings for label and default

File size: 4.5 KB
Line 
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}
23
24form_spec: (list_def | description_def | group_def | line)(s)
25    {
26        $return = {
27            title    => $title,
28            author   => $author,
29            description => $description,
30            lists    => \%lists,
31            patterns => \%patterns,
32            headings => \@headings,
33            fields   => \@fields,
34            lines    => \@lines,
35            groups   => \%groups,
36        }
37    }
38
39list_def: '!list' var_name (static_list | dynamic_list)
40    { $lists{$item{var_name}} = [ @options ]; @options = () }
41
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
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
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    }
67
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
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
78pattern_def: '!pattern' var_name pattern
79    { $patterns{$item{var_name}} = $item{pattern} }
80
81pattern: /.*/
82
83heading: '!head' /.*/
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    }
89
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
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       
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        }
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
134var_name: /[A-Z_]+/
135
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
144label: '|' (simple_multiword | quoted_string) { $item[2] }
145
146hint: '[' /[^\]]+/ ']'    { $item[2] }
147
148type: ':' /textarea|text|password|file|checkbox|radio|select|hidden|static/
149
150default: '=' (simple_multiword | quoted_string) { $item[2] }
151
152# for simple multiword values not involving punctuation
153simple_multiword: <skip:''> /[\w\t ]+/ { $item[2] }
154
155# my attempt at a single-quoted, non-interpolating string
156# where the backslash can escape literal single quotes
157quoted_string: <skip:''> "'" /(\\'|[^'])*/ "'"
158    { $item[3] =~ s/\\'/'/g; $item[3] }
159
160option_list: options | list_var
161   
162options: '{' option(s /,\s*/) '}'
163
164list_var: /@[A-Z_]+/ { $list_var = $item[1] }
165
166option: value display_text(?)
167    { push @options, { $item{value} => $item{'display_text(?)'}[0] } }
168
169value: identifier
170
171display_text: '[' /[^\]]+/i ']'    { $item[2] }
172
173validate: '//' value
174
175comment: '#' /.*/
176blank:
177
178identifier: /\w+/
179
180# skip unknown directives with a warning
181unknown_directive: /\!\S*/ /.*/
182    { warn "[Text::Formbuilder] Skipping unknown directive '$item[1]' at input text line $thisline\n"; }
Note: See TracBrowser for help on using the repository browser.