Changeset 21 in text-formbuilder


Ignore:
Timestamp:
11/12/04 16:54:23 (20 years ago)
Author:
peter
Message:

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

Location:
trunk/lib/Text
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/lib/Text/FormBuilder.pm

    r19 r21  
    66use vars qw($VERSION); 
    77 
    8 $VERSION = '0.05'; 
     8$VERSION = '0.06'; 
    99 
    1010use Carp; 
    … …  
    8787        delete $$_{validate} unless $$_{validate}; 
    8888    } 
     89 
     90    # expand groups 
     91    my %groups = %{ $self->{form_spec}{groups} }; 
     92    foreach (grep { $$_[0] eq 'group' } @{ $self->{form_spec}{lines} }) { 
     93        $$_[1]{group} =~ s/^\%//;       # strip leading % from group var name 
     94         
     95        if (exists $groups{$$_[1]{group}}) { 
     96            my @fields; # fields in the group 
     97            push @fields, { %$_ } foreach @{ $groups{$$_[1]{group}} }; 
     98            for my $field (@fields) { 
     99                $$field{label} ||= ucfirst $$field{name}; 
     100                $$field{name} = "$$_[1]{name}_$$field{name}";                 
     101            } 
     102            $_ = [ 'group', { label => $$_[1]{label} || ucfirst(join(' ',split('_',$$_[1]{name}))), group => \@fields } ]; 
     103        } 
     104    } 
     105     
     106    $self->{form_spec}{fields} = []; 
     107    for my $line (@{ $self->{form_spec}{lines} }) { 
     108        if ($$line[0] eq 'group') { 
     109            push @{ $self->{form_spec}{fields} }, $_ foreach @{ $$line[1]{group} }; 
     110        } elsif ($$line[0] eq 'field') { 
     111            push @{ $self->{form_spec}{fields} }, $$line[1]; 
     112        } 
     113    } 
     114     
    89115     
    90116    # substitute in list names 
    … …  
    105131        } 
    106132    } 
    107  
     133     
     134     
     135     
     136 
     137     
     138    # TODO: use lines instead of fields 
     139    # TODO: change template to do groups 
     140     
    108141    # TODO: configurable threshold for this 
    109142    foreach (@{ $self->{form_spec}{fields} }) { 
    … …  
    116149        keepextras => 1, 
    117150        title => $self->{form_spec}{title}, 
    118         fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ], 
     151        #fields => [ map { $$_{name} } @{ $self->{form_spec}{fields} } ], 
    119152        template => { 
    120153            type => 'Text', 
    … …  
    125158            }, 
    126159            data => { 
     160                lines       => $self->{form_spec}{lines}, 
    127161                headings    => $self->{form_spec}{headings}, 
    128162                author      => $self->{form_spec}{author}, 
    … …  
    137171    $self->{built} = 1; 
    138172     
     173    # TEMP: dump @lines structure 
     174    use YAML; 
     175    warn YAML::Dump($self->{form_spec}->{lines}), "\n"; 
     176     
    139177    return $self; 
    140178} 
    … …  
    182220    my $source = $options{form_only} ? $self->_form_template : $self->_template; 
    183221     
    184     delete $options{fomr_only}; 
     222    delete $options{form_only}; 
    185223     
    186224    my $form_options = keys %options > 0 ? Data::Dumper->Dump([$self->{build_options}],['*options']) : ''; 
    … …  
    262300<% $start %> 
    263301<table> 
    264 <% my $i; foreach(@fields) { 
    265     $OUT .= qq[  <tr><th class="sectionhead" colspan="2"><h2>$headings[$i]</h2></th></tr>\n] if $headings[$i]; 
    266     $OUT .= $$_{invalid} ? qq[  <tr class="invalid">] : qq[  <tr>]; 
    267     $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>'; 
    268     if ($$_{invalid}) { 
    269         $OUT .= qq[<td>$$_{field} $$_{comment} Missing or invalid value.</td></tr>\n]; 
    270     } else { 
    271         $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n]; 
    272     } 
    273     $i++; 
     302 
     303<% for my $line (@lines) { 
     304 
     305    if ($$line[0] eq 'head') { 
     306        $OUT .= qq[  <tr><th class="sectionhead" colspan="2"><h2>$$line[1]</h2></th></tr>\n] 
     307    } elsif ($$line[0] eq 'field') { 
     308        #TODO: we only need the field names, not the full field spec in the lines strucutre 
     309        local $_ = $field{$$line[1]{name}}; 
     310        $OUT .= $$_{invalid} ? qq[  <tr class="invalid">] : qq[  <tr>]; 
     311        $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}:</strong>] : "$$_{label}:") . '</th>'; 
     312        if ($$_{invalid}) { 
     313            $OUT .= qq[<td>$$_{field} $$_{comment} Missing or invalid value.</td></tr>\n]; 
     314        } else { 
     315            $OUT .= qq[<td>$$_{field} $$_{comment}</td></tr>\n]; 
     316        } 
     317    } elsif ($$line[0] eq 'group') { 
     318        my @field_names = map { $$_{name} } @{ $$line[1]{group} }; 
     319        my @group_fields = map { $field{$_} } @field_names; 
     320        $OUT .= (grep { $$_{invalid} } @group_fields) ? qq[  <tr class="invalid">\n] : qq[  <tr>\n]; 
     321         
     322         
     323        #TODO: validated but not required fields 
     324        # in a form spec: //EMAIL? 
     325         
     326        #TODO: this doesn't seem to be working; all groups are getting marked as required         
     327        $OUT .= '    <th class="label">'; 
     328        $OUT .= (grep { $$_{required} } @group_fields) ? qq[<strong class="required">$$line[1]{label}:</strong>] : "$$line[1]{label}:"; 
     329        $OUT .= qq[</th>\n]; 
     330         
     331        $OUT .= qq[    <td>]; 
     332        $OUT .= join(' ', map { qq[<small class="sublabel">$$_{label}</small> $$_{field} $$_{comment}] } @group_fields); 
     333        $OUT .= qq[    </td>\n]; 
     334        $OUT .= qq[  </tr>\n]; 
     335    }    
     336     
     337 
    274338} %> 
    275339  <tr><th></th><td style="padding-top: 1em;"><% $submit %></td></tr> 
    … …  
    290354    th.label { font-weight: normal; text-align: right; vertical-align: top; } 
    291355    td ul { list-style: none; padding-left: 0; margin-left: 0; } 
     356    .sublabel { color: #999; } 
    292357  </style> 
    293358</head> 
    … …  
    321386=head1 NAME 
    322387 
    323 Text::FormBuilder - Parser for a minilanguage for generating web forms 
     388Text::FormBuilder - Create CGI::FormBuilder objects from simple text descriptions 
    324389 
    325390=head1 SYNOPSIS 
    … …  
    536601    static 
    537602 
    538 This example also shows how you can list multiple values for the input types 
    539 that take multiple values (C<select>, C<radio>, and C<checkbox>). Values are 
    540 in a comma-separated list inside curly braces. Whitespace between values is 
    541 irrelevant, although there cannot be any whitespace within a value. 
     603To change the size of the input field, add a bracketed subscript after the 
     604field name (but before the descriptive label): 
     605 
     606    # for a single line field, sets size="40" 
     607    title[40]:text 
     608     
     609    # for a multiline field, sets rows="4" and cols="30" 
     610    description[4,30]:textarea 
     611 
     612For the input types that can have options (C<select>, C<radio>, and 
     613C<checkbox>), here's how you do it: 
     614 
     615    color|Favorite color:select{red,blue,green} 
     616 
     617Values are in a comma-separated list inside curly braces. Whitespace 
     618between values is irrelevant, although there cannot be any whitespace 
     619within a value. 
    542620 
    543621To add more descriptive display text to a vlaue in a list, add a square-bracketed 
    … …  
    566644The code inside the C<&{ ... }> is C<eval>ed by C<build>, and the results 
    567645are stuffed into the list. The C<eval>ed code can either return a simple 
    568 list, as the example does, or the fancier C<( { value1 => 'Description 1'}, 
    569 { value2 => 'Description 2}, ...)> form. 
     646list, as the example does, or the fancier C<< ( { value1 => 'Description 1'}, 
     647{ value2 => 'Description 2}, ... ) >> form. 
    570648 
    571649B<NOTE:> This feature of the language may go away unless I find a compelling 
    … …  
    583661    email|Email address//EMAIL 
    584662 
    585 Valid validation types include any of the builtin defaults from CGI::FormBuilder, 
     663Valid validation types include any of the builtin defaults from L<CGI::FormBuilder>, 
    586664or the name of a pattern that you define with the C<!pattern> directive elsewhere 
    587665in your form spec: 

  • trunk/lib/Text/FormBuilder/grammar

    r16 r21  
    1 { my ($title, $author, $description, %lists, %patterns, @fields, @headings, $type, @options, $list_var, $size, $rows, $cols); } 
     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} 
    223 
    3 form_spec: (list_def | description_def | line)(s)  
     24form_spec: (list_def | description_def | group_def | line)(s)  
    425    { 
    526        $return = { 
    … …  
    1132            headings => \@headings, 
    1233            fields   => \@fields, 
     34            lines    => \@lines, 
     35            groups   => \%groups, 
    1336        } 
    1437    } 
    … …  
    3659    } 
    3760 
    38 line: <skip:'[ \t]*'> ( title | author | pattern_def | heading | unknown_directive | field | comment | blank ) "\n" 
     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" 
    3970 
    4071title: '!title' /.*/ 
    … …  
    5182 
    5283heading: '!head' /.*/ 
    53     { warn "[Text::FormBuilder] Header before field " . scalar(@fields) . " redefined at input text line $thisline\n" if defined $headings[@fields]; 
    54     $headings[@fields] = $item[2] } 
     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_]+/ 
    5596 
    5697field: name field_size(?) label(?) hint(?) type(?) default(?) option_list(?) validate(?) 
    … …  
    72113        $$field{size} = $size if defined $size; 
    73114         
    74         push @fields, $field; 
     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        } 
    75122         
    76123        $type = undef; 
    … …  
    95142    { $rows = $item[1]; $cols = $item[3] } 
    96143 
    97 label: '|' /[^:\[\{\/]+/i 
     144#TODO: zero width labels 
     145label: '|' /[^:\[\{\/\n]*/i { $item[2] } 
    98146 
    99147hint: '[' /[^\]]+/ ']'    { $item[2] } 
Note: See TracChangeset for help on using the changeset viewer.