# = HISTORY SECTION ===================================================================== # --------------------------------------------------------------------------------------- # version | date | author | changes # --------------------------------------------------------------------------------------- # 0.04 |25.04.2006| JSTENZEL | added INDEXCLOUD support; # 0.03 |09.04.2006| JSTENZEL | new option -acceptedFormat; # | | JSTENZEL | file test adapted to new IMPORT: directive; # |22.04.2006| JSTENZEL | new option -version; # 0.02 |09.12.2005| JSTENZEL | main stream now produces stack objects as well, but # | | | still outside the special "streamframe" wrapper; # | | JSTENZEL | new option -mainstream; # |06.01.2006| JSTENZEL | runParser() supports nested table setting; # |08.01.2006| JSTENZEL | "pp2tdo" became "perlpoint", adapted POD; # 0.01 |25.05.2003| JSTENZEL | new. # --------------------------------------------------------------------------------------- # = POD SECTION ========================================================================= =head1 NAME B - generic PerlPoint generator =head1 VERSION This manual describes version B<0.04>. =head1 SYNOPSIS =head1 DESCRIPTION =head1 METHODS =cut # check perl version require 5.00503; # = PACKAGE SECTION ====================================================================== # declare package package PerlPoint::Generator; # declare package version and author $VERSION=0.04; $AUTHOR=$AUTHOR='J. Stenzel (perl@jochen-stenzel.de), 2003-2006'; # = PRAGMA SECTION ======================================================================= # set pragmata use strict; # declare object data fields use fields qw( anchorfab backend buffer build chapterdata cfg document help latest optionlist options pages pkg safe template ); # = LIBRARY SECTION ====================================================================== # load modules use Carp; use Safe; use File::Path; use Getopt::Long; use File::Basename; use PerlPoint::Tags; use Pod::Simple::Text; use PerlPoint::Anchors; use PerlPoint::Template; use File::Copy qw(copy); use PerlPoint::Parser 0.40; use PerlPoint::Constants 0.17; use Cwd qw(:DEFAULT abs_path); use Storable qw(nstore retrieve); use Getopt::ArgvFile qw(argvFile); use PerlPoint::Generator::Object::Page; # = CODE SECTION ========================================================================= # class data: formatter name table my %formatters=( # most type are set up by constants DIRECTIVE_SIMPLE() => 'formatSimple', DIRECTIVE_BLOCK() => 'formatBlock', DIRECTIVE_COMMENT() => 'formatComment', DIRECTIVE_DLIST() => 'formatDlist', DIRECTIVE_DPOINT() => 'formatDpoint', DIRECTIVE_DPOINT_ITEM() => 'formatDpointItem', DIRECTIVE_DPOINT_TEXT() => 'formatDpointText', DIRECTIVE_HEADLINE() => 'formatHeadline', DIRECTIVE_OLIST() => 'formatOlist', DIRECTIVE_OPOINT() => 'formatOpoint', DIRECTIVE_TAG() => 'formatTag', DIRECTIVE_TEXT() => 'formatText', DIRECTIVE_ULIST() => 'formatUlist', DIRECTIVE_UPOINT() => 'formatUpoint', DIRECTIVE_VERBATIM() => 'formatVerbatim', DIRECTIVE_DSTREAM_ENTRYPOINT() => 'formatDStreamEntrypoint', # a few more are set up by strings DSTREAMFRAME => 'formatDStreamFrame', PAGE => 'formatPage', ); =pod =head2 new() B =over 4 =item class The class name. =back B the new object. B =cut sub new { # get parameter my ($class, %params)=@_; # check parameters confess "[BUG] Missing class name.\n" unless $class; confess "[BUG] Missing target language parameter.\n" unless exists $params{options}{target} or exists $params{options}{help} or exists $params{options}{version}; confess "[BUG] This method should be called via its own package only.\n" unless $class eq __PACKAGE__; # declarations (my __PACKAGE__ $plugin, my $stylepath); # init style directory setting $params{options}{styledir}=['.'] unless exists $params{options}{styledir}; # check style settings if (exists $params{options}{style}) { # add the style directories subdir "lib" to the Perl include path # (this is potentially dangerous because there might be a "lib" subdirectory in the # start directory when someone starts without -styledir, but probably there is no # PerlPoint::Generator subclass there - so it should cause no trouble, and "lib" is # an intuitive name, so we stay with this) unshift(@INC, "$_/$params{options}{style}/lib") for @{$params{options}{styledir}}; # check for a configuration file (first search subdirectory "cfg" (new convention), # then fallback to the traditional direct access (style directory itself) my $cfg=(grep(-e "$_/$params{options}{style}/cfg/$params{options}{style}.cfg", @{$params{options}{styledir}}))[0]; # anything found? if (defined $cfg) { # store style path $stylepath=$cfg; # complete configuration path $cfg.="/$params{options}{style}/cfg/$params{options}{style}.cfg"; } else { # fallback to traditional path $cfg=(grep(-e "$_/$params{options}{style}/$params{options}{style}.cfg", @{$params{options}{styledir}}))[0]; # anything found? if (defined $cfg) { # store style path $stylepath=$cfg; # complete configuration path $cfg.="/$params{options}{style}/$params{options}{style}.cfg"; } } # anything found? if (defined $cfg) { # great, we found a style definition, add it to the option list unshift(@ARGV, "\@$cfg"); } else { # oops! die "[Fatal] No style definition \"$params{options}{style}/cfg/$params{options}{style}.cfg\" to be found in style directories (", join(', ', @{$params{options}{styledir}}), ").\n"; } } # any target setting passed? if ($params{options}{target}) { # try to load the language class my $pluginClass=join('::', $class, uc($params{options}{target})); eval "require $pluginClass" or die "[Fatal] Missing plugin $pluginClass, please install it ($@).\n"; die $@ if $@; # set default formatter, if necessary $params{options}{formatter}='Default' unless exists $params{options}{formatter}; # normalize formatter name # $params{options}{formatter}=join('::', map {ucfirst(lc)} split('::', $params{options}{formatter})); # build an object of the *plugin* class and check it $plugin=$pluginClass->new(formatter=>$params{options}{formatter}, %params); confess "[BUG] $pluginClass does not inherit from ", __PACKAGE__, ".\n" unless $plugin->isa(__PACKAGE__); } else { # no target specified, so build an object of your own class # (this is only allowed to make -help work) $plugin=fields::new($class); } # store more data $plugin->{pkg}=exists $params{package} ? $params{package} : caller; # perform further initializations $plugin->{anchorfab}=new PerlPoint::Anchors('__FINISH__'); # complete option set $plugin->{options}={ exists $params{options}{style} ? (style => $params{options}{style}) : (), exists $params{options}{styledir} ? (styledir => $params{options}{styledir}) : (), target => uc($params{options}{target}), formatter => $params{options}{formatter}, exists $params{options}{help} ? (help => $params{options}{help}) : (), exists $params{options}{version} ? (version => $params{options}{version}) : (), }; # add configuration setting $plugin->{cfg}{setup}{stylepath}=$stylepath; # perform inits $plugin->{build}{docstream}=undef; $plugin->{build}{listclosingops}=[]; $plugin->{build}{listlevels}=[0]; $plugin->{build}{listtypes}=[]; $plugin->{build}{nestedTables}=0; $plugin->{build}{sourcefilters}=[]; $plugin->{build}{stack}=[]; $plugin->{build}{streamData}=[]; $plugin->{pages}=[new PerlPoint::Generator::Object::Page()]; # perform bootstrap $plugin->bootstrap(); # all options should be processed now Getopt::Long::Configure(qw(no_pass_through)); die "[Fatal] Unknown options: please use the correct -target and -style settings.\n" unless GetOptions(); # check for a version report request if (exists $plugin->{options}{version}) { exit; } # check for a help request if (exists $plugin->{options}{help}) { # build a helper object to parse and display the help texts my $helper=new Pod::Simple::Text; # collect help text hashes from the main script and from both generators and template # engines (templates first: this way, their synopsis is displayed *after* the general # synopsis of the generator) $plugin->addHelp($plugin, 'main'); $plugin->addHelp($plugin->{template}, ref($plugin->{template}), 'PerlPoint::Template') if exists $plugin->{template}; $plugin->addHelp($plugin, ref($plugin)); no strict 'refs'; my $package=__PACKAGE__; my $pod=join("\n", "=pod", "", "=head1 NAME", "", basename($0), "- This is a ", ref($plugin), " converter.\n\n", "", "=head1 VERSION", "", ${join('::', $plugin->{pkg}, 'VERSION')}, "", "=head1 INVOCATION", "", (exists $plugin->{options}{target} and $plugin->{options}{target}) ? ( "You are going to produce $plugin->{options}{target} with a", (ref($plugin)=~/${package}::(.+)/), exists $plugin->{template} ? ("formatter using", (ref($plugin->{template})=~/PerlPoint::Template::(.+)/), "templates", exists $plugin->{cfg}{setup}{stylepath} ? "provided by style $plugin->{cfg}{setup}{stylepath}/$plugin->{options}{style}." : '.') : "formatter.", ) : ( "You did not specify a target yet, so it is unclear what result your call would produce.", "Please set C<-target> to get a more detailled help.", ), "", "=head1 SYNOPSIS", "", "Usage:", "", basename($0), "-target -formatter [-styledir