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

# ---------------------------------------------------------------------------------------
# version | date   | author   | changes
# ---------------------------------------------------------------------------------------
# 0.06    |27.02.02| JSTENZEL | auto-anchors headlines (for \REF);
# 0.05    |10.06.01| JSTENZEL | new script namespace "PerlPoint::Converter::pp2tree";
#         |        | JSTENZEL | adapted to new tag declarations;
# 0.04    |07.12.00| JSTENZEL | new module namespace "PerlPoint";
# 0.03    |07.10.00| JSTENZEL | renamed to pp2tree;
# 0.02    |12.10.99| JSTENZEL | added a simple backend;
# 0.01    |09.10.99| JSTENZEL | derived from the PerlPoint::Parser draft.
# ---------------------------------------------------------------------------------------

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

=head1 NAME

B<pp2tree> - a Perl Point demo application visualizing a documents structure

=head1 VERSION

This manual describes version B<0.05>.

This is a demonstration application of the PP package. It
visualizes a Perl Point document as a tree.

=head1 SYNOPSIS

=head1 FILES

=head1 ENVIRONMENT

=head1 NOTES

This is a demonstration only. A real life pp2tree visualizer 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), 1999-2001. All rights reserved.

=cut


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

# declare version
$VERSION=$VERSION=0.05;

# pragmata
use strict;

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


# declare variables
my ($depth, $patt, @streamData, %options)=(0, "   |");

# 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,
             trace           => TRACE_NOTHING,
             display         => DISPLAY_ALL,
            );

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

# register backend handlers
$backend->register(DIRECTIVE_BLOCK, \&handleBlock);
$backend->register(DIRECTIVE_COMMENT, \&handleComment);
$backend->register(DIRECTIVE_DOCUMENT, \&handleDocument);
$backend->register(DIRECTIVE_HEADLINE, \&handleHeadline);
$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_SIMPLE, \&handleSimple);
$backend->register(DIRECTIVE_TAG, \&handleTag);
$backend->register(DIRECTIVE_TEXT, \&handleText);
$backend->register(DIRECTIVE_VERBATIM, \&handleVerbatim);

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


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

# helper function
sub visualize
 {
  # get and check parameters
  my ($state, $msg)=@_;
  confess "[BUG] Missing state parameter.\n" unless defined $state;
  confess "[BUG] Missing message parameter.\n" unless defined $msg;

  if ($state==DIRECTIVE_START)
    {
     # update graphics
     warn(($patt x $depth), "\n");
     warn(($patt x $depth), "- $msg.\n");
     warn(($patt x ($depth+1)), "\n");

     # update data
     $depth++;
    }
  else
    {
     # update data
     $depth-- if $depth>0;

     # update graphics
     warn(($patt x ($depth+1)), "\n");
     warn(($patt x $depth), "- $msg.\n");
     warn(($patt x $depth), "\n");
    }
 }

# simple directive handlers
sub handleSimple
 {
  # update the token counter
  ;
 }
sub handleHeadline
 {visualize($_[1], "Headline $_[2]");}

sub handleList
 {visualize($_[1], join(' ', $_[0]==DIRECTIVE_OLIST ? 'Ordered' : $_[0]==DIRECTIVE_ULIST ? 'Unordered' : 'Definition', 'list'));}

sub handleListPoint
 {visualize($_[1], $_[0]==DIRECTIVE_DPOINT ? 'Definition' : 'Item');}

sub handleListShift
 {visualize($_[1], "List Shift");}

sub handleBlock
 {visualize($_[1], "Block");}

sub handleText
 {visualize($_[1], "Text");}

sub handleVerbatim
 {visualize($_[1], "Verbatim block");}

sub handleComment
 {visualize($_[1], "Comment");}

sub handleTag
 {visualize($_[1], "Tag $_[2]");}

sub handleDocument
 {
  if ($_[1]==DIRECTIVE_START)
    {
     # update graphics
     warn "Document (base $_[2]).\n";
     warn "$patt\n";

     # update data
     $depth++;
    }
  else
    {
     # update data
     $depth-- if $depth>0;

     # update graphics
     warn "$patt\n";
     warn "Document (base $_[2]).\n";
    }
 }