File Coverage

lib/Mediawiki/POD.pm

Criterion	Covered	Total	%
statement	92	99	92.9
branch	20	28	71.4
condition			n/a
subroutine	8	9	88.8
pod	4	4	100.0
total	124	140	88.5

package Mediawiki::POD;

our $VERSION = '0.06';

use strict;
use Pod::Simple::HTML;
use Mediawiki::POD::HTML;

sub new
  {
  my $class = shift;

  my $self = bless {}, $class;

  # some defaults
  $self->{remove_newlines} = 1;
  $self->{body_only} = 1;

  $self;
  }

sub remove_newlines
  {
  my $self = shift;

  $self->{remove_newlines} = ( $_[0] ? 1 : 0 ) if @_ > 0;
  $self->{remove_newlines};
  }

sub body_only
  {
  my $self = shift;

  $self->{body_only} = ( $_[0] ? 1 : 0 ) if @_ > 0;
  $self->{body_only};
  }

sub as_html
  {
  my ($self, $input) = @_;

  my $parser = Mediawiki::POD::HTML->new();

  my ($html, $headlines);

  $parser->output_string( \$html );

  $parser->parse_string_document( $input );

  # remove form-feeds and tabs
  $html =~ s/[\f\t]+//g;

  # remove comments
  $html =~ s///g;

  if ($self->{body_only})
    {
    # remove the unwanted HTML sections
    $html =~ s/(.|\n)*<\/head>//;

    $html =~ s/<\/?(html|body).*?>//g;
    }

  # clean up some crazy tags
  # converting "" to "
  $html =~ s/<(pre|code|p)\s.*?>/<$1>/g;

  # insert a class for
  $html =~ s/
70

  # make it readable again :)
  $html =~ s/\'/'/g;
  $html =~ s/\"/"/g;

  # remove empty paragraphs before a closing  (for instance for X keywords)
  $html =~ s/<\/p>\n<\/div>/<\/div>/g;

  # if the last item is a keyword, we need to add a closing
  $html =~ s/<\/p>\s*\z/<\/div>/;

  # make '>"foo"' to '>foo'
  $html =~ s/class="podlinkpod"\s*>"(.*?)"<\/a>/class="podlinkpod">$1<\/a>/g;

  # convert newlines between  tags to
  # remove all new lines and tabs
  $html = $self->_parse_output($html) if $self->{remove_newlines};

  $html = $self->_generate_toc( $parser->get_headlines() ) . $html;

  # return the result
  $html;
  };

###########################################################################
# We need to remove all new lines, other Mediawiki will insert spurious
# linebreaks. However, inside  we need to replace them with
#  so that verbatim sections render properly. A nested regexp could
# solve this, but is not possible. So we implement a very basic parser
# that recognizes three things: , , anything else.

# This routine assumes that the  tags are not nested.

sub _parse_output
  {
  my ($self, $input) = @_;

  my $in_pre = 0;

  my $qr_tag = qr/^(<\w+(.|\n)*?>)/;
  my $qr_end_tag = qr/^(<\/\w+>)/;
  my $qr_else = qr/^((?:.|\n)+?)(<|\z)/;

  my $last_len = 1;
  my $output = '';
  while (length($input) > 0)
    {
    $last_len = length($input);
    # math the start of the input, and remove the matching part
    if ($input =~ $qr_tag)
      {
      $input =~ s/$qr_tag//;
      my $tag = $1;
      $tag =~ s/[\n\r\t]/ /g;
      $output .= $tag;
      if ($tag =~ /^/i)
        {
	$in_pre++;
	}
      }
    elsif ($input =~ $qr_end_tag)
      {
      $input =~ s/$qr_end_tag//;
      my $tag = $1;
      $tag =~ s/[\n\r\t]/ /g;
      $output .= $tag;
      if ($tag =~ /^<\/pre.*?>/i)
        {
	$in_pre--;
	}
      }
    else
      {
      $input =~ s/$qr_else/$2/;
      # remove newlines
      my $else = $1;
      if ($in_pre > 0)
        {
        # also remove excessive leading whitespace
        $else =~ s/[\n\r\t]\s*/ /g;
        $else =~ s/^\s*/ /;
        }
      else
        {
        $else =~ s/[\n\r\t]/ /g;
        }
      $output .= $else;
      }
    }
  $output;
  }

