#!/usr/local/bin/perl # # @(#) t2html.pl -- Perl, text2html converter. Uses Techical text format (TF) # @(#) $Id: t2html.pl,v 1.29 2001/08/05 08:26:31 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.0805'; # }}} # {{{ 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 ( not defined $DELETE_DEFAULT or $DELETE_DEFAULT == 1 ) { # Delete Emacs folding.el marks that keeps text in sections. #fl # # # {{{ Folding begin mark # # }}} Folding end mark # # Delete also comments # # #_COMMENT $DELETE_REGEXP = '^((# )?(\Q{{{\E|\Q}}}\E))|(#_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<--nodelete-default> THE DEWFAULt DELETE Is ON BY DEFAULT, TO SUPPLESS DELETION use this C<--no> option. 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" which is hopefully part of any other programming or markup language. See examples 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 * #PIC command is used to include pictures into the text #PIC picture-name.png;Caption Text;Picture HTML attributes;align; (1) (2) (3) (4) 1. The NAME or URL address of the picturere. Like image/this.png 2. The Text that appears below picture 3. Additional attributes that is attached inside tag, like , where the line would read: #PIC some.png;Caption Text;width="200" length="200"; 4. The position of image: "left", "center" (default), "right" =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.29 2001/08/05 08:26:31 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
#
#       Make clickable url
#
#   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
#
#       Make Picture URL tag
#
#   INPUT PARAMETERS
#
#       $ref        url reference or "none"
#       $txt        text
#       $attr       [optional] additional IMG attributes
#	$align	    [optional] How to align picture: "left", "right",
#	$count	    [optional] Picture number
#
#   RETURN VALUES
#
#       $string     html code
#
# ****************************************************************************

