view release on metacpan or  search on metacpan

demo/pp2sdf  view on Meta::CPAN

# ---------------------------------------------------------------------------------------

# = POD SECTION =========================================================================

=head1 NAME

B<pp2sdf> - translates PerlPoint to SDF

=head1 VERSION

This manual describes version B<0.12>.

=head1 DESCRIPTION

This is a demonstration application of the PerlPoint package. It
translates PerlPoint into SDF.

SDF is, of course, no presentation format by itself. Nevertheless
it I<is> useful as a target format because sdf can produce
various other formats. Presentation formats are fine but often
one wants to provide additional handouts, notes or a printed version.
pp2sdf opens a simple way to do this.


=head1 SYNOPSIS

pp2sdf [<options>] <PerlPoint sources>

=head2 Options

All options can be abbreviated uniqly.

=over 4

=item -activeContents

PerlPoint sources can embed Perl code which is evaluated while the source is parsed. For
reasons of security this feature is deactivated by default. Set this option to active
it. You can use I<-safeOpcode> to fine tune which operations shall be permitted.

=item -cache

parsing of one and the same document several times can be accelerated by activating the
PerlPoint parser cache by this option. The performance boost depends on your document
structure.

Cache files are written besides the source and named ".<source file>.ppcache".

It can be useful to (temporarily) deactivate the cache to get correct line numbers in
parser error messages (currently numbers cannot always reported correctly with activated
cache because of a special perl behaviour).

=item -cacheCleanup

PerlPoint parser cache files grow (with every modified version of a source parsed)
because they store expressions for every parsed variant of a paragraph. This is usually
uncritical but you may wish to clean up the cache occasionally. Use this option to
perform the task (or remove the cache file manually).


=item -docstreaming <mode>

sets up the mode the converter handles document streams. Document streams are document
parts belonging to the last recent headline and starting with a document stream entry
point (which is a special paragraph):

 =This is the main stream

 Bla bla

 ~A special document stream starts here

 Blu blu

 ~And this is another one

 Bli bli

 =The next headline switches back to the main stream

 Bla bla

You might think of these streams as "document threads" or "docs in docs".

Now, the transformations of those streams are controled by this option.

B<Mode 0> is the default. It is entered automatically if a document contains
docstreams and C<-docstreaming> is not set.

This mode causes C<pp2sdf> to produce one document per document stream, each of
them containing only the main stream and the parts written of one certain stream.
For example, the first produced document according to the code above would be
equivalent to the following source:

 =This is the main stream

 Bla bla

 Blu blu

 =The next headline switches back to the main stream

 Bla bla

Result files will be named as specified by I<-sdffile>, with a sequentially
incremented appendix (C<name.stream1>, C<name.stream2> etc.). If the document
contains no docstream, the result file defaults to the specified name (without
appendix).

B<Mode 1> causes the converter to I<ignore> everything except of the main stream.
In this mode, the example above is converted according to this source:

 =This is the main stream

 Bla bla

 =The next headline switches back to the main stream

 Bla bla


B<Mode 2> transforms every stream entry point into a sub-headline of the same name.
In the example, this results in a document part equivalent to the following source:

 =This is the main stream

 Bla bla

 ==A special document stream starts here

 Blu blu

 ==And this is another one

 Bli bli

 =The next headline switches back to the main stream

 Bla bla

So results are slightly different in different modes. The best way to get an
impression is to give a certain mode a try.


=item -help

displays an online help and terminates the script.

demo/pp2sdf  view on Meta::CPAN

Please refer to the Artistic License that came with your Perl
distribution for more details.

=cut

# declare script package
package PerlPoint::Converter::pp2sdf;

# declare version
$VERSION=$VERSION=0.12;

# pragmata
use strict;

# load modules
use Safe;
use IO::File;
use Getopt::Long;
use File::Basename;
use PerlPoint::Tags;
use PerlPoint::Backend;
use PerlPoint::Tags::SDF;
use PerlPoint::Parser 0.37;
use PerlPoint::Constants 0.16;
use Getopt::ArgvFile qw(argvFile);


# declare variables
my (
    $table,                     # a table buffer
    $htmlBuffer,                # intermediate buffer for embedded HTML;

    @streamData,                # PerlPoint stream;
    @openTags,                  # a buffer used to autoclose / autoopen tags exceeding example lines;
    @headlinePath,              # composite headline (consisting of all hierarchy levels);
    @headlineNumbers,           # internal headline number memory, used for \LOCALTAG;
    @targethandles,             # array of target handles (usually one element);

    %flags,
    %options,                   # option hash;
    %tagHash,                   # accepted PerlPoint tags;
    %formatting,                # formatting configurations;
    %docstreamdata,             # data used to handle document streams;
   )=(
      {},			# table buffer init value
     );

