Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Re: RFC: Proofread the POD for my HTML elements module

by Khen1950fx (Canon)
on Apr 19, 2013 at 12:52 UTC ( #1029506=note: print w/ replies, xml ) Need Help??


in reply to RFC: Proofread the POD for my HTML elements module

Good morning, Lady_Aleena. I had some extra time, so let's get the ball rolling.

When I finish a module, I try to edit it as many times as possible. I usually start by running it through Deparse and perltidy, then I edit it some more and repeat the process until I'm sure that it's ready for production. Go through the script and look for obvious errors like barewords, etc.. Once the script is tidied, then run perltidy again. Looking at the first 13 lines or so, perltidy output this:
package HTML::Element; use strict; use warnings; use base qw( Exporter ); our (EXPORT_OK) = qw( title script heading anchor paragraph sparagraph list definition_list table form fieldset legend label selection input textarea div pre ); use HTML::Entities qw( encode_entities ); my (@ics) = qw( id class style ); my (@java) = qw( onclick ondblclick onkeypress onkeydown onkeyup onmouseover onmousedown onmouseup onmousemove onmouseout );
It's already better, no? Now, here's deparse and perltidy output for your entire script:
package HTML::Element; use strict; use warnings; use base qw( Exporter ); our (EXPORT_OK) = qw( title script heading anchor paragraph sparagraph list definition_list table form fieldset legend label selection input textarea div pre ); use HTML::Entities qw( encode_entities ); my (@ics) = qw( id class style ); my (@java) = qw( onclick ondblclick onkeypress onkeydown onkeyup onmouseover onmousedown onmouseup onmousemove onmouseout ); sub get_attributes { my ( $options, $valid ) = @_; my @attributes; foreach $_ ( @{ $valid; } ) { my $value = $$options{$_}; push @attributes, qq[$_="$value"] if defined $$options{$_}; } return join( ' ', ( '', @attributes ) ); } sub open_tag { my ( $tag, $opt, $attributes ) = @_; my $tag_attributes = get_attributes( $opt, $attributes ); return $tag . $tag_attributes; } sub plain_element { my ( $tag, $attributes, $tab, $value, $opt ) = @_; my $open = open_tag( $tag, $opt, $attributes ); return sline( $tab, "<$open>$value</$tag>" ); } sub anchor { my ( $value, $opt ) = @_; my $tag = 'a'; my $open = open_tag( $tag, $opt, [ 'href', 'target', 'title', @ics, @ja +va ] ); return "<$open>$value</$tag>"; } sub title { my ( $tab, $value, $opt ) = @_; my $tag = 'title'; my $open = $tag; line( $tab, "<$open>$value</$tag>" ); } sub script { my ( $tab, $opt ) = @_; my $tag = 'script'; my $open = open_tag( $tag, $opt, [ 'type', 'src' ] ); line( $tab, "<$open></$tag>" ); } sub heading { my ( $tab, $level, $value, $opt ) = @_; my $tag = 'h' . $level; print plain_element( $tag, [ @ics, @java ], $tab, $value, $opt ); } sub sparagraph { my ( $tab, $value, $opt ) = @_; my $tag = 'p'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); my $sep = $$opt{'separator'} ? $$opt{'separator'} : "\n"; my $line; foreach $_ ( grep length($_), split( /$sep/, $value, 0 ) ) { $line .= sline( $tab, "<$open>" ); $line .= sline( $tab + 1, $_ ); $line .= sline( $tab, "</$tag>" ); } return $line; } sub paragraph { print sparagraph(@_); } sub item { my ( $tab, $value, $opt ) = @_; my $tag = 'li'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); line( $tab, "<$open>" ); line( $tab + 1, $value ); if ( $$opt{'inlist'} ) { list( $tab + 1, @{ $$opt{'inlist'}; } ); } line( $tab, "</$tag>" ); } sub list { my ( $tab, $type, $list, $opt ) = @_; my $tag = $type . 'l'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); line( $tab, "<$open>" ); foreach my $item (@$list) { if ( ref $item eq 'ARRAY' ) { item $tab + 1, $$item[0], $$item[1]; } else { item $tab + 1, $item; } } line( $tab, "</$tag>" ); } sub term { print plain_element( 'dt', [ @ics, @java ], @_ ); } sub definition { my ( $tab, $value, $opt ) = @_; my $tag = 'dd'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); line( $tab, "<$open>" ); line( $tab + 1, $value ); line( $tab, "</$tag>" ); } sub definition_list { my ( $tab, $opt ) = @_; my $tag = 'dl'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); my (%definition_list) = get_hash( 'file', $$opt{'file'} ? $$opt{'file'} : 'data_file', 'headings', [ @{ $$opt{'headings'}; } ], 'sorted', 'yes' ); line( $tab, "<$open>" ); my $term = shift @{ $$opt{'headings'}; }; foreach my $term ( sort { $definition_list{$a}{'sort_number'} <=> $definition_list{$b}{'sort_number'}; } keys %definition_list ) { term $tab + 1, $term; if ( @{ $$opt{'headings'}; } == 1 ) { definition $tab + 2, $definition_list{$term}{ $$opt{'headings'}[0] }; } else { foreach my $heading ( @{ $$opt{'headings'}; } ) { my $upheading = ucfirst $heading; definition $tab + 2, "<b>${upheading}:</b> " . encode_entities( $definition_list{$term}{$headin +g} ); } } } line( $tab, "</$tag>" ); } sub caption { print plain_element( 'caption', [ 'align', @ics, @java ], @_ ); } sub cell { my ( $tab, $type, $value, $opt ) = @_; $type = $$opt{'type_override'} ? $$opt{'type_override'} : $type; my $tag = 't' . $type; my $open = open_tag( $tag, $opt, [ 'colspan', 'rowspan', @ics, @ja +va ] ); line( $tab, "<$open>" ); if ( $value eq 'list' ) { list $tab + 1, @{ $$opt{'list'}; }; } else { line( $tab + 1, $value ); } line( $tab, "</$tag>" ); } sub row { my ( $tab, $type, $cells, $opt ) = @_; my $tag = 'tr'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); my (%types) = ( 'header', 'h', 'data', 'd', 'whead', 'd' ); line( $tab, "<$open>" ); if ( $type eq 'whead' ) { my $cell = shift @{ $cells; }; if ( ref $cell eq 'ARRAY' ) { cell $tab + 1, 'h', ucfirst $$cell[0], { 'class', 'row_header', $$cell[1] }; } else { cell $tab + 1, 'h', ucfirst $cell, { 'class', 'row_header' + }; } } my $cell_type = $types{$type}; foreach my $cell ( @{ $cells; } ) { if ( ref $cell eq 'ARRAY' ) { cell $tab + 1, $cell_type, $$cell[0], $$cell[1]; } else { cell $tab + 1, $cell_type, $cell; } } line( $tab, "</$tag>" ); } sub col { my ( $tab, $opt ) = @_; my $tag = 'col'; my $open = open_tag( $tag, $opt, [ 'span', @ics, @java ] ); line( $tab, "<$open>" ); } sub cols { my ( $tab, $cols ) = @_; col $tab, $_ foreach ( @{ $cols; } ); } sub table { my ( $tab, $opt ) = @_; my $tag = 'table'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); line( $tab, "<$open>" ); if ( $$opt{'caption'} ) { if ( ref $$opt{'caption'} eq 'ARRAY' ) { caption $tab + 1, $$opt{'caption'}[0], $$opt{'caption'}[1] +; } else { caption $tab + 1, $$opt{'caption'}; } } if ( $$opt{'cols'} ) { col $tab + 1, $_ foreach ( @{ $$opt{'cols'}; } ); } foreach my $rowgroup ( @{ $$opt{'rows'}; } ) { my $type = $$rowgroup[0]; my (@rows) = $$rowgroup[1]; my $attributes = $$rowgroup[2]; if ( $type eq 'header' ) { row $tab + 1, $type, @rows, $attributes; } else { foreach my $row (@rows) { row $tab + 1, $type, $_, $attributes foreach (@$row); } } } line( $tab, "</$tag>" ); } sub label { print plain_element( 'label', [ 'for', @ics, @java ], @_ ); } sub option { print plain_element( 'option', [ 'value', @ics, @java ], @_ ); } sub selection { my ( $tab, $options, $opt ) = @_; my $tag = 'select'; my $open = open_tag( $tag, $opt, [ 'name', 'multiple', @ics, @java + ] ); label $tab, @{ $$opt{'label'}; } if $$opt{'label'} and $$opt{'place_label'} eq 'before'; line( $tab, "<$open>" ); foreach $_ (@$options) { option $tab + 1, @$_; } line( $tab, "</$tag>" ); label $tab, @{ $$opt{'label'}; } if $$opt{'label'} and $$opt{'place_label'} eq 'after'; } sub textarea { my ( $tab, $value, $opt ) = @_; my $tag = 'textarea'; my $open = open_tag( $tag, $opt, [ 'name', 'rows', 'cols', @ics, @java +] ); label $tab, @{ $$opt{'label'}; } if $$opt{'label'} and $$opt{'place_label'} eq 'before'; line( $tab, "<$open>$value</$tag>" ); label $tab, @{ $$opt{'label'}; } if $$opt{'label'} and $$opt{'place_label'} eq 'after'; } sub input { my ( $tab, $opt ) = @_; my $tag = 'input'; my $open = open_tag( $tag, $opt, [ 'type', 'value', 'name', @ics, @java + ] ); my $text = $$opt{'text'} ? "$$opt{'text'} " : ''; label $tab, @{ $$opt{'label'}; } if $$opt{'label'} and $$opt{'place_label'} eq 'before'; line( $tab, "$text<$open>" ); label $tab, @{ $$opt{'label'}; } if $$opt{'label'} and $$opt{'place_label'} eq 'after'; } sub legend { print plain_element( 'legend', [ @ics, @java ], @_ ); } sub fieldset { my ( $tab, $code, $opt ) = @_; my $tag = 'fieldset'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); line( $tab, "<$open>" ); legend $tab, $$opt{'legend'} if $$opt{'legend'}; &$code; line( $tab, "</$tag>" ); } sub form { my ( $tab, $/ root / Desktop / lady . pl . tdy syntax OK code, $op +t ) = @_; my $tag = 'form'; my $open = open_tag( $tag, $opt, [ 'action', 'method', @ics, @java + ] ); line( $tab, "<$open>" ); &$code; line( $tab, "</$tag>" ); } sub div { my ( $tab, $code, $opt ) = @_; my $tag = 'div'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); line( $tab, "<$open>" ); &$code; line( $tab, "</$tag>" ); } sub pre { my ( $tab, $code ) = @_; line( 0, '<pre>' ); &$code; line( 0, '</pre>' ); } '???';


Comment on Re: RFC: Proofread the POD for my HTML elements module
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1029506]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (12)
As of 2014-07-22 20:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (127 votes), past polls