sub MakeUrlPicture ($$;$$$)
{

    my $id = "$LIB.MakeUrlPicture";
    my( $ref, $txt, $attr, $align, $nbr ) = @ARG;

    if ( not defined $align  or  not $align )
    {
	$align  = "center";
    }

    my $picText;

    if ( $nbr )
    {
	$picText = "Picture $nbr. "
    }

    #  td     .. align="center" valign="middle"
    #  table  .. width="220" height="300"
    #  img    .. width="180" height="250"

    my $ret = <<"EOF";

    

[$picText$txt]
$picText$txt
EOF $ret; } # **************************************************************************** # # 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"; local $ARG = shift; if ( /(.*)#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:/; $debug and warn "$id: #REF--> [$1]\n [$2]\n [$3]\n [$ARG]"; $ARG = $1 . MakeUrlRef($2, $3) . $4; unless ( $ARG =~ /#|http:|file:|news:|wais:|ftp:/ ) { warn "$id: Suspicious REF. Did you forgot # or http?\n\t$ARG" } $debug and warn "$id:LINE[$ARG]"; } elsif ( /#REF.*;/ ) { warn "$id: Suspicious #REF format [$ARG]. Must have 2 semicolons(;)"; } $ARG; } # **************************************************************************** # # DESCRIPTION # # Translate PIC special markers to pictures # # #PIC link-to; caption text; image-attributes; # # INPUT PARAMETERS # # $line # # RETURN VALUES # # $html # # **************************************************************************** { my $staticPicCount = 0; sub XlatPicture ($) { my $id = "$LIB.XlatPicture"; local $ARG = shift; if ( /(.*)#PIC\s+(.*)\s*;\s*(.*);\s*(.*);\s*(.*);(.*)/ ) { # This is used to number each picture as it appears $staticPicCount++; # There already may be absolute reference, check it first # # http:/www.this.com#referece_here $debug and warn "$id: #PIC--> \$1[$1]\n\$2[$2]\n\$3[$3]\nLINE[$ARG]"; $ARG = $1 . MakeUrlPicture($2, $3, $4, $5, $staticPicCount) . $6; # Try finding .gif .jpg .png or something ... unless ( m,\.[a-z][a-z][a-z],i ) { warn "$id: Suspicious #PIC [$ARG]. Did you forgot .png .jpg ...?" } $debug and warn "$id:LINE[$ARG]"; } elsif ( /#PIC.*;.*;/ ) { warn "$id: Suspicious #PIC format [$ARG]. Must have 3 semicolons(;)"; } $ARG; }} # **************************************************************************** # # 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; } DIV.picture { font-style: italic; } 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/ # # 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 1996-04-21 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' => link # # **************************************************************************** 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. # # Allow http://site:PORT/page if ( $elt =~ m,(http://[A-Za-z.]+(?:\:\d+])[^][\r\n\t :;<>\"\']+), ) { $ARG = $1; } # 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( %errDesc, %linkErr ); my( $lnk, $text, $status , $err); my %link = ReadLinks $arrayRef; my $i = 0; $debug and PrintHash "$id", \%link; 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 starters: # # . 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) . qq( http://www.cpan.org/modules/by-authors/id/J/JA/JARIAALTO/">\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
........EOF # ................................................. return value ... @ret; } # **************************************************************************** # # DESCRIPTION # # Print whole generated html body with header and footer. # # INPUT PARAMETERS # # The Global variables that have been defined at the start # are used here # # $arrayRef Content of the body already in html # $lines # $file # $type # # RETURN VALUES # # \@ Whole html # # **************************************************************************** sub PrintHtmlDoc ($ $$$) { my $id = "$LIB.PrintHtmlDoc"; my( $arrayRef, $lines, $file, $type) = @ARG; my $str; my $base = $BASE; # With filename (single file) $base = $BASE_URL if $FRAME; # directory my @ret = PrintStart $DOC , $AUTHOR , $TITLE , $base , $BUT_TOP , $BUT_PREV , $BUT_NEXT , $META_DESC , $META_KEYWORDS , $HTML_BODY_ATTRIBUTES , $EMAIL ; unless ( $AS_IS ) { my @toc = MakeToc \@HEADING_ARRAY , \%HEADING_HASH , $DOC , $FRAME , $file , $AUTHOR , $EMAIL ; if ( $FRAME ) { WriteFile FileFrameNameToc(), \@toc; } else { push @ret, @toc; } } push @ret, @$arrayRef; if ( $type == $OutputSimple ) { push @ret, PrintEndSimple $DOC, $EMAIL; } elsif ( $type == $OutputQuiet ) { push @ret, PrintEndQuiet(); } else { push @ret, PrintEnd $DOC , $AUTHOR, , $DOC_URL , $DISCLAIMER_FILE , $EMAIL ; } \@ret; } # }}} # {{{ misc # **************************************************************************** # # DESCRIPTION # # Delete section "Table of contents" from text file # # INPUT PARAMETERS # # \@arrayRef whole text # # RETURN VALUES # # @ modified text # # **************************************************************************** sub KillToc ($) { my $id = "$LIB.KillToc"; my $arrayRef = shift; my( @ret, $flag ); for ( @$arrayRef ) { $flag = 1 if /^Table\s+of\s+contents\s*$/i; if ( $flag ) { # save next header next if /^Table/; if ( /^[A-Z0-9]/ ) { $flag = 0; } else { next; } } push @ret, $ARG; } @ret; } # **************************************************************************** # # DESCRIPTION # # Read 4 first words and make heading name. Any numbering or # special marks are removed. The result is all lowercase. # # INPUT PARAMETERS # # $lien Heading string # # RETURN VALUES # # $ Abbreviated name. Suitable eg for #NAME tag. # # **************************************************************************** { # Static variables. Only used once to make constructiong regexp easier my $w = "[.\\w]+"; # A word. my $ws = "$w\\s+"; # A word and A space sub MakeHeadingName ($) { my $id = "$LIB.MakeHeadingName"; local ( $ARG ) = @ARG; # Remove HTMl tags like: ä #255; s/[&][a-zA-Z]+;//g; s/#\d+;//g; # Pick first 1-5 words for header name if ( /($ws$ws$ws$ws$w)/o or /($ws$ws$ws$w)/o or /($ws$ws$w)/o or /($ws$w)/o or /($w)/o ) { $ARG = $1; } s/^\s+//; s/\s+$//; # strip trailing spaces s/\s/_/g; lc $ARG; }} # **************************************************************************** # # DESCRIPTION # # After you have checked that line is header with IsHeading() # the line is sent to here. It reformats the lie and # # Contructs 1-5 first words to forn the TOC NAME reference # # SETS GLOBAL # # @HEADING_ARRAY 'heading', 'heading' ... # The headings as they appear in the text. # This is used as index when reading # HEADING_HASH in ordered manner. # # !HEADING_HASH 'heading' -- 'NAME(html)' # Original headings from text. This is ordered # as the heading apper in the text. # # USE FUNCTION STATIC VARIABLE # # %staticNameHash 'NAME(html)' -- 1 # We must index the hash in this order to find # out if we clash duplicate NAME later in text. # Remember, we only pick 1-5 unique words. # # $staticCounter Counts headings. This is used for NAME(html) # rteference name if NAME_UNIQ option has been # turned on. # # INPUT PARAMETERS # # $line string, header line # # RETURN VALUES # # none # # **************************************************************************** { my %staticNameHash; my $staticCounter; sub UpdateHeaderArray ($) { my $id = "$LIB.UpdateHeaderArray"; local $ARG = shift; my $origHeading = $ARG; my $name = $ARG ; # the NAME html reference $debug and warn "$id: $ARG\n"; # When constructing names, the numbers may move, # So it is more logical to link to words only when making NAME ref. # # 11.0 Using lambda notation --> Using lambda notation s/^\s*[0-9][0-9.]*// if $FORGET_HEAD_NUMBERS; # Kill characters that we do not want to see in NAME reference s/[-+,:;!\"#%&=?^{}()<>?!\\\/~*'|]//g; # dummy for font-lock ' # Kill hyphens "Perl -- the extract language" # --> "Perl the extract language" s/\s+-+//g; s/-+\s+//g; # warn ">>$id: $ARG\n"; if ( $NAME_UNIQ ) # use numbers for AHREF NAME="" { $ARG = $staticCounter; } else { $ARG = MakeHeadingName $ARG; } # ........................................ check duplicate clash ... if ( not defined $staticNameHash{ $ARG } ) # are 1-5 words unique? { $debug and warn "$id: Added $ARG\n"; $staticNameHash{ $ARG } = $origHeading; # add new } else { print "$id: $staticNameHash{$ARG}"; # current value PrintHash "$id: HEADING_HASH", \%HEADING_HASH, \*STDERR; warn Here <<"............EOF"; $id: LINE NOW : $origHeading ALREADY : $staticNameHash{ $ARG } CONVERSION: [$name] --> [$ARG] Cannot pick 1-4 words to construct NAME reference, because there already is entry with the same name. Please consider renaming you HEADINGS so that they do not have same first 1-4 words. Alternatively you have to turn on option --name-uniq. ............EOF die; } # ............................................... update globals ... $debug and warn "$id: $origHeading -- $ARG\n"; push @HEADING_ARRAY, $origHeading; $HEADING_HASH{ $origHeading } = $ARG; $staticCounter++; $ARG; }} # close sub and static block # **************************************************************************** # # DESCRIPTION # # Start a heading. Only headings 1 and 2 are supported. # # INPUT PARAMETERS # # $header the full header text # $hname the NAME reference for this header # $level heading level 1..x # # RETURN VALUES # # $ ready html text # # **************************************************************************** sub MakeHeadingHtml ($$$) { my $id = "$LIB.PrintHeader"; my( $header , $hname, $level) = @ARG; my ($ret, $button); $PRINT_NAME_REFS and warn "NAME REFERENCE: $hname\n"; if ( not $AS_IS and not $FRAME ) { my $attr = qq( class="btn-toc" ); # It doesn't matter how the FONT is reduced, it # won't make the [toc] button any smaller inside the tag. # -- too bad -- # # $button = qq() # . MakeUrlRef( "#toc", "[toc]", $attr) # . "" # ; # if ( 0 ) { $button = MakeUrlRef ( "#toc", qq() . "[toc]" . "" , $attr ); } } $header =~ s/^\s+//; if ( $level == 1 ) { $ret = HereQuote <


