epics/epics-base
0
0
Fork 0
Code Issues Pull Requests Projects Wiki Activity

Merged dbd2html branch

Browse Source
This commit is contained in:
Andrew Johnson
2014-10-03 14:23:04 -05:00
parent ec7b0d5737 9b73fd1730
commit a4298bec56
38 changed files with 2948 additions and 811 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/tools/DBD.pm
+21 -1
View File
@@ -21,7 +21,9 @@ sub new {
'DBD::Menu' => {},
'DBD::Recordtype' => {},
'DBD::Registrar' => {},
'DBD::Variable' => {}
'DBD::Variable' => {},
'COMMENTS' => [],
'POD' => []
};
bless $this, $class;
return $this;
@@ -43,6 +45,24 @@ sub add {
}
}
sub add_comment {
my $this = shift;
push @{$this->{COMMENTS}}, @_;
}
sub comments {
return @{shift->{COMMENTS}};
}
sub add_pod {
my $this = shift;
push @{$this->{POD}}, @_;
}
sub pod {
return @{shift->{POD}};
}
sub breaktables {
return shift->{'DBD::Breaktable'};
}
src/tools/DBD/Base.pm
+12 -1
View File
@@ -104,7 +104,7 @@ sub escapeCstring {
}
# Base class routines for the DBD component objects
# Base methods for the DBD component objects
sub new {
my $class = shift;
@@ -128,6 +128,17 @@ sub what {
return shift->{WHAT};
}
sub add_comment {
my $this = shift;
confess "add_comment() not supported by $this->{WHAT} ($this)\n",
"Context: ", join(' in ', @context), "\n";
}
sub add_pod {
my $this = shift;
warnContext "Warning: Pod text inside $this->{WHAT} will be ignored";
}
sub equals {
my ($a, $b) = @_;
return $a->{NAME} eq $b->{NAME}
src/tools/DBD/Breaktable.pm
+10
View File
@@ -8,6 +8,7 @@ sub init {
my ($this, $name) = @_;
$this->SUPER::init($name, "breakpoint table");
$this->{POINT_LIST} = [];
$this->{COMMENTS} = [];
return $this;
}
@@ -31,6 +32,15 @@ sub point {
return $this->{POINT_LIST}[$idx];
}
sub add_comment {
my $this = shift;
push @{$this->{COMMENTS}}, @_;
}
sub comments {
return @{shift->{COMMENTS}};
}
sub equals {
my ($a, $b) = @_;
return $a->SUPER::equals($b)
src/tools/DBD/Menu.pm
+10
View File
@@ -7,6 +7,7 @@ sub init {
$this->SUPER::init($name, "menu");
$this->{CHOICE_LIST} = [];
$this->{CHOICE_INDEX} = {};
$this->{COMMENTS} = [];
return $this;
}
@@ -39,6 +40,15 @@ sub legal_choice {
return exists $this->{CHOICE_INDEX}->{$value};
}
sub add_comment {
my $this = shift;
push @{$this->{COMMENTS}}, @_;
}
sub comments {
return @{shift->{COMMENTS}};
}
sub equals {
my ($a, $b) = @_;
return $a->SUPER::equals($b)
src/tools/DBD/Parser.pm
+37 -15
View File
@@ -19,10 +19,9 @@ use DBD::Variable;
our $debug=0;
sub ParseDBD {
my $dbd = shift;
$_ = shift;
(my $dbd, $_) = @_;
while (1) {
parseCommon();
parseCommon($dbd);
if (m/\G menu \s* \( \s* $RXstr \s* \) \s* \{/oxgc) {
print "Menu: $1\n" if $debug;
parse_menu($dbd, $1);
@@ -59,12 +58,12 @@ sub ParseDBD {
\s* $RXstr \s* , \s*$RXstr \s* \)/oxgc) {
print "Device: $1, $2, $3, $4\n" if $debug;
my $rtyp = $dbd->recordtype($1);
if (!defined $rtyp) {
$rtyp = DBD::Recordtype->new($1);
warn "Device using undefined record type '$1', place-holder created\n";
$dbd->add($rtyp);
if (!defined $rtyp) {
$rtyp = DBD::Recordtype->new($1);
warn "Device using undefined record type '$1', place-holder created\n";
$dbd->add($rtyp);
}
$rtyp->add_device(DBD::Device->new($2, $3, $4));
$rtyp->add_device(DBD::Device->new($2, $3, $4));
} else {
last unless m/\G (.*) $/moxgc;
dieContext("Syntax error in '$1'");
@@ -73,21 +72,27 @@ sub ParseDBD {
}
sub parseCommon {
my ($obj) = @_;
while (1) {
# Skip leading whitespace
m/\G \s* /oxgc;
if (m/\G \# /oxgc) {
if (m/\G \#!BEGIN\{ ( [^}]* ) \}!\#\# \n/oxgc) {
# Extract POD
if (m/\G ( = [a-zA-Z] .* ) \n/oxgc) {
$obj->add_pod($1, &parsePod);
}
elsif (m/\G \# /oxgc) {
if (m/\G \# ! BEGIN \{ ( [^}]* ) \} ! \# \# \n/oxgc) {
print "File-Begin: $1\n" if $debug;
pushContext("file '$1'");
}
elsif (m/\G \#!END\{ ( [^}]* ) \}!\#\# \n?/oxgc) {
elsif (m/\G \# ! END \{ ( [^}]* ) \} ! \# \# \n?/oxgc) {
print "File-End: $1\n" if $debug;
popContext("file '$1'");
}
else {
m/\G (.*) \n/oxgc;
$obj->add_comment($1);
print "Comment: $1\n" if $debug;
}
} else {
@@ -96,12 +101,29 @@ sub parseCommon {
}
}
sub parsePod {
pushContext("Pod markup");
my @pod;
while (1) {
if (m/\G ( =cut .* ) \n?/oxgc) {
popContext("Pod markup");
return @pod;
}
elsif (m/\G ( .* ) $/oxgc) {
dieContext("Unexpected end of input file, Pod block not closed");
}
elsif (m/\G ( .* ) \n/oxgc) {
push @pod, $1
}
}
}
sub parse_menu {
my ($dbd, $name) = @_;
pushContext("menu($name)");
my $menu = DBD::Menu->new($name);
while(1) {
parseCommon();
parseCommon($menu);
if (m/\G choice \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/oxgc) {
print " Menu-Choice: $1, $2\n" if $debug;
$menu->add_choice($1, $2);
@@ -123,7 +145,7 @@ sub parse_breaktable {
pushContext("breaktable($name)");
my $bt = DBD::Breaktable->new($name);
while(1) {
parseCommon();
parseCommon($bt);
if (m/\G point\s* \(\s* $RXstr \s* , \s* $RXstr \s* \)/oxgc) {
print " Breaktable-Point: $1, $2\n" if $debug;
$bt->add_point($1, $2);
@@ -149,7 +171,7 @@ sub parse_recordtype {
pushContext("recordtype($name)");
my $rtyp = DBD::Recordtype->new($name);
while(1) {
parseCommon();
parseCommon($rtyp);
if (m/\G field \s* \( \s* $RXstr \s* , \s* $RXstr \s* \) \s* \{/oxgc) {
print " Recordtype-Field: $1, $2\n" if $debug;
parse_field($rtyp, $1, $2);
@@ -175,7 +197,7 @@ sub parse_field {
my $fld = DBD::Recfield->new($name, $field_type);
pushContext("field($name, $field_type)");
while(1) {
parseCommon();
parseCommon($fld);
if (m/\G (\w+) \s* \( \s* $RXstr \s* \)/oxgc) {
print " Field-Attribute: $1, $2\n" if $debug;
$fld->add_attribute($1, $2);
src/tools/DBD/Recfield.pm
+11
View File
@@ -56,6 +56,7 @@ sub init {
sort keys %field_types) unless exists $field_types{$type};
$this->{DBF_TYPE} = $type;
$this->{ATTR_INDEX} = {};
$this->{COMMENTS} = [];
return $this;
}
@@ -109,6 +110,16 @@ sub check_valid {
if (defined($default) and !$this->legal_value($default));
}
sub add_comment {
my $this = shift;
push @{$this->{COMMENTS}}, @_;
}
sub comments {
return @{shift->{COMMENTS}};
}
# The C structure member name is usually the field name converted to
# lower-case. However if that is a reserved word, use the original.
sub C_name {
src/tools/DBD/Recordtype.pm
+20
View File
@@ -12,6 +12,8 @@ sub init {
$this->{DEVICE_LIST} = [];
$this->{DEVICE_INDEX} = {};
$this->{CDEFS} = [];
$this->{COMMENTS} = [];
$this->{POD} = [];
return $this;
}
@@ -69,6 +71,15 @@ sub device {
return $this->{DEVICE_INDEX}->{$choice};
}
sub add_comment {
my ($this, $comment) = @_;
push @{$this->{COMMENTS}}, $comment;
}
sub comments {
return @{shift->{COMMENTS}};
}
sub add_cdef {
my ($this, $cdef) = @_;
push @{$this->{CDEFS}}, $cdef;
@@ -82,6 +93,15 @@ sub toCdefs {
return join("\n", shift->cdefs) . "\n\n";
}
sub add_pod {
my $this = shift;
push @{$this->{POD}}, @_;
}
sub pod {
return @{shift->{POD}};
}
sub equals {
my ($new, $known) = @_;
return 0 if ! $known->fields;
src/tools/Makefile
+3
View File
@@ -49,8 +49,11 @@ PERL_SCRIPTS += dbdToMenuH.pl
PERL_SCRIPTS += dbdToRecordtypeH.pl
PERL_SCRIPTS += dbdExpand.pl
PERL_SCRIPTS += dbdToHtml.pl
PERL_SCRIPTS += podToHtml.pl
PERL_SCRIPTS += registerRecordDeviceDriver.pl
HTMLS = style.css
# Build Package Config Files
FINAL_LOCATION ?= $(shell $(PERL) $(TOOLS)/fullPathName.pl $(INSTALL_LOCATION))
src/tools/dbdToHtml.pl
+175 -198
View File
@@ -1,7 +1,6 @@
#!/usr/bin/perl
#*************************************************************************
# Copyright (c) 2010 UChicago Argonne LLC, as Operator of Argonne
# Copyright (c) 2012 UChicago Argonne LLC, as Operator of Argonne
# National Laboratory.
# EPICS BASE is distributed subject to a Software License Agreement found
# in file LICENSE that is included with this distribution.
@@ -9,6 +8,8 @@
# $Id$
use strict;
use FindBin qw($Bin);
use lib "$Bin/../../lib/perl";
@@ -17,20 +18,35 @@ use DBD::Parser;
use EPICS::Getopts;
use EPICS::macLib;
use EPICS::Readfile;
use HTML::Entities;
BEGIN {
$::XHTML = eval "require Pod::Simple::XHTML; 1";
if (!$::XHTML) {
require Pod::Simple::HTML;
}
}
my $tool = 'dbdToHtml';
getopts('DI@o:') or
die "Usage: $tool [-D] [-I dir] [-o xRecord.html] xRecord.dbd\n";
my @path = map { split /[:;]/ } @opt_I;
use vars qw($opt_D @opt_I $opt_o);
getopts('DI@o:') or
die "Usage: $tool [-D] [-I dir] [-o file.html] file.dbd.pod\n";
my $dbd = DBD->new();
my $infile = shift @ARGV;
$infile =~ m/\.dbd$/ or
die "$tool: Input file '$infile' must have '.dbd' extension\n";
$infile =~ m/\.dbd.pod$/ or
die "$tool: Input file '$infile' must have '.dbd.pod' extension\n";
&ParseDBD($dbd, &Readfile($infile, 0, \@opt_I));
if (!$opt_o) {
($opt_o = $infile) =~ s/\.dbd\.pod$/.html/;
$opt_o =~ s/^.*\///;
$opt_o =~ s/dbCommonRecord/dbCommon/;
}
if ($opt_D) { # Output dependencies only
my %filecount;
my @uniqfiles = grep { not $filecount{$_}++ } @inputfiles;
@@ -39,214 +55,175 @@ if ($opt_D) { # Output dependencies only
exit 0;
}
my $out;
if ($opt_o) {
$out = $opt_o;
} else {
($out = $infile) =~ s/\.dbd$/.html/;
$out =~ s/^.*\///;
$out =~ s/dbCommonRecord/dbCommon/;
}
open $out, '>', $opt_o or die "Can't create $opt_o: $!\n";
(my $title = $opt_o) =~ s/\.html$//;
print $out "<h1>$infile</h1>\n";
open my $out, '>', $opt_o or
die "Can't create $opt_o: $!\n";
my $rtypes = $dbd->recordtypes;
my ($rn, $rtyp) = each %{$rtypes};
print $out "<h2>Record Name $rn</h2>\n";
my @fields = $rtyp->fields;
#create a Hash to store the table of field information for each GUI type
%dbdTables = (
"GUI_COMMON" => "",
"GUI_COMMON" => "",
"GUI_ALARMS" => "",
"GUI_BITS1" => "",
"GUI_BITS2" => "",
"GUI_CALC" => "",
"GUI_CLOCK" => "",
"GUI_COMPRESS" => "",
"GUI_CONVERT" => "",
"GUI_DISPLAY" => "",
"GUI_HIST" => "",
"GUI_INPUTS" => "",
"GUI_LINKS" => "",
"GUI_MBB" => "",
"GUI_MOTOR" => "",
"GUI_OUTPUT" => "",
"GUI_PID" => "",
"GUI_PULSE" => "",
"GUI_SELECT" => "",
"GUI_SEQ1" => "",
"GUI_SEQ2" => "",
"GUI_SEQ3" => "",
"GUI_SUB" => "",
"GUI_TIMER" => "",
"GUI_WAVE" => "",
"GUI_SCAN" => "",
"GUI_NONE" => ""
);
#Loop over all of the fields. Build a string that contains the table body
#for each of the GUI Types based on which fields go with which GUI type.
foreach $fVal (@fields) {
my $pg = $fVal->attribute('promptgroup');
while ( ($typ1, $content) = each %dbdTables) {
if ( $pg eq $typ1 or ($pg eq "" and $typ1 eq "GUI_NONE")) {
buildTableRow($fVal, $dbdTables{$typ1} );
# Parse the Pod text from the root DBD object
my $pod = join "\n", '=for html <div class="pod">', '',
map {
# Handle a 'recordtype' Pod directive
if (m/^ =recordtype \s+ (.*)/x) {
my $rn = $1;
my $rtyp = $dbd->recordtype($rn);
die "Unknown recordtype '$rn' in $infile POD directive\n"
unless $rtyp;
rtypeToPod($rtyp, $dbd);
}
}
}
#Write out each table
while ( ($typ2, $content) = each %dbdTables) {
printHtmlTable($typ2, $content);
}
#add a field to a table body. The specified field and table body are passed
#in as parameters
sub buildTableRow {
my ( $fld, $outStr) = @_;
$longDesc = "&nbsp;";
%htmlCellFmt = (
rowStart => "<tr><td rowspan = \"2\">",
nextCell => "</td><td>",
endRow => "</td></tr>",
nextRow => "<tr><td colspan = \"7\" align=left>"
);
my %cellFmt = %htmlCellFmt;
my $rowStart = $cellFmt{rowStart};
my $nextCell = $cellFmt{nextCell};
my $endRow = $cellFmt{endRow};
my $nextRow = $cellFmt{nextRow};
$outStr = $outStr . $rowStart;
$outStr = $outStr . $fld->name;
$outStr = $outStr . $nextCell;
$outStr = $outStr . $fld->attribute('prompt');
$outStr = $outStr . $nextCell;
my $recType = $fld->dbf_type;
$typStr = $recType;
if ($recType eq "DBF_STRING") {
$typStr = $recType . " [" . $fld->attribute('size') . "]";
}
$outStr = $outStr . $typStr;
$outStr = $outStr . $nextCell;
$outStr = $outStr . design($fld);
$outStr = $outStr . $nextCell;
my $initial = $fld->attribute('initial');
if ( $initial eq '' ) {$initial = "&nbsp;";}
$outStr = $outStr . $initial;
$outStr = $outStr . $nextCell;
$outStr = $outStr . readable($fld);
$outStr = $outStr . $nextCell;
$outStr = $outStr . writable($fld);
$outStr = $outStr . $nextCell;
$outStr = $outStr . processPassive($fld);
$outStr = $outStr . $endRow;
$outStr = $outStr . "\n";
$outStr = $outStr . $nextRow;
$outStr = $outStr . $longDesc;
$outStr = $outStr . $endRow;
$outStr = $outStr . "\n";
$_[1] = $outStr;
}
#Check if the prompt group is defined so that this can be used by clients
sub design {
my $fld = $_[0];
my $pg = $fld->attribute('promptgroup');
if ( $pg eq '' ) {
my $result = 'No';
}
else {
my $result = 'Yes';
}
}
#Check if this field is readable by clients
sub readable {
my $fld = $_[0];
if ( $fld->attribute('special') eq "SPC_DBADDR") {
$return = "Probably";
}
else{
if ( $fld->dbf_type eq "DBF_NOACCESS" ) {
$return = "No";
# Handle a 'menu' Pod directive
elsif (m/^ =menu \s+ (.*)/x) {
my $mn = $1;
my $menu = $dbd->menu($mn);
die "Unknown menu '$mn' in $infile POD directive\n"
unless $menu;
menuToPod($menu);
}
elsif (m/^ =title \s+ (.*)/x) {
$title = $1;
"=head1 $title";
}
else {
$return = "Yes"
$_;
}
}
} $dbd->pod,
'=for html </div>', '';
my $podHtml;
if ($::XHTML) {
$podHtml = Pod::Simple::XHTML->new();
$podHtml->html_doctype(<< '__END_DOCTYPE');
<?xml version='1.0' encoding='iso-8859-1'?>
<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Transitional//EN'
'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'>
__END_DOCTYPE
} else { # Fall back to HTML
$podHtml = Pod::Simple::HTML->new();
}
#Check if this field is writable by clients
sub writable {
my $fld = $_[0];
my $spec = $fld->attribute('special');
if ( $spec eq "SPC_NOMOD" ) {
$return = "No";
}
else {
if ( $spec ne "SPC_DBADDR") {
if ( $fld->dbf_type eq "DBF_NOACCESS" ) {
$return = "No";
}
else {
$return = "Yes";
}
$podHtml->html_css('style.css');
$podHtml->force_title(encode_entities($title));
$podHtml->perldoc_url_prefix('');
$podHtml->perldoc_url_postfix('.html');
$podHtml->output_fh($out);
$podHtml->parse_string_document($pod);
close $out;
sub menuToPod {
my ($menu) = @_;
my $index = 0;
return '=begin html', '', '<blockquote><table border="1"><tr>',
'<th>Index</th><th>Identifier</th><th>Choice String</th></tr>',
map({choiceTableRow($_, $index++)} $menu->choices),
'</table></blockquote>', '', '=end html';
}
sub choiceTableRow {
my ($ch, $index) = @_;
my ($id, $name) = @{$ch};
return '<tr>',
"<td class='cell DBD_Menu index'>$index</td>",
"<td class='cell DBD_Menu identifier'>$id</td>",
"<td class='cell DBD_Menu choice'>$name</td>",
'</tr>';
}
sub rtypeToPod {
my ($rtyp, $dbd) = @_;
return map {
# Handle a 'fields' Pod directive
if (m/^ =fields \s+ (.*)/x) {
my @names = split /\s*,\s*/, $1;
# Look up the named fields
my @fields = map {
my $field = $rtyp->field($_);
die "Unknown field name '$_' in $infile POD\n"
unless $field;
$field;
} @names;
# Generate Pod for the table
'=begin html', '', '<blockquote><table border="1"><tr>',
'<th>Field</th><th>Summary</th><th>Type</th><th>DCT</th>',
'<th>Default</th><th>Read</th><th>Write</th><th>CA PP</th>',
'</tr>',
map({fieldTableRow($_, $dbd)} @fields),
'</table></blockquote>', '', '=end html';
}
# Handle a 'menu' Pod directive
elsif (m/^ =menu \s+ (.*)/x) {
my $mn = $1;
my $menu = $dbd->menu($mn);
die "Unknown menu '$mn' in $infile POD directive\n"
unless $menu;
menuToPod($menu);
}
else {
$return = "Maybe";
# Raw text line
$_;
}
} $rtyp->pod;
}
sub fieldTableRow {
my ($fld, $dbd) = @_;
my $html = '<tr><td class="cell">';
$html .= $fld->name;
$html .= '</td><td class="cell">';
$html .= $fld->attribute('prompt');
$html .= '</td><td class="cell">';
my $type = $fld->public_type;
$html .= $type;
$html .= ' [' . $fld->attribute('size') . ']'
if $type eq 'STRING';
if ($type eq 'MENU') {
my $mn = $fld->attribute('menu');
my $menu = $dbd->menu($mn);
my $url = $menu ? "#Menu_$mn" : "${mn}.html";
$html .= " (<a href='$url'>$mn</a>)";
}
$html .= '</td><td class="cell">';
$html .= $fld->attribute('promptgroup') ? 'Yes' : 'No';
$html .= '</td><td class="cell">';
$html .= $fld->attribute('initial') || '&nbsp;';
$html .= '</td><td class="cell">';
$html .= $fld->readable;
$html .= '</td><td class="cell">';
$html .= $fld->writable;
$html .= '</td><td class="cell">';
$html .= $fld->attribute('pp') eq 'TRUE' ? 'Yes' : 'No';
$html .= "</td></tr>\n";
return $html;
}
#Check to see if the field is process passive on caput
sub processPassive {
my $fld = $_[0];
$pp = $fld->attribute('pp');
if ( $pp eq "YES" or $pp eq "TRUE" ) {
$result = "Yes";
}
elsif ( $PP eq "NO" or $pp eq "FALSE" or $pp eq "" ) {
$result = "No";
}
# Native type presented to dbAccess users
sub DBD::Recfield::public_type {
my $fld = shift;
m/^=type (.+)$/i && return $1 for $fld->comments;
my $type = $fld->dbf_type;
$type =~ s/^DBF_//;
return $type;
}
#print the start row to define a table
sub printTableStart {
print $out "<table border =\"1\"> \n";
print $out "<caption><em>$_[0]</em></caption>";
print $out "<th>Field</th>\n";
print $out "<th>Summary</th>\n";
print $out "<th>Type</th>\n";
print $out "<th>DCT</th>\n";
print $out "<th>Default</th>\n";
print $out "<th>Read</th>\n";
print $out "<th>Write</th>\n";
print $out "<th>caPut=PP</th></tr>\n";
# Check if this field is readable
sub DBD::Recfield::readable {
my $fld = shift;
m/^=read (Yes|No)$/i && return $1 for $fld->comments;
return 'Probably'
if $fld->attribute('special') eq "SPC_DBADDR";
return $fld->dbf_type eq 'DBF_NOACCESS' ? 'No' : 'Yes';
}
#print the tail end of the table
sub printTableEnd {
print $out "</table>\n";
# Check if this field is writable
sub DBD::Recfield::writable {
my $fld = shift;
m/^=write (Yes|No)$/i && return $1 for $fld->comments;
my $special = $fld->attribute('special');
return 'No'
if $special eq "SPC_NOMOD";
return 'Maybe'
if $special eq "SPC_DBADDR";
return $fld->dbf_type eq "DBF_NOACCESS" ? 'No' : 'Yes';
}
# Print the table for a GUI type. The name of the GUI type and the Table body
# for this type are fed in as parameters
sub printHtmlTable {
my ($typ2, $content) = $_;
if ( (length $_[1]) gt 0) {
printTableStart($_[0]);
print $out "$_[1]\n";
printTableEnd();
}
}
src/tools/podToHtml.pl
+47
View File
@@ -0,0 +1,47 @@
#!/usr/bin/env perl
#*************************************************************************
# Copyright (c) 2013 UChicago Argonne LLC, as Operator of Argonne
# National Laboratory.
# EPICS BASE is distributed subject to a Software License Agreement found
# in file LICENSE that is included with this distribution.
#*************************************************************************
# $Id$
use strict;
use warnings;
use Getopt::Std;
use Pod::Simple::HTML;
our ($opt_o);
$Getopt::Std::OUTPUT_HELP_VERSION = 1;
&HELP_MESSAGE if !getopts('o:') || @ARGV != 1;
my $infile = shift @ARGV;
if (!$opt_o) {
($opt_o = $infile) =~ s/\. \w+ $/.html/x;
$opt_o =~ s/^.*\///;
}
open my $out, '>', $opt_o or
die "Can't create $opt_o: $!\n";
my $podHtml = Pod::Simple::HTML->new();
$podHtml->html_css('style.css');
$podHtml->perldoc_url_prefix('');
$podHtml->perldoc_url_postfix('.html');
$podHtml->set_source($infile);
$podHtml->output_string(\my $html);
$podHtml->run;
print $out $html;
close $out;
sub HELP_MESSAGE {
print STDERR "Usage: podToHtml.pl [-o file.html] file.pod\n";
exit 2;
}
src/tools/style.css
+442
View File
@@ -0,0 +1,442 @@
BODY, .logo { background: white; }
BODY {
color: black;
font-family: arial,sans-serif;
margin: 0;
padding: 1ex;
}
TABLE {
border-collapse: collapse;
border-spacing: 0;
border-width: 0;
color: inherit;
}
IMG { border: 0; }
FORM { margin: 0; }
input { margin: 2px; }
.logo {
float: left;
width: 264px;
height: 77px;
}
.front .logo {
float: none;
display:block;
}
.front .searchbox {
margin: 2ex auto;
text-align: center;
}
.front .menubar {
text-align: center;
}
.menubar {
background: #006699;
margin: 1ex 0;
padding: 1px;
}
.menubar A {
padding: 0.8ex;
font: bold 10pt Arial,Helvetica,sans-serif;
}
.menubar A:link, .menubar A:visited {
color: white;
text-decoration: none;
}
.menubar A:hover {
color: #ff6600;
text-decoration: underline;
}
A:link, A:visited {
background: transparent;
color: #006699;
}
A[href="#POD_ERRORS"] {
background: transparent;
color: #FF0000;
}
TD {
margin: 0;
padding: 0;
}
DIV {
border-width: 0;
}
DT {
margin-top: 1em;
}
.credits TD {
padding: 0.5ex 2ex;
}
.huge {
font-size: 32pt;
}
.s {
background: #dddddd;
color: inherit;
}
.s TD, .r TD {
padding: 0.2ex 1ex;
vertical-align: baseline;
}
TH {
background: #bbbbbb;
color: inherit;
padding: 0.4ex 1ex;
text-align: left;
}
TH A:link, TH A:visited {
background: transparent;
color: black;
}
.box {
border: 1px solid #006699;
margin: 1ex 0;
padding: 0;
}
.distfiles TD {
padding: 0 2ex 0 0;
vertical-align: baseline;
}
.manifest TD {
padding: 0 1ex;
vertical-align: top;
}
.l1 {
font-weight: bold;
}
.l2 {
font-weight: normal;
}
.t1, .t2, .t3, .t4, .t5 {
background: #006699;
color: white;
}
.t4 {
padding: 0.2ex 0.4ex;
}
.t1, .t2, .t3 {
padding: 0.5ex 1ex;
}
/* IE does not support .box>.t1 Grrr */
.box .t1, .box .t2, .box .t3, .box .t5 {
margin: 0;
}
.t1 {
font-size: 1.4em;
font-weight: bold;
text-align: center;
}
.t2 {
font-size: 1.0em;
font-weight: bold;
text-align: left;
}
.t3 {
font-size: 1.0em;
font-weight: normal;
text-align: left;
}
.t5 {
font-size: 0.8em;
font-weight: normal;
text-align: center;
}
/* width: 100%; border: 0.1px solid #FFFFFF; */ /* NN4 hack */
.datecell {
text-align: center;
width: 17em;
}
.cell {
padding: 0.2ex 1ex;
text-align: left;
}
.DBD_Menu.index {
padding: 0.2ex 2ex;
text-align: right;
}
.DBD_Menu.choice {
font: 1.0em monospace;
}
.label {
background: #aaaaaa;
color: black;
font-weight: bold;
padding: 0.2ex 1ex;
text-align: right;
white-space: nowrap;
vertical-align: baseline;
}
.categories {
border-bottom: 3px double #006699;
margin-bottom: 1ex;
padding-bottom: 3ex;
padding-top: 2ex;
}
.categories TABLE {
margin: auto;
}
.categories TD {
padding: 0.5ex 1ex;
vertical-align: baseline;
}
.path A {
background: transparent;
color: #006699;
font-weight: bold;
}
.pages {
background: #dddddd;
color: #006699;
padding: 0.2ex 0.4ex;
}
.path {
background: #dddddd;
border-bottom: 1px solid #006699;
color: #006699;
/* font-size: 1.4em;*/
margin: 1ex 0;
padding: 0.5ex 1ex;
}
.menubar TD {
background: #006699;
color: white;
}
.menubar {
background: #006699;
color: white;
margin: 1ex 0;
padding: 1px;
}
.menubar .links {
background: transparent;
color: white;
padding: 0.2ex;
text-align: left;
}
.menubar .searchbar {
background: black;
color: black;
margin: 0px;
padding: 2px;
text-align: right;
}
A.m:link, A.m:visited {
background: #006699;
color: white;
font: bold 10pt Arial,Helvetica,sans-serif;
text-decoration: none;
}
A.o:link, A.o:visited {
background: #006699;
color: #ccffcc;
font: bold 10pt Arial,Helvetica,sans-serif;
text-decoration: none;
}
A.o:hover {
background: transparent;
color: #ff6600;
text-decoration: underline;
}
A.m:hover {
background: transparent;
color: #ff6600;
text-decoration: underline;
}
table.dlsip {
background: #dddddd;
border: 0.4ex solid #dddddd;
}
.pod, .manifest { margin-right: 0; }
.pod PRE {
background: #eeeeee;
border: 1px solid #888888;
color: black;
padding: 1em;
white-space: pre;
}
.pod H1 {
background: transparent;
color: #006699;
font-size: 1.4em;
}
.pod H1 A { text-decoration: none; }
.pod H2 A { text-decoration: none; }
.pod H3 A { text-decoration: none; }
.pod H4 A { text-decoration: none; }
.pod H2 {
background: transparent;
color: #006699;
font-size: 1.2em;
}
.pod H3 {
background: transparent;
color: #006699;
font-size: 1em;
font-style: italic;
}
.pod H4 {
background: transparent;
color: #006699;
font-size: 1em;
font-weight: normal;
}
.pod IMG {
vertical-align: top;
}
.pod .toc A {
text-decoration: none;
}
.pod .toc LI {
line-height: 1.2em;
list-style-type: none;
}
.faq DT {
font-size: 1.4em;
font-weight: bold;
}
.chmenu {
background: black;
color: red;
font: bold 1.1em Arial,Helvetica,sans-serif;
margin: 1ex auto;
padding: 0.5ex;
}
.chmenu TD {
padding: 0.2ex 1ex;
}
.chmenu A:link, .chmenu A:visited {
background: transparent;
color: white;
text-decoration: none;
}
.chmenu A:hover {
background: transparent;
color: #ff6600;
text-decoration: underline;
}
.column {
padding: 0.5ex 1ex;
vertical-align: top;
}
.datebar {
margin: auto;
width: 14em;
}
.date {
background: transparent;
color: #008000;
}
.footer {
margin-top: 1ex;
text-align: right;
color: #006699;
font-size: x-small;
border-top: 1px solid #006699;
line-height: 120%;
}
.front .footer {
border-top: none;
}
#permalink {
float: right
}
#permalink A {
font-size: small;
}
.sr {
font-size: inherit;
margin: 0;
}
.cpanstats {
float: left;
text-align: left;
color: #bbb;
white-space: pre;
}
form.tool {
margin: 1ex;
}
.styleswitch {
text-align: right;
}