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