File Coverage

blib/lib/Pod/Simple/Wiki/Mediawiki.pm

Criterion	Covered	Total	%
statement	103	108	95.3
branch	52	66	78.7
condition	5	15	33.3
subroutine	15	16	93.7
pod	2	2	100.0
total	177	207	85.5

package Pod::Simple::Wiki::Mediawiki;

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

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

use Pod::Simple::Wiki;
use strict;
use vars qw(@ISA $VERSION);


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


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

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


###############################################################################
#
# The default module options
#
my $default_opts = {
    transformer_lists     => 0,
    link_prefix           => 0,
    sentence_case_headers => 0,
    remove_name_section   => 0,
};


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

    my $class = shift;
    my $opts  = {};

    if ( ref $_[-1] eq 'HASH' ) {
        $opts = pop @_;

        # Merge custom tags with the default tags, if passed.
        $opts->{tags} = {
            %$tags,
            %{
                exists $opts->{custom_tags}
                ? delete $opts->{custom_tags}
                : {}
            }
        };
    }
    else {
        $opts->{tags} = $tags;
    }

    $opts = { %$default_opts, %$opts };

    my $self = Pod::Simple::Wiki->new( 'wiki', @_ );
    $self->{_tags}                  = $opts->{tags};
    $self->{_transformer_lists}     = $opts->{transformer_lists};
    $self->{_link_prefix}           = $opts->{link_prefix};
    $self->{_sentence_case_headers} = $opts->{sentence_case_headers};
    $self->{_remove_name_section}   = $opts->{remove_name_section};

    bless $self, $class;

    $self->accept_targets( 'mediawiki' );
    $self->nbsp_for_S( 1 );

    return $self;
}


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

    my $self = shift;

    if ( $self->{_indent_text} ) {
        $self->{_wiki_text} .= $self->{_indent_text};
        $self->{_indent_text} = '';
    }

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


###############################################################################
#
# _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 . ' ' );
    }
    elsif ( $item_type eq 'number' ) {
        $self->_append( '#' x $indent_level . ' ' );
    }
    elsif ( $item_type eq 'text' ) {
        $self->_append( ':' x ( $indent_level - 1 ) . '; ' );
    }
}


###############################################################################
#
# Functions to deal with links.

sub _start_L {

    my ( $self, $attr ) = @_;

    if ( !$self->_skip_headings ) {
        $self->_append( '' );    # In case we have _indent_text pending
        # Flush the text buffer, so it will contain only the link text
        $self->_output;
        $self->{_link_attr} = $attr;    # Save for later
    }
}

sub _end_L {

    my $self = $_[0];

    my $attr = delete $self->{_link_attr};

    if ( $attr and my $method = $self->can( '_format_link' ) ) {
        $self->{_wiki_text} = $method->( $self, $self->{_wiki_text}, $attr );
    }
}


###############################################################################
#
# _format_link

sub _format_link {

    my ( $self, $text, $attr ) = @_;

    if ( $attr->{type} eq 'url' ) {
        my $link = $attr->{to};

        return $link if $attr->{'content-implicit'};
        return "[$link $text]";
    }

    # Manpage:
    if ( $attr->{type} eq 'man' ) {

        # FIXME link to http://www.linuxmanpages.com?
        return "$text" if $attr->{'content-implicit'};
        return "$text ($attr->{to})";
    }

    die "Unknown link type $attr->{type}" unless $attr->{type} eq 'pod';

    # Handle a link within this page:
    return "[[#$attr->{section}|$text]]" unless defined $attr->{to};

    # Handle a link to a specific section in another page:
    if ( defined $attr->{section} ) {
        return $self->{_link_prefix}
          ? "[$self->{_link_prefix}$attr->{to}#$attr->{section} $text]"
          : "[[$attr->{to}#$attr->{section}|$text]]";
    }

    if ( $attr->{'content-implicit'} ) {
        return $self->{_link_prefix}
          ? "[$self->{_link_prefix}$attr->{to} $attr->{to}]"
          : "[[$attr->{to}]]";
    }

    return "[[$attr->{to}|$text]]";
}


###############################################################################
#
# _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];

    if ( $self->{_sentence_case_headers} ) {
        if ( $self->{_in_head1} ) {
            $text = ucfirst( lc( $text ) );
        }
    }

    if ( !$self->{_in_Data} ) {

        # Escape colons in definition lists:
        if ( $self->{_in_item_text} ) {
            $text =~ s/:/:/g;    # A colon would end the item
        }

        # Escape empty lines in verbatim sections:
        if ( $self->{_in_Verbatim} ) {
            $text =~ s/^$/ /mg;      # An empty line would split the section
        }

        $text =~ s/\xA0/ /g;    # Convert non-breaking spaces to entities

        $text =~ s/''/''/g;      # It's not a formatting code

        $text =~ s/\xA9/©/g;    # Convert copyright symbols to entities
    }

    $self->_append( $text );
}


###############################################################################
#
# Functions to deal with =over ... =back regions for
#
# Bulleted lists
# Numbered lists
# Text     lists
# Block    lists
#
sub _end_item_text { }    # _start_Para will insert the :


###############################################################################
#
# _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->{_indent_text} = ( ':' x $indent_level );
    }

    if ( $self->{_in_over_text} ) {
        $self->{_indent_text} = "\n" . ( ':' x $indent_level );
    }

    if ( $self->{_transformer_lists} ) {
        if ( $self->{_in_over_bullet} || $self->{_in_over_number} ) {
            if ( $self->{output_string} ) {
                chomp( ${ $self->{output_string} } );
            }
            $self->{_indent_text} = "";
        }
    }
}


###############################################################################
#
# _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.
    }
    elsif ( $self->{_transformer_lists}
        && ( $self->{_in_over_bullet} || $self->{_in_over_number} ) )
    {

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

    if ( !$self->{_transformer_lists}
        || ( !$self->{_in_over_bullet} && !$self->{_in_over_number} ) )
    {

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


######################################################################
#
# _end_Data
#
# Special handling for data paragraphs

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


###############################################################################
#
# parse_string_document()
#
# Optional overriding of Pod::Simple method to remove the "NAME" section
#
sub parse_string_document {

    my $self = shift;

    $self = $self->SUPER::parse_string_document( @_ );

    if ( $self->{_remove_name_section} ) {
        no warnings 'uninitialized';
        ${ $self->{output_string} } =~
          s/^==\s*NAME\s*==\n(?:[\w:]+)(?: - (.*))*/$1||''/iesg;
    }

    return $self;
}

1;


__END__