File Coverage

blib/lib/Pod/Simple/Wiki.pm

Criterion	Covered	Total	%
statement	119	123	96.7
branch	37	50	74.0
condition	2	4	50.0
subroutine	46	47	97.8
pod	1	1	100.0
total	205	225	91.1

package Pod::Simple::Wiki;

###############################################################################
#
# Pod::Simple::Wiki - A class for creating Pod to Wiki filters.
#
#
# Copyright 2003-2015, John McNamara, [e-mail]
#
# Documentation after __END__
#

# perltidy with the following options: -mbl=2 -pt=0 -nola

use strict;

#use Pod::Simple::Debug (5);
use Pod::Simple;
use vars qw(@ISA $VERSION);

@ISA     = qw(Pod::Simple);
$VERSION = '0.19';


###############################################################################
#
# The tag to wiki mappings.
#
my $tags = {
    ''    => "'''",
    ''   => "'''",
    ''    => "''",
    ''   => "''",
    ''   => '"',
    ''  => '"',
    ''  => '',
    '' => "\n\n",

    ''  => "\n----\n'''",
    '' => "'''\n\n",
    ''  => "\n'''''",
    '' => "'''''\n\n",
    ''  => "\n''",
    '' => "''\n\n",
    ''  => "\n",
    '' => "\n\n",
};


###############################################################################
#
# new()
#
# Simple constructor inheriting from Pod::Simple.
#
sub new {

    my $class = shift;
    my $format = lc( shift || 'wiki' );
    $format = 'mediawiki' if $format eq 'wikipedia';
    $format = 'moinmoin'  if $format eq 'moin';

    my $module = "Pod::Simple::Wiki::" . ucfirst $format;

    # Try to load a sub-module unless the format type is 'wiki' in which
    # case we use this, the parent, module.
    if ( $format ne 'wiki' ) {
        eval "require $module";
        die "Module $module not implemented for wiki format $format\n" if $@;
        return $module->new( @_ );
    }

    my $self = Pod::Simple->new( @_ );
    $self->{_wiki_text} = '';
    $self->{_tags}      = $tags;
    $self->{output_fh} ||= *STDOUT{IO};
    $self->{_item_indent} = 0;
    $self->{_debug}       = 0;

    # Set Pod::Simple parser options
    # - Merge contiguous text        RT#60304
    $self->merge_text( 1 );

    # - Ignore X<>  (index entries)  RT#60307
    $self->nix_X_codes( 1 );

    bless $self, $class;
    return $self;
}


###############################################################################
#
# _debug()
#
# Sets the debug flag for some Pod::Simple::Wiki debugging. See also the
# Pod::Simple::Debug module.
#
sub _debug {

    my $self = shift;

    $self->{_debug} = $_[0];
}


###############################################################################
#
# _append()
#
# Appends some text to the buffered Wiki text.
#
sub _append {

    my $self = shift;

    $self->{_wiki_text} .= $_[0];
}


###############################################################################
#
# _output()
#
# Appends some text to the buffered Wiki text and then emits it. Also resets
# the buffer.
#
sub _output {

    my $self = shift;
    my $text = $_[0];

    $text = '' unless defined $text;

    print { $self->{output_fh} } $self->{_wiki_text}, $text;

    $self->{_wiki_text} = '';
}


###############################################################################
#
# _indent_item()
#
# Indents an "over-item" to the correct level.
#
sub _indent_item {

    my $self         = shift;
    my $item_type    = $_[0];
    my $item_param   = $_[1];
    my $indent_level = $self->{_item_indent};

    if ( $item_type eq 'bullet' ) {
        $self->_append( "*" x $indent_level );

        # This was the way C2 Wiki used to define a bullet list
        # $self->_append("\t" x $indent_level . '*');
    }
    elsif ( $item_type eq 'number' ) {
        $self->_append( "\t" x $indent_level . $item_param );
    }
    elsif ( $item_type eq 'text' ) {
        $self->_append( "\t" x $indent_level );
    }
}


###############################################################################
#
# _skip_headings()
#
# Formatting in headings doesn't look great or is ignored in some formats.
#
sub _skip_headings {

    my $self = shift;

    return 0;
}


###############################################################################
#
# _append_tag()
#
# Add an open or close tag to the current text.
#
sub _append_tag {

    my $self = shift;
    my $tag  = $_[0];

    $self->_append( $self->{_tags}->{$tag} );
}


###############################################################################
###############################################################################
#
# The methods in the following section are required by Pod::Simple to handle
# Pod directives and elements.
#
# The methods _handle_element_start() _handle_element_end() and _handle_text()
# are called by Pod::Simple in response to Pod constructs. We use
# _handle_element_start() and _handle_element_end() to generate calls to more
# specific methods. This is basically a long-hand version of Pod::Simple::
# Methody with the addition of location tracking.
#


###############################################################################
#
# _handle_element_start()
#
# Call a method to handle the start of a element if one has been defined.
# We also set a flag to indicate that we are "in" the element type.
#
sub _handle_element_start {

    my $self    = shift;
    my $element = $_[0];

    $element =~ tr/-/_/;

    if ( $self->{_debug} ) {
        print '    ' x $self->{_item_indent}, "<$element>\n";
    }

    $self->{ "_in_" . $element }++;

    if ( my $method = $self->can( '_start_' . $element ) ) {
        $method->( $self, $_[1] );
    }
}


