File Coverage

blib/lib/Pod/From/GoogleWiki.pm

Criterion	Covered	Total	%
statement	141	145	97.2
branch	58	70	82.8
condition	12	17	70.5
subroutine	17	17	100.0
pod	0	5	0.0
total	228	254	89.7

package Pod::From::GoogleWiki;

use warnings;
use strict;
use vars qw/$VERSION/;
$VERSION = '0.07';

use Text::SimpleTable;

sub new {
	my $class = shift;
	my $self = { @_ };

	unless ( exists $self->{tags} ) {
	    $self->{tags} = {
            strong		=> sub { "B<$_[0]>" },
        	italic      => sub { "I<$_[0]>" },
        	strike   	=> sub { "C<--$_[0]-->" },
        	superscript => sub { "($_[0])" },
        	subscript   => sub { "($_[0])" },
        	inline      => sub { "C<$_[0]>" },
        	inline_code => sub { "C<<<$_[0]>>>" },
        	strong_tag  => qr/\*(.+?)\*/,
        	italic_tag  => qr/_(.+?)_/,
        	strike_tag  => qr/\~\~(.+?)\~\~/,
        	superscript_tag => qr/\^(.+?)\^/,
        	subscript_tag   => qr/\,\,(.+?)\,\,/,
        	inline_tag  => qr/\`(.+?)\`/,
            inline_code_tag => qr/\{\{\{(.+?)\}\}\}/,

            link		=> sub {
                my $link = shift;
                return $link if ($link =~ /\]$/); # for [text link], deal later
                ($link, my $title)    = split(/\s+/, $link, 2);
                my $output;
                # it's an image
                if ($link =~ /\.(jpe?g|png|bmp|gif)$/is
                    or ($title and $title =~ /\.(jpe?g|png|bmp|gif)$/is) ) {
                    $output = "=begin html\n\n";
                    if ($title) {
                        $output .= "\n\n";
                    } else {
                        $output .= "\n\n";
                    }
                    $output .= "=end html\n";
                } else {
                    if ($title) {
                        # for [http://search.cpan.org/perldoc?Pod::From::GoogleWiki Pod::From::GoogleWiki]
                        if ($link eq "http://search.cpan.org/perldoc?$title") {
                            $output = "L<$title>";
                        } else {
                            $output = "L<$link|$title>";
                        }
                    } else {
                        $output = "L<$link>";
                    }
                }
                return $output;
            },

            schemas => [ qw( http https ftp mailto gopher ) ],
        };
    }

	return bless $self => $class;
}

sub wiki2pod {
    my ($self, $text) = @_;

    # rest block_mark
    $self->{_block_mark} = {};

    my $tags = $self->{tags};

    my $output = ''; my $do_last_line = 1;
    my @lines = split(/\r?\n/, $text);
    foreach my $line_no ( 0 .. $#lines ) {
        my $line = $lines[$line_no];
        my $pre_line = ($line_no > 0) ? $lines[ $line_no - 1 ] : '';

        # skip some lines
        next if (not $output and $line =~ /^\#/); # like #labels

        # 1, code
        if ( $line =~ /^\}\}\}$/ ) {
            $self->{_block_mark}->{is_code} = 0;
            $do_last_line = 0;
            $output .= "\n" unless ($output =~ /\n{2,}$/);
            next;
        } elsif ( $line =~ /^\{\{\{$/) {
            $self->{_block_mark}->{is_code} = 1;
            $output .= "\n" unless ($output =~ /\n{2,}$/);
            next;
        } elsif ( $self->{_block_mark}->{is_code} ) {
            $output .= "  $line\n" and next;
        }

        # 2, table
        if ( $line =~ /^\|\|(.*?)\|\|$/) {
            if ( $self->{_block_mark}->{in_table} ) {
                push @{ $self->{_block_mark}->{trs} }, $self->format_line($line);
            } else {
                $self->{_block_mark}->{in_table} = 1;
                $self->{_block_mark}->{trs} = [ $self->format_line($line) ];
            }
            if ($line_no == $#lines) { # if that's last line
                $self->{_block_mark}->{in_table} = 0;
                my @trs = @{ $self->{_block_mark}->{trs} };
                $output .= $self->make_table( @trs ) and next;
            } else {
                next;
            }
        } elsif ( $self->{_block_mark}->{in_table} ) {
            $self->{_block_mark}->{in_table} = 0;
            my @trs = @{ $self->{_block_mark}->{trs} };
            $output .= $self->make_table( @trs ) and next;
        }

        if ($line =~ /^\s*$/) { # blank line
            $do_last_line = 1;
            $self->{_block_mark}->{in_list} = 0;
            $output .= "\n" and next;
        }

        # 2, header
        if ($line =~ /^(=+)\s+(.*?)\s+\1\s*$/) {
            my $h_level = length($1);
            my $text    = $self->format_line($2);
            $do_last_line = 0;
            $output .= "\n" unless ($output =~ /\n{2,}$/);
            $output .= "=head$h_level $text\n" and next;
        }

        # 3, list into code needs a newline in front
        if ($line =~ /^\s+[\*|\#]/) {
            unless ( $self->{_block_mark}->{in_list} ) {
                if ($output !~ /\n{2,}$/) {
                    $output .= "\n";
                }
            }
            $self->{_block_mark}->{in_list} = 1;
        }
        if ($line !~ /^\s+/) {
            if ($self->{_block_mark}->{in_list} and $output !~ /\n{2,}$/) {
                $output .= "\n";
            }
            $self->{_block_mark}->{in_list} = 0;
        }

        # at last
        $output .= $self->format_line($line) . "\n";
        $do_last_line = 1;
    }

    if ($do_last_line) {
        my $last_line = 0;
        while ($text =~ s/\n$//isg) {
            $last_line++;
        }
        $output =~ s/\n$//isg;
        $output .= "\n" x $last_line;
    }

    # if list into code, last we need a newline after
    if ($self->{_block_mark}->{in_list} and $output !~ /\n{2,}$/) {
        $output .= "\n";
    }

    return $output;
}

sub format_line {
    my ($self, $line) = @_;

    my $tags = $self->{tags};

    foreach my $type (qw/strong italic strike superscript subscript inline inline_code/) {
        my $sym     = $tags->{"${type}_tag"};
        my $pod_sym = $tags->{$type};
        $line =~ s/$sym/$pod_sym->($1)/eg;
    }

    # deal with link
    my $schemas = join('|', @{$tags->{schemas}});
    $line =~ s!(^|\s+)(($schemas):\S+)!$1 . $tags->{link}->($2)!egi;

    while (my @pieces = $self->find_innermost_balanced_pair( $line, '[', ']' ) ) {
		my ($tag, $before, $after) = map { defined $_ ? $_ : '' } @pieces;
		my $extended               = $tags->{link}->( $tag ) || '';
		$line                      = $before . $extended . $after;
	};

    return $line;
}

sub make_table {
    my ($self, @trs) = @_;

    @trs = map { $_ =~ s/^\|\|(.*?)\|\|$/$1/isg; $_ } @trs;

    my $first_line = shift @trs;
    my @cols = split(/\s*\|\|\s*/, $first_line);
    @cols = map { [ length($_), $_ ] } @cols;

    my $t = Text::SimpleTable->new(@cols);
    foreach my $tr (@trs) {
        $t->row( split(/\s*\|\|\s*/, $tr) );
    }
    return $t->draw;
}

sub find_innermost_balanced_pair {
	my ($self, $text, $open, $close) = @_;

	my $start_pos             = rindex( $text, $open              );
	return if $start_pos == -1;

	my $end_pos               =  index( $text, $close, $start_pos );
	return if $end_pos   == -1;

	my $open_length           = length( $open );
	my $close_length          = length( $close );
	my $close_pos             = $end_pos + $close_length;
	my $enclosed_length       = $close_pos - $start_pos;

	my $enclosed_atom        = substr( $text, $start_pos, $enclosed_length );
	return substr( $enclosed_atom, $open_length, 0 - $close_length ),
	       substr( $text, 0, $start_pos ),
		   substr( $text, $close_pos );
}

1;
__END__