# = HISTORY SECTION =====================================================================

# ---------------------------------------------------------------------------------------
# version | date   | author | changes
# ---------------------------------------------------------------------------------------
# 0.02    |07.12.00| ste    | new module namespace "PerlPoint";
# 0.01    |01.06.00| ste    | new.
# ---------------------------------------------------------------------------------------

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

=head1 NAME

B<pp2pp> - a Perl Point demo translator to PP itself (in variable syntaxi)

=head1 VERSION

This manual describes version B<0.02>.

=head1 DESCRIPTION

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

The target syntax depends on the specified I<-target> option.
It can be version 1, which is the I<original Perl Point syntax> as
introduced by I<T. Christiansen>, or version 2 which is version 1
with the extensions made by I<L. Domke>, or version 3 which is the
most recent syntax and equal to the source processed by PerlPoint::Package.

Besides the demonstration of PerlPoint::Package usage, a translator like this
provides a way to use I<syntax 3> (as declared for PerlPoint::Package) with
an existing I<syntax 1> or I<syntax 2> translator.

=head1 SYNOPSIS

=head1 FILES

=head1 ENVIRONMENT

=head1 NOTES

This is a demonstration only. A real life pp2pp translator surely
should be more robust etc., the intention of this code is simply
to I<show the usage of PerlPoint::Package>, not a perfect translator.

=head1 SEE ALSO

PerlPoint::Parser

PerlPoint::Backend

=head1 AUTHOR

Copyright (c) Jochen Stenzel (perl@jochen-stenzel.de), 2000. All rights reserved.

=cut


# declare version
$VERSION=$VERSION=0.02;

# pragmata
use strict;

# load modules
use Carp;
use PerlPoint::Backend;
use PerlPoint::Parser 0.12;
use PerlPoint::Constants;
use Getopt::Long;
use Getopt::ArgvFile qw(argvFile);


# declare variables
my ($verbatim, %options, @streamData, @olists, %tagHash)=(0);

# get options
argvFile(home=>1, default=>1);
GetOptions(\%options,
           "target=i", # target syntax;
          );

# check options
$options{target}=3 unless exists $options{target};
die "PP syntax $options{target} can currently not be generated by this translator.\n" if $options{target}>3;

# declare list of accepted tag openers (should be all PP tags)
@tagHash{qw(
            B
            C
            I
            IMG
            E
           )}=();

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

# and call it
$parser->run(
             stream  => \@streamData,
             tags    => \%tagHash,
             files   => \@ARGV,
             trace   => TRACE_NOTHING,
             display => DISPLAY_NOINFO,
            ) or exit 1;

# build a backend
my $backend=new PerlPoint::Backend(name=>'pp2pp2', trace=>TRACE_NOTHING, display=>DISPLAY_NOINFO);

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

$backend->register(DIRECTIVE_SIMPLE, \&handleSimple);
$backend->register(DIRECTIVE_TAG, \&handleTag);
$backend->register(DIRECTIVE_HEADLINE, \&handleHeadline);

$backend->register(DIRECTIVE_TEXT, sub {print "\n\n" if $_[1]==DIRECTIVE_COMPLETE;});

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

$backend->register(DIRECTIVE_LIST_LSHIFT, \&handleListShift);
$backend->register(DIRECTIVE_LIST_RSHIFT, \&handleListShift);

$backend->register(DIRECTIVE_BLOCK, \&handleBlock);
$backend->register(DIRECTIVE_VERBATIM, \&handleVerbatim);

$backend->register(DIRECTIVE_COMMENT, \&handleComment);

# and run it
$backend->run(\@streamData);


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

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

  # try to emulate empty verbatim lines, if necessary
  if ($options{target}==2)
    {
     if ($token eq "\n")
       {
        $verbatim++;
        print '.' if $verbatim>1;
       }
     else
       {$verbatim=0;}
    }

  # simply print the token (restoring backslashes)
  $token=~s/\\/\\\\/;
  print $token;
 }

