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

# ---------------------------------------------------------------------------------------
# version | date   | author   | changes
# ---------------------------------------------------------------------------------------
# 0.07    |02.01.03| JSTENZEL | modern run() call;
# 0.06    |27.02.02| JSTENZEL | auto-anchors headlines (for \REF);
# 0.05    |24.07.01| JSTENZEL | now adds additional lines to complete examples;
# 0.04    |26.03.01| JSTENZEL | adapted to new tag templates;
#         |10.06.01| JSTENZEL | new script namespace "PerlPoint::Converter::pp2pod";
#         |        | JSTENZEL | more tag adaptations;
# 0.03    |07.12.00| JSTENZEL | new module namespace "PerlPoint";
# 0.02    |01.06.00| JSTENZEL | added comment transformation;
# 0.01    |27.05.00| JSTENZEL | new.
# ---------------------------------------------------------------------------------------

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

=head1 NAME

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

=head1 VERSION

This manual describes version B<0.07>.

=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 script package
package PerlPoint::Converter::pp2pod;

# declare version
$VERSION=$VERSION=0.07;

# pragmata
use strict;

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


# declare variables
my (@streamData, @openLists, %options);

# get options
argvFile(home=>1, default=>1);
GetOptions(\%options,
           "tagset=s@",         # add a tag set to the scripts own tag declarations;
          );

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

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

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

             headlineLinks   => 1,

             filter          => 'perl|pod',

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

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

             vispro          => 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=>'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;

  # in case of an example, add additional lines to complete it
  print "\n\n" if $mode==DIRECTIVE_COMPLETE and ($opcode==DIRECTIVE_BLOCK or $opcode==DIRECTIVE_VERBATIM)
 }

# 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;
 }