

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

# ---------------------------------------------------------------------------------------
# version | date   | author | changes
# ---------------------------------------------------------------------------------------
# 0.03    |07.12.00| ste    | new module namespace "PerlPoint";
# 0.02    |01.06.00| ste    | added comment transformation;
# 0.01    |27.05.00| ste    | new.
# ---------------------------------------------------------------------------------------

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

=head1 NAME

B<pp2pod> - a Perl Point demo translator to POD

=head1 VERSION

This manual describes version B<0.03>.

=head1 DESCRIPTION

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

=head1 SYNOPSIS

=head1 FILES

=head1 ENVIRONMENT

=head1 NOTES

This is a demonstration only. A real life pp2pod 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.03;

# 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 (@streamData, @openLists, %tagHash);

# declare list of accepted tag openers
@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=>'pp2pod', 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, \&handleSimple);
$backend->register(DIRECTIVE_VERBATIM, \&handleSimple);

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



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


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

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

  # simply print the token
  print @contents;
 }

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

  # act mode dependend
  print "=head$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=(
            B => 'B',
            C => 'C',
            E => 'E',
            I => 'I',
           );

  # act mode dependend
  print $tags{uc($tag)}, '<' if $mode==DIRECTIVE_START;
  print '>'                  if $mode==DIRECTIVE_COMPLETE;
 }

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

  # act list and mode dependend
  unshift(@openLists, 0), print "=over 4\n\n" if $mode==DIRECTIVE_START;
  shift(@openLists), print "=back\n\n"        if $mode==DIRECTIVE_COMPLETE;
 }

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

  # anything to do?
  return unless $mode==DIRECTIVE_START;

  # handle operation dependend
  unshift(@openLists, 0), print "=over 4\n\n" if $opcode==DIRECTIVE_LIST_RSHIFT;
  shift(@openLists), print "=back\n\n"        if $opcode==DIRECTIVE_LIST_LSHIFT;
 }

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

  # update list counter if the item begins
  $openLists[0]++ if $mode==DIRECTIVE_START;

  # act list and mode dependend
  print "=item\n\n"                if $mode==DIRECTIVE_START and $opcode==DIRECTIVE_UPOINT;
  print "=item $openLists[0].\n\n" if $mode==DIRECTIVE_START and $opcode==DIRECTIVE_OPOINT;
  print "=item $data[0].\n\n"      if $mode==DIRECTIVE_START and $opcode==DIRECTIVE_DPOINT;
  print "\n\n"                     if $mode==DIRECTIVE_COMPLETE;
 }

# comment (there is no comment feature built into POD (which is
# intended for comments completely), so make it a foreign language)
sub handleComment
 {
  # get parameters
  my ($opcode, $mode)=@_;

  # act list and mode dependend
  print "=for comment\n\n" if $mode==DIRECTIVE_START;
  print "\n\n"             if $mode==DIRECTIVE_COMPLETE;
 }