###############################################################################
#
# _handle_element_end()
#
# Call a method to handle the end of a element if one has been defined.
# We also set a flag to indicate that we are "out" of the element type.
#
sub _handle_element_end {

    my $self    = shift;
    my $element = $_[0];

    $element =~ tr/-/_/;

    if ( my $method = $self->can( '_end_' . $element ) ) {
        $method->( $self );
    }

    $self->{ "_in_" . $element }--;

    if ( $self->{_debug} ) {
        print "\n", '    ' x $self->{_item_indent}, "\n\n";
    }
}


###############################################################################
#
# _handle_text()
#
# Perform any necessary transforms on the text. This is mainly used to escape
# inadvertent CamelCase words.
#
sub _handle_text {

    my $self = shift;
    my $text = $_[0];

    # Split the text into tokens but maintain the whitespace
    my @tokens = split /(\s+)/, $text;

    for ( @tokens ) {
        next unless /\S/;    # Ignore the whitespace
        next if m[^(ht|f)tp://];    # Ignore URLs
        s/([A-Z][a-z]+)(?=[A-Z])/$1''''''/g    # Escape with 6 single quotes

    }

    # Rejoin the tokens and whitespace.
    $self->{_wiki_text} .= join '', @tokens;
}


###############################################################################
#
# Functions to deal with the I<>, B<> and C<> formatting codes.
#
sub _start_I { $_[0]->_append_tag( '' )  unless $_[0]->_skip_headings() }
sub _start_B { $_[0]->_append_tag( '' )  unless $_[0]->_skip_headings() }
sub _start_C { $_[0]->_append_tag( '' ) unless $_[0]->_skip_headings() }
sub _start_F { $_[0]->_start_I }

sub _end_I { $_[0]->_append_tag( '' )  unless $_[0]->_skip_headings() }
sub _end_B { $_[0]->_append_tag( '' )  unless $_[0]->_skip_headings() }
sub _end_C { $_[0]->_append_tag( '' ) unless $_[0]->_skip_headings() }
sub _end_F { $_[0]->_end_I }


###############################################################################
#
# Functions to deal with the Pod =head directives
#
sub _start_head1 { $_[0]->_append_tag( '' ) }
sub _start_head2 { $_[0]->_append_tag( '' ) }
sub _start_head3 { $_[0]->_append_tag( '' ) }
sub _start_head4 { $_[0]->_append_tag( '' ) }

sub _end_head1 { $_[0]->_append_tag( '' ); $_[0]->_output() }
sub _end_head2 { $_[0]->_append_tag( '' ); $_[0]->_output() }
sub _end_head3 { $_[0]->_append_tag( '' ); $_[0]->_output() }
sub _end_head4 { $_[0]->_append_tag( '' ); $_[0]->_output() }


###############################################################################
#
# Functions to deal with verbatim paragraphs. We emit the text "as is" for now.
# TODO: escape any Wiki formatting in text such as ''code''.
#
sub _start_Verbatim { $_[0]->_append_tag( '' ) }
sub _end_Verbatim { $_[0]->_append_tag( '' ); $_[0]->_output() }


###############################################################################
#
# Functions to deal with =over ... =back regions for
#
# Bulleted lists
# Numbered lists
# Text     lists
# Block    lists
#
sub _start_over_bullet { $_[0]->{_item_indent}++ }
sub _start_over_number { $_[0]->{_item_indent}++ }
sub _start_over_text   { $_[0]->{_item_indent}++ }

sub _end_over_bullet {
    $_[0]->{_item_indent}--;
    $_[0]->_output( "\n" ) unless $_[0]->{_item_indent};
}

sub _end_over_number {
    $_[0]->{_item_indent}--;
    $_[0]->_output( "\n" ) unless $_[0]->{_item_indent};
}

sub _end_over_text {
    $_[0]->{_item_indent}--;
    $_[0]->_output( "\n" ) unless $_[0]->{_item_indent};
}

sub _start_item_bullet { $_[0]->_indent_item( 'bullet' ) }
sub _start_item_number { $_[0]->_indent_item( 'number', $_[1]->{number} ) }
sub _start_item_text   { $_[0]->_indent_item( 'text' ) }

sub _end_item_bullet { $_[0]->_output( "\n" ) }
sub _end_item_number { $_[0]->_output( "\n" ) }

sub _end_item_text { $_[0]->_output( ":\t" ) }    # Format specific.

sub _start_over_block { $_[0]->{_item_indent}++ }
sub _end_over_block   { $_[0]->{_item_indent}-- }


###############################################################################
#
# _start_Para()
#
# Special handling for paragraphs that are part of an "over" block.
#
sub _start_Para {

    my $self         = shift;
    my $indent_level = $self->{_item_indent};

    if ( $self->{_in_over_block} ) {
        $self->_append( ( "\t" x $indent_level ) . " :\t" );
    }
}


###############################################################################
#
# _end_Para()
#
# Special handling for paragraphs that are part of an "over_text" block.
#
sub _end_Para {

    my $self = shift;

    # Only add a newline if the paragraph isn't part of a text
    if ( $self->{_in_over_text} ) {

        # Do nothing in this format.
    }
    else {
        $self->_output( "\n" );
    }

    $self->_output( "\n" );
}


1;


__END__