view release on metacpan or  search on metacpan

lib/App/sdview/Parser/Pod.pm  view on Meta::CPAN

field $_curpara;

field %_verbatim_options = ( language => "__AUTO__" );
field %_next_verbatim_options;

field $_conv_nbsp;

method parse_file ( $fh )
{
   push @_indentstack, 0;
   push @_parastack, [];
   $self->SUPER::parse_file( $fh );
   return $_parastack[0]->@*;
}

method parse_string ( $str )
{
   push @_indentstack, 0;
   push @_parastack, [];
   $self->SUPER::parse_string_document ( $str );
   return $_parastack[0]->@*;
}

my %PARA_TYPES = (
   Para     => "App::sdview::Para::Plain",
   Verbatim => "App::sdview::Para::Verbatim",
);

field $_redirect_text;

method start_Document { $self->reset_tags; }

method start_head1 { $self->_start_head( 1 ); }
method start_head2 { $self->_start_head( 2 ); }
method start_head3 { $self->_start_head( 3 ); }
method start_head4 { $self->_start_head( 4 ); }
method _start_head ( $level )
{
   push $_parastack[-1]->@*, $_curpara = App::sdview::Para::Heading->new(
      level => $level,
      text  => String::Tagged->new,
   );
   $self->reset_tags;
}

method start_code { $self->_start_highlighter( \%_next_verbatim_options ); }
method end_code { undef $_redirect_text; }

method start_for ( $attrs )
{
   my $target = $attrs->{target};
   my $code = $self->can( "start_for_$target" ) or return;
   return $self->$code( $attrs );
}
method end_for  { undef $_redirect_text; }

method start_for_highlighter { $self->_start_highlighter( \%_verbatim_options ) }

method start_for_table ( $attrs )
{
   my @spec = split m/\s+/, $attrs->{title} // "";
   $spec[0] = "style=$spec[0]" if @spec and $spec[0] !~ m/=/;
   my %spec = map { m/^(.*?)=(.*)$/ ? ( $1, $2 ) : () } @spec;

   my $style = $spec{style} // "md";

   $style eq "md" and
      $_redirect_text = \&_handle_text_table_md, return;
   $style eq "mediawiki" and
      $_redirect_text = \&_handle_text_table_mediawiki, return;

   warn "TODO unrecognised table style $style\n";
}

method _start_highlighter ( $options )
{
   $_redirect_text = method ( $text ) {
      my @args = split m/\s+/, $text;
      $args[0] = "language=$args[0]" if @args and $args[0] !~ m/=/;

      %$options = ();

      foreach ( @args ) {
         my ( $key, $val ) = m/^(.*?)=(.*)$/ or next;
         $options->{$key} = $val;
      }
   };
}

method start_S {       $_conv_nbsp = 1; }
method end_S   { undef $_conv_nbsp; }

role App::sdview::Parser::Pod::_TagHandler {
   ADJUST {
      $self->nix_X_codes( 1 );
      $self->accept_codes(qw( U ));
   }

   field %_curtags :reader;
   method reset_tags { %_curtags = (); }

   method start_B {        $_curtags{bold}++ }
   method end_B   { delete $_curtags{bold}   }
   method start_I {        $_curtags{italic}++ }
   method end_I   { delete $_curtags{italic}   }
   method start_U {        $_curtags{underline}++ }
   method end_U   { delete $_curtags{underline}   }
   method start_C {        $_curtags{monospace}++ }
   method end_C   { delete $_curtags{monospace}   }
   method start_F {        $_curtags{file}++ }
   method end_F   { delete $_curtags{file}   }

   method start_L ( $attrs )
   {
      my $uri = $attrs->{to};
      # TODO: more customizable
      if( defined $uri and $uri !~ m(^\w+://) ) {
         $uri = "https://metacpan.org/pod/$uri";
      }
      $_curtags{link} = { uri => $uri };
   }
   method end_L { delete $_curtags{link} }
}

apply App::sdview::Parser::Pod::_TagHandler;

method start_over_block ( $attrs )
{
   push @_indentstack, $_indentstack[-1] + $attrs->{indent};
}
method end_over_block
{
   pop @_indentstack;
}

method start_over_number ( $attrs ) { $self->_start_over( number => $attrs ); }
method start_over_bullet ( $attrs ) { $self->_start_over( bullet => $attrs ); }
method start_over_text   ( $attrs ) { $self->_start_over( text   => $attrs ); }

lib/App/sdview/Parser/Pod.pm  view on Meta::CPAN

}

