File Coverage

blib/lib/Pod/HtmlEasy/Data.pm

Criterion	Covered	Total	%
statement	68	68	100.0
branch	12	12	100.0
condition	3	3	100.0
subroutine	22	22	100.0
pod	0	17	0.0
total	105	122	86.0

#
#===============================================================================
#
#         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{
54
        . qq{Perl/$] [$^O]">};
    $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{}, 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{

    # First case - provide the defau( $body, lt body addtributes
    if ( not defined $body_spec ) {
        foreach my $key ( sort keys %body ) {
            $body .= qq{ $key="$body{$key}"};
        }
        return $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
.pod .toc A  {
    text-decoration: none;
}
/*  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{ <!--$data-->};
}
1;