view release on metacpan or  search on metacpan

lib/Pod/From/GoogleWiki.pm  view on Meta::CPAN

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 .= "<a href='$link'><img src='$title' /></a>\n\n";
                    } else {
                        $output .= "<img src='$link' />\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;
        }