#!/usr/local/bin/perl
#
# @(#) t2html.pl -- Perl, text2html converter. Uses Techical text format (TF)
# @(#) $Id: t2html.pl,v 1.26 2001/03/05 02:46:58 jaalto Exp $
#
# {{{ Documentation
#
# File id
#
# .$Copyright: (C) 1996-2001 Jari Aalto $
# .$Created: 1996-11 $
# .$Keywords: Perl, text, html, conversion $
# .$Perl: 5.004 $
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation,
# Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# About program layout
#
# Code written with Unix Emacs and indentation controlled with
# Emacs package tinytab.el, a generic tab minor mode for programming.
#
# The {{ }}} marks you see in this file are party of file "fold"
# control package called folding.el (Unix Emacs lisp package).
# ftp://ftp.csd.uu.se/pub/users/andersl/beta/ to get the latest./
#
# There is also lines that look like # ....... &tag ... and they
# are generated by Emacs Lisp package tinybm.el, which is also
# document structure tool. You can jump between the blocks with
# Ctrl-up and Ctrl-down keys and create those "bookmarks" with
# Emacs M-x tibm-insert. See www contact site below.
#
# Funny identifiers in the file
#
# The GNU RCS ident(1) program can print useful information out
# of all variables that are in format $ IDENTIFIER: text $
# See also Unix man pages for command what(1) which outputs all lines
# matching @( # ). Try commands:
#
# % what PRGNAME
# % ident PRGNAME
#
# Emacs has been used to edit this file and a mode called font-lock.el
# which colorizzes the code. However the perl mode colorizations
# goes beserk from time to time by extending the color to the end of
# file and that is why you see comments like "#font ..." spread around.
# They stop the colorization nightmare right there. do not remove those,
# because you will make all Emacs users ver, very unhappy.
#
#
# Introduction
#
# Please start this perl script with options
#
# --help to get the help page
#
# Www contact site
#
# [2000-11-03] See http://www. poboxes.com/jari.aalto/ and navigate
# to html pages in the site to get more information about me
# and my tools (Emacs, Perl, procmail mostly)
#
# Description
#
# This perl program converts text files that are written in rigid
# (T)echnical layout (f)ormat (which is explained when you run -h)
# to html pages very easily and effectively.
#
# If you plan to put any text files available in HTML format you will
# find this program a very useful. If you want to have fancy
# graphics or more personal page layout, then this program is not for
# you.
#
# I have also made package that helps you to write and format text
# files to Technical format. Please see following Emacs package at
# the previously mentioned URL.
#
# tinytf.el
#
# Profiling results
#
# Here are Devel::Dprof profiling results for 560k text file in HP-UX
# Time in seconds is User time.
#
# perl5 -d:DProf ./t2html.pl page.txt > /dev/null
#
# Time Seconds #Calls sec/call Name
# 52.1 22.96 12880 0.0018 main::DoLine
# 8.31 3.660 19702 0.0002 main::IsHeading
# 5.72 2.520 9853 0.0003 main::XlatUrl
# 5.56 2.450 9853 0.0002 main::XlatMailto
# 5.22 2.300 1 2.3000 main::HandleOneFile
# 4.22 1.860 9853 0.0002 main::XlatHtml
# 4.06 1.790 9853 0.0002 main::IsBullet
# 3.18 1.400 9853 0.0001 main::XlatRef
# 1.77 0.780 1 0.7800 main::KillToc
# 1.43 0.630 1 0.6300 Text::Tabs::expand
# 1.09 0.480 1 0.4800 main::PrintEnd
# 0.61 0.270 353 0.0008 main::MakeHeadingName
# 0.57 0.250 1 0.2500 main::CODE(0x401e4fb0)
# 0.48 0.210 1 0.2100 LWP::UserAgent::CODE(0x4023394c)
# 0.41 0.180 1 0.1800 main::PrintHtmlDoc
#
# Change Log: (none)
BEGIN { require 5.004 }
use integer; # standard pragmas
use strict;
# A U T O L O A D
#
# The => operator quotes only words, and File::Basename is not
# Perl "word"
use autouse 'Carp' => qw( croak carp cluck confess );
use autouse 'Text::Tabs' => qw( expand );
use autouse 'Pod::Text' => qw( pod2text );
use autouse 'Pod::Html' => qw( pod2html );
use Env;
use Cwd;
use English;
use File::Basename;
use Getopt::Long;
use vars qw ( $VERSION );
# This is for use of Makefile.PL and ExtUtils::MakeMaker
# So that it puts the tardist number in format YYYY.MMDD
# The REAL version number is defined later
#
# The following variable is updated by Emacs setup whenever
# this file is saved. See Emacs module tinymy.el where this
# feature is implemented, available at
# http//tiny-tools.sourceforge.net
$VERSION = '2001.0305';
# }}}
# {{{ Initial setup
# ****************************************************************************
#
# DESCRIPTION
#
# Ignore HERE document indentation. You cann this function like this
#
# @var = Here < ""
, "beg7" => qq(
)
, "end7" => ""
, "beg9" => qq(
)
, "end9" => ""
, "beg10" => qq(
)
, "end10" => ""
, beg7quote => qq()
, end7quote => ""
, "begemp" => qq()
, "endemp" => ""
, "begbold" => qq()
, "endbold" => ""
, "begquote" => qq()
, "endquote" => ""
, "begsmall" => qq()
, "endsmall" => ""
, "begbig" => qq()
, "endbig" => ""
, "begref" => qq()
, "endref" => ""
);
# ..................................................... language ...
# There are some visible LANGUAGE dependent things which must
# be changed. the internal HTML, NAMES and all can be in English.
use vars qw( %LANGUAGE_HASH );
%LANGUAGE_HASH =
(
-toc =>
{
en => 'Table Of Contents' # U.S. English -- all caps
, es => 'Tabla de Contenidos'
, fi => 'Sisällysluettelo'
}
);
# .......................................................... dtd ...
use vars qw ( $HTML_DOCTYPE );
sub Here($);
$HTML_DOCTYPE = Here <
EOF
use vars qw ( $HTML_DOCTYPE_FRAME );
$HTML_DOCTYPE_FRAME = HereQuote <<"EOF";
EOF
# ............................................... css properties ...
use vars qw
(
$CSS_BODY_FONT_TYPE_NORMAL
$CSS_BODY_FONT_TYPE_READABLE
$CSS_BODY_FONT_SIZE_FRAME
$CSS_BODY_FONT_SIZE_NORMAL
);
$CSS_BODY_FONT_TYPE_NORMAL = qq(font-family: "Times New Roman", serif;);
$CSS_BODY_FONT_TYPE_READABLE = qq(font-family: "verdana", sans-serif;);
$CSS_BODY_FONT_SIZE_FRAME = qq("font-size: 0.6em; /* relative, 8pt */";);
$CSS_BODY_FONT_SIZE_NORMAL = qq("font-size: 12pt; /* points */";);
# ............................................. run time globals ...
use vars qw
(
$ARG_PATH
$ARG_FILE
$ARG_DIR
);
}
# }}}
# {{{ Args parsing
# ************************************************************** &args *******
#
# DESCRIPTION
#
# Read command line options from file. This is necessary, because
# many operating systems have a limit how long and how many options
# can be passed in command line. The file can have "#" comments and
# options spread on multiple lines.
#
# Putting the options to separate file overcomes this limitation.
#
# INPUT PARAMETERS
#
# $file File where the command line call is.
#
# RETURN VALUES
#
# @array Like if you got the options via @ARGV
#
# ****************************************************************************
sub HandleCommandLineArgsFromFile ( $ )
{
# $debug = 1;
my $id = "$LIB.HandleCommandLineArgsFromFile";
my ( $file ) = @ARG;
local ( *FILE, $ARG );
my ( @arr, $line );
unless ( open FILE, $file )
{
die "$id: Cannot open file [$file] $ERRNO";
}
while ( defined($ARG = ) )
{
s/#\s.*//g; # Delete comments
next if /^\s*$/; # if empty line
s/^\s+//; # trim leading and trailing spaces
s/\s+$//; #font-lock s //
$debug and warn "$id: ADD => $ARG\n";
$line .= $ARG;
}
# Now comes the difficult part, We can't just split()'
# Because thre may be options like
#
# --autor "John doe"
#
# Which soule beome as split()
#
# --author
# "John
# Doe"
#
# But it should really be two arguments
#
# --author
# John doe
$ARG = $line;
while ( $ARG ne "" )
{
s/^\s+//;
if ( /^(-+\S+)(.*)/ ) #font-lock s//
{
$debug and warn "$id: PARSE option $1\n";
push @arr, $1;
$ARG = $2;
}
elsif ( /^[\"]([^\"]*)[\"](.*)/ ) #font-lock s//
{
$debug and warn "$id: PARSE dquote $1\n";
push @arr, $1;
$ARG = $2;
}
elsif ( /^'([^']*)'(.*)/ ) #font-lock s//
{
$debug and warn "$id: PARSE squote $1\n";
push @arr, $1;
$ARG = $2;
}
elsif ( /^(\S+)(.*)/ ) #font-lock s// #
{
$debug and warn "$id: PARSE value $1\n";
push @arr, $1;
$ARG = $2;
}
}
close FILE;
@arr;
}
# ************************************************************** &args *******
#
# DESCRIPTION
#
# Read and interpret command line arguments
#
# INPUT PARAMETERS
#
# none
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub HandleCommandLineArgs ()
{
my $id = "$LIB.HandleCommandLineArgs";
local $ARG;
# ....................................... options but not globals ...
# The variables are defined in Getopt, but they are locally used
# only inside this fucntion
my $DELETE_DEFAULT;
my $VERSION_OPTION;
# .......................................... command line options ...
# These are environment variables
use vars qw
(
$EMAIL
$PATH
$LANG
);
# Global varaibles
use vars qw
(
$AS_IS
$AUTHOR
$BASE
$BASE_URL
$BASE_URL_ALL
$BUT_TOP
$BUT_PREV
$BUT_NEXT
$DELETE_EMAIL
$DOC_URL
$DOC
$DISCLAIMER_FILE
$FONT
$FRAME
$HTML_BODY_ATTRIBUTES
$SCRIPT_FILE
$JAVA_CODE
$META_DESC
$META_KEYWORDS
$PRINT
$PRINT_URL
$QUIET
$SPLIT_REGEXP
$SPLIT1
$SPLIT2
$SPLIT_NAME_FILENAMES
$time
$TITLE
$OUTPUT_TYPE
$OUTPUT_SIMPLE
$OUTPUT_AUTOMATIC
$OUTPUT_DIR
$LINK_CHECK_ERR_TEXT_ONE_LINE
$FORGET_HEAD_NUMBERS
$NAME_UNIQ
$PRINT_NAME_REFS
$DELETE_REGEXP
$LINK_CHECK
$CSS_FONT_TYPE
$CSS_FONT_SIZE
$LANG_ISO
%REFERENCE_HASH
$debug
$verb
);
# When heading string is read, forget the numbering by default
#
# 1.1 heading --> "Heading"
$FORGET_HEAD_NUMBERS = 1;
# When gathering Toc jump points, NAME AHREF=""
#
# NAME_UNIQ if 1, then use sequential numbers for headings
# PRINT_NAME_REFS if 1, print to stderr the gathered NAME REFS.
$NAME_UNIQ = 0;
$PRINT_NAME_REFS = 0;
# ................................................... link check ...
# The LWP module is optional and we raise a Flag
# if we were able to import it. See CheckLWP()
#
# LINK_CHECK requires LWP_OK == 1
use vars qw( $LWP_OK );
$LWP_OK = 0;
# ..................................................... language ...
$LANG_ISO = "en"; # Standard ISO language name, two chars
if ( defined $LANG and $LANG =~ /^[a-z][a-z]/i ) # s/ environment var
{
$LANG_ISO = lc $LANG;
}
# ......................................................... Other ...
$ARG = join '', @ARGV;
if ( /options?-file(=|\s+)(\S+)/ )
{
my $file = $2;
@ARGV = HandleCommandLineArgsFromFile $file;
}
my @argv = @ARGV; # Save value for debugging;
# .................................................. column-args ...
# Remember that shell eats the double spaces.
# --html-column-beg="10 " -->
# --html-column-beg=10
my ( $key, $tag, $val , $email );
for ( @ARGV )
{
if ( /--html-column-(beg|end)/ )
{
if ( /--html-column-(beg|end)=(\w+) +(.+)/ ) #font-lock s//
{
( $key, $tag, $val ) = ( $1, $2, $3);
$COLUMN_HASH{ $key . $tag } = $val;
# warn "$key$tag ==> $val\n";
}
else
{
warn "Unregognized switch: $ARG";
}
}
}
@ARGV = grep ! /--html-column-/, @ARGV;
$BASE = "";
$TITLE = "No title";
my ( @reference , $referenceSeparator );
my ( $fontNormal, $fontReadable );
my ( $help, $helpHTML, $version, $testpage );
# .................................................... read args ...
Getopt::Long::config( qw
(
require_order
no_ignore_case
no_ignore_case_always
));
GetOptions # Getopt::Long
(
"debug:i" => \$debug
, "d" => \$debug
, "help" => \$help
, "help-html" => \$helpHTML
, "test-page" => \$testpage
, "Version" => \$version
, "verbose:i" => \$verb
, "as-is" => \$AS_IS
, "author=s" => \$AUTHOR
, "email=s" => \$email
, "B|base=s" => \$BASE
, "document=s" => \$DOC
, "disclaimer-file=s" => \$DISCLAIMER_FILE
, "t|title=s" => \$TITLE
, "language" => \$LANG_ISO
, "Butp|button-previous=s" => \$BUT_PREV
, "Butn|button-next=s" => \$BUT_NEXT
, "Butt|button-top=s" => \$BUT_TOP
, "html-body=s" => \$HTML_BODY_ATTRIBUTES
, "html-font=s" => \$FONT
, "F|html-frame" => \$FRAME
, "script-file=s" => \$SCRIPT_FILE
, "css-font-type=s" => \$CSS_FONT_TYPE
, "css-font-size=s" => \$CSS_FONT_SIZE
, "css-font-normal" => \$fontNormal
, "css-font-readable" => \$fontReadable
, "delete-lines=s" => \$DELETE_REGEXP
, "delete-email-headers" => \$DELETE_EMAIL
, "delete-default" => \$DELETE_DEFAULT
, "name-uniq" => \$NAME_UNIQ
, "T|toc-url-print" => \$PRINT_NAME_REFS
, "url=s" => \$DOC_URL
, "simple" => \$OUTPUT_SIMPLE
, "quiet" => \$QUIET
, "print" => \$PRINT
, "P|print-url" => \$PRINT_URL
, "time" => \$time
, "split=s" => \$SPLIT_REGEXP
, "S1|split1" => \$SPLIT1
, "S2|split2" => \$SPLIT2
, "SN|split-name-files" => \$SPLIT_NAME_FILENAMES
, "Out" => \$OUTPUT_AUTOMATIC
, "Out-dir=s" => \$OUTPUT_DIR
, "Reference-separator=s@" => \$referenceSeparator
, "reference=s@" => \@reference
, "l|link-check" => \$LINK_CHECK
, "L|link-check-single" => \$LINK_CHECK_ERR_TEXT_ONE_LINE
, "md|meta-description=s" => \$META_DESC
, "mk|meta-keywords=s" => \$META_KEYWORDS
);
$help and Help();
$helpHTML and Help(undef, -html);
$version and die "$VERSION $PROGNAME $CONTACT $URL\n";
$testpage and TestPage();
if ( $debug )
{
PrintArray( "$id: ARGV", \@argv );
warn "$id: ARGV => @argv\n";
}
$LINK_CHECK = 1 if $LINK_CHECK_ERR_TEXT_ONE_LINE;
for ( @reference )
{
my $sep = $referenceSeparator || "=";
my ( $key, $value ) = split /$sep/, $ARG; #font-lock s/
unless ( $key and $value )
{
die "No separator [$sep] found from --reference [$ARG]";
}
$REFERENCE_HASH{ $key } = $value;
$debug and warn "$id: [$ARG] Making TAG $key ==> $value\n";
}
if ( $LANG_ISO !~ /^[a-z][a-z]/ ) #font s/
{
die "$id: --language setting must contain two character ISO 639 id."
}
else
{
my $lang = substr lc $LANG_ISO, 0, 2;
unless ( exists $LANGUAGE_HASH{ -toc }{ $lang } )
{
warn "$id: Language [$LANG_ISO] is not supported, please contact "
, "maintainer $CONTACT. Switched to English."
;
$LANG_ISO = "en";
}
}
if ( defined $email )
{
$EMAIL = $email; # possibly substitute env. var.
}
if ( defined $DOC_URL )
{
local $ARG = $DOC_URL;
m,/$, and die "$id: trailing slash in --url ? [$DOC_URL]"; #font m"
}
if ( defined $OUTPUT_DIR and $OUTPUT_DIR eq "none" ) #font m"
{
undef $OUTPUT_DIR;
}
if ( $FRAME )
{
$HTML_DOCTYPE = $HTML_DOCTYPE_FRAME;
$OUTPUT_AUTOMATIC = 1;
$BASE eq '' and die "$id: Frame needs --base"; #font m:
}
if ( $DELETE_DEFAULT )
{
# Delete Emacs folding.el marks that keeps text in sections. #fl
#
# # {{{ Folding begin mark
# # }}} Folding end mark
#
# Delete also comments
#
# #COMMENT
$DELETE_REGEXP = "^(# )?\{\{\{|^(# )?\}\}\}|(#_comment(?i))"
}
if ( $BASE ne '' )
{
$BASE_URL_ALL = $BASE; # copy original
local $ARG = $BASE;
s,\n,,g; # No newlines
# If /users/foo/ given, treat as file access protocol
m,^/, and $ARG = "file:$ARG"; #font s,
# To ensure that we really get filename
not m,/, and die "Base must contain slash, URI [$ARG]"; #font m"
warn "Base may need trailing slash: $ARG" if /file/ and not m,/$,;
# Exclude the filename part
$BASE_URL = $ARG;
$BASE_URL = $1 if m,(.*)/,;
}
if ( defined $SCRIPT_FILE and $SCRIPT_FILE ne '' )
{
local *FILE;
$debug and
print "$id: Reading CSs and Java definitions form $SCRIPT_FILE\n";
open FILE, $SCRIPT_FILE or die "$id: $ERRNO";
$JAVA_CODE = join '', ;
close FILE;
}
if ( $LINK_CHECK )
{
$LINK_CHECK = 1;
$LWP_OK = CheckLWP();
if ( not $LWP_OK )
{
$LINK_CHECK = 0;
warn "Need perl 5 LWP::UserAgent to check links. Option ignored.";
}
}
$OUTPUT_TYPE = $OutputSimple if $OUTPUT_SIMPLE;
$OUTPUT_TYPE = $OutputQuiet if $QUIET;
if ( defined $SPLIT1 )
{
$SPLIT_REGEXP = '^([.0-9]+ )?[A-Z][a-z0-9]';
$debug and warn "$id: SPLIT_REGEXP = $SPLIT_REGEXP\n";
}
if ( defined $SPLIT2 )
{
$SPLIT_REGEXP = '^ ([.0-9]+ )?[A-Z][a-z0-9]';
$debug and warn "$id: SPLIT_REGEXP = $SPLIT_REGEXP\n";
}
use vars qw( $HOME_ABS_PATH );
if ( defined $PRINT_URL )
{
# We can't print absolute references like:
# file:/usr136/users/PM3/foo/file.html because that cannot
# be swallowed by browser. We must canonilise it to $HOME
# format file:/users/foo/file.html
#
# Find out where is HOME
my $previous = cwd();
if ( defined $HOME )
{
chdir $HOME;
$HOME_ABS_PATH = cwd();
chdir $previous;
}
}
if ( $AS_IS )
{
$BUT_TOP = $BUT_PREV = $BUT_NEXT = "";
}
# .................................................... css fonts ...
unless ( defined $CSS_FONT_TYPE )
{
$CSS_FONT_TYPE = $CSS_BODY_FONT_TYPE_NORMAL;
}
unless ( defined $CSS_FONT_SIZE )
{
$CSS_FONT_SIZE = $CSS_BODY_FONT_SIZE_NORMAL;
}
if ( $fontNormal )
{
$CSS_FONT_TYPE = $CSS_BODY_FONT_TYPE_NORMAL;
}
elsif ( $fontReadable )
{
$CSS_FONT_TYPE = $CSS_BODY_FONT_TYPE_READABLE
}
}
# }}}
# {{{ usage/help
# ***************************************************************** help ****
#
# DESCRIPTION
#
# Print help and exit.
#
# INPUT PARAMETERS
#
# $msg [optional] Reason why function was called.
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
=pod
=head1 NAME
t2html.pl - Simple text to html converter. Relies on text indentation rules.
=head1 README
This program converts pure text files into nice looking, possibly
framed HTML pages.
B
The file must be written in Technical format, whose layout is
described when you run the program with I<--help>. Basicly, you have
two heading levels, at column 0 and at column 4, the standard text
starts at column 8 (at regular tab position).
The idea of technical format is that each column represents different
html rendering layout in the generated HTML. There is no special
markup needed in the text file, so you can use text version as a
master copy (or FAQ) and post is as via email.
Bullets, numbered lists, word emphasis and quotation can instructed
easily in the technical format. All the features are described when you
use the I<--help> switch.
B
The generated HTML has Cascading Style Sheet 2 (CSS2) embedded and samll
piece of Java code. The CSS2 is used to colorize the page loyout and define
suitable printing font sizes.
B
The easiest format to write large documents, like 500K faqs is text. A text
file offers WysiWyg editing which can be reproduced in HTML format.
Text files can be easily maintained and there is no requirements for
any special text editor. You can use notepad, vi, pico or Emacs for that
purpose.
Text files are also the only sensible format if you are keeping the
documents under version control like RCS, CVS, Perforce, ClearCase. You can
diff, send and receive patches to the text documents.
To help maintining large documents, there is also available an I
minor mode, lisp package, called I, which will assist and make
it even more easier to keep your documents up to date. Indentation control,
bullet filling, renumbering headings, marking words, syntax highlighting
etc. are included. You can find pointers to all the tools at the
Sourceforge project http://tiny-tools.sourceforge.net/
=head1 SYNOPSIS
To convert text file into html:
t2html.pl [options] file.txt > file.html
To check links in the text file and report errors in I like fashion:
t2html.pl --link-check-single --quiet file.txt
To split big document into pieces according to toplevel heading
and making html pages for each split
t2html.pl --S1 --SN | t2html.pl --simple -Out
=head1 OPTIONS
=head2 Html: Header and Footer options
=over 4
=item B<--as-is>
Any extra html formatting or text manipulation is suppressed. Text is
preserved as it appears in file. You use this option if you plan to do
presentations and print the text as is.
o If file has "Table of Contents" it is not removed
o TOC jump block is not created
o I<[toc]> buttons are not added next to headings.
=item B<--author -a STR>
Author of document e.g. B<--author "Mr. Foo">
=item B<--disclaimer-file> FILE
The text that appears in the footer is read from this file. If not given
the default copyright text is added, unless you use C<--quiet> and
C<--simple> options to suppress discalimers.
=item B<--document FILE>
B of the document or filename. This may be different than given in
then B<--base> option, but it is usually the same. You could list all
alternative urls to the document with this option.
=item B<--email -e EMAIL>
The contact address of the author of the document. Put simple email,
with no <> characters included. Eg. B<--email foo@example.com>
=item B<--simple> B<-s>
Print minimum footer only: contact, email and date. Use C<--quiet> to
completely discard footer.
=item B<--title -t STR>
The title text that appears in browser's top frame.
=item B<--url URL>
=back
Location of the html file. When B<--document> gave the name, this gives the
location. Usually same as given with B<--base> option.
=head2 Html: Navigation urls
=over 4
=item B<--base -B URL>
Url location of the html file in the B where the html
will be put available.
If file is not put in http server, but to a ftp directory, IT IS VERY
IMPORTANT THAT YOU SPECIFY the ftp directory (base). All html I<#tag>
tokens refer to the url where base points to.
Examples I
--base http://remote.example.com/file.html
--base file:/users/foo/txt/test-html/file.html
--base /users/foo/txt/
=item B<--button-top --Butt URL>
Buttons are placed at the top of document in order: [previous][top][next]
and these I<--button> options give values to those URLs.
URL to go to top level document. If URL is string I
then no button is inserted. This may be handy if you have a batch job
where you define each button, but you only fill some of them
$top = "index.html"; # set defaults
$prev = "none";
$next = "none";
...somewhere $prev or $next may get set, or then not
qx( t2html --simple --butt "$top" --butp "$prev" --butn "$next");
=item B<--button-prev --Butp URL>
URL to go to previous document or string I.
=item B<--button-next -Butn URL>
URL to go to next document or string I.
=item B<--reference tag=value>
You can add any custom references (tags) inside text and get them expand to
any value. This option can be given multiple times and every occurrance
of TAG is replaced with VALUE. E.g if you give following options:
--reference "#HOME-URL=http://www.example.com/dir"
--reference "#ARCHIVE-URL-=http://www.example.com/dir/dir2"
you can write the text using #HOME-URL/page.html and #ARCHIVE-URL/page.html
and in the generated html these are expanded to their respective values.
=item B<--reference-separator STRING>
which string is used to split the TAG and VALUE. Default is "=".
=item B<--Toc-url-print -T>
Print urls (contructed from headings) that build up the Table of Contents
(NAME AHREF tags) in a document. The list is printed in stderr, so that you
can do
% t2html.pl tmp.txt > file.html
and the reference names printed do not go to a html file.
=back
=head2 Html: Controlling the body of document
=over 4
=item B<--css-font-type CSS-DEFINITION>
Set the BODY element's font defintion to CSS-DEFINITION. The
default value used is the regular typeset used in newspapers and books:
font-family: "Times New Roman", serif;
=item B<--css-font-size CSS-DEFINITION>
Set the body element's font size to CSS-DEFINITION. The default font
size is expressed in points:
"font-size: 12pt;
=item B<--delete REGEXP>
Delete lines matching perl REGEXP. This is useful if you use some document
tool that uses navigation tags in the text file that you do not want to show
up in generated html.
=item B<--delete-email-headers>
Delete email headers at the beginning of file, until first empty line that
starts the body. If you keep your document ready for usenet posting, it
contains header and body:
From: ...
Newsgroups: ...
X-Sender-Info:
Summary:
BODY-OF-TEXT
=item B<--delete-default>
This is shorthand to B<--delete option>. Defines regexp to delete some
preset strings or tags.
Emacs C can be used with any text or programming language to
place sections of text between tags B<{{{> B<}}}> You can open or close
such folds. Keeping big documents (Megs) in order and manageable quite
easy. See. ftp://ftp.csd.uu.se/pub/users/andersl/beta/
the default value deletes Emacs folding.el {{{ }}} markers and special
comments "#_comment" like in text below:
{{{ Security section
#_comment Make sure you revise this section to
#_comment the next release
The seecurity is an important issue in everyday administration...
More text ...
}}}
=item B<--html-body STR>
Additional attributes to add to html tag . You could e.g. define
language of the text with B<--html-body LANG=en> which would generate
html tag See section "SEE ALSO" for ISO 639.
=item B<--html-column-beg="SPEC HTML-SPEC">
The defualt interpretation of columns 1,2,3 5,6,7,8,9,10,11,12 can be
changed with I and I swithes. Columns 0,4 can't be changed becaus
they are reserved for Headings. Here is some samples:
--html-column-beg="7quote "
--html-column-end="7quote "
--html-column-beg="10
class='column10'"
--html-column-end="10
"
--html-column-beg="quote "
--html-column-end="quote "
B You can only give specifications up till column 12. If text
is beyound column 12, it is interpreted like it were at column 12.
In addition to column number, the I can also be one of the
following strings
Spec equivalent word markup
------------------------------
quote `' # '`
bold _
emp *
small +
big =
ref [] # like: [Michael] referred to [rfc822]
Other available Specs
------------------------------
7quote When column 7 starts with double quote.
For style Sheet values for each color, refer to I attribute and use
B<--java-file> switch to import definitions. Usually /usr/lib/X11/rgb.txt
lists possible color values and the HTML standard at http://www.w3.org/
defines following named colors:
Black #000000 Maroon #800000
Green #008000 Navy #000080
Silver #C0C0C0 Red #FF0000
Lime #00FF00 Blue #0000FF
Gray #808080 Purple #800080
Olive #808000 Teal #008080
White #FFFFFF Fuchsia #FF00FF
Yellow #FFFF00 Aqua #00FFFF
=item B<--html-column-end="COL HTML-SPEC">
See B<--html-column-beg>
=item B<--html-font SIZE>
Define FONT SIZE. It is usefull to set big font size if you are
planning to print slides.
=item B<--html-frame -F [FRAME-PARAMS]>
If given, then two separate frame files are generated. The left frame will
contain TOC and right frame contains rest of the text. The I
can be any valid parameters for HTML tag FRAMESET. The default is
Cols="25%,75%".
Using this opption generates 3 files (implies B<--Out> option)
file.html --> file.html The Frame file, point browser here
file-toc.html Left frame (navigation)
file-body.html Right frame (content)
=item B<--language ID>
Use language ID, a two character ISO identifier like "en" for English
during the generation of HTML. This only affects the text that is shown
to end-user, like text "Table Of contents". The default setting is
"en". See section "SEE ALSO" for standards ISO 639 and ISO 3166.
=item B<--script-file FILE>
Include java code that must be complete from FILE. The
code is put inside of each html. The default java provided by this
filter is used if you do not supply B<--script-file>. It contains some
Style sheet (CSS) definitions.
The B<--script-file> is a general way to import anything into the HEAD
element. Eg. If you want to keep separate style definitions for
all, you could only import a pointer to a style sheet.
See I<14.3.2 Specifying external style sheets> in HTML 4.0 standard.
=item B<--meta-keywords --mk STR>
Meta keywords. Used by search engines. Separate kwywords like "AA, BB, CC"
with commas. See http://www.sandia.gov/sci_compute/html_ref.html and
http://www.htmlhelp.com/reference/wilbur/
--meta-keywords "AA,BB,CC"
=item B<--meta-description --md STR>
Meta Description. Include description string, max 1000 characters. This is
used by search engines.
=item B<--name-uniq>
(NOT RECOMMENDED TO BE USED)
First 1-4 words from the heading are used for the html I tags.
However, it is possible that two same headings start with exactly the same
1-4 words. In those cases you have to turn on this option. It will use
counter 00 - 999 instead of words from headings to construct HTML I
references.
Please use this option only in emergencies, because referring to jump block
I via
httpI://foo.com/doc.html#header_name
is more convenient than using obscure reference
httpI://foo.com/doc.html#11
In addition, each time you add a new heading the number changes, whereas
the symbolic name picked from heading stays as long as you do not change
the heading. Think about welfare of your netizens who bookmark you pages.
Make sure that the headings do not have same subjects and you do not need
this option.
=back
=head2 Document maintenance or batch job commands
=over 4
=item B<--link-check -l>
Check all http and ftp links.
I
Option B<--quiet> has special meaning when used with link check.
With this option you can regularly validate your document and remove dead
links or update moved links. Problematic links are outputted to I.
This link check feature is available only if you have the LWP web
library installed. Program will check if you have it at runtime.
Links that are big, e.g. which match I or that run programs
(links with ? character) are ignored because the GET request used in
checking returns content of the link. You know what that would mean
if I<.tar.gz> were checked. When you put binary links to your documents,
add them with space:
http://foo.com/dir/dir/ filename.tar.gz
Then the program I check the http addresses. Users may not be able to
get the file at one click, but if you care about maintaining you huge
documents, this is the only way to include the link to the checking phase.
=item B<--link-check-single -L>
Print condensed output in I like manner I
This option concatenates the url response text to single line, so that you
can view the messages in one line. You can use programming tools (Lioke
Emacs M-x compile) that can parse standard grep syntax to jump to locations
in your document to correct the links later.
=item B<--Out -O>
write generated html to file that is derived from the input filename.
--Out --print /dir/file --> /dir/file.html
--Out --print /dir/file.txt --> /dir/file.html
--Out --print /dir/file.this.txt --> /dir/file.this.html
=item B<--Out-dir DIR>
Like B<--Out>, but chop the directory part and write output files to
DIR. The following would generate the html file to current directory:
--Out-dir .
If you have automated tool that fills in the directory, you can use word
B to ignore this option. The following is a no-op, it will not generate
output to directory "none":
--Out-dir none
=item B<--print -p>
Print filename to stdout after html processing. Normally program prints
no output.
% t2html.pl --Out --print page.txt
--> page.html
=item B<--print-url -P>
Print filename in URL format. This is usefull if you want to check the
layout immediately with your browser.
% t2html.pl --Out --print-url page.txt | xargs lynx
--> file:/users/foo/txt/page.html
=item B<--split REGEXP>
Split document into smaller pieces when REGEXP matches. I, meaning, that it starts and quits. No html conversion for
the file is engaged.
If REGEXP is found from the line, it is a start point of a split. E.g. to
split according to toplevel headings, which have no numbering, you would
use:
--split '^[A-Z]'
A sequential numbers, 3 digits, are added to the generated partials:
filename.txt-NNN
The split feature is handy if you want to generate slides from each heading:
First split the document, then convert each part to HTML and finally print
each part (page) separately to printer.
=item B<--split1 --S1>
This is shorthand of B<--split> command. Define regexp to split on toplevel
heading.
=item B<--split2 --S2>
This is shorthand of B<--split> command. Define regexp to split on second
level heading.
=item B<--split-named-files --SN>
Additional directive for split commands. If you split e.g. by headings using
B<--split1>, it would be more informative to generate filenames according
to first few words from the heading name. Suppose the heading names where
split occur were:
Program guidelines
Conclusion
Then the generated partial filenames would be as follows.
FILENAME-program_guidelines
FILENAME-conclusion
=back
=head2 Miscellaneous options
=over 4
=item B<--debug -d LEVEL>
Turn on debug with positive LEVEL number. Zero means no debug.
=item B<--help -h>
Print help screen.
=item B<--help-html>
Print help in HTML format.
=item B<--test-page>
Print the test page: html and exampl etext file that demonstrates
the capabilities.
=item B<--time>
Print to stderr time spent used for handling the file.
=item B<--verbose -v>
Print verbose messages.
=item B<--quiet -q>
Print no footer at all. This option has different meaning if
I<--link-check> option is turned on: print only errorneous links.
=item B<--Version -V>
Print program version information.
=back
=head1 DESCRIPTION
This is simple text to html converter. Unlike other tools, this
tries to minimize the use of text tags to format the document,
The basic idea is to rely on indentation level, and the layout used is
called 'Technical format' (TF)
--//-- decription start
0123456789 123456789 123456789 123456789 123456789 column numbers
Heading 1 starts from left with big letter
The column positions are currently undeined and may not
format correcly. Do ot place text at columns 1,2,3
This is heading2 at column 4 started with big letter
Standard text starts at column 8, you can *emphatize* text or
make it _strong_ and write =SmallText= or +BigText+ show
variable name `ThisIsAlsoVariable'. You can `_*nest*_' `the'
markup. more txt in this paragraph txt txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt txt txt txt txt
Normal but colored text is between columns 5, 6
Emphatised text at column 7, like heading level 3
"Special text at column 7 starts with double quote"
Another standard text block at column 8 txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt txt txt txt
strong text at columns 9 and 11
Column 10 is normally reserved for quotations
Column 10 is normally reserved for quotations
Column 10 is normally reserved for quotations
Column 10 is normally reserved for quotations
Column 12 and further is reserved for code examples
Column 12 and further is reserved for code examples
All text here are surrounded by
HTML codes
Heading2 at column 4 again
If you want something like Heading level 3, use colum 7 (bold)
txt txt txt txt txt txt txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt txt
[1998-09-10 comp.lang.perl.misc Mr. Foo said]
cited text cited text cited text cited text cited text cited
text cited text cited text cited text cited text cited text
cited text cited text cited text cited text
[1998-09-10 comp.lang.perl.misc Mr. Bar said]
cited text cited text cited text cited text cited text cited
text cited text cited text cited text cited text cited text
cited text cited text cited text cited text
If you want something like Heading level 3, use colum 7 (bold)
txt txt txt txt txt txt txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt txt
* Bullet 1 text starts at column 1
txt txt txt txt txt txt txt txt
,txt txt txt txt txt txt txt txt
Notice that previous paragraph ends to P-comma code,
it tells this paragraph to continue in bullet
mode, otherwise this text at column 12 would be
intepreted as code section surrpoundedn by
HTML codes.
* Bullet 2, text starts at column 12
* Bullet 3. Bullets are adviced to keep together
* Bullet 4. Bullets are adviced to keep together
. This is ordered list nbr 1, text starts at column 12
. This is ordered list nbr 2
. This is ordered list nbr 3
.This line has BR, notice the DOT-code at beginning of
line. It is efective only at columns 1..11, because column 12
is reserved for code examples.
.This line has BR code and is displayed in line by itself.
.This line has BR code and is displayed in line by itself.
!! This adds an HTML code, text in line is marked with
!!
"This is emphasised text starting at column 7"
.And this text is put after the previous line with BR code
"This starts as separate line just below previous one"
.And continues again as usual with BR code
See the document #URL-BASE/document.txt, where #URL-BASE
tag is substituted with contents of --base switch.
Make this email address clickable
Do not make this email address clickable bar@example.com,
because it is only an example and not a real address. Notice
that the last one was not surrounded by <>. Common login names
like foo, bar, quux are also ignored automatically.
Also do not make < this@example.com> because there is extra
white spaces. This may be more convenient way to disable
email addresses temporarily.
Heading1 again at colum 0
Subheading at colum 4
And regular text, column 8 txt txt txt txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt txt txt txt txt txt
txt txt txt txt txt txt txt txt txt txt txt
--//-- decription end
That is it, there is the whole layout described. More formally the rules
of text formatting are secribed below.
=head2 USED HEADINGS
=over 4
=item *
There are only I heading levels in this style. Heading columns are 0
and 4 and the heading must start with big letter or number
=item *
at column 4, if the text starts with small letter, that line is interpreted
as
=item *
A HTML mark is added just before printing heading at level 1.
=item *
The headings are gathered, the TOC is built and inserted to the beginning
of html page. The HTML references used in TOC are the first 4
sequential words from the headings. Make sure your headings are uniquely
named, otherwise there will be same NAME references in the generated html.
Spaces are converted into underscore when joining the words. If you can not
write unique headings by four words, then you must use B<--name-uniq>
switch
=back
=head1 TEXT PLACEMENT RULES
=head2 General
The basic rules for positioning text in certain columns:
=over 4
=item *
Text at column 0 is undefined if it does not start with big letter or number
to indicate Heading level 1.
=item *
Text between colums 1-3 is marked with
=item *
Column 4 is reserved for heading level 2
=item *
Text between colums 5-7 is marked with
=item *
Text at column 7 is if the first character is double quote.
=item *
Column 10 is reserved for text. If you want to quote someone
or to add reference text, place the text in this column.
=item *
Text at colums 9,11 are marked with
=back
Column 8 for text and special codes
=over 4
=item *
Column 8 is reserved for normal text
=item *
At the start of text, at colum 8, there can be DOT-code or COMMA-code.
=back
Column 12 is special
=over 4
=item *
Column 12 is treated specially: block is started with
and lines are
marked as . When the last text at I 12 is found, the
block is closed with
Note follwing example
txt txt txt ;evenly placed block, fine, do it like this
txt txt
txt txt txt txt ;Can not terminate the /pre, because last
txt txt txt txt ;column is not at 12
txt txt txt txt
txt txt txt txt
txt txt txt txt
txt txt txt txt
;; Finalizing comment, now the text is evenly placed
=back
=head2 Additional tokens for use at column 8
=over 4
=item *
If there is C<.>(dot) at the beginning of a line and immediately
non-whitespace, then code is added to the end of line.
.This line has BR code at the end.
While these two line are joined together
by your browser, depending on the frame width.
=item *
If there is C<,>(comma) then the
code is not inserted if the previous line is empty. If you use both C<.>(dot) and C<,>(comma), they must be in
order dot-comma. The C<,>(comma) works differently if it is used in bullet
A
is always added if there is separation of paragraphs, but when you are
writing a bullet, there is a problem, because a bullet exist only as long
as text is kept together
* This is a bullet and it has all text ketp together
even if there is another line in the bullet.
But to write bullets tat spread multiple paragraphs, you must instruct
that those are to kept together and the text in next paragraph is
not while it is placed at column 12
* This is a bullet and it has all text ketp together
,even if there is another line in the bullet.
This is new paragrah to the previous bullet and this is
not a text sample. See COMMa-code below.
* This is new bullet
// and this is code sample after bullet
if ( $flag ) { ..do something.. }
=item *
Special text markings:
_this_ is intepreted as this
*this* is intepreted as this
`this' is intepreted as this `
Exra modifiers that can be mixed with the above. Usually if you want
bigger font, CAPITALIZE THE WORDS.
=this= is intepreted as this
+this+ is intepreted as this
[this] is intepreted as this
=back
=head2 Directives
=over 4
=item *
#REF command is used for refering to HTML tag inside current document.
The whole command must be placed on one single line, you cannot
break the line. Example:
#REF #how_to_profile;(Note: profiling);
(1) (2)
1. The NAME reference in current document, a single word.
This can also be full http url link.
You can get NAME list by enabling
--Toc-url-print option.
2. The clickable text is delimited by ; characters.
=item *
#URL-BASE is substituted with the contents of command line option B<--base
URL>. The #URL-BASE token allows you to refer to documents local to the
current site.
--base http://www.example.com/dir1/dir2/text.html
Then in text the reference is expanded like this
#URL-BASE/next.html
-->
http://www.example.com/dir1/dir2/next.html
=item *
A !! (two exclamation marks) at text column (position 8) causes adding
immediate code. Any text after !! in the same line is written with
and inserted just after code, therefore the word
formatting commands have no effect in this line.
=back
=head2 Http and email marking control
=over 4
=item *
All http and ftp references as well as email
addresses are marked clickable. Email must have surrounding <>
characters to be recognized.
=item *
If url is preceded with hyphen, it will not be clickable. If a string
foo, bar, quux, test, site is found from url, then it is not counted as
clickable.
clickable
http://this.com clickable
me@here.com not clickable
< me@here.com> not clickable; contains space
<5dko56$1@news02.deltanet.com> Message-Id, not clickable
http://foo.com "foo" found, not clickable
-http://this.com hyphen, not clickable
http://$EXAMPLE variable. not clickable
=back
=head2 Lists and bullets
=over 4
=item *
The bulletin table is contructed if there is "o" or "*" at column 8 and 3
spaces after it, so that text starts at column 12. Bulleted lines are
adviced to be kept together; no spaces between bullet blocks.
=item *
The ordered list is started with ".", a dot, and written like bullet where
text starts at column 12.
=back
=head2 Line breaks
=over 4
=item *
All line breaks are visible in your document, do not use more than one line
break to separate paragraphs.
=item *
Very important is that there is only I line break after headings.
=back
=head1 TABLE OF CONTENT HEADING
If there is heading 1, which is named exactly "Table of Contents", then all
text up to next heading are discarded from the generated html file. This is
done because program generates its own TOC. It is supposed that you use
some text formatting program to generate the toc for you in .txt file and
you do not maintain it manually. For example Emacs package I can
be used.
=head1 TROUBLESHOOTING
=head2 Generated html document did not look what I intended
The most common mistake is that you have extra newlines all over your
document. Keeep I empty line between headings and text, keep I
empty line between paragraphs, keep I empty line between body
text and bullet. Make it your mantra: I I I ...
Next, you may have put text at wrong column position. Remember that text
column position is 8.
If generated html suddendly starts using only one font, eg
, then
you have forgot to close the block. Make it read even, like this:
Code block
Code block
Code block
;; Add empty comment here to "close" the code example at column 12
Headings start with I letter or number. Double check your headings.
=head1 EXAMPLES
To print the test page and show all the possibilities:
% t2html.pl --test-page
To make simple html page without any meta information:
% t2html.pl --title "Html Page Title" --author "Mr. Foo" \
--simple --Out --print file.txt
If you have periodic post in email format, use B<--delete-email-headers> to
ignore the header text:
% t2html --Out --print --delete-email-headers --base /users/foo/txt page.txt
To make cool page fast
% t2html --html-frame --Out --print --base /users/foo/txt page.txt
To make Cool looking page from big document, including meta tags,
buttons, colors and frames. Pay attention to switch
I<--html-body> which defines document language.
% t2html.pl \
--print \
--Out \
--author "Mr. foo" \
--title "This is manual page of page BAR" \
--html-body LANG=en \
--butp previous.html \
--butt index.html \
--butn next.html \
--base http://example.com/dir/this-page.html \
--document http://example.com/dir/this-page.html \
--url this-page.html \
--html-frame \
--disclaimer-file $HOME/txt/my-html-footer.txt \
--meta-keywords "language-quux,manual,program" \
--meta-description "Bar program to do this that and more of those" \
manual.txt
To check links and printing status of all links in par with the http error
message (most verbose):
% t2html.pl --link-check file.txt | tee link-error.log
To print only problematic links:
% t2html.pl --link-check --quiet file.txt | tee link-error.log
To print terse output in egep -n like manner: line number, link anderror code.
% t2html.pl --link-check-single --quiet file.txt | tee link-error.log
To split large document into pieces, and convert each piece to html
% t2html.pl --split1 --split-name file.txt | t2html --simple -Out
=head1 ENVIRONMENT
=head2 EMAIL
If environment variable I is defined, it is used in footer for
contact address. Option B<--email> overrides the environment setting.
=head2 LANG
The default language setting for switch --language
Make sure the first characters contains the language as in:
LANG=en.iso88591
=head1 SEE ALSO
perl(1) html2ps(1) weblint(1) htmlpp(1)
=head2 Related programs
Jan Kärrman wrote a html2ps which is available at
http://www.tdb.uu.se/~jan/html2ps.html
Neil Bower wrote weblint which is available at
http://www.cre.canon.co.uk/~neilb/weblint/
iMATIX created htmlpp which is available at http://www.imatix.com/
Emacs minor mode to write documents based on TF layout is available. See
package tinytf.el in Tiny Tools kit at http://tiny-tools.sourceforge.net/
Latest HTML and CSS specification is at http://www.w3c.org/
=head2 RFC standards
http://www.rfc.net/
B<1766> C
=head2 ISO standards
B<639> C
http://www.oasis-open.org/cover/iso639a.html
B<3166> C
http://www.niso.org/3166.html and
http://www.netstrider.com/tutorials/HTMLRef/standards/
=head1 AVAILABILITY
t2html Homepage is at http://poboxes.com/jari.aalto/t2html.html
and CPAN entry is at http://www.perl.com/CPAN-local//scripts/
Reach author at jari.aalto@poboxes.com HomePage is at
http://poboxes.com/jari.aalto/
=head1 SCRIPT CATEGORIES
CPAN/Administrative
html
=head1 PREREQUISITES
No additional CPAN modules needed.
=head1 COREQUISITES
If you have module C, program can be used to verify
the URL links in your text file.
=head1 OSNAMES
C
=head1 VERSION
$Id: t2html.pl,v 1.26 2001/03/05 02:46:58 jaalto Exp $
=head1 AUTHOR
Copyright (C) 1996-1999 Jari Aalto. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself or in terms of Gnu General Public licence v2 or later.
=cut
sub Help (;$ $)
{
my $id = "$LIB.Help";
my $msg = shift; # optional arg, why are we here...
my $type = shift; # optional arg, type
if ( $type eq -html )
{
pod2html $PROGRAM_NAME;
}
else
{
pod2text $PROGRAM_NAME;
}
print "\n\n"
, "Default CSS and JAVA code inserted to the beginning of each file\n"
, JavaScript();
exit 1;
}
# }}}
# {{{ misc
# ****************************************************************************
#
# DESCRIPTION
#
# Convert to Unix or dos styled path
#
# INPUT PARAMETERS
#
# $path Path to convert
# $unix If non-zero, convert to unix slashes. If missing or zero,
# convert to dos paths.
# $tail if set, make sure there is trailing slash or backslash
#
# RETURN VALUES
#
# $ New path
#
# ****************************************************************************
sub PathConvert ( $ ; $ )
{
my $id = "$LIB.PathConvert";
local ( $ARG ) = shift;
my ( $unix ) = shift;
my ( $trail ) = shift;
if ( defined $unix )
{
s,\\,/,g; #font s/
if ( $trail )
{
s,/*$,/,; #font s/
}
else
{
s,/+$,,;
}
}
else
{
s,/,\\,g; #fonct s/
if ( $trail )
{
s,\\*$,\\,;
}
else
{
s,\\+$,,;
}
}
$ARG;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Return HOME location if possible. Guess, if cannot determine.
#
# INPUT PARAMETERS
#
# None
#
# RETURN VALUES
#
# $dir
#
# ****************************************************************************
sub GetHomeDir ()
{
my $id = "$LIB.GetHomeDir";
my $ret;
unless ( defined $HOME )
{
print "$id: WARNING Please set environement variable HOME"
, " to your home directory location. In Win32 This might be c:/home"
;
}
if ( defined $HOME )
{
$ret = $HOME;
}
else
{
local $ARG;
for ( qw(~/tmp /tmp c:/temp) )
{
-d and $ret = $ARG, last;
}
}
$debug and warn "$id: RETURN $ret\n";
$ret;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Debug function: Print content of an array
#
# INPUT PARAMETERS
#
# $title String to name the array or other information
# \@array Reference to an Array
# $fh [optional] Filehandle
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub PrintArray ($$;*)
{
my $id = "$LIB.PrintArray";
my ( $title, $arrayRef , $fh ) = @ARG;
$fh = $fh || \*STDERR;
my $i = 0;
my $count = @$arrayRef;
print $fh "\n ------ ARRAY BEG $title -----------\n";
for ( @$arrayRef )
{
print $fh "[$i/$count] $ARG\n";
$i++;
}
print $fh " ------ ARRAY END $title ------------\n";
}
# ****************************************************************************
#
# DESCRIPTION
#
# Print Array
#
# INPUT PARAMETERS
#
# $name The name of the array
# @array array itself
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub PrintArray2 ( $ @ )
{
my $id = "$LIB.PrintArray";
my ( $name, @arr) = @ARG;
local $ARG;
my $i = 0;
my $count = @arr;
warn "$id: $name is empty" if not @arr;
for ( @arr )
{
warn "$id: $name\[$i\] = $ARG/$count\n";
$i++;
}
}
# ****************************************************************************
#
# DESCRIPTION
#
# Debug function: Print content of a hash
#
# INPUT PARAMETERS
#
# $title String to name the array or other information
# \%array Reference to a hash
# $fh [optional] Filehandle. Default is \*STDOUT
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub PrintHash ($$;*)
{
my $id = "$LIB.PrintHash";
my ( $title, $hashRef, $fh ) = @ARG;
$fh = $fh || \*STDOUT;
my ( $i, $out );
print $fh "\n ------ HASH $title -----------\n";
for ( sort keys %$hashRef )
{
if ( $$hashRef{$ARG} )
{
$out = $$hashRef{ $ARG };
}
else
{
$out = "";
}
print $fh "$i / $ARG = $out \n";
$i++;
}
print $fh " ------ END $title ------------\n";
}
# ****************************************************************************
#
# DESCRIPTION
#
# Check that variable $EMAIL is available. Die if not ok.
#
# INPUT PARAMETERS
#
# $email
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub CheckEmail ($)
{
my $id = "$LIB.CheckEmail";
my $email = shift;
not defined $email and Help "--email missing";
my $die;
if ( $email =~ /^\S*$/ ) # Contains something
{
if ( $email !~ /@/ or $email =~ /[<>]/ )
{
$die = "Invalid EMAIL [$EMAIL]. It must not contain characters <> ",
"or you didn't include \@\n"
;
die "Example: me\@example.com";
}
}
else
{
}
}
# ****************************************************************************
#
# DESCRIPTION
#
# Remove Headers from the text array.
#
# INPUT PARAMETERS
#
# \@array Text
#
# RETURN VALUES
#
# \@array
#
# ****************************************************************************
sub DeleteEmailHeaders ($)
{
my $id = "$LIB.DeleteEmailHeaders";
my ($txt) = @ARG;
my ( @array, $body);
my $line = @$txt[0];
if ( $line !~ /^[-\w]+:|^From/ )
{
$debug and print "$id: Skipped, no email ", @$txt[0];
@array = @$txt;
}
else
{
for $line ( @$txt )
{
next if $body == 0 and $line !~ /^\s*$/;
unless ( $body )
{
$body = 1;
next; # Ignore one empty line
}
push @array, $line;
}
}
\@array;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Print help and exit.
#
# INPUT PARAMETERS
#
# $ref url reference or "none"
# $txt text
# $attr [optional] additional attributes
#
# RETURN VALUES
#
# $string html code
#
# ****************************************************************************
sub MakeUrlRef ($$;$)
{
my $id = "$LIB.MakeUrlRef";
my( $ref, $txt, $attr ) = @ARG;
qq($txt);
}
# ****************************************************************************
#
# DESCRIPTION
#
# Check if LWP::UserAgent module is available. It is used for
# verifying URLs.
#
# INPUT PARAMETERS
#
# none
#
# RETURN VALUES
#
# 0 Error
# 1 Ok, http support present
#
# ****************************************************************************
sub CheckLWP ()
{
my $id = "$LIB.CheckLWP";
eval "use LWP::UserAgent";
$debug and warn "$id: eval [$EVAL_ERROR] \n";
return 0 if $EVAL_ERROR;
1;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Translate some special characters into Html codes.
#
# INPUT PARAMETERS
#
# $line text
#
# RETURN VALUES
#
# $line html
#
# ****************************************************************************
sub XlatTag2html ($)
{
my $id = "$LIB.XlatTag2html";
local $ARG = shift;
s,\&,&,g;
s,\>,>,g;
s,\<,<,g;
s,\",",g; # dummy-coment " to fix Emacs font-lock highlighting
# The Finnish special alphabet conversions are
#
# 0xE4 228 a: ä
# 0xC4 196 A: Ä
# 0xF6 246 o: ö
# 0xD6 214 O: Ö
s,\xE4,ä,g;
s,\xC4,Ä,g;
s,\xF6,ö,g;
s,\xD6,Ö,g;
$ARG;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Translate html to text
#
# INPUT PARAMETERS
#
# $line html
#
# RETURN VALUES
#
# $line text
#
# ****************************************************************************
sub XlatHtml2tag ($)
{
my $id = "$LIB.XlatHtml2tag";
local $ARG = shift;
# According to "Mastering regular expressions: O'Reilly", the
# /i is slower than charset []
#
# s/a//i is slow
# s/[aA]// is faster
s,&,\&,gi;
s,>,>,gi;
s,<,<,gi;
s,",\",gi; # dummy-comment to close opened quote (")
s,ä,\0xE4,g;
s,Ä,\0xC4,g;
s,ö,\0xF6,g;
s,Ö,\0xD6,g;
$ARG;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Translate $REF special markers to clickable html.
# A reference link looks like
#
# #REF link-to; shown text;
#
# INPUT PARAMETERS
#
# $line
#
# RETURN VALUES
#
# $html
#
# ****************************************************************************
sub XlatRef ($)
{
my $id = "$LIB.XlatRef";
my $line = shift;
if ( $line =~ /(.*)#REF\s+(.*)\s*;(.*);(.*)/ )
{
# There already may be absolute reference, check it first
#
# http:/www.this.com#referece_here
# $s2 = "#$s2" if not /(\#REF.*\#)/ and /ftp:|htp:/;
$line = $1 . MakeUrlRef($2, $3) . $4;
unless ( $line =~ /#|http:|file:|news:|wais:|ftp:/ )
{
warn "$id: Suspicious REF. Did you forgot # or http?\n\t$line"
}
$debug and warn "$id: #REF--> [$1]\n [$2]\n [$3]\n [$line]";
}
$line;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Check if we accept URL. Any foo|bar|baz|quu|test or the like
# is discarded. In exmaples, you should use "example" domain
# that is Valud, but non-sensial. (See RFCs for more)
#
# http://www.example.com/
# ftp:/ftp.example.com/
#
# INPUT PARAMETERS
#
# $url
#
# RETURN VALUES
#
# 1, 0
#
# ****************************************************************************
sub AcceptUrl($)
{
$ARG[0] !~ m,foo|ba[rz]|quu[zx]|:/\S*\.?example\.|example\.com|:/test\.,;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Translate url references to clickable html format
#
# INPUT PARAMETERS
#
# $line
#
# RETURN VALUES
#
# $html
#
# ****************************************************************************
sub XlatUrl ($)
{
my $id = "$LIB.XlatUrl";
local $ARG = shift;
my ($url, $pre);
s
{
([^\"]?) # Emacs font-lock comment to terminate opening "
((?:file|ftp|http|news|wais|mail|telnet):
# This is two path catching: urls can contain almost anything,
# BUT the lats character grabbed must not be period, colon etc.
#
# See url http://example.com/that.txt. New sentence starts here.
#
# Of course, it would be better to write
#
# See url . New sentence starts here.
#
[^][\s<>]+[^\s,.!?;:<>])
}
{
$pre = $1;
$url = $2;
# Unfortunately the Link that is passed to us has already
# gone through conversion of "<" and ">" as in
# so we must treat the ending
# ">" as a separate case
my $last = "";
if ( $url =~ />$/ )
{
$last = ">";
$url =~ s/>//;
}
# warn ">>#ORA $ARG [$pre][$url]", AcceptUrl $url, "\n" if /ietf/i;
# Do not make -http://some.com clickable. Remove "-" in
# front of the URL.
my $clickable = 1;
if ( $pre =~ /-/ )
{
$clickable = 0;
$pre = "";
}
if ( not $clickable or not AcceptUrl $url )
{
$pre . $url . $last ;
}
else
{
# When we make HREF target to point to "_top", then
# the destination page will occupy whole browser window
# automatically and delete any existing frames.
#
# --> Destination may freely sset up its own frames
join ''
, $pre
, MakeUrlRef( $url, $url, qq!target="_top"! )
, $last
;
}
}egx;
$ARG;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Translate email references to clickable html format
#
# INPUT PARAMETERS
#
# $line
#
# RETURN VALUES
#
# $html
#
# ****************************************************************************
sub XlatMailto ($)
{
my $id = "$LIB.Mailto";
local $ARG = shift;
# Handle Mail references, we need while because there may be
# multiple mail addresses on the line
#
# A special case; in text there may be written like these. They are NOT
# clickable email addresses.
#
# References: <5dfqlm$m50@basement.replay.com>
# Message-ID: <5dko56$1lv$1@news02.deltanet.com>
#
# Ignore certain email addresses like
# foo@example.com bar@example.com ... that are used as examples
# in the document.
#
# Ignore also any address that is like
# - Leading dash
# < addr@example.com> space follows character <
s
{
(^|.) # must not start with "-"
< # html < tag.
([^ \t$<>]+@[^ \t$<>]+)
>
}
{
my $pre = $1;
my $url = $2;
my $clickable = 1;
if ( $pre eq '-' )
{
$clickable = 0;
$pre = "";
}
if ( not $clickable or not AcceptUrl $url )
{
$pre . $url;
}
else
{
$pre . "" . MakeUrlRef( "mailto:$url" , $url) . ""
}
}egx;
$ARG;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Return standard Unix date
#
# Tue, 20 Aug 1999 14:25:27 GMT
#
# The HTML 4.0 specification gives an example date in that format in
# chapter "Attribute definitions".
#
# INPUT PARAMETERS
#
# $ How many days before expiring
#
# RETURN VALUES
#
# $str
#
# ****************************************************************************
sub GetExpiryDate (;$)
{
my $id = "$LIB.GetExpiryDate";
my $days = shift || 60;
# 60 days Expiry period, about two months
gmtime(time + 60*60*24 * $days) =~ /(...)( ...)( ..)( .{8})( ....)/;
"$1,$3$2$5$4 GMT";
}
# ****************************************************************************
#
# DESCRIPTION
#
# Return ISO 8601 date YYYY-MM-DD HH:MM
#
# INPUT PARAMETERS
#
# none
#
# RETURN VALUES
#
# $str
#
# ****************************************************************************
sub GetDate ()
{
my $id = "$LIB.GetDate";
my (@time) = localtime(time);
my $YY = 1900 + $time[5];
my ($DD, $MM) = @time[3..4];
my ($mm, $hh) = @time[1..2];
$debug and warn "$id: @time\n";
# I do not know why Month(MM) is one less that the number month
# in my calendar. That's why +1. Does it count from zero?
sprintf "%d-%02d-%02d %02d:%02d", $YY, $MM + 1, $DD, $hh, $mm;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Return ISO 8601 date YYYY-MM-DD HH:MM
#
# INPUT PARAMETERS
#
# none
#
# RETURN VALUES
#
# $str
#
# ****************************************************************************
sub GetDateYear ()
{
my $id = "$LIB.GetDateYear";
my (@time) = localtime(time);
my $YY = 1900 + $time[5];
$debug and warn "$id: @time\n";
# I do not know why Month(MM) is one less that the number month
# in my calendar. That's why +1. Does it count from zero?
$YY;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Return approproate sentence in requested language.
#
# INPUT PARAMETERS
#
# $token The name of the token to get. e.g "-toc"
#
# RETURN VALUES
#
# $string String in the set language. See --language switch
#
# ****************************************************************************
sub Language ($)
{
my $id = "$LIB.Language";
my $lang = substr $LANG_ISO, 0, 2;
XlatTag2html $LANGUAGE_HASH{ shift() }{ $LANG_ISO };
}
# ****************************************************************************
#
# DESCRIPTION
#
# Add string to filename. file.html --> fileSTRING.html
#
# INPUT PARAMETERS
#
# $file filename
# $string string to add to the adn of name, but before extension
# $extension
#
# RETURN VALUES
#
# $file
#
# ****************************************************************************
sub FileNameChange ($$;$)
{
my $id = "$LIB.FileNameChange";
my ( $file, $string , $ext ) = @ARG;
my ( $filename, $path, $extension ) = fileparse $file, '\.[^.]+$'; #font '
$path . $filename . $string . ($ext or $extension);
}
# ****************************************************************************
#
# DESCRIPTION
#
# Return fram html file name
#
# INPUT PARAMETERS
#
# $type "-frm", "-toc", "-txt"
#
# USE GLOBAL
#
# $ARG_PATH
#
# RETURN VALUES
#
# $file
#
# ****************************************************************************
sub FileFrameName($)
{
my $id = "$LIB.FileFrameName";
my $type = shift;
if ( $ARG_PATH ne '' )
{
FileNameChange $ARG_PATH, $type, ".html";
}
}
sub FileFrameNameMain() { FileFrameName "" }
sub FileFrameNameToc() { FileFrameName "-toc" }
sub FileFrameNameBody() { FileFrameName "-body" }
# ****************************************************************************
#
# DESCRIPTION
#
# CLOSURE. Return new filename file.txt-NNN based on initial values.
# Each NNN is inncremented during call.
#
# INPUT PARAMETERS
#
# $file starting filename
# $heading Flag. If 1, generate name from headings, instead of
# numeric names.
#
# RETURN VALUES
#
# &Sub($) Anonymous subroutine that must be called withg string.
#
# ****************************************************************************
sub GeneratefileName ($;$)
{
my $id = "$LIB.GeneratefileName";
my ($file, $headings ) = @ARG;
if ( $headings )
{
return sub
{
my $line = shift;
not defined $line
and croak "You must pass one ARG";
not $line =~ /[a-z]/
and croak "ARG must contain some words. Cannot make filename";
sprintf "$file-%s", MakeHeadingName($line);
}
}
else
{
my $i = 0;
return sub
{
# Ignore passed ARG
sprintf "$file-%03d", $i++;
}
}
}
# ****************************************************************************
#
# DESCRIPTION
#
# Write content to file
#
# INPUT PARAMETERS
#
# $file
# \@content text
#
# RETURN VALUES
#
# @ list of filenames
#
# ****************************************************************************
sub WriteFile ($$)
{
my $id = "$LIB.WriteFile";
my ( $file, $array ) = @ARG;
local *F;
# croak if $file =~ /\.txt/;
open F, ">$file" or die "$id: Cannot write to [$file] $ERRNO";
print F @$array;
close F;
$debug and warn "$id: $file %d lines: ", scalar @$array, "\n";
}
# ****************************************************************************
#
# DESCRIPTION
#
# Split text into separate files file.txt-NNN, search REGEXP.
# Files are ruthlessly overwritten.
#
# INPUT PARAMETERS
#
# $regexp If found. The line is discarded and anything gathered
# for far is printed to file. This is the Split point.
# $file Used in split mode only to generate multiple files.
# $useNames Flag. If set compose filenames based on REGEXP split.
# \@content text
#
# RETURN VALUES
#
# @ list of filenames
#
# ****************************************************************************
sub SplitToFiles ($ $$ $)
{
my $id = "$LIB.SplitToFiles";
my ( $regexp, $file, $useNames, $array ) = @ARG;
my ( @fileArray, $name , @tmp , $match );
my $FileName = GeneratefileName $file, $useNames;
local (*F , $ARG);
for ( @$array )
{
if ( /$regexp/o && @tmp )
{
# Get the first line that matched and use it as filename
# base
($match) = grep /$regexp/o, @tmp;
$name = &$FileName( $match );
WriteFile $name, \@tmp;
@tmp = ();
push @tmp, $ARG;
push @fileArray, $name;
}
else
{
push @tmp, $ARG;
}
}
if ( @tmp ) # last block
{
$name = &$FileName( $tmp[0] );
WriteFile $name, \@tmp;
push @fileArray, $name;
}
@fileArray;
}
# }}}
# {{{ misc - make
# ****************************************************************************
#
# DESCRIPTION
#
# Return BASE. must be inside HEAD tag
#
# INPUT PARAMETERS
#
# $file html file
# $attrib Additional attributes
#
# USES GLOBAL
#
# $BASE_URL
#
# RETURN VALUES
#
# $html
#
# ****************************************************************************
sub Base (;$$)
{
my $id = "$LIB.Base";
my ($file, $attrib) = @ARG;
if ( defined $BASE_URL and $BASE_URL ne '' )
{
qq( \n) ;
}
}
# ****************************************************************************
#
# DESCRIPTION
#
# Return CSS Style sheet data without the tokens
#
# RETURN VALUES
#
# code
#
# ****************************************************************************
sub CssData (;$)
{
local ( $ARG ) = @ARG;
my $bodyFontType = $CSS_FONT_TYPE;
my $bodyFontSize;
if ( /toc/i )
{
$bodyFontSize = $CSS_BODY_FONT_SIZE_FRAME;
}
return <...
to get that kind of text seen in printer too. You cannot
just define P.column7 { ... }
The \@media CSS definition is not supported by Netscape 4.05
I do not know if MSIE 4.0 supports it.
So doing this would cause CSS to be ignored completely
(never mind that CSS says the default CSS applies to "visual",
which means both print and scree types.)
\@media print, screen { P.code {..} }
To work around that, we separate the definitions with
P.code { .. } // For screen
\@media print { P.code // for printer
{
..
}}
And wish that some newer browser will render it right.
-->
BODY
{
$bodyFontType;
$bodyFontSize
/*
More readable font, Like Arial in MS Word
The background color is grey
font-family: "verdana", sans-serif;
background-color: #dddddd;
foreground-color: #000000;
Traditional "Book" and newspaper font
font-family: "Times New Roman", serif;
*/
}
A:link
{
font-style: italic;
}
/* link references */
A.name
{
font-style: normal;
}
A:hover
{
color: purple;
background: #AFB
text-decoration: none;
font-weight: italic;
}
A.btn:link
{
font-style: normal;
}
A.toc:link
{
font-style: normal;
}
A.btn-toc:link
{
font-style: normal;
font-size: 0.7em;
}
BLOCKQUOTE
{
margin-right: 0;
}
\@media print { BLOCKQUOTE
{
margin-right: 0;
}}
SAMP.code
{
color: Navy;
}
PRE
{
font-family: "Courier New", monospace;
font-size: 0.8em;
}
PRE.code, P.code1, P.code2
{
/*
margin-top: 0.4em;
margin-bottom: 0.4em;
line-height: 0.9em;
*/
font-family: "Courier New", monospace;
font-size: 0.8em;
color: Navy;
}
P.column3
{
color: Green;
}
P.column5
{
color: #87C0FF; /* shaded casual blue */
}
P.column6
{
color: #809F69; /* Forest green */
}
P.column7
{
font-style: italic;
font-weight: bold
}
\@media print { P.column7
{
font-style: italic;
font-weight: bold
}}
P.column8
{
}
P.column9
{
font-weight: bold
}
P.column10
{
padding-top: 0;
}
EM.quote10
{
/*
#FF00FF Fuchsia;
#0000FF Blue
#87C0FF casual blue
#87CAF0
#A0FFFF Very light blue
#809F69 = Forest Green , see /usr/lib/X11/rgb.txt
background-color:
color: #80871F ; Orange, short of
# font-family: "Gill Sans", sans-serif;
# See a nice page at
# http://www.cs.helsinki.fi/linux/
# http://www.cs.helsinki.fi/include/tktl.css
#
# 3-4 of these first fonts have almost identical look
# Browser will pick the one that is supported
line-height: 0.9em;
font-style: italic;
font-size: 0.8em;
line-height: 0.9em;
color: #008080;
background-color: #F5F5F5;
#809F69; forest green
#F5F5F5; Pale grey
#FFf098; pale green
##bfefff; #ffefff; LightBlue1
*/
font-family: lucida, lucida sans unicode, arial, helvetica, sans-serif;
background-color: #ffefff;
font-size: 0.8em;
}
\@media print { EM.quote10
{
font-style: italic;
line-height: 0.9em;
font-size: 0.8em;
}}
P.column11
{
color: Fuchsia;
}
EM.word { color: #809F69; /*Forest green */ }
STRONG.word { }
SAMP.word
{
color: Blue;
font-family: "Courier New", monospace;
font-size: 0.8em;
}
SPAN.word-ref { color: Teal; }
BIG.word-big { color: Teal; font-size: 1.2em; }
SMALL.word-small { color: Teal; font-size: 0.8em; }
EM.quote7
{
color: Green;
font-style: italic;
}
DIV.TOC
{
font-size: 0.8em;
}
EM.footer
{
font-size: 0.9em;
}
EOF
}
# ****************************************************************************
#
# DESCRIPTION
#
# Return CSS Style sheet and Java Script data.
#
# USES GLOBAL
#
# JAVA_CODE See options.
#
# INPUT VALUES
#
# $type What page we're creating? eg: "toc"
#
# RETURN VALUES
#
# $html
#
# ****************************************************************************
sub JavaScript (; $)
{
my $id = "$LIB.JavaScript";
my ( $type )= @ARG;
if ( $JAVA_CODE ne '' )
{
$JAVA_CODE;
}
else
{
my $css = CssData $type;
# won't work in Browsers....
#
EOF
}
}
# ****************************************************************************
#
# DESCRIPTION
#
# Return Basic html start: doctype, head, body-start
#
# INPUT PARAMETERS
#
# $title
# $baseFile [optional] The html filename at $BASE_URL
# $attrib [optional] Attitional attributes
# $rest [optional] Rest HTML before
#
# USES GLOBAL
#
# $BASE_URL
#
# RETURN VALUES
#
# $html
#
# ****************************************************************************
sub HtmlStartBasic ($ ; $$$)
{
# [HTML 4.0/12.4] When present, the BASE element must appear in the
# HEAD section of an HTML document, before any element that refers to
# an external source. The path information specified by the BASE
# element only affects URIs in the document
# where the element appears.
my $id = "$LIB.HtmlStartBasic";
my ($title, $baseFile, $attrib, $rest) = @ARG;
my $ret = HereQuote <<"........EOF";
$HTML_DOCTYPE
$title
........EOF
$ret .= join ''
, JavaScript()
, Base($baseFile, $attrib)
, $rest
, "\n\n\n"
;
$ret;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Create html tag
#
# Advanced net browsers can use the included LINK tags.
# http://www.htmlhelp.com/reference/wilbur/alltags.html
#
# REL="home": indicates the location of the homepage, or
# starting page in this site.
#
# REL="next"
#
# Indicates the location of the next document in a series,
# relative to the current document.
#
# REL="previous"
#
# Indicates the location of the previous document in a series,
# relative to the current document.
#
# NOTES
#
# Note, 1997-10, you should not use this function because
#
# a) netscape 3.0 doesn't obey LINK HREF
# b) If you supply LINK and normal HREF; then lynx would show both
# which is not a good thing.
#
# Let's just conclude,t that LINK tag is not yet handled right
# in browsers.
#
# INPUT PARAMETERS
#
# $type the value of REL
# $url the value for HREF
# $title [optional] An advisory title for the linked resource.
#
# RETURN VALUES
#
# $string html string
#
# **************************************************************************
sub MakeLinkHtml ($$$)
{
my $id = "$LIB.MakeLinkHtml";
my( $type, $url , $title ) = @ARG;
$title = $title || qq(TITLE="$title");
qq(\n);
}
# ****************************************************************************
#
# DESCRIPTION
#
# Wrap text inkside comment
#
# INPUT PARAMETERS
#
# $text Text to be put inside comment block
#
# RETURN VALUES
#
# $string Html codes
#
# ****************************************************************************
sub MakeComment ($)
{
my $id = "$LIB.MakeComment";
my $txt = shift;
join ''
, "\n\n\n\n"
;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Create Table of contents jump table to the html page
#
# INPUT PARAMETERS
#
# \@headingArrayRef All heading in the text: 'heading', 'heading' ..
# \%headingHashRef 'heading' -- 'NAME(html)' pairs
# $doc [optional] Url address pointing to the document
# $frame [optional] Aadd frame codes.
# $file [optional] Needed if frame is given.
# $author [optional]
# $email [optional]
#
# RETURN VALUES
#
# @array Html codes for TOC
#
# ****************************************************************************
sub MakeToc ($$ ;$$$ $$)
{
my $id = "$LIB.MakeToc";
my
(
$headingArrayRef
, $headingHashRef
, $doc
, $frame
, $file
, $author
, $email
) = @ARG;
local $ARG;
my( $txt, $spc, $li, $ul , $refname );
my( $styleb, $stylee , @ret , $str , $ref );
my $frameFrm = basename FileFrameNameMain();
my $frameToc = basename FileFrameNameToc();
my $frameTxt = basename FileFrameNameBody();
$debug and $frame and warn "$id: $ARG_DIR $frameFrm, $frameToc, $frameTxt";
if ( 0 ) # disabled now
{
$styleb = "";
$stylee = "";
}
# ........................................................ start ...
if ( $frame )
{
push @ret, <<"........EOF";
$HTML_DOCTYPE
Navigation
........EOF
push @ret,
, MakeMetaTags($author, $email)
, qq( \n)
, JavaScript( "toc" )
;
push @ret, Here <<"........EOF";
........EOF
}
else
{
push @ret
, "\n\n"
, MakeComment "TABLE OF CONTENT END"
;
push @ret , Here <<"........EOF";
........EOF
}
$debug and PrintArray "$id", \@ret;
@ret;
}
# }}}
# {{{ URL Link
# *************************************************************** &link ******
#
# DESCRIPTION
#
# Check if link is valid
#
# INPUT PARAMETERS
#
# $str string containing the link or pure URL link
#
# RETURN VALUES
#
# nbr Error code.
# Global %LINK_HASH is updated too with key 'link' -- 'response'
#
# ****************************************************************************
sub LinkCheckExternal ($$$)
{
my $id = "$LIB.LinkCheckExternal";
my( $url , $LINK_HASH_REF , $LINK_HASH_CODE_REF) = @ARG;
my( $ret , $txt ) = 0;
if ( $LWP_OK )
{
eval "use LWP::UserAgent" unless exists $INC{"LWP/UserAgent"};
# Note: 'HEAD' request doesn't actually download the
# whole document. 'GET' would.
#
# Hm,
# HEAD is not the total answer because there are still servers
# that do not understand it. if the HEAD fails, revert to GET. HEAD
# can only tell you that a URL has something behind it. it can't tell
# you that it doesn't, necessarily.
my $ua = new LWP::UserAgent;
my $request = new HTTP::Request( 'HEAD', $url );
my $obj = $ua->request( $request );
unless ( $obj->is_success )
{
my $ua2 = new LWP::UserAgent;
my $request2 = new HTTP::Request( 'GET', $url );
my $obj2 = $ua2->request( $request2 );
unless ( $obj2->is_success )
{
$ret = 1;
$$LINK_HASH_REF{ $url } = $obj2->code;
# There is new error code, record it.
if ( not defined $$LINK_HASH_CODE_REF{ $obj2->code } )
{
$txt = $obj->message;
$$LINK_HASH_CODE_REF{ $obj2->code } = $txt;
}
}
}
}
$debug and warn "$url $ret $txt";
($ret , $txt);
}
# ****************************************************************************
#
# DESCRIPTION
#
# convert html into ascii by just stripping anything between
# < and > written 4/21/96 by Michael Smith for WebGlimpse
#
# INPUT PARAMETERS
#
# \@arrayRef text lines
#
# RETURN VALUES
#
# @
#
# ****************************************************************************
sub Html2txt ($)
{
my $id = "$LIB.Html2txt";
my $arrayRef = shift;
my ( @ret, $carry, $comment );
for ( @$arrayRef )
{
if ( 0 ) # enable/disable comment stripping
{
$comment = 1 if //;
$comment = 0 if /--->/;
next if $comment;
}
if ( $carry )
{
# remove all until the first >
next if not s/[^>]*>// ;
# if we didn't do next, it succeeded -- reset carry
$carry = 0;
}
while( s/<[^>]*>//g ) { }
if( s/<.*$// )
{
$carry = 1;
}
$ARG = XlatHtml2tag $ARG;
push @ret, $ARG;
}
@ret;
}
# ****************************************************************************
#
# DESCRIPTION
#
# read external links
#
# INPUT PARAMETERS
#
# \@txt whole text where to find links.
#
# RETURN VALUES
#
# % all found links 'line nbr' -- 'lnk'
#
# ****************************************************************************
sub ReadLinks ($)
{
my $id = "$LIB.ReadLinks";
my $arrayRef = shift;
local $ARG; # the URL
my( $url, %ret, $i, $elt);
for $elt ( @$arrayRef )
{
$i++;
$ARG = "";
# This used to read (ftp|http), but the ftp check does not
# know GET request.
$ARG = $1 if $elt =~ m,(([Hh][Tt][Tt][Pp])://[^][\r\n:;<>]+),;
# Do not check the "tar.gz" links. or "perl?args" cgi calls
if ( m,\.(gz|tgz|Z|bz2|rar)$|\?, )
{
not $QUIET and warn "$id: ignored complex url: $url";
next if m,\?,; # forget cgi programs
# but try to verify at least directory
s,(.*/),$1,;
}
if ( $ARG ne '' )
{
$debug and warn "$id: $i $ARG\n";
$ret{ $i } = $ARG ;
}
}
%ret;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Check all links in a file
#
# INPUT PARAMETERS
#
# $file filename
# $arrayRef content of the file
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub LinkCheck ($$)
{
my $id = "$LIB.LinkCheck";
my( $file, $arrayRef ) = @ARG;
my( %link, %errDesc, %linkErr );
my( $i, $lnk, $text, $status , $err);
%link = ReadLinks $arrayRef;
$debug and PrintHash "$id", \%link;
$i = 0;
for ( sort {$a <=> $b} keys %link )
{
$i = $ARG;
$lnk = $link{ $ARG };
not $QUIET and print "$file:$i:$lnk";
( $status, $err ) = LinkCheckExternal $lnk , \%linkErr, \%errDesc;
$text = "";
if ( $LINK_CHECK_ERR_TEXT_ONE_LINE )
{
( $text = $err ) =~ s/\n/./;
}
if ( not $QUIET )
{
print " $status $text\n";
}
elsif ( $status != 0 )
{
printf "$file:$i:%-4d $lnk $text\n", $status;
}
}
}
# }}}
# {{{ Is, testing
# **************************************************************** &test *****
#
# DESCRIPTION
#
# Check if TEXT contains no data. Empty, only whitespaces
# or "none" word is considered empty text.
#
# INPUT PARAMETERS
#
# $text string
#
# RETURN VALUES
#
# 0,1
#
# ****************************************************************************
sub IsEmptyText ($)
{
my $id = "$LIB.IsEmptyText";
my $text = shift;
return 1 if ( $text eq '' or $text =~ /^\s+$|[Nn][Oo][Nn][Ee]$/ );
0;
}
# **************************************************************** &test *****
#
# DESCRIPTION
#
# If LINE is heading, return level of header.
# Heading starts at column 0 or 4 and the first leffter must be capital.
#
# INPUT PARAMETERS
#
# $line
#
# RETURN VALUES
#
# 1..2 Level of heading
# 0 Was not a heading
#
# ****************************************************************************
sub IsHeading ($)
{
my $id = "$LIB.IsHeading";
my $line = shift;
return 1 if $line =~ /^[A-Z0-9.]/;
return 2 if $line =~ /^ {4}[A-Z0-9.]/;
0;
}
# **************************************************************** &test *****
#
# DESCRIPTION
#
# If LINE is bullet, return type of bullet
#
# INPUT PARAMETERS
#
# $line line
# $textRef [returned] the bullet text
#
# RETURN VALUES
#
# $BulletNumbered constants
# $Bulletnormal
#
# ****************************************************************************
sub IsBullet ($$)
{
my $id = "$LIB.IsBullet";
my( $line, $textRef ) = @ARG;
my $type = 0;
# Bullet can start with "o" or "." only
#
# . Numbered list
# . Numbered list
#
# o Regular bullet
# o Regular bullet
#
# * Regular bullet
# * Regular bullet
if ( $line =~ /^ {8}([*o.]) {3}(.+)/ )
{
$$textRef = $2; # fill return value
if ( $1 eq "o" or $1 eq "*" )
{
$debug and warn "$id: BulletNormal >>$2\n";
$type = $BulletNormal;
}
elsif ( $1 eq "." )
{
$debug and warn "$id: BulletNumbered >>$2\n";
$type = $BulletNumbered;
}
}
$type;
}
# }}}
# {{{ start, end
# ****************************************************************************
#
# DESCRIPTION
#
# Return HTML string containing meta tags.
#
# INPUT PARAMETERS
#
# $author
# $email
# $kwd [optional]
# $desc [optional]
#
# RETURN VALUES
#
# @html
#
# ****************************************************************************
sub MakeMetaTags ($$ ;$$)
{
my $id = "$LIB.MakeMetaTags";
my ( $author, $email, $kwd, $desc ) = @ARG;
# META tags provide "meta information" about the document.
#
# [wilbur] You can use either HTTP-EQUIV or NAME to name the
# meta-information, but CONTENT must be used in both cases. By using
# HTTP-EQUIV, a server should use the name indicated as a header,
# with the specified CONTENT as its value.
my @ret;
my $META = "META HTTP-EQUIV";
my $METAN = "META NAME";
# ............................................. meta information ...
# META must be inside HEAD block
push @ret, MakeComment "META TAGS (FOR SEARCH ENGINES)";
if ( $kwd =~ /\S+/ and $kwd !~ /^\S+$/ )
{
# "keywords" [according to Wilbur]
# Provides keywords for search engines such as Infoseek or Alta
# Vista. These are added to the keywords found in the document
# itself. If you insert a keyword more than seven times here,
# the whole tag will be ignored!
if ( $kwd !~ /,/ )
{
$kwd = join "," , split ' ', $kwd;
warn "$id: META KEYWORDS must have commas (fixed): ",
" [$kwd]";
}
push @ret, qq( <$META="keywords"\n\tCONTENT="$kwd">\n\n);
}
if ( defined $desc )
{
length($desc) > 1000
and warn "$id: META DESC over 1000 characters";
push @ret, qq( <$META="description"\n\tCONTENT="$desc">\n\n);
}
# ................................................. general meta ...
push @ret, qq( \n\n)
;
if ( defined $author )
{
$author = qq( <$META="Author"\n\tCONTENT="$author">\n\n);
}
if ( defined $email )
{
$email = qq( <$META="Made"\n\tCONTENT="mailto:$email">\n\n);
}
my $gen = qq( <$METAN="Generator"\n)
. qq(\tCONTENT=") #font "
. GetDate()
. qq( Perl 5 program $PROGNAME v$VERSION)
. qq( available at http://cpan.perl.com/ => scripts">\n) #font "
;
push @ret, "$author\n", "$email\n", "$gen\n";
@ret;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Print start of html document
#
# INPUT PARAMETERS
#
# $doc
# $author Author of the document
# $title Title of the document, appears in Browser Frame
# $base URL to this localtion of the document.
# $butt Url Button to point to "Top"
# $butp Url Button to point to "Previous"
# $butn Url Button to point to "next"
# $metaDesc [optional]
# $metaKeywords [optional]
# $bodyAttr [optional] Attributes to attach to BODY tag,
# e.g. when value would be "LANG=en".
# $email [optional]
#
# RETURN VALUES
#
# @ list of html lines
#
# ****************************************************************************
sub PrintStart ($$$ $$$$ ;$$$$)
{
my $id = "$LIB.PrintStart";
my
(
$doc, $author, $title
, $base,
, $butt, $butp, $butn
, $metaDesc , $metaKeywords
, $bodyAttr
, $email
) = @ARG;
my( @ret, $str , $tmp );
my $link = 0; # Flag; Do we add LINK AHREF ?
my $tab = " ";
$title = "No title" if $title eq '';
# ................................................ start of html ...
# 1998-08 Note: Microsoft Internet Explorer can't show the html page
# if the comment '
........EOF
# ... ... ... ... ... ... ... ... ... ... ... ... ... ... .. push ...
$base = Base( basename FileFrameName "");
$base = Base( basename FileFrameNameBody() ) if $FRAME;
push @ret, HereQuote <<"........EOF";
$title
$base
........EOF
push @ret, MakeMetaTags $author, $email, $metaKeywords, $metaDesc;
# ....................................................... button ...
my $attr;
# [wc3 html 4.0 / 6.16 Frame target names]
# _top
# The user agent should load the document into the full, original window
# (thus cancelling all other frames). This value is equivalent to _self
# if the current frame has no parent.
$attr = qq( target="_top" class="btn" );
push @ret, MakeComment "BUTTON DEFINITION START";
if ( not IsEmptyText $butp )
{
$tmp = "Previous document";
$link and push @ret, $tab , MakeLinkHtml("previous","$butp", $tmp);
push @ret
, $tab
, MakeUrlRef( $butp, "[Previous]", $attr)
, "\n";
}
if ( not IsEmptyText $butt )
{
$tmp = "The homepage of site";
$link and push @ret, $tab , MakeLinkHtml("home","$butt", $tmp);
push @ret
, $tab
, MakeUrlRef( $butt, "[home]", $attr)
, "\n";
}
if ( not IsEmptyText $butn )
{
$tmp = "Next document";
$link and push @ret, $tab . MakeLinkHtml("next","$butt", $tmp);
push @ret
, $tab
, MakeUrlRef( $butn, "[Next]", $attr)
, "\n";
}
push @ret
, JavaScript()
, "\n\n"
, "\n";
$debug and PrintArray "$id", \@ret;
@ret;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Print end of html (quiet)
#
# INPUT PARAMETERS
#
# none
#
# RETURN VALUES
#
# $html
#
# ****************************************************************************
sub PrintEndQuiet ()
{
my $id = "$LIB.PrintEndQuiet";
join ''
, MakeComment "DOCUMENT END BLOCK"
, "\n"
, "
\n"
, "\n"
, "\n"
;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Print end of html (simple)
#
# INPUT PARAMETERS
#
# $doc The document filename, defaults to "document" if empty
#
# RETURN VALUES
#
# $html
#
# ****************************************************************************
sub PrintEndSimple ($;$)
{
my $id = "$LIB.PrintEndSimple";
my ($doc, $email) = @ARG;
my $date = GetDate();
if ( defined $EMAIL )
{
$email = qq(Contact: <$email> \n)
}
join ''
, MakeComment "DOCUMENT END BLOCK"
, "\n"
, "\n\n"
, "\n\n"
, qq()
, $email
, qq(Html date: $date \n)
, "\n"
, ""
, "\n"
, "\n"
;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Print end of html
#
# INPUT PARAMETERS
#
# $doc The document filename, defaults to "document" if empty
# $author Author of the document
# $url Url location of the file
# $file [optional] The disclaimer text file
# $email Email contact address. Without <>
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub PrintEnd ($$$;$$)
{
my $id = "$LIB.PrintEnd";
my( $doc , $author, $url , $file , $email ) = @ARG;
$doc = "document" unless defined $doc;
$author = "" unless defined $author;
my( @ret, $str );
my $date = GetDate();
my $year = GetDateYear();
# ................................................... disclaimer ...
# Set default value first
my $disc = Here <<"........EOF";
Copyright (c) $year by ${author}. This material may be
distributed only subject to the terms and conditions set forth
in the Open Publication License, v1.0 or later (the latest
version is presently available at
http://www.opencontent.org/openpub/). Distribution of the work
or derivative of the work for commercial purposes in any
form is prohibited unless prior permission is obtained from
the copyright holder. (VI.B LICENSE OPTIONS)
........EOF
if ( $file ne '' ) # Read the disclaimer from separate file.
{
local *F;
open F, $file or die "$id: Can't open [$file] $ERRNO";
binmode F;
$disc = join '', ;
close F;
}
# ....................................................... footer ...
push @ret, MakeComment "DOCUMENT END BLOCK";
$author ne '' and $author = qq(Document author: $author );
$url ne '' and $url = qq(Url: $url );
$email ne '' and $email =
qq(Contact: <$email> );
$author eq '' and $disc = '';
push @ret, Here <<"........EOF";
$disc
This file has been automatically generated from plain text file
with perl script $PROGNAME $VERSION
$author
$url
$email
Html date: $date