$header $button

EOF } elsif ( $level > 1 ) { $ret = <

$header $button

EOF } $ret; } # }}} # {{{ Do the line, txt --> html # **************************************************************************** # # DESCRIPTION # # Substitute user tags given at --refrence "TAG=value". The values # are stored in %REFERENCE_HASH # # INPUT PARAMETERS # # $ Plain text # # RETURN VALUES # # $ formatted html line # # **************************************************************************** sub DoLineUserTags ( $ ) { my $id = "$LIB.DoLineUserTags"; local ( $ARG ) = @ARG; # ........................................ substitute user tags ... my ($key, $value); while ( ($key, $value) = each %REFERENCE_HASH ) { if ( /$key/ ) { $debug and print "$id: $ARG -- KEY $key => VAL $value\n"; s,$key,$value,gi; $debug and print "$id: " } } $ARG; } # ************************************************************ &DoLine ******* # # DESCRIPTION # # Add html tags per line basis. This function sets some global # states to keep track on bullet mode etc. # # USES FUNCTION STATIC VARIABLES # # $staticBulletMode When bullet is opened, the flag is set to 0 # # INPUT PARAMETERS # # $line # # RETURN VALUES # # $ formatted html line # # **************************************************************************** { my $staticBulletMode = 0; sub DoLine ($$$$) { # .................................................... arguments ... my $id = "$LIB.DoLine"; my( $input, $base, $line, $arrayRef ) = @ARG; not defined $input and warn "$id: INPUT not defined?"; not defined $line and warn "$id: LINE not defined? "; return "" if not defined $input; # ........................................................... $ARG ... local $ARG = $input; chomp; my $origLine = $ARG; return "" if /^\s*$/; # quit on empty line # ............................................... misc variables ... my ( $url , $s1, $s2 , $hname , $tmp , $tmpLine , $beg, $end, $spaces ); my $bulletText = ""; my $i = -1; # .................................... lines around current-line ... # HEADER <-- search this # # text starts here my $prev2 = ""; $prev2 = $$arrayRef[ $line -2] if $line > 1; my $prev = ""; $prev = $$arrayRef[ $line -1] if $line > 0; my $next = ""; $next = $$arrayRef[ $line +1] if $line +1 < @$arrayRef ; my $prevEmpty = 0; $prevEmpty = 1 if $prev =~ /^\s*$/; my $nextEmpty = 0; $nextEmpty = 1 if $next =~ /^\s*$/; # ............................................... flag variables ... my( $AsIs, $hlevel, $isBullet ); my $isCode = 0; my $isText = 0; my $isPcode = 0; my $isBrCode = 0; my $isPrevHdr = 0; $isPrevHdr = IsHeading $prev2 if $line > 1; my $isPureText = 0; $tmp = " "; # 4 spaces $isPureText = 1 if /^$tmp$tmp$tmp/o; # {12} # ................................................. command tags ... if ( /^( {1,11})\.([^ \t.].*)/ ) { # The "DOT" code at the beginning of word. Notice that the dot # code is efective only at columns 1..11 # warn "BR $line <$ARG>\n"; $isBrCode = 1; $s1 = $1; $s2 = $2; $ARG = $s1 . $s2; # Remove the DOT control code } if ( /^([ \t]+),([^ \t,].*)/ ) # The "P" tag { # Remove the command from the output. $isPcode = 1; $s1 = $1; $s2 = $2; $ARG = $s1 . $s2; # warn "P $line $ARG\n"; } # .................................................. Strip lines ... # It is usual that the is "End of file" marker left flushed. # Strip that tag away and do not interpret it as a heading. Allow # optional heading numbering at front. # # 1.1 End # 1.2.3 End of document if ( /^([\d.]*[\d]\s+)?End\s+of\s+(doc(ument)?|file).*$ | ^([\d.]\s+)?End\s*$ /xi ) { # This is the marked that ends the dokument of file. Do not # print it. return ""; } # ........................................ substitute user tags ... $ARG = DoLineUserTags $ARG; if( /#URL-BASE/ ) { # warn ">> $ARG"; $Base = 1 s,#URL-BASE,$base,gi; } # $debug = 2 if /Terminol/; $ARG = XlatTag2html $ARG; # ......................................................... &url ... $ARG = XlatRef $ARG; $ARG = XlatPicture $ARG; $ARG = XlatUrl $ARG; $ARG = XlatMailto $ARG; # ......................................................... &rcs ... # RCS keywords if ( m"(.*)(\$Id.*\$)(.*)" ) { $ARG = "$1$2$3"; } # The bullet text must be examined only after the expansions # in the line $isBullet = IsBullet $ARG , \$bulletText; # ................................................... study line ... ($spaces) = /^( +)[^ ]/; $spaces = length $spaces; if ( /^ {8}[^ ]/o ) { $isText = 1; } # elsif ( /^$s1(!!)([^!\n\r]*)$/o ) elsif ( /^ {4}(!!)([^!\n\r]*)$/o ) { # A special !! code means adding
tag if ( defined $2 ) { $ARG = qq(\n
\n) . qq(\t $2
\n) ; } else { $ARG = "\n
\n\t
\n"; } } elsif ( $hlevel = IsHeading $ARG ) { $hname = UpdateHeaderArray $ARG; $ARG = MakeHeadingHtml $ARG, $hname, $hlevel; return $ARG; } elsif ( /^ {12,}[^ ]/o and not $staticBulletMode and not $isBullet ) { $AsIs = 1; $isCode = 1; # Make it little shorted by removing spaces # Otw, the indent level is too deep $ARG = substr $ARG, 6; # $beg = $COLUMN_HASH{beg12}; # $end = $COLUMN_HASH{end12}; # $ARG = $beg . $ARG . $end; } elsif ( /^ {7}\"/o ) { $debug > 1 and warn "pos7:$ARG\n"; $beg = $COLUMN_HASH{ beg7quote }; $end = $COLUMN_HASH{ end7quote }; $ARG = $beg . $ARG . $end . "
"; $spaces = 8; # for

} # ...................................................... bullets ... $debug > 1 and warn "$line: " , " spaces $spaces " , " PrevEmpty $prevEmpty " , " NextEmpty $nextEmpty " , " isPrevHdr $isPrevHdr " , " hlevel $hlevel " , " IsBR $isBrCode " , " isPcode $isPcode " , " IsBullet $isBullet " , " StaticBulletMode $staticBulletMode " , "\n\t<$ARG>\n\t<$next>\n" ; if ( $isBullet and $prevEmpty ) { $s1 = "

    "; $s1 = "

      " if $isBullet == $BulletNumbered; $ARG = $s1 . "\n\t
    1. " . $bulletText; $staticBulletMode = 1; $isBullet = 0; # we handled this. Marks as used. $debug > 1 and warn "______________BULLET ON [$isBullet] $ARG\n"; } if ( ($isBullet or $staticBulletMode) and $nextEmpty ) { $s1 = "