sub _generate_toc
  {
  my ($self, $headlines) = @_;

  my $toc = 'Contents'; 




167




5





 





 





 





 





13



   $toc .= "\n\n"; 




168




 





 





 





 





 





 



   




169




5





 





 





 





 





13



   my $level = 1; 




170




5





 





 





 





 





15



   my @cur_nr = ( 0 ); 




171




5





 





 





 





 





15



   for my $headline (@$headlines) 




172




 





 





 





 





 





 



     { 




173




7





 





 





 





 





31



     $headline =~ /^head([1-9]) (.*)/; 




174




 





 





 





 





 





 



   




175




7





 





 





 





 





21



     my $cur_level = $1; 




176




7





 





 





 





 





17



     my $txt = $2; 




177




7





 





 





 





 





13



     my $link = $txt; $link =~ s/ /_/g; $link =~ s/"<>//g; 




 




7





 





 





 





 





16



   




 




7





 





 





 





 





14



   




178




 





 





 





 





 





 



     #print STDERR "$headline $cur_level $level\n"; 




179




 





 





 





 





 





 



   




180




 





 





 





 





 





 



     # we enter a scope 




181




7




  
100
  




 





 





 





42



     if ($cur_level > $level) 




 




 




  
 50
  




 





 





 





 



   




182




 





 





 





 





 





 



       { 




183




2





 





 





 





 





4



       my $levels_up = $cur_level - $level; 




184




2





 





 





 





 





8



       for (1..$levels_up) 




185




 





 





 





 





 





 



 	{ 




186




2





 





 





 





 





4



 	push @cur_nr, 0; 




187




2





 





 





 





 





6



 	$toc .= ''; 




188




 





 





 





 





 





 



 	} 




189




 





 





 





 





 





 



       } 




190




 





 





 





 





 





 



     elsif ($cur_level < $level) 




191




 





 





 





 





 





 



       { 




192




0





 





 





 





 





0



       my $levels_down = $level - $cur_level; 




193




0





 





 





 





 





0



       for (1..$levels_down) 




194




 





 





 





 





 





 



         { 




195




0





 





 





 





 





0



         pop @cur_nr; 




196




0





 





 





 





 





0



         $toc .= ''; 




197




 





 





 





 





 





 



         } 




198




 





 





 





 





 





 



       } 




199




7





 





 





 





 





15



     $cur_nr[-1]++; 




200




7





 





 





 





 





30



     my $tnr = join ('.', @cur_nr); 




201




7





 





 





 





 





32



     $toc .= "$tnr $txt\n"; 




202




7





 





 





 





 





20



     $level = $cur_level; 




203




 





 





 





 





 





 



     } 




204




 





 





 





 





 





 



   




205




5





 





 





 





 





16



   $toc .= "\n";
  $toc .= "\n\n";

  my $level = 1;
  my @cur_nr = ( 0 );
  for my $headline (@$headlines)
    {
    $headline =~ /^head([1-9]) (.*)/;

    my $cur_level = $1;
    my $txt = $2;
    my $link = $txt; $link =~ s/ /_/g; $link =~ s/"<>//g;
    #print STDERR "$headline $cur_level $level\n";

    # we enter a scope
    if ($cur_level > $level)
      {
      my $levels_up = $cur_level - $level;
      for (1..$levels_up)
	{
	push @cur_nr, 0;
	$toc .= '';
	}
      }
    elsif ($cur_level < $level)
      {
      my $levels_down = $level - $cur_level;
      for (1..$levels_down)
        {
        pop @cur_nr;
        $toc .= '';
        }
      }
    $cur_nr[-1]++;
    my $tnr = join ('.', @cur_nr);
    $toc .= "$tnr $txt\n";
    $level = $cur_level;
    }

  $toc .= "
  $toc .= '' . "\n" . </td>
</tr>

<tr>
<td  class="h" >
<a name="207">207</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> 	  'if (window.showTocToggle) {var tocShowText="show";var tocHideText="hide";showTocToggle();}' . </td>
</tr>

<tr>
<td  class="h" >
<a name="208">208</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> 	  "\n\n";

  $toc =~ s/[\n\r\t]/ /g if $self->{remove_newlines};
  $toc;
  }

1;

__END__