# precompile a pattern describing accepted SDF paragraph style markers
my $paragraphStyles=qr(^(Note|Sign)$);


# resolve option files
argvFile(default=>1, home=>1);

# get options
GetOptions(\%options,
                      "activeContents",    # evaluation of active contents;
                      "cache",             # control the cache;
                      "cacheCleanup",      # cache cleanup;
                      "docstreaming=s",    # document stream handling;
                      "help",              # online help, usage;
                      "includelib=s@",     # library pathes;
                      "nocopyright",       # suppress copyright message;
                      "noinfo",            # suppress runtime informations;
                      "nowarn",            # suppress runtime warnings;
                      "quiet",             # suppress all runtime messages except of error ones;
                      "sdffile=s",         # result file;
                      "safeOpcode=s@",     # permitted opcodes in active contents;
                      "set=s@",            # user settings;
                      "skipstream=s@",     # skip certain document streams;
                      "tagset=s@",         # add a tag set to the scripts own tag declarations;
                      "trace:i",           # activate trace messages;
          );

# propagate options as necessary
@options{qw(nocopyright noinfo nowarn)}=() x 3 if exists $options{quiet};
$options{trace}=$ENV{SCRIPTDEBUG} if not exists $options{trace} and exists $ENV{SCRIPTDEBUG};

# display copyright unless suppressed
warn "\n",
     basename($0), ' ',
     do {no strict 'refs'; ${join('::', __PACKAGE__, 'VERSION')}},
     ", (c) J. Stenzel (perl\@jochen-stenzel.de) 2000-2002. \n\n"
  unless exists $options{nocopyright};

# check for a help request
(exec("pod2text $0 | less") or die "[Fatal] exec() cannot be called: $!\n") if $options{help};

# check usage
die "[Fatal] Usage: $0 [<options>] -sdffile <targetfile> <PerlPoint source(s)>\n" unless @ARGV>=1;

# check passed sources
-r or die "[Fatal] Source file $_ does not exist or is unreadable.\n" foreach @ARGV;

# more parameter checks
die "[Fatal] Please specify the name of the result file by -sdffile.\n" unless exists $options{sdffile};
not -e $options{sdffile} or -w _ or die "[Fatal] SDF file $options{sdffile} cannot be written.\n";

# import tags as wished
PerlPoint::Tags::addTagSets(@{$options{tagset}}) if exists $options{tagset};

# declare SDF tag translations
%tagHash=(
          # base
	  B     => 'B',
	  C     => 'EX',
	  E     => 'E',
	  I     => 'I',

          # imported tags
          U     => 'U',
	 );

# build parser
my $parser=new PerlPoint::Parser;

# Set up active contents handling. By default, we use a Safe object.
my $safe=new Safe;
if (exists $options{safeOpcode})
 {
  unless (grep($_ eq 'ALL', @{$options{safeOpcode}}))
    {
     # configure compartment
     $safe->permit(@{$options{safeOpcode}});
    }
  else
    {
     # simply flag that we want to execute active contents
     $safe=1;
    }
 }

# and call it
$parser->run(
             stream          => \@streamData,

             files           => \@ARGV,

             filter          => 'perl|sdf|html',

             safe            => exists $options{activeContents} ? $safe : undef,

             activeBaseData  => {
                                 targetLanguage => 'SDF',
                                 userSettings   => {map {$_=>1} exists $options{set} ? @{$options{set}} : ()},
                                },

             predeclaredVars => {
                                 CONVERTER_NAME    => basename($0),
                                 CONVERTER_VERSION => do {no strict 'refs'; ${join('::', __PACKAGE__, 'VERSION')}},
                                },

             libpath         => exists $options{includelib} ? $options{includelib} : [],

             docstreams2skip => exists $options{skipstream} ? $options{skipstream} : [],

             docstreaming    => (exists $options{docstreaming} and ($options{docstreaming}==DSTREAM_HEADLINES or $options{docstreaming}==DSTREAM_IGNORE)) ? $options{docstreaming} : DSTREAM_DEFAULT,

             vispro          => 1,

             headlineLinks   => 1,

             cache           =>   (exists $options{cache} ? CACHE_ON : CACHE_OFF)
                                + (exists $options{cacheCleanup} ? CACHE_CLEANUP : 0),
             display         =>   DISPLAY_ALL
                                + (exists $options{noinfo} ? DISPLAY_NOINFO : 0)
                                + (exists $options{nowarn} ? DISPLAY_NOWARN : 0),
             trace           =>   TRACE_NOTHING
                                + ((exists $options{trace} and $options{trace} & TRACE_PARAGRAPHS) ? TRACE_PARAGRAPHS : 0)
                                + ((exists $options{trace} and $options{trace} & TRACE_LEXER)      ? TRACE_LEXER      : 0)
                                + ((exists $options{trace} and $options{trace} & TRACE_PARSER)     ? TRACE_PARSER     : 0)
                                + ((exists $options{trace} and $options{trace} & TRACE_SEMANTIC)   ? TRACE_SEMANTIC   : 0)
                                + ((exists $options{trace} and $options{trace} & TRACE_ACTIVE)     ? TRACE_ACTIVE     : 0)
                                + ((exists $options{trace} and $options{trace} & TRACE_TMPFILES)   ? TRACE_TMPFILES   : 0),
            ) or exit(1);


