File Coverage

blib/lib/Pod/InDesign/TaggedText/TPR.pm

Criterion	Covered	Total	%
statement	81	96	84.3
branch	9	12	75.0
condition	1	2	50.0
subroutine	24	36	66.6
pod	8	29	27.5
total	123	175	70.2

# $Id$
package Pod::InDesign::TaggedText::TPR;
use strict;
use base 'Pod::InDesign::TaggedText';

use warnings;
no warnings;

use subs qw();
use vars qw($VERSION);

$VERSION = '0.10';

=head1 NAME

Pod::InDesign::TaggedText - Turn Pod into Tagged Text for The Perl Review

=head1 SYNOPSIS

	use Pod::InDesign::TaggedText::TPR;

=head1 DESCRIPTION

***THIS IS ALPHA SOFTWARE. MAJOR PARTS WILL CHANGE***

This module overrides and extends C to translate
Pod into the InDesign Tagged Text format used by The Perl Review.

=cut

sub document_header
	{
	<<'HTML';

>
>
>
>
>
>
>>>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>>>
>>>
>
>
HTML
	}

sub head1_style         { 'Feature Section' }
sub head2_style         { 'Feature Sub Section' }

sub normal_para_style
	{
	# The paragraph style depends on which para it is. The very first para
	# has a drop cap. The first para after a section title has no initial
	# indent. All other paras have an initial indent.
	my $last_thing = $_[0]{last_thingy} || 'para';

	   if( $last_thing eq 'para' )  { 'Feature Para' } #indent
	elsif( $last_thing eq 'head1' ) { 'Feature Section Lead' } # no indent
	elsif( $last_thing eq 'start' ) { 'Feature Lead' }  # has drop cap
	else                            { 'Feature Para' }
	}

sub code_para_style     { 'Feature Code Para'   }

sub inline_code_style	{ 'pod-C' }

sub inline_url_style    { 'pod-I'  }

sub inline_italic_style { 'pod-I' }

sub inline_bold_style   { 'pod-B' }

sub start_Document
	{
	my $self = shift;

	$self->SUPER::start_Document;

	$self->{last_thingy} = 'start';
	}

sub start_head1
	{
	my $self = shift;

	$self->SUPER::start_head1;

	$self->{scratch} .= 'n ';
	}

sub end_head1
	{
	my $self = shift;

	$self->{scratch} .= "\t"; # right tab to get ----- to right margin
	$self->{last_thingy} = 'head1';

	$self->SUPER::end_head1;
	}

sub start_Para
	{
	my $self = shift;

	$self->SUPER::start_Para;

	# psb must be after the start of the para. Go figure.
	$self->{scratch} .= ''
		if $self->{last_thingy} eq 'bullet_list';


	$self->{last_thingy} = 'para';
	}

sub new { $_[0]->SUPER::new() }

sub end_Verbatim
	{
	my @lines = split m/^/m, $_[0]{'scratch'};

	my $first = shift @lines;
	my $last  = shift @lines;

	$_[0]{'scratch'} =~ s/\n+\z/\n/;

	my $style = $_[0]->code_para_style;

	# the pSpaceBefore comes after the  on the first line
	# so add it before I add the  to the front of every
	# line
	$_[0]{'scratch'} =~ s/^//;

	$_[0]{'scratch'} =~ s/^//gm;

	# after the first line, I need to reset , so
	# find the position of the first newline and shove it in
	# right after it. There's a special case where the code line
	# is a single line (so, no newline in scratch).
	my $first_newline_pos = index( $_[0]{'scratch'}, "\n" );

	if( $first_newline_pos == -1 )
		{
		$first_newline_pos = length( $_[0]{'scratch'} ) - 1;
		}

	#print STDERR "first_newline_pos is $first_newline_pos\n";
	#print STDERR "length of scratch is " . length( $_[0]{'scratch'} ) . "\n";

	substr( $_[0]{'scratch'}, $first_newline_pos + 1, 0 ) = '';


	# right after the last  I need to specify the space after
	# that line. Heh, this might be the first time I've used rindex
	# for anything useful.
	my $substr_len = length "";

	my $last_para_pos = rindex( $_[0]{'scratch'}, "" );
	substr( $_[0]{'scratch'}, $last_para_pos + $substr_len, 0 )
		= '';


	# the  really comes before the next normal para, but
	# I only need it after a verbatim block, so just attach it at the end
	# of this instead of the beginning of the next thing. Alternatively,
	# I could look at last_thingy in normal_para_style, but that's a bit
	# more pain.
	$_[0]{'scratch'} .= "\n";

	$_[0]->emit();

	$_[0]->{last_thingy} = 'verbatim';
	$_[0]{'in_verbatim'} = 0;
	}

sub _get_initial_item_type
	{
	my $self = shift;

	my $type = $self->SUPER::_get_initial_item_type;

	#print STDERR "My item type is [$type]\n";

	$type;
	}

sub start_item_bullet
	{
	my $self = shift;

	my $end_last =
		$self->{bullet_count}++ ?
			''
			:
			'';

	$self->{'scratch'} .= <<"HERE";

$end_last
HERE

	chomp $self->{'scratch'};

	$self->emit;
	}

sub start_item_number { }
sub start_item_text   { }

sub start_over_bullet
	{
	my $self = shift;

	$self->{in_bullet_list} = 1;
	$self->{bullet_count} = 0;
	}
sub start_over_text   { }
sub start_over_block  { }
sub start_over_number { }

sub end_over_bullet
	{
	my $self = shift;

	$self->{'scratch'} .= "\n";

	$self->end_non_code_text;

	$self->{in_bullet_list} = 0;
	$self->{bullet_count}   = 0;
	$self->{last_thingy}    = 'bullet_list';
	}

sub end_over_text   { }
sub end_over_block  { }
sub end_over_number { }

sub end_item_bullet
	{
	my $self = shift;

	$self->end_non_code_text;

	$self->{'scratch'} .= '';

	$self->emit;
	}

sub end_item_number { $_[0]->emit() }
sub end_item_text   { $_[0]->emit() }

=head1 TO DO

=over 4

=item * handle item lists

=back

=head1 SEE ALSO

L, L

=head1 SOURCE AVAILABILITY

This source is part of a SourceForge project which always has the
latest sources in CVS, as well as all of the previous releases.

	http://sourceforge.net/projects/brian-d-foy/

If, for some reason, I disappear from the world, one of the other
members of the project can shepherd this module appropriately.

=head1 AUTHOR

brian d foy, C<<  >>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2007, brian d foy, All Rights Reserved.

You may redistribute this under the same terms as Perl itself.

=cut

1;