#!/usr/local/bin/perl # # @(#) Perl -- Simple text2html converter. Uses Techical text format (TF) # @(#) $Id: t2html.pl,v 1.174 1999/04/23 10:12:50 jaalto Exp $ # # {{{ Documentation # # File id # # .$Copyright: (C) 1996-1999 Jari Aalto $ # .$Created: 1996-11 $ # .$Keywords: Perl, txt, 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 at the top of 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 # # Introduction # # Please start this perl script with options # # --help to get the help page # # Www contact site # # See http://www.netforward.com/poboxes/?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 'Cwd' => qw( cwd ); use autouse 'File::Basename'=> qw( basename fileparse ); use autouse 'Pod::Text' => qw( pod2text ); use Getopt::Long; use Env; use English; 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 my Emacs setup whenever # this file is saved $VERSION = '1999.0423'; # }}} # {{{ 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" => "" ); # .......................................................... dtd ... use vars qw ( $HTML_DOCTYPE ); sub Here($); $HTML_DOCTYPE = Here < EOF use vars qw ( $HTML_DOCTYPE_FRAME ); $HTML_DOCTYPE_FRAME = HereQuote <<"EOF"; EOF # ............................................. run time globals ... use vars qw ( $ARG_PATH $ARG_FILE $ARG_DIR ); } # }}} # {{{ Args parsing # ************************************************************** &args ******* # # DESCRIPTION # # Read and interpret command line arguments # # INPUT PARAMETERS # # none # # RETURN VALUES # # none # # **************************************************************************** sub HandleCommandLineArgs () { my $id = "$LIB.HandleCommandLineArgs"; local $ARG; # ....................................... opttins but not globals ... # The variables are defined in Getopt, but they are locally used # only inside this fucntion my $DELETE_FOLDING; my $VERSION_OPTION; # .......................................... command line options ... 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 $EMAIL $FONT $FRAME $HTML_BODY_ATTRIBUTES $JAVA_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_CWD $LINK_CHECK_ERR_TEXT_ONE_LINE $FORGET_HEAD_NUMBERS $NAME_UNIQ $PRINT_NAME_REFS $DELETE_REGEXP $LINK_CHECK $debug ); # 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; # ......................................................... Help ... # Do not even bother calling GetOpt for this. Launch Help immediately. Help() if grep /^(-h|--help)$/ , @ARGV; # .................................................. column-args ... # Remember that shell eats the double spaces. # --html-column-beg="10 " --> # --html-column-beg=10 my ( $key, $tag, $val ); for ( @ARGV ) { if ( /--html-column-(beg|end)/ ) { if ( /--html-column-(beg|end)=(\w+) +(.+)/ ) { ( $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; # .................................................... read args ... Getopt::Long::config( qw ( require_order no_ignore_case no_ignore_case_always )); $BASE = ""; $TITLE = "No title"; GetOptions # Getopt::Long ( "debug:i" => \$debug , "d" => \$debug , "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 , "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 , "java-file=s" => \$JAVA_FILE , "delete-lines=s" => \$DELETE_REGEXP , "delete-email-headers" => \$DELETE_EMAIL , "delete-folding" => \$DELETE_FOLDING , "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-cwd" => \$OUTPUT_CWD , "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 , "Version" => \$VERSION_OPTION ); $LINK_CHECK = 1 if $LINK_CHECK_ERR_TEXT_ONE_LINE; if ( defined $DOC_URL ) { local $ARG = $DOC_URL; m,/$, and die "$id: trailing slash in URL? [$DOC_URL]"; } if ( $FRAME ) { $HTML_DOCTYPE = $HTML_DOCTYPE_FRAME; $OUTPUT_AUTOMATIC = 1; $BASE eq '' and die "$id: Frame needs --base"; } if ( $DELETE_FOLDING ) { # Delete Emacs folding.el marks that keeps text in sections. # # # {{{ Folding begin mark # # }}} Folding end mark $DELETE_REGEXP = "^(# )?\{\{\{|^(# )?\}\}\}" } if ( $BASE ne "" ) { $BASE_URL_ALL = $BASE; # copy original local $ARG = $BASE; s,\n,,g; # No newlines # If direct /users/foo/dir given, treat as file:/... # access protocol m,^/, and $ARG = "file:$ARG"; # To ensure that we really get filename not m,/, and die "Base must contain URI [$ARG]"; 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 ( $JAVA_FILE ne '' ) { local *FILE; open FILE, $JAVA_FILE or die "$id: $ERRNO"; $JAVA_CODE = ; 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 what is HOME my $previous = cwd(); if ( defined $HOME ) { chdir $HOME; $HOME_ABS_PATH = cwd(); chdir $previous; } } if ( $VERSION_OPTION ) { print "$VERSION $PROGNAME $CONTACT $URL\n"; exit; } if ( $AS_IS ) { $BUT_TOP = $BUT_PREV = $BUT_NEXT = ""; } } # }}} # {{{ 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 Technical format's idea 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 CC2 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're keeping the documents under Version Control like RCS, CVS, ClearCase. you can diff, send and receive patches to the text documents. To help maintining large documents, the author has also developed 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 Authors web site (look for perl-*, tar.gz, *.html files) ftp://cs.uta.fi/pub/ssjaaa/ =head1 SYNOPSIS To convert text file into html: t2html.pl [options] file.txt > file.html To check links in the text file and reports 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> If you supply this option, then 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 html to printed 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 heading. =item B<--author -a STR> Author of document eg. 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 semi-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> Location of the html file. When B<--document> gave the name, this gives the location. Usually same as given with B<--base> option. =back =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 --Buttt URL> Buttons are placed at the top of document in order: [previoous][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<--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<--delete REGEXP> Delete lines matching perl regexp. This is useful if you use some document tool that uses navigation tags in the text file that you do not want to show up in generated html. =item B<--delete-email-headers> Delete email headers at the beginning of file, until first empty line that starts the body. If you keep your document ready for usenet posting, it contains header and body: From: ... Newsgroups: ... X-Sender-Info: Summary: BODY-OF-TEXT =item B<--delete-folding> This is shorthand to B<--delete option>. Defines regexp to delete Emacs package folding.el marks. Folding.el can be used with any text or programming language to place sections of text between tags I<{{{> I<}}}> You can open or close such folds. Keeping big documents (Megs) in order and manageable is of no problem. See. ftp://ftp.csd.uu.se/pub/users/andersl/beta/ =item B<--html-body STR> Additional attributes to add to html tag . You could eg. define language of the text with B<--html-body LANG=en> which would generate html tag See ftp://ftp.nordu.net/rfc/rfc1766.txt and http://www.sil.org/sgml/iso639a.html =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="30%,70%". Using this opption generates 3 files (implies B<--Out> option) file.html --> file-frm.html The Frame file, point browser here file-toc.html Left frame (navigation) file.txt.html Right frame (content) =item B<--java-file FILE> Include java code that must be conplete 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<--java-file>. It contains some Style sheet (CSS) definitions. The B<--java-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, eg. 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-cwd> Like B<--Out>, but chop the directory part and write the output files to the current directory. =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. Eg. 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 eg. 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 commands =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<--time> Print to stderr time spent used for handling the file. =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 emphasised text at column 1,2,3 If you want to include large code examples, large PGP base64 signed blocks, Include them here so that they start at column 2. 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 strong text is between columns 5, 6, 7 "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're 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 can't break the line. Example: #REF #how_to_profile;(Note: profiling); (1) (2) 1. The NAME reference in current document, a single word. This can also be full http url link. You can get NAME list by enabling --Toc-url-print option. 2. The clickable text is delimited by ; characters. =item * #URL-BASE is substituted with the contents of command line option B<--base URL>. The #URL-BASE token allows you to refer to documents local to the current site. --base http://www.example.com/dir1/dir2/text.html Then in text the reference is expanded like this #URL-BASE/next.html --> http://www.example.com/dir1/dir2/next.html =item * A !! (two exclamation marks) at text column (position 8) causes adding immediate