# build a backend
my $backend=new PerlPoint::Backend(
                                   name    => 'pp2sdf',
                                   display =>   DISPLAY_ALL
                                              + (exists $options{noinfo} ? DISPLAY_NOINFO : 0)
                                              + (exists $options{nowarn} ? DISPLAY_NOWARN : 0),
                                   trace   =>   TRACE_NOTHING
                                              + ((exists $options{trace} and $options{trace} & 32) ? TRACE_BACKEND : 0),
                                   vispro  => 1,
                                  );

# register backend handlers
$backend->register(DIRECTIVE_DOCUMENT, sub {print "\n\n";});

$backend->register(DIRECTIVE_BLOCK, \&handleBlock);
$backend->register(DIRECTIVE_COMMENT, \&handleComment);
$backend->register(DIRECTIVE_HEADLINE, \&handleHeadline);
$backend->register(DIRECTIVE_SIMPLE, \&handleSimple);
$backend->register(DIRECTIVE_TAG, \&handleTag);
$backend->register(DIRECTIVE_TEXT, \&handleText);
$backend->register(DIRECTIVE_VERBATIM, \&handleBlock);

$backend->register($_, \&handleList) foreach (DIRECTIVE_ULIST, DIRECTIVE_OLIST, DIRECTIVE_DLIST);
$backend->register($_, \&handleListPoint) foreach (DIRECTIVE_UPOINT, DIRECTIVE_OPOINT, DIRECTIVE_DPOINT);
$backend->register(DIRECTIVE_DPOINT_ITEM, \&handleDListPointItem);
$backend->register($_, \&handleListShift) foreach (DIRECTIVE_LIST_LSHIFT, DIRECTIVE_LIST_RSHIFT);

$backend->register(DIRECTIVE_DSTREAM_ENTRYPOINT, \&handleDocstreamEntry); 


# init several variables
@flags{qw(listlevel sdf html textstart headline)}=(1, 0, 0, 0, 0);

# bind the backend to the stream (to enable access to its data *before* backend invokation)
$backend->bind(\@streamData);

# open result file(s): docstreams to handle?
if (
        (
            not exists $options{docstreaming}
         or $options{docstreaming}==DSTREAM_DEFAULT
        )
    and $backend->docstreams
   )
 {
  # scopies
  my ($c, $d)=(0, 1);

  # open a target file for each handle
  foreach my $docstream (sort $backend->docstreams)
   {
    # build filename
    my $filename="$options{sdffile}.stream$d";

    # inform user, if necessary
    warn qq([Info] Document stream "$docstream" generates result file $filename.\n) unless exists $options{noinfo};

    # open file
    $targethandles[$c]=new IO::File(">$filename");

    # store handle
    $docstreamdata{$docstream}=$targethandles[$c];

    # update counters
    $c++; $d++;
   }
 }
else
 {
  # default output file, named as specified
  $targethandles[0]=new IO::File(">$options{sdffile}");
 }

# select the default output handle
select($targethandles[0]);

# now run the backend
$backend->run(\@streamData);


# SUBROUTINES ###############################################################################

# simple directive handlers
sub handleSimple
 {
  # get parameters
  my ($opcode, $mode, @contents)=@_;

  # build a small translation table to handle curly braces
  my %curlyBraceTranslations=('{' => '{{CHAR:lbrace}}', '}' => '{{CHAR:rbrace}}');

  unless ($flags{sdf})
    {
     @contents=map
                {
		 # Guard translations of things like "\B<{key=>value}>" by translating "{".
                 # *Opening* curly braces might confuse SDF as well (unless corresponding
                 # closing braces will follow).
		 s/([{}])/$curlyBraceTranslations{$1}/g;

		 # complete block lines as necessary