"; $s1 = "" if $isBullet == $BulletNumbered; $ARG = "
  • $bulletText" if $isBullet; if ( not $isPcode ) { # if previous paragraph does not contain P code, # then terminate this bullet $staticBulletMode = 0; $ARG = "\t$ARG\n$s1\n\n"; } else { $ARG = "\t$ARG\n

    \n"; # Continue in bullet mode } $debug > 1 and warn "______________BULLET OFF [$isBullet] $ARG\n"; $isBullet = 0; } if ( $isBullet ) { $ARG = "\t

  • $bulletText"; $debug > 1 and warn "BULLET $ARG\n"; } # ...................................... determining line context ... # If this is column 8, suppose regular text. See if this # is begining or end of paragraph. if ( $spaces == 1 or $spaces == 2 ) { $AsIs = $isCode = 1; } if ( $spaces > 0 and not $isCode # if this the above line was header, we must not insert P tag, # because it would double the line spacing # BUT, if user has moved this line out of col 8, go ahead and ( not $isPrevHdr or ($isPrevHdr and $spaces != 8 )) and not $hlevel and not $isBullet and not $staticBulletMode # If user has not prohibited using P code and not $isPcode # these tags do not need P tag, otw line doubles and not /
    /i
    
        )
        {
            my $code;
    
            if ( $prevEmpty )
            {
    
                if ( exists $COLUMN_HASH{ "beg" . $spaces } )
                {
                    $code = $COLUMN_HASH{ "beg" . $spaces };
                    $ARG = "\n$code\n$ARG";
                }
                elsif ( $spaces <= 12 )
                {
                    $code = " class=" . qq("column) . $spaces . qq(");
                    $ARG = "\n\n$ARG";
                }
            }
    
            if ( $nextEmpty )
            {
                if ( exists $COLUMN_HASH{ "end" . $spaces } )
                {
                    $code = $COLUMN_HASH{ "end" . $spaces };
                    $ARG .= $code . "\n";
                }
                elsif ( $spaces <= 12 )
                {
                    # No 

    needed } } } if ( $line > 0 and $AsIs and $prevEmpty ) { $ARG = qq(\n
    \n$ARG);
        }
    
        if ( $AsIs and  $nextEmpty )
        {
            $ARG = $ARG . "\n
    \n"; } # _WORD_ is strong # *WORD* is emphasised # The '_' must preceede whitespace and '>' which could be # html code ending character. # do not touch "code" text above 12 column if ( not $AsIs ) { # Turn `this-function' references into samples # too. $beg = $COLUMN_HASH{ begquote }; $end = $COLUMN_HASH{ endquote }; if ( s,([ \t>=+*_\"()])\`(\S+?)\',$1$beg$2$end,gi and 0 ) { # turn above 0 to 1 to debug some color definitions manually warn "$beg end $ARG"; } # The '>' is included in the start of the regexp because this # may be the end of html tag and there may not be a space $beg = $COLUMN_HASH{ begbold }; $end = $COLUMN_HASH{ endbold }; s,([ \t>=+*_()])\_(\S+?)\_,$1$beg$2$end,g; $beg = $COLUMN_HASH{ begemp }; $end = $COLUMN_HASH{ endemp }; s,([ \t>=+*_])\*(\S+?)\*,$1$beg$2$end,g; $beg = $COLUMN_HASH{ begsmall }; $end = $COLUMN_HASH{ endsmall }; s,([ \t>+])\=(\S+)\=,$1$beg$2$end,g; $beg = $COLUMN_HASH{ begbig }; $end = $COLUMN_HASH{ endbig }; s,([ \t>])\+(\S+?)\+,$1$beg$2$end,g; # [Mike] referred to [rfc822] $beg = $COLUMN_HASH{ begref }; $end = $COLUMN_HASH{ endref }; s,([ \t>])\[([a-zA-Z]\S+)\],$1$beg\[$2\]$end,g; # [Figure: this here] s,([ \t>])\[([^]\n\r]+)\],$1$beg\[$2\]$end,g; # If already has /P then do nothing. if ( $isBrCode and not m,

    , ) { $ARG .= "
    "; } } # die if /example/; "$ARG\n"; }} # }}} # {{{ Main # **************************************************************************** # # DESCRIPTION # # Handle htmlizing the file # # INPUT PARAMETERS # # \@content text # $filename Used in split mode only to generate multiple files. # $regexp Split Regexp. # $splitUseFileNames Use symbolic names instead of numeric filenames # when splitting. # $auto Flag or string. # If 1, write directly to .html files. no stdout # If String, then write to file. # $frame Is frame html requested # # RETURN VALUES # # none # # **************************************************************************** sub HandleOneFile ($ ; $$$ $$) { my ( $id) = "$LIB.HandleOneFile"; my ( $txt , $file , $regexp , $splitUseFileNames , $auto , $frame ) = @ARG; # ........................................................ local ... my ( $i, $line , @arr, $htmlArrRef); my $timeStart = time(); not defined @$txt[1] and die "$id: No input lines"; # We got no input # ..................................................... html2txt ... # - If text contains tag in the begining of file then automatically # convert the input into text if ( defined @$txt[2] and grep /<[Hh][Tt][Mm][Ll]>/, @$txt[0 .. 100] ) { warn "$id: $file was HTML page. Simple conversion to text:\n"; print Html2txt $txt; exit; } $txt = DeleteEmailHeaders $txt if $DELETE_EMAIL; # We can't remove TOC if link check mode is on, because then the line # numbers reported wouoldn't match the original if TOC were removed. @$txt = KillToc $txt unless $LINK_CHECK; # handle split marks if ( defined $regexp ) { @arr = SplitToFiles $regexp, $file, $splitUseFileNames, $txt; print join("\n", @arr), "\n" ; return; #todo: } # Prevent processing empty files @$txt < 2 and die "$id ARGV [@ARGV] not enough input lines"; # Should we ignore some lines according to regexp ? if ( defined $DELETE_REGEXP and not $DELETE_REGEXP eq "") { @$txt = grep !/$DELETE_REGEXP/o, @$txt ; } @$txt = expand @$txt; # Text::Tabs if ( $LINK_CHECK ) { LinkCheck $file, $txt; exit; } else { my $tmp; for $line ( @$txt ) { if ( defined $line ) { $tmp = DoLine $line , $BASE_URL, $i++, $txt; push @arr, $tmp; } } } $htmlArrRef = PrintHtmlDoc \@arr, scalar @$txt, $file, $OUTPUT_TYPE; my $timeDiff = time() - $timeStart; if ( defined $auto ) { my ( $name, $path, $extension ) = fileparse $file, '\.[^.]+$'; #font ' if ( $auto =~ /../ ) # Suppose filename if more than 2 { $name = $auto; } my $htmlFile = $path . $name . ".html"; if ( $FRAME ) { $htmlFile = FileFrameNameBody(); WriteFile $htmlFile, $htmlArrRef; # This is the file browser wants to read. Printed to stdout $htmlFile = FileFrameNameMain(); } else { WriteFile $htmlFile, $htmlArrRef; } $htmlFile =~ s/$HOME_ABS_PATH/$HOME/ if defined $HOME_ABS_PATH; $PRINT and print "$name\n"; $PRINT_URL and print "file:$htmlFile\n" } else { print @$htmlArrRef; } $time and warn "Lines: ", scalar @$txt, " $timeDiff secs\n"; } # **************************************************************************** # # DESCRIPTION # # Run the test page creation command # # INPUT PARAMETERS # # $cmd Additional option to perl command # $fileText Text file source # $fileHtml [optional] Generated Html destination # # RETURN VALUES # # None # # **************************************************************************** sub TestPageRun ( $ $ ; $ ) { my $id = "$LIB.TestPageRun"; my ( $cmd, $fileText, $fileHtml ) = @ARG; not defined $fileHtml and $fileHtml = ""; print "\n Run cmd : $cmd\n"; my @ret = `$cmd`; if ( grep /fail/i, @ret ) { print "$id: Please run the command manually and use absolute path names"; } else { print " Original text : $fileText\n" , " Generated html: $fileHtml\n" ; } print @ret if @ret; } # **************************************************************************** # # DESCRIPTION # # Print the test pages: html and txt # # INPUT PARAMETERS # # None # # RETURN VALUES # # None # # **************************************************************************** sub TestPage ( $ ) { my $id = "$LIB.TestPage"; # ............................................. initial settings ... my $home = GetHomeDir(); my $tmp = "$home/tmp"; $home = $tmp if -d $tmp; my $fileHtml1 = "$home/$PROGNAME-1.html"; my $fileHtml2 = "$home/$PROGNAME-2.html"; my $fileText1 = "$home/$PROGNAME-1.txt"; my $fileText2 = "$home/$PROGNAME-2.txt"; my $fileFrame = "$home/$PROGNAME-3.txt"; # ............................................. write test files ... my $cmd; my @test = grep ! /__END__/, ; WriteFile $fileText1, \@test; WriteFile $fileText2, \@test; WriteFile $fileFrame, \@test; local $ARG = $PROGRAM_NAME; if ( not m,[/\\], ) { # There is no absolute dir that we could refer to ourself. # the -S forces perl to search the path, but what if the progrma # is not in the PATH yet? --> failure. print "$id: WARNING No absolute PROGRAM_NAME $PROGRAM_NAME", "$id: The automatic call may fail, if program is not in \$PATH;" ; $cmd = "perl -S $PROGRAM_NAME"; } else { $cmd = "perl $PROGRAM_NAME"; } # ..................................................... generate ... TestPageRun "$cmd --css-font-normal --Out $fileText1" , $fileText1, $fileHtml1 ; TestPageRun "$cmd --css-font-readable --Out $fileText2" , $fileText2, $fileHtml2 ; my $base = $fileFrame; TestPageRun "$cmd --html-frame --base $base --print-url --Out $fileFrame" # "$cmd -F --base $base --print-url --Out $fileFrame" , $fileFrame ; exit 0; } # **************************************************************************** # # DESCRIPTION # # Main entry point # # INPUT PARAMETERS # # none # # RETURN VALUES # # none # # **************************************************************************** sub main () { # The --debug option is recognized in HandleCommandLineArgs() but # we want to know it immediately here grep /^-d$|^--debug$/, @ARGV and PrintArray " ARGV (orig) ", \@ARGV; Initialize(); HandleCommandLineArgs(); my $id = "$LIB.main"; # Must be after Initialize(), defined $LIB. $debug and PrintArray " ARGV (after) ", \@ARGV; my ( @slurp , $dir , $file ); if ( defined $EMAIL and $EMAIL ne '' ) { $EMAIL =~ s/[<>]//g; # Do this automatic fix CheckEmail $EMAIL; } # ................................................... read file ... $dir = cwd(); not @ARGV and push @ARGV, "-"; for $file ( @ARGV ) { $file = "$dir/$file" unless $file =~ m,[\\/]|^-$,; $debug and warn "$id: Reading file [$file]"; unless ( open F, $file ) { warn "$id: Cannot open [$file] line ", __LINE__ , "\n" ; } else { @slurp = ; close F; $ARG_PATH = $file; $ARG_PATH = "stdin" if $file eq '-'; if ( $ARG_PATH eq "stdin" ) { $ARG_PATH = $BASE_URL_ALL; } elsif ( $ARG_PATH !~ m,[/\\], or $OUTPUT_DIR ) { if ( $OUTPUT_DIR eq "." ) { $ARG_PATH = cwd(); } else { $ARG_PATH = $OUTPUT_DIR; } $ARG_PATH .= "/" if $ARG_PATH !~ m,/$,; $ARG_PATH .= basename $file; } ($ARG_FILE , $ARG_DIR ) = fileparse $ARG_PATH; HandleOneFile \@slurp , $file , $SPLIT_REGEXP , $SPLIT_NAME_FILENAMES , $OUTPUT_AUTOMATIC , $FRAME ; } } } main(); # }}} 0; __DATA__ Tinytf This is a sampler of a text file used to generate HTML when processed with a supporting perl script. See Emacs add-on package tinytf.el at http://tiny-tools.sourceforge.com/ and the t2html.pl at http://www.cpan.org/modules/by-authors/id/J/JA/JARIAALTO/ Headings The tool provides for two heading levels. Combined with bullets and numbered lists, it ought to be enough for most purposes, unless you really like section 1.2.5.3.4. You can insert links to headings or other documents. The convention is interior links are made by joining the first four words of the heading with underscores, so they must be unique. A link to a heading below looks like this in the text document and generates the link shown. There also is syntax for automatically inserting a base URL (see the tool documentation). Rhe followinf ble link is generated with markup code:cc _#REF_ tinytest-body.html#line_breaking ;(Line breaking); #REF #line_breaking ;(Line breaking); Markup The markup here is mostly based on column position, meaning mostly no tags. The exceptions are special marks for bullets and for emphasis. See later sections for the effects of column position on the output HTML. .Text surrounded by equals comes out =another= =color=. .Text surrounded by backquote/forward quotes comes out `color'. ` .Text surrounded by asterisks comes out *italic* *text*. .Text surrounded by underscores comes out _bold_. Emacs minor mode If you use the provided emacs minor mode you can easily make the headings renumber as you revise the text, use outline mode to collapse and expand while editing, and use font lock to get syntax coloring. The editing mode can automatically generate the table of contents and the HTML generator can use it to generate a two frame output with the TOC in the left frame as hotlinks to the sections and subsections. Bullets, lists, and links This is ordinary text. o This is a bullet paragraph with a continuation mark (leading comma) in the last line. It will not work if the ,comma is on the same line as the bullet. This is a continued bullet paragraph. You use a leading comma in the last line of the previous block to make a continued item. This is ok except the paragraph fill code (for the previous paragraph) cannot deal with it. Maybe it is a hint not to do continued bullets, or a hint not to put the comma in until you are done formatting. o The next bullet. the sldjf sldjf sldkjf slkdjf sldkjf lsdkjf slkdjf sldkjf sldkjf lskdj flskdjf lskdjf lsdkjf. . This is a numbered list, made with a '.' in column 8 of its first line and text in column 12. You may not have blank lines between the items. . Clickable email . . Non-clickable email gork@ork.com. . Clickable link: http://this.com . Non-clickable link: -http://this.com. . Clickable file: file:/home/gork/x.txt. Line breaking Ordinary text with leading '.' forces line breaks in the .HTML. .Here is a broken line. Here is another. Samples per column These samples show the range of effects produced by writing text beginning in different columns. The column numbers referred to are columns in the source text, not (obviously) the output. Column 2, same as code 10pt courier navy Column 3, plain text, with color Column 5, plain text, with color Column 6, plain text, with color Column 7, bold, italic "Column 7, double quoted italic, with color" Column 8, standard text _strong_ *emphasized* Column 9, font weight bold, not italic. Column 10, quotation text, italic serif. This text has been made a little smaller and condensed than the rest of the text. More quotation text. More quotation text. More quotation text. More quotation text. More quotation text. More quotation text. More quotation text. More quotation text. More quotation text. More quotation text. More quotation text. More quotation text. Column 11, another color, for Question, Exercise texts etc. /* Column 12 code */ /* 10pt courier navy */ // col 12 and beyond stay as is to preserve code formatting. for(i=0;i<10;i++) { more(); whatever(); } More column 8 regular text. The noral text paragraphs are at standard tab position. Another minor head This is more ordinary text. Conversion program The perl program t2html.pl turns the raw technical format text into HTML. Among other things it can produce HTML files with an index frame, a main frame, and a master that ties the two together. It has features too numerous to list to control the output. For details see the perldoc than is embeddedinside the program: perl -S t2html.pl --help | more The Frame aware html pages are simply generated by adding the *--html-frame* option in the html conversion. __END__