code. Any text after !! in the same line is written with and inserted just after
code, therefore the word formatting commands have no effect in this line. =back =head2 Http and email marking control =over 4 =item * All http and ftp references as well as email addresses are marked clickable. Email must have surrounding <> characters to be recognized. =item * If url is preceded with hyphen, it will not be clickable. If a string foo, bar, quux, test, site is found from url, then it is not counted as clickable. clickable http://this.com clickable me@here.com not clickable < me@here.com> not clickable; contains space <5dko56$1@news02.deltanet.com> Message-Id, not clickable http://foo.com "foo" found, not clickable -http://this.com hyphen, not clickable http://$EXAMPLE variable. not clickable =back =head2 Lists and bullets =over 4 =item * The bulletin table is contructed if there is `o' or `*' at column 8 and 3 spaces after it, so that text starts at column 12. Bulleted lines are adviced to be kept together; no spaces between bullet blocks. =item * The ordered list is started with `.', a dot, and written like bullet where text starts at column 12. =back =head2 Line breaks =over 4 =item * All line breaks are visible in your document, do not use more than one line break to separate paragraphs. =item * Very important is that there is only I line break after headings. =back =head1 TABLE OF CONTENT HEADING If there is heading 1, which is named exactly "Table of Contents", then all text up to next heading are discarded from the generated html file. This is done because program generates its own TOC. It is supposed that you use some text formatting program to generate the toc for you in .txt file and you do not maintain it manually. For example Emacs package I can be used. =head1 TROUBLESHOOTING =head2 Generated html document didn't 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 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.