# headlines
sub handleHeadline
 {
  # get parameters
  my ($opcode, $mode, $level, @contents)=@_;

  # act mode dependend
  print '=' x $level if $mode==DIRECTIVE_START;
  print "\n\n"       if $mode==DIRECTIVE_COMPLETE;
 }

# tags
sub handleTag
 {
  # get parameters
  my ($opcode, $mode, $tag, $settings)=@_;

  # declare tag translations
  my %tags=(
            1 => {
                  I => 'I',
                 },
            2 => {
                  I => 'I',
                 },
            3 => {
                  I => '\I',
                 },
           );

  # act mode dependend
  if ($mode==DIRECTIVE_START)
    {
     # preparations
     $tag=uc($tag);

     # print tag
     print exists $tags{$options{target}}{$tag} ? $tags{$options{target}}{$tag} : ($options{target}==3 ? "\\$tag" : $tag);

     # print tag options, if necessary
     if (%$settings and $options{target}==3)
       {
        # start tag options
        print '{';
        # print option settings
        print " $_=$settings->{$_} " foreach sort keys %$settings;
        # close option part
        print '}';
       }

     # open tag body
     print '<';
    }
  else
    {
     # close tag
     print '>';
    }
 }

# list
sub handleList
 {
  # get parameters
  my ($opcode, $mode)=@_;

  # anything to do?
  return unless $options{target}<3 and $opcode==DIRECTIVE_OLIST;

  # handle mode dependend to emulate ordered lists
  unshift(@olists, 0) if $mode==DIRECTIVE_START;
  shift(@olists)      if $mode==DIRECTIVE_COMPLETE;
 }

# list shift
sub handleListShift
 {
  # get parameters
  my ($opcode, $mode)=@_;

  # anything to do?
  return unless $mode==DIRECTIVE_START and $options{target}==3;

  # handle operation dependend
  print "\n>\n\n" if $opcode==DIRECTIVE_LIST_RSHIFT;
  print "\n<\n\n" if $opcode==DIRECTIVE_LIST_LSHIFT;
 }

# list point
sub handleListPoint
 {
  # get parameters
  my ($opcode, $mode, @data)=@_;

  # act list, mode and target dependend
  print '* '          if $mode==DIRECTIVE_START and $opcode==DIRECTIVE_UPOINT;

  if ($options{target}==3)
    {
     print '# '          if $mode==DIRECTIVE_START and $opcode==DIRECTIVE_OPOINT;
     print ":$data[0]: " if $mode==DIRECTIVE_START and $opcode==DIRECTIVE_DPOINT;
    }
  else
    {
     print "* B<", ++$olists[0], ".> " if $mode==DIRECTIVE_START and $opcode==DIRECTIVE_OPOINT;
     print "* B<$data[0]:> "           if $mode==DIRECTIVE_START and $opcode==DIRECTIVE_DPOINT;
    }

  print "\n\n"        if $mode==DIRECTIVE_COMPLETE;
 }

# comment
sub handleComment
 {
  # get parameters
  my ($opcode, $mode)=@_;

  # act mode dependend
  print $options{target}==3 ? '//' : '#' if $mode==DIRECTIVE_START;
  print "\n"                             if $mode==DIRECTIVE_COMPLETE;
 }

# block
sub handleBlock
 {
  # get parameters
  my ($opcode, $mode)=@_;

  # act mode dependend
  print "\n" if $mode==DIRECTIVE_COMPLETE;
 }

# verbatim block
sub handleVerbatim
 {
  # get parameters
  my ($opcode, $mode)=@_;

  # act mode dependend for target syntax 3
  if ($options{target}==3)
    {
     print "<<EOM\n" if $mode==DIRECTIVE_START;
     print "EOM\n\n" if $mode==DIRECTIVE_COMPLETE;
    }
  elsif ($options{target}==2)
    {
     # set a flag ...
     $verbatim=1;
     print "\n\n" if $mode==DIRECTIVE_COMPLETE;
    }
 }