method start_Verbatim
{
   push $_parastack[-1]->@*, $_curpara = App::sdview::Para::Verbatim->new(
      text   => String::Tagged->new,
      indent => $_indentstack[-1],
      ( %_verbatim_options, %_next_verbatim_options ),
   );
   $self->reset_tags;
   %_next_verbatim_options = ();
}
method end_Verbatim
{
   my $para = $_parastack[-1][-1];
   my @lines = $para->text->split( qr/\n/ );

   my $trimlen = min map { m/^(\s*)/; $+[1] } grep { length } @lines;

   length and $_ = $_->substr( $trimlen, length $_ ) for @lines;

   my $text = shift @lines;
   $text .= "\n" . $_ for @lines;

   my $language = $para->language;
   if( ( $language // "" ) eq "__AUTO__" ) {
      # Try to detect the language. It doesn't have to be perfect, just a good
      # guess is enough.
      undef $language;

      if( $text =~ m/^use [A-Za-z_]|^package [A-Za-z_]/ ) {
         $language = "perl";
      }
      elsif( $text =~ m/^(my )?[\$\@%][A-Za-z_]/m ) {
         $language = "perl";
      }
      elsif( $text =~ m/^#!.*\bperl\b/ ) {
         $language = "perl";
      }
   }

   $_parastack[-1][-1] = (ref $para)->new(
      text     => $text,
      language => $language,
   );
}

method handle_text ( $text )
{
   if( $_redirect_text ) {
      return $self->$_redirect_text( $text );
   }

   $text =~ s/ /\xA0/g if $_conv_nbsp;

   $_curpara->append_text( $text, $self->curtags );
}

method _handle_text_table_md ( $text )
{
   my @lines = split m/\n/, $text
      or return;

   my @rows;
   push @rows, _split_table_row( shift @lines );

   my $heading = !!0;
   my @align;
   my $alignspec = _split_table_row( shift @lines );
   if( all { $_ =~ m/^(:?)-{3,}(:?)$/ } @$alignspec ) {
      $heading = !!1;
      @align = map {
         m/^(:?)-{3,}(:?)$/;
         ( $1 and $2 ) ? "centre" :
         ( $2        ) ? "right" :
                         "left";
      } @$alignspec;
   }
   else {
      push @rows, $alignspec;
      @align = ( "left" ) x scalar @$alignspec;
   }

   push @rows, map { _split_table_row( $_ ) } @lines;

   foreach my $row ( @rows ) {
      @$row = map {
         my $colidx = $_;
         App::sdview::Para::TableCell->new(
            align => $align[$colidx],
            heading => $heading,
            text  => $row->[$colidx],
         )
      } keys @$row;
      $heading = !!0;
   }

   push $_parastack[-1]->@*, App::sdview::Para::Table->new(
      rows => \@rows
   );
}

sub _split_table_row ( $str )
{
   # Leading/trailing pipes are optional
   $str =~ s/^\s*\|//;
   $str =~ s/\|\s*$//;

   my @cols = split m/\|/, $str;
   s/^\s+//, s/\s+$// for @cols;

   # TODO: Find out why these parsers aren't reusable
   $_ = App::sdview::Parser::Pod::_TableCellParser->new->parse_string( $_ ) for @cols;

   return \@cols;
}

method _handle_text_table_mediawiki ( $text )
{
   my @lines = split m/\n/, $text
      or return;

   my @rows;
   foreach my $line ( @lines ) {
      $line =~ m/^\|-/ and
         push @rows, [] and next;

      $line =~ s/^([!|])\s*// or
         warn "Unsure what to do with line $line" and next;
      my $chr = $1;
      my $heading = ( $chr eq "!" );

      foreach my $cell ( split m/\s*\Q$chr$chr\E\s*/, $line ) {
         @rows or push @rows, [];
         push $rows[-1]->@*, App::sdview::Para::TableCell->new(
            align => "left", # TODO
            heading => $heading,
            text => App::sdview::Parser::Pod::_TableCellParser->new->parse_string( $cell ),
         );
      }
   }

   push $_parastack[-1]->@*, App::sdview::Para::Table->new(
      rows => \@rows,
   );
}

class App::sdview::Parser::Pod::_TableCellParser
{
   inherit Pod::Simple::Methody;
   apply App::sdview::Parser::Pod::_TagHandler;

   field $body;

   method parse_string ( $str )
   {
      $body = String::Tagged->new;

      # Protect a leading equals sign
      $str =~ s/^=/E<61>/;

      $self->SUPER::parse_string_document( "=pod\n\n$str" );

      return $body;
   }

   method handle_text ( $text )
   {
      $body->append_tagged( $text, $self->curtags );
   }
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;