=head1 SEE ALSO

perl(1) html2ps(1) weblint(1) htmlpp(1)

Jan Kärrman's  html2ps is available at
http://www.tdb.uu.se/~jan/html2ps.html and
Neil Bower's  weblint is available at
http://www.cre.canon.co.uk/~neilb/weblint/
iMATIX's htmlpp is available at http://www.imatix.com/

Emacs minor mode to write documets based on TF layout is available. See
package tinytf.el in ftp://cs.uta.fi/pub/ssjaaa/tiny-tools.tar.gz and to
learn about Emacs, see ftp://cs.uta.fi/pub/ssjaaa/elisp.html

Latest HTML and CSS specification is at http://www.w3c.org/

=head1 AVAILABILITY

t2html Homepage is at ftp://cs.uta.fi/pub/ssjaaa/t2html.html
CPAN entry is at http://www.perl.com/CPAN-local//scripts/

Reach author at jari.aalto@poboxes.com HomePage via forwarding service is at
http://www.netforward.com/poboxes/?jari.aalto or alternatively absolute
url is at ftp://cs.uta.fi/pub/ssjaaa/ but this may move without notice.
Prefer keeping the forwarding service link in your bookmark.

=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.174 1999/04/23 10:12:50 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...

    pod2text $PROGRAM_NAME;

    print "\n\n"
	, "Default CSS and JAVA code inserted to the beginning of each file\n"
	, JavaScript();

    exit 1;
}

# }}}
# {{{ misc



# ****************************************************************************
#
#   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 || \*STDOUT;

    my $i;

    print $fh "\n ------ ARRAY $title -----------\n";
    for ( @$arrayRef )
    {
	print $fh "$i / $ARG\n";
	$i++;
    }
    print $fh " ------ END $title ------------\n";
}


# ****************************************************************************
#
#   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";

    if	( $email !~ /^\s*$/ )				# Not empty, continue
    {
	if  ( $email !~ /@/  or  $email =~ /[<>]/ )
	{
	    warn "Invalid EMAIL, must not contain characters [<>] ",
		 "or you didn't give \@\n"
		 ;
	    die "Example: me\@example.com";
	}
    }
}


# ****************************************************************************
#
#   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
#
#       Prin help and exit.
#
#   INPUT PARAMETERS
#
#	$ref        url reference or "none"
#	$txt        text
#	$attr       [optional] additional attributes
#
#   RETURN VALUES
#
#	$string	    html code
#
# ****************************************************************************

