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

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

fixed errors from undefined references
removed old field/heading code from grammar

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        @group,        # current group
11        %groups,       # stored groups of fields
12        $type,
13        @options,
14        $required,
15        $list_var,
16        $size,
17        $rows,
18        $cols,
19    );
20    $context = 'line';
21}
22
23form_spec: (list_def | description_def | group_def | line)(s)
24    {
25        $return = {
26            title    => $title,
27            author   => $author,
28            description => $description,
29            lists    => \%lists,
30            patterns => \%patterns,
31            lines    => \@lines,
32            groups   => \%groups,
33        }
34    }
35
36list_def: '!list' var_name (static_list | dynamic_list)
37    { $lists{$item{var_name}} = [ @options ]; @options = () }
38
39static_list: '{' option(s /,\s*/) /,?/ '}'
40
41dynamic_list: '&' <perl_codeblock>
42    {
43        my @results = (eval $item[2]);
44        if (ref $results[0] eq 'HASH') {
45            @options = @results;
46        } else {   
47            @options = map { { $_ => $_ } } @results;
48        }
49    }
50
51description_def: '!description' <perl_codeblock>
52    { warn "[Text::FormBuilder] Description redefined at input text line $thisline\n" if defined $description;
53   
54    $description = $item[2];
55    $description =~ s/^{\s*|\s*}$//g;
56    }
57
58group_def: '!group' { $context = 'group' } var_name '{' field_line(s) '}' { $context = 'line' }
59    {
60        #warn "$item{var_name} group; context $context\n"
61        $groups{$item{var_name}} = [ @group ];
62        @group = ();
63    }
64
65field_line: <skip:'[ \t]*'> ( field | comment | blank ) "\n"
66line: <skip:'[ \t]*'> ( title | author | pattern_def | heading | group_field | unknown_directive | field | comment | blank ) "\n"
67
68title: '!title' /.*/
69    {
70        warn "[Text::Formbuilder] Title redefined at input text line $thisline\n" if defined $title;
71        $title = $item[2];
72    }
73
74author: '!author' /.*/
75    {
76        warn "[Text::Formbuilder] Author redefined at input text line $thisline\n" if defined $author;
77        $author = $item[2];
78    }
79
80pattern_def: '!pattern' var_name pattern
81    { $patterns{$item{var_name}} = $item{pattern} }
82
83pattern: /.*/
84
85heading: '!head' /.*/    { push @lines, [ 'head', $item[2] ] }
86
87group_field: '!field' group_name name label(?)
88    {
89        push @lines, [ 'group', { name => $item{name}, label => $item{'label(?)'}[0], group => $item{group_name} } ];
90    }
91
92group_name: /%[A-Z_]+/
93
94field: name field_size(?) label(?) hint(?) type(?) default(?) option_list(?) validate(?)
95    {
96        my $field = {
97            name     => $item{name},
98            label    => $item{'label(?)'}[0],
99            comment  => $item{'hint(?)'}[0],
100            type     => $item{'type(?)'}[0],
101            value    => $item{'default(?)'}[0],
102            list     => $list_var,
103            validate => $item{'validate(?)'}[0],
104            required => $required || 0,
105        };
106       
107        $$field{options} = [ @options ] if @options;
108       
109        $$field{rows} = $rows if defined $rows;
110        $$field{cols} = $cols if defined $cols;
111        $$field{size} = $size if defined $size;
112       
113        #warn "[$thisline] field $item{name}; context $context\n";
114        if ($context eq 'group') {
115            push @group, $field;
116        } else {
117            push @lines, [ 'field', $field ];
118        }
119       
120        $type = undef;
121        $required = 0;
122        $list_var = undef;
123        $size = undef;
124        $rows = undef;
125        $cols = undef;
126        @options = ();
127       
128    }
129   
130name: identifier
131
132var_name: /[A-Z_]+/
133
134field_size: '[' ( row_col | size ) ']'
135
136size: /\d+/
137    { $size = $item[1] }
138
139row_col: /\d+/ /,\s*/ /\d+/
140    { $rows = $item[1]; $cols = $item[3] }
141
142label: '|' (simple_multiword | quoted_string) { $item[2] }
143
144hint: '[' /[^\]]+/ ']'    { $item[2] }
145
146type: ':' /textarea|text|password|file|checkbox|radio|select|hidden|static/
147
148default: '=' (simple_multiword | quoted_string) { $item[2] }
149
150# for simple multiword values not involving punctuation
151simple_multiword: <skip:''> /[\w\t ]+/ { $item[2] }
152
153# my attempt at a single-quoted, non-interpolating string
154# where the backslash can escape literal single quotes
155quoted_string: <skip:''> "'" /(\\'|[^'])*/ "'"
156    { $item[3] =~ s/\\'/'/g; $item[3] }
157
158option_list: options | list_var
159   
160options: '{' option(s /,\s*/) '}'
161
162list_var: /@[A-Z_]+/ { $list_var = $item[1] }
163
164option: (simple_multiword | value | quoted_string) display_text(?)
165    { push @options, { $item[1] => $item{'display_text(?)'}[0] } }
166
167value: identifier
168
169display_text: '[' /[^\]]+/i ']'    { $item[2] }
170
171validate: '//' (optional_pattern | required_pattern)    { $item[2] }
172
173optional_pattern: /[A-Z_]+/ '?' { $required = 0; $item[1] }
174
175required_pattern: /[A-Z_]+/ { $required = 1; $item[1] }
176
177comment: '#' /.*/
178blank:
179
180identifier: /\w+/
181
182# skip unknown directives with a warning
183unknown_directive: /\!\S*/ /.*/
184    { warn "[Text::Formbuilder] Skipping unknown directive '$item[1]' at input text line $thisline\n"; }
Note: See TracBrowser for help on using the repository browser.