# #=============================================================================== # # FILE: Data.pm # # DESCRIPTION: Data definitions # # FILES: --- # BUGS: --- # NOTES: --- The intent of this module is to localize some of the HTML # generation so as to make it accessible to the test suite. # AUTHOR: Geoffrey Leach, # VERSION: 1.1.11 # CREATED: 10/17/07 15:14:33 PDT # UPDATED: Wed Jan 20 05:28:34 PST 2013 # COPYRIGHT: (c) 2008-2010 Geoffrey Leach # #=============================================================================== package Pod::HtmlEasy::Data; use 5.006002; use strict; use warnings; use English qw{ -no_match_vars }; our $VERSION = version->declare("v1.1.11"); use Exporter::Easy ( OK => [ qw( EMPTY FALSE NL NUL SPACE TRUE body css gen head headend podoff podon title toc toc_tag top ) ], ); sub EMPTY { return q{}; } sub NL { return $INPUT_RECORD_SEPARATOR; } sub NUL { return qq{\0}; } sub SPACE { return q{ }; } sub TRUE { return 1; } sub FALSE { return 0; } sub head { return q{}, q{}, q{}; } sub headend { return q{}; } sub gen { my ( $ver, $pver ) = @_; my $g = q{}; $g =~ s{VERSION}{$ver}msx; $g =~ s{PVERSION}{$pver}msx; return $g; } sub podon { return q{
}; } sub podoff { my $no_body = shift; return defined $no_body ? q{
} : q{}; } sub title { my $title = shift; return q{}, $title, q{}; } sub toc { my @index = @_; my @toc = ( q{
}, q{}, q{
} ); ## no critic (ProhibitMagicNumbers) return @index ? ( @toc[ 0 .. 1 ], @index, @toc[ 2 .. 3 ] ) : @toc; } # Create the toc tag. # First we remove <' to '>'. These are HTML encodings ( ... , for example) # that have been introduced processing directives (I<...>, for example) # Spaces are reduced to one to eliminate problems created by embedded tabs. # HTTP prefix removed to avoid getting tag post-processed as an URL. sub toc_tag { my $txt = shift; $txt =~ s{<.+?>}{}msxg; $txt =~ s{\s+}{ }msxg; $txt =~ s{https?://}{}msxg; return $txt; } sub top { return q{}; } sub body { my $body_spec = shift; my %body = ( alink => '#FF0000', bgcolor => '#FFFFFF', link => '#000000', text => '#000000', vlink => '#000066', ); my $body = q{}; } # Second case - we're given a new, complete (by definition), set of body attributes if ( ref $body_spec ne q{HASH} ) { return qq{}; } # Third case - we have a hash to update the body attributes my %new_body = %body; # Make sure that the user-defined keys are formatted correctly foreach my $key ( keys %{$body_spec} ) { my $value = $body_spec->{$key}; $value =~ s{['"#]}{}smxg; $new_body{$key} = qq{#$value}; } # Convert the hash to a string of HTML stuff, maintaining alpha sort foreach my $key ( sort keys %new_body ) { $body .= qq{ $key="$new_body{$key}"}; } return $body . q{>}; } sub css { my $data = shift; my $css = << "END_CSS"; /* Properties that apply to the entire HTML file produced */ BODY { background: white; color: black; font-family: arial,sans-serif; margin: 0; padding: 1ex; } /* The links; no change once visited */ A:link, A:visited { background: transparent; color: #006699; } /* Applies to
contents; that's most everything DIV { border-width: 0; } /*
 is used for verbatum POD */
.pod PRE     {
    background: #eeeeee;
    border: 1px solid #888888;
    color: black;
    padding: 1em;
    white-space: pre;
}
/* This is the style of the header/footer of the POD pages */
.HF     {
    background: #eeeeee;
    border: 1px solid #888888;
    color: black;
    margin: 1ex 0;
    padding: 0.5ex 1ex;
}
/* 

result from processing =head1, and are generated only in class="pod" */ .pod H1 { background: transparent; color: #006699; font-size: large; } /* Ditto

*/ .pod H2, H3, H4 { background: transparent; color: #006699; font-size: medium; } /* Applies to all items in the class="toc"; the table of contents, aka "index" */ /*
  • in class="pod" -- the actual POD -- default to browser defaults */ .toc li { line-height: 1.2em; list-style-type: none; } END_CSS my $NL = NL; # "x" modifier inappropriate here # RE sees it as embedded whitespace ## no critic (RequireExtendedFormatting) if ( defined $data && $data !~ m{$NL}sm ) { # No newlines in $css, so we assume that it is a file name return qq{}; } if ( not defined $data ) { $data = $css; } return qq{}; } 1;