sub MakeUrlRef ($$;$)
{

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


    qq($txt);
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Check if LWP::UserAgent module is available. It is used for
#       verifying URLs.
#
#   USES GLOBAL
#
#	EMAIL	Check the contents or existense of this variable
#
#   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,\0xE4,ä,g;
    s,\0xC4,Ä,g;
    s,\0xF6,ö,g;
    s,\0xD6,Ö,g;

    $ARG;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Translate html to text
#
#   INPUT PARAMETERS
#
#	$line	html
#
#   RETURN VALUES
#
#	$line   text
#
# ****************************************************************************

sub XlatHtml2tag ($)
{

    my    $id   = "$LIB.XlatHtml2tag";
    local $ARG  = shift;

    #	According to "Mastering regular expressions: O'Reilly", the
    #	/i is slower than charset []
    #
    #	    s/a//i	is slow
    #	    s/[aA]//	is faster
    #
    #

    s,&,\&,gi;
    s,>,>,gi;
    s,<,<,gi;
    s,",\",gi;	    # dummy-comment to close opened quote (")

    s,ä,\0xE4,g;
    s,Ä,\0xC4,g;
    s,ö,\0xF6,g;
    s,Ö,\0xD6,g;

    $ARG;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Translate $REF special markers to clickable html.
#       A reference link looks like
#
#	    #REF link-to; shown text;
#
#   INPUT PARAMETERS
#
#	$line
#
#   RETURN VALUES
#
#       $html
#
# ****************************************************************************

sub XlatRef ($)
{

    my $id   = "$LIB.XlatRef";
    my $line = shift;

    if ( $line =~ /(.*)#REF\s+(.*)\s*;(.*);(.*)/ )
    {
        # There already may be absolute reference, check it first
        #
        #   http:/www.this.com#referece_here

#       $s2 = "#$s2"  if not /(\#REF.*\#)/ and /ftp:|htp:/;

        $line = $1 .  MakeUrlRef($2, $3) . $4;

	unless ( $line =~ /#|http:|file:|news:|wais:|ftp:/ )
	{
	    warn "$id: Suspicious REF. Did you forgot # or http?\n\t$line"
	}


        $debug and warn "$id: #REF--> [$1]\n [$2]\n [$3]\n [$line]";

    }

    $line;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Check if we accept URL. Any foo|bar|baz|quu|test is discarded
#
#   INPUT PARAMETERS
#
#	$url
#
#   RETURN VALUES
#
#	1, 0
#
# ****************************************************************************

sub AcceptUrl($)
{
    $ARG[0] !~ m,foo|ba[rz]|quu[zx]|:/example|:/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
    {
	([^\"])((?:file|ftp|http|news|wais):\S+)  # dummy-comment "
    }
    {

	$pre = $1;
	$url = $2;

#	print ">>$ARG [$pre][$url]",AcceptUrl $url, "\n" if /ora/;

	if ( not AcceptUrl $url )
	{
	    $pre . $url;
	}
	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 ''
		, "$1"
		, MakeUrlRef( $url, $url, qq!target="_top"! )
		;
	}
    }egx;


    $ARG;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#       Translate email references to clickable html format
#
#   INPUT PARAMETERS
#
#	$line
#
#   RETURN VALUES
#
#       $html
#
# ****************************************************************************

sub XlatMailto ($)
{
    my $id   = "$LIB.Mailto";
    my $line = 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 <

    $line =~ s
    {
	(?!-)				# must not start with "-"

	<				# html <  tag.
	     ([^ \t$<>]+@[^ \t$<>]+)
	>
    }
    {
	my $url = $1;

	if ( not AcceptUrl $url )
	{
	    $url;
	}
	else
	{
	    "" . MakeUrlRef( "mailto:$url" , $url) . ""
	}
    }egx;

    $line;
}


# ****************************************************************************
#
#   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
#
#       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, '\.[^.]+$';

    $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 "-frame"    }
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 $bodyFont;

        if ( /toc/i )
        {
            $bodyFont = "font-size: 8pt;";
        }


	return <...
	      to get that kind of text seen in printer too. You can't
	      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
	{
	    font-family: "Times New Roman", serif;
	    $bodyFont
	}

	A:link		{ font-style: italic; }

	/*    */

	A.name		{ font-style: normal; }

	A:hover
	{
	    color:	     red;
	    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;
	}

	

	/* MSIE ok, Netscape nok: Indent text to same level to the right */
	BLOCKQUOTE	{ margin-right: 0; }

	\@media print	{ BLOCKQUOTE
	{
	    margin-right: 0;
	}}




	SAMP.code	{ color: Navy; }

	PRE
	{
	    font-family:    "Courier New", monospace;
	    font-size: 10pt;
	}

	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:	    10pt;

	    color:	    Navy;
	}

	

	P.column3	{ color: Green; }

	P.column5	{}
	P.column6	{}

	    

	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

	       #809F69 = Forest Green , see /usr/lib/X11/rgb.tx
	     */

	    color: #80871F ;

	    font-family: "Gill Sans", sans-serif;
	    font-style:  italic;
	    font-size:	 10pt;

	    line-height: 0.9em;
	}

	\@media print { EM.quote10
	{
	    font-style:  italic;
	    line-height: 0.9em;
	    font-size:   0.8em;
	}}

	P.column11
	{
	    color: Fuchsia;
	}


	

	EM.word		 { color: Red; }
	STRONG.word	 { }
	SAMP.word	 { color: Blue;  }

	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: 10pt; }

	    

	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 brocsers can use the included LINK tags.
#	http://www.htmlhelp.com/reference/wilbur/alltags.html
#
#	    REL="home": indicates the location of the homepage, or
#		starting page in this site.
#
#	    REL="next"
#
#	Indicates the location of the next document in a series,
#	relative to the current document.
#
#	    REL="previous"
#
#	Indicates the location of the previous document in a series,
#	relative to the current document.
#
#   NOTES
#
#	Note, 1997-10, you should not use this function because
#	a) netscape 3.0 doesn't obey LINK HREF
#	b) If you supply LINK and normal HREF; then lynx would show both
#	   which is not a good thing.
#	Let's just conclude,t hat LINK tag is not handled right
#	in net 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 StudyLinkExternal ($$$) { my $id = "$LIB.StudyLinkExternal"; my( $url , $LINK_HASH_REF , $LINK_HASH_CODE_REF) = @ARG; my( $ret , $txt ) = 0; if ( $LWP_OK ) { eval "use LWP::UserAgent"; # Note: 'HEAD' request doesn't actually download the # whole document. 'GET' would. # # Hm, # HEAD is not the total answer because there are still servers # that do not understand it. if the HEAD fails, revert to GET. HEAD # can only tell you that a URL has something behind it. it can't tell # you that it doesn't, necessarily. my $ua = new LWP::UserAgent; my $request = new HTTP::Request( 'HEAD', $url ); my $obj = $ua->request( $request ); unless ( $obj->is_success ) { my $ua2 = new LWP::UserAgent; my $request2 = new HTTP::Request( 'GET', $url ); my $obj2 = $ua2->request( $request2 ); unless ( $obj2->is_success ) { $ret = 1; $$LINK_HASH_REF{ $url } = $obj2->code; # There is new error code, record it. if ( not defined $$LINK_HASH_CODE_REF{ $obj2->code } ) { $txt = $obj->message; $$LINK_HASH_CODE_REF{ $obj2->code } = $txt; } } } } $debug and warn "$url $ret $txt"; ($ret , $txt); } # **************************************************************************** # # DESCRIPTION # # convert html into ascii by just stripping anything between # < and > written 4/21/96 by Michael Smith for WebGlimpse # # INPUT PARAMETERS # # \@arrayRef text lines # # RETURN VALUES # # @ # # **************************************************************************** sub Html2txt ($) { my $id = "$LIB.Html2txt"; my $arrayRef = shift; my ( @ret, $carry, $comment ); for ( @$arrayRef ) { if ( 0 ) # enable/disable comment stripping { $comment = 1 if //; $comment = 0 if /--->/; next if $comment; } if ( $carry ) { # remove all until the first > next if not s/[^>]*>// ; # if we didn't do next, it succeeded -- reset carry $carry = 0; } while( s/<[^>]*>//g ) { } if( s/<.*$// ) { $carry = 1; } $ARG = XlatHtml2tag $ARG; push @ret, $ARG; } @ret; } # **************************************************************************** # # DESCRIPTION # # read external links # # INPUT PARAMETERS # # \@txt whole text where to find links. # # RETURN VALUES # # % all found links 'line nbr' -- 'lnk' # # **************************************************************************** sub ReadLinks ($) { my $id = "$LIB.ReadLinks"; my $arrayRef = shift; local $ARG; # the URL my( $url, %ret, $i, $elt); for $elt ( @$arrayRef ) { $i++; $ARG = ""; # This used to read (ftp|http), but the ftp check does not # know GET request. $ARG = $1 if $elt =~ m"(([Hh][Tt][Tt][Pp])://[^\s\)\'\",;]+)"; # Do not check the tar.gz links. or perl?args cgi calls if ( m"\.(gz|tgz|Z)$|\?" ) { 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 Studylinks ($$) { my $id = "$LIB.Studylinks"; my( $file, $arrayRef ) = @ARG; my( %link, %errDesc, %linkErr ); my( $i, $lnk, $i , $text, $status , $err); %link = ReadLinks $arrayRef; $debug and PrintHash "$id", \%link; $i = 0; for ( sort {$a <=> $b} keys %link ) { $i = $ARG; $lnk = $link{ $ARG }; not $QUIET and print "$file:$i:$lnk"; ( $status, $err ) = StudyLinkExternal $lnk , \%linkErr, \%errDesc; $text = ""; if ( $LINK_CHECK_ERR_TEXT_ONE_LINE ) { ( $text = $err ) =~ s/\n/./; } if ( not $QUIET ) { print " $status $text\n"; } elsif ( $status != 0 ) { printf "$file:$i:%-4d $lnk $text\n", $status; } } } # }}} # {{{ Is, testing # **************************************************************** &test ***** # # DESCRIPTION # # Check if TEXT contains no data. Empty, only whitespaces # or "none" word is considered empty text. # # INPUT PARAMETERS # # $text string # # RETURN VALUES # # 0,1 # # **************************************************************************** sub IsEmptyText ($) { my $id = "$LIB.IsEmptyText"; my $text = shift; return 1 if ( $text eq '' or $text =~ /^\s+$|[Nn][Oo][Nn][Ee]$/ ); 0; } # **************************************************************** &test ***** # # DESCRIPTION # # If LINE is heading, return level of header. # Heading starts at column 0 or 4 and the first leffter must be capital. # # INPUT PARAMETERS # # $line # # RETURN VALUES # # 1..2 Level of heading # 0 Was not a heading # # **************************************************************************** sub IsHeading ($) { my $id = "$LIB.IsHeading"; my $line = shift; return 1 if $line =~ /^[A-Z0-9]/; return 2 if $line =~ /^ {4}[A-Z0-9.]/; 0; } # **************************************************************** &test ***** # # DESCRIPTION # # If LINE is bullet, return type of bullet # # INPUT PARAMETERS # # $line line # $textRef [returned] the bullet text # # RETURN VALUES # # $BulletNumbered constants # $Bulletnormal # # **************************************************************************** sub IsBullet ($$) { my $id = "$LIB.IsBullet"; my( $line, $textRef ) = @ARG; my $type = 0; # Bullet can start with "o" or "." only # # . Numbered list # . Numbered list # # o Regular bullet # o Regular bullet # # * Regular bullet # * Regular bullet if ( $line =~ /^ {8}([*o.]) {3}(.+)/ ) { $$textRef = $2; # fill return value if ( $1 eq "o" or $1 eq "*" ) { $debug and warn "$id: BulletNormal >>$2\n"; $type = $BulletNormal; } elsif ( $1 eq "." ) { $debug and warn "$id: BulletNumbered >>$2\n"; $type = $BulletNumbered; } } $type; } # }}} # {{{ start, end # **************************************************************************** # # DESCRIPTION # # Return HTML string containing meta tags. # # INPUT PARAMETERS # # $author # $email # $kwd [optional] # $desc [optional] # # RETURN VALUES # # @html # # **************************************************************************** sub MakeMetaTags ($$ ;$$) { my $id = "$LIB.MakeMetaTags"; my ( $author, $email, $kwd, $desc ) = @ARG; # META tags provide "meta information" about the document. # # [wilbur] You can use either HTTP-EQUIV or NAME to name the # meta-information, but CONTENT must be used in both cases. By using # HTTP-EQUIV, a server should use the name indicated as a header, # with the specified CONTENT as its value. my @ret; my $META = "META HTTP-EQUIV"; my $METAN = "META NAME"; # ............................................. meta information ... # META must be inside HEAD block push @ret, MakeComment "META TAGS (FOR SEARCH ENGINES)"; if ( $kwd =~ /\S+/ and $kwd !~ /^\S+$/ ) { # "keywords" [according to Wilbur] # Provides keywords for search engines such as Infoseek or Alta # Vista. These are added to the keywords found in the document # itself. If you insert a keyword more than seven times here, # the whole tag will be ignored! if ( $kwd !~ /,/ ) { $kwd = join "," , split ' ', $kwd; warn "$id: META KEYWORDS must have commas (fixed): ", " [$kwd]"; } push @ret, qq( <$META="keywords"\n\tCONTENT="$kwd">\n\n); } if ( defined $desc ) { length($desc) > 1000 and warn "$id: META DESC over 1000 characters"; push @ret, qq( <$META="description"\n\tCONTENT="$desc">\n\n); } # ................................................. general meta ... push @ret, qq( \n\n) ; if ( defined $author ) { $author = qq( <$META="Author"\n\tCONTENT="$author">\n\n); } if ( defined $email ) { $email = qq( <$META="Made"\n\tCONTENT="mailto:$email">\n\n); } my $gen = qq( <$METAN="Generator"\n) . qq(\tCONTENT="Perl 5 program $PROGNAME v$VERSION">\n) ; 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, # eg. 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(); # ................................................... disclaimer ... # Set default value first my $disc = Here <<"........EOF";

Copyright (C) $author. All rights reserved. This material can be publically distributed and copied with the permission of Author, provided that you mention the Author's name and email address or http reference where to get the original document. ........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. # # **************************************************************************** { # Only used once to make contructiong 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; # 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's 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" ); $button = qq() . MakeUrlRef( "#toc", "[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 # ************************************************************ &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,].*)/ ) # The "P" tag { $isPcode = 1; $s1 = $1; $s2 = $2; $ARG = "$s1" . substr($s2, 1); # warn "P $line $ARG\n"; } if( /#URL-BASE/ ) { # warn ">> $ARG"; $Base = 1 s,#URL-BASE,$base,gi; } # $debug = 2 if /Terminol/; $ARG = XlatTag2html $ARG; # ......................................................... &url ... $ARG = XlatRef $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(!!)([^!].*)?$/o ) { # A special !! code means adding
tag if (defined $2 ) { $ARG = "\n
\n\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 doesn't 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 definition kmanuall 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; # If already has /P then do nothing. if ( $isBrCode and not m,

    , ) { $ARG .= "
    "; } } # die if /exaple/; "$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 ? @$txt = grep !/$DELETE_REGEXP/o, @$txt unless $DELETE_REGEXP eq ""; @$txt = expand @$txt; # Text::Tabs if ( $LINK_CHECK ) { Studylinks $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, '\.[^.]+$'; 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"; } # ............................................................ &main ... Initialize(); HandleCommandLineArgs(); my $id = "$LIB.main"; # Must be after Initialize(), defined $LIB. my ( @slurp , $dir , $file ); if ( defined $EMAIL and $EMAIL ne '' ) { CheckEmail $EMAIL; } # ................................................... read file ... $debug and warn "$id: [ARGV] @ARGV\n"; $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]\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_CWD ) { $ARG_PATH = cwd(); $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 ; } } # }}} 0; __END__