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

{ my ($title, $author, $description, %lists, %patterns, @fields, @headings, $type, @options, $list_var, $size, $rows, $cols); }

form_spec: (list_def | description_def | line)(s) 
    {
        $return = {
            title    => $title,
            author   => $author,
            description => $description,
            lists    => \%lists, 
            patterns => \%patterns, 
            headings => \@headings,
            fields   => \@fields,
        }
    }

list_def: '!list' var_name (static_list | dynamic_list)
    { $lists{$item{var_name}} = [ @options ]; @options = () }

static_list: '{' option(s /,\s*/) /,?/ '}'

dynamic_list: '&' <perl_codeblock>
    {
        my @results = (eval $item[2]);
        if (ref $results[0] eq 'HASH') {
            @options = @results;
        } else {    
            @options = map { { $_ => $_ } } @results;
        }
    }

description_def: '!description' <perl_codeblock>
    { warn "[Text::FormBuilder] Description redefined at input text line $thisline\n" if defined $description;
    
    $description = $item[2];
    $description =~ s/^{\s*|\s*}$//g;
    }

line: <skip:'[ \t]*'> ( title | author | pattern_def | heading | unknown_directive | field | comment | blank ) "\n"

title: '!title' /.*/
    { warn "[Text::Formbuilder] Title redefined at input text line $thisline\n" if defined $title;
    $title = $item[2] }

author: '!author' /.*/
    { $author = $item[2] }

pattern_def: '!pattern' var_name pattern
    { $patterns{$item{var_name}} = $item{pattern} }

pattern: /.*/

heading: '!head' /.*/
    { warn "[Text::FormBuilder] Header before field " . scalar(@fields) . " redefined at input text line $thisline\n" if defined $headings[@fields];
    $headings[@fields] = $item[2] }

field: name field_size(?) label(?) hint(?) type(?) default(?) option_list(?) validate(?)
    {
        my $field = {
            name     => $item{name},
            label    => $item{'label(?)'}[0],
            comment  => $item{'hint(?)'}[0],
            type     => $item{'type(?)'}[0],
            value    => $item{'default(?)'}[0],
            list     => $list_var,
            validate => $item{'validate(?)'}[0],
        };
        
        $$field{options} = [ @options ] if @options;
        
        $$field{rows} = $rows if defined $rows;
        $$field{cols} = $cols if defined $cols;
        $$field{size} = $size if defined $size;
        
        push @fields, $field;
        
        $type = undef;
        $list_var = undef;
        $size = undef;
        $rows = undef;
        $cols = undef;
        @options = ();
        
    }
    
name: identifier

var_name: /[A-Z_]+/

field_size: '[' ( row_col | size ) ']'

size: /\d+/
    { $size = $item[1] }

row_col: /\d+/ /,\s*/ /\d+/
    { $rows = $item[1]; $cols = $item[3] }

label: '|' /[^:\[\{\/]+/i

hint: '[' /[^\]]+/ ']'    { $item[2] }

type: ':' /textarea|text|password|file|checkbox|radio|select|hidden|static/

default: '=' /[^\@\{\s]+/

option_list: options | list_var
    
options: '{' option(s /,\s*/) '}'

list_var: /@[A-Z_]+/ { $list_var = $item[1] }

option: value display_text(?)
    { push @options, { $item{value} => $item{'display_text(?)'}[0] } }

value: identifier

display_text: '[' /[^\]]+/i ']'    { $item[2] }

validate: '//' value

comment: '#' /.*/
blank:

identifier: /\w+/

# skip unknown directives with a warning
unknown_directive: /\!\S*/ /.*/
    { warn "[Text::Formbuilder] Skipping unknown directive '$item[1]' at input text line $thisline\n"; }