Changeset 82 in text-formbuilder for trunk/lib


Ignore:
Timestamp:
04/21/05 10:48:19 (20 years ago)
Author:
peichman
Message:

added a $parser->{debug} attribute to Class::ParseText::Base that controls $::RD_TRACE
added as_script and as_module methods that return the Perl code without writing to a file
changed required field message and markers

Location:
trunk/lib
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/lib/Class/ParseText/Base.pm

    r75 r82  
    7878    croak '[' . (caller(0))[3] . '] No start rule given for the parser' unless defined $start_rule; 
    7979     
     80    # set the trace in RecDescent if we have the debug flag 
     81    $::RD_TRACE = $self->{debug} ? 1 : undef; 
     82     
    8083    $self->{$start_rule} = $self->{parser}->$start_rule($src); 
    8184     
  • trunk/lib/Text/FormBuilder.pm

    r81 r82  
    3636th { text-align: left; } 
    3737th h2 { padding: .125em .5em; background: #eee; font-size: 1.25em; } 
    38 th.label { font-weight: normal; text-align: right; vertical-align: top; } 
     38.label { font-weight: normal; text-align: right; vertical-align: top; } 
    3939td ul { list-style: none; padding-left: 0; margin-left: 0; } 
    4040.note { background: #eee; padding: .5em 1em; } 
     
    4747    text_author   => 'Created by %s', 
    4848    text_madewith => 'Made with %s version %s', 
    49     text_required => '(Required fields are marked in <strong>bold</strong>.)', 
     49    text_required => '* denotes a <strong>required field</strong>.', 
    5050    text_invalid  => 'Missing or invalid value.', 
    5151); 
     
    363363        map { $object_name . '->field' . Data::Dumper->Dump([$_],['*field']) . ';' } @{ $self->{form_spec}{fields} } 
    364364    ); 
    365 }     
    366  
    367 sub write_module { 
     365} 
     366 
     367sub as_module { 
    368368    my ($self, $package, $use_tidy) = @_; 
    369369 
     
    372372    # remove a trailing .pm 
    373373    $package =~ s/\.pm$//; 
    374 ##     warn  "[Text::FromBuilder::write_module] Removed extra '.pm' from package name\n" if $package =~ s/\.pm$//; 
    375      
     374 
     375    # auto-build 
     376    $self->build unless $self->{built}; 
     377 
    376378    my $form_options = $self->_form_options_code; 
    377379    my $field_setup = $self->_field_setup_code('$self'); 
     
    4294311; 
    430432END 
    431     _write_output_file($module, (split(/::/, $package))[-1] . '.pm', $use_tidy); 
     433 
     434    $module = _tidy_code($module, $use_tidy) if $use_tidy; 
     435     
     436    return $module; 
     437} 
     438 
     439sub write_module { 
     440    my ($self, $package, $use_tidy); 
     441     
     442    my $module = $self->as_module($package, $use_tidy); 
     443     
     444    _write_output_file($module, (split(/::/, $package))[-1] . '.pm'); 
    432445    return $self; 
    433446} 
    434447 
    435 sub write_script { 
    436     my ($self, $script_name, $use_tidy) = @_; 
    437  
    438     croak '[' . (caller(0))[3] . '] Expecting a script name' unless $script_name; 
     448sub as_script { 
     449    my ($self, $use_tidy) = @_; 
     450     
     451    # auto-build 
     452    $self->build unless $self->{built}; 
    439453     
    440454    my $form_options = $self->_form_options_code; 
     
    460474} 
    461475END 
    462      
    463     _write_output_file($script, $script_name, $use_tidy);    
     476    $script = _tidy_code($script, $use_tidy) if $use_tidy; 
     477     
     478    return $script; 
     479} 
     480     
     481sub write_script { 
     482    my ($self, $script_name, $use_tidy) = @_; 
     483 
     484    croak '[' . (caller(0))[3] . '] Expecting a script name' unless $script_name; 
     485 
     486    my $script = $self->as_script($use_tidy); 
     487     
     488    _write_output_file($script, $script_name);    
    464489    return $self; 
    465490} 
    466491 
     492sub _tidy_code { 
     493    my ($source_code, $use_tidy) = @_; 
     494    eval 'use Perl::Tidy'; 
     495    carp '[' . (caller(0))[3] . "] Can't tidy the code: $@" and return $source_code if $@; 
     496     
     497    # use the options string only if it begins with '_' 
     498    my $options = ($use_tidy =~ /^-/) ? $use_tidy : undef; 
     499     
     500    my $tidy_code; 
     501    Perl::Tidy::perltidy(source => \$source_code, destination => \$tidy_code, argv => $options || $TIDY_OPTIONS); 
     502     
     503    return $tidy_code; 
     504} 
     505 
     506 
    467507sub _write_output_file { 
    468     my ($source_code, $outfile, $use_tidy) = @_; 
    469     if ($use_tidy) { 
    470         # clean up the generated code, if asked 
    471         eval 'use Perl::Tidy'; 
    472         unless ($@) { 
    473             Perl::Tidy::perltidy(source => \$source_code, destination => $outfile, argv => $TIDY_OPTIONS); 
    474         } else { 
    475             carp '[' . (caller(0))[3] . "] Can't tidy the code: $@" if $@; 
    476             # fallback to just writing it as-is 
    477             open OUT, "> $outfile" or die $!; 
    478             print OUT $source_code; 
    479             close OUT; 
    480         } 
    481     } else { 
    482         # otherwise, just print as is 
    483         open OUT, "> $outfile" or die $!; 
    484         print OUT $source_code; 
    485         close OUT; 
    486     } 
     508    my ($source_code, $outfile) = @_;     
     509    open OUT, "> $outfile" or croak '[' . (caller(1))[3] . "] Can't open $outfile for writing: $!"; 
     510    print OUT $source_code; 
     511    close OUT; 
    487512} 
    488513 
     
    531556                # special case single value checkboxes 
    532557                if ($$_{type} eq 'checkbox' && @{ $$_{options} } == 1) { 
    533                     $OUT .= qq[<th></th>]; 
     558                    $OUT .= qq[<td></td>]; 
    534559                } else { 
    535                     $OUT .= '<th class="label">' . ($$_{required} ? qq[<strong class="required">$$_{label}</strong>] : "$$_{label}") . '</th>'; 
     560                    $OUT .= '<td class="label">' . ($$_{required} ? qq[* <strong class="required">$$_{label}</strong>] : "$$_{label}") . '</td>'; 
    536561                } 
    537562                 
     
    549574                $OUT .= (grep { $$_{invalid} } @group_fields) ? qq[  <tr class="invalid">\n] : qq[  <tr>\n]; 
    550575                 
    551                 $OUT .= '    <th class="label">'; 
    552                 $OUT .= (grep { $$_{required} } @group_fields) ? qq[<strong class="required">$$line[1]{label}</strong>] : "$$line[1]{label}"; 
    553                 $OUT .= qq[</th>\n]; 
     576                $OUT .= '    <td class="label">'; 
     577                $OUT .= (grep { $$_{required} } @group_fields) ? qq[* <strong class="required">$$line[1]{label}</strong>] : "$$line[1]{label}"; 
     578                $OUT .= qq[</td>\n]; 
    554579                 
    555580                $OUT .= qq[    <td><span class="fieldgroup">]; 
     
    815840HTML to a file, or to STDOUT if no filename is given. 
    816841 
     842=head2 as_module 
     843 
     844    my $module_code = $parser->as_module($package, $use_tidy); 
     845 
    817846=head2 write_module 
    818847 
     
    857886    # write tidier code 
    858887    $parser->write_module('My::Form', 1); 
     888 
     889If you set C<$use_tidy> to a string beginning with `-' C<write_module> will 
     890interpret C<$use_tidy> as the formatting option switches to pass to Perl::Tidy. 
     891 
     892=head2 as_script 
     893 
     894    my $script_code = $parser->as_script($use_tidy); 
    859895 
    860896=head2 write_script 
Note: See TracChangeset for help on using the changeset viewer.