File Coverage

blib/lib/Perl6/Pod/Test.pm

Criterion	Covered	Total	%
statement	37	57	64.9
branch	0	8	0.0
condition	0	6	0.0
subroutine	13	14	92.8
pod			n/a
total	50	85	58.8

package Perl6::Pod::To::Test;
our $VERSION = '0.01';
use strict;
use warnings;
use Perl6::Pod::To;
use base 'Perl6::Pod::To';
sub __default_method {
    my $self   = shift;
    my $n      = shift;
    unless (defined $n) {
    warn "default" . $n;
    use Data::Dumper;
    warn Dumper([caller(0)]);
    }

    #detect output format
    # Perl6::Pod::To::DocBook -> to_docbook
    my $export_method ='to_xhtml';
    unless ( $export_method && UNIVERSAL::can($n, $export_method) ) {
    my $method = $self->__get_method_name($n);
    die ref($self)
      . ": Method '$method' for class "
      . ref($n)
      . " not implemented. But also can't found export method ". ref($n) . "::$export_method";
    }
    #call method for export
    $n->$export_method($self);
   #src_name may be not eq for name
    # ie/ item2, head5
    my $name = $n->{name};
    if (UNIVERSAL::isa($n, 'Perl6::Pod::FormattingCode')) {
        $name = "$name<>";
    }
    push @{ $self->{ $name }}, $n;
    if ( exists ($n->{src_name}) && ($name ne  $n->{src_name}) ) {
       push @{ $self->{ $n->{src_name} }}, $n;
    }
}

package Perl6::Pod::Test;
our $VERSION = '0.01';

=pod

=head1 NAME

Perl6::Pod::Test - test lib

=head1 SYNOPSIS


=head1 DESCRIPTION

=cut
use strict;
use warnings;

use Test::More;
use Perl6::Pod::Writer;

use Perl6::Pod::To::DocBook;
use Perl6::Pod::To::XHTML;
use Perl6::Pod::To::Latex;
use XML::Flow;

sub parse_to_docbook {
    shift if ref($_[0]);
    my ( $text) = @_;
    my $out    = '';
    open( my $fd, ">", \$out );
    my $renderer = new Perl6::Pod::To::DocBook::
      writer  => new Perl6::Pod::Writer( out => $fd, escape=>'xml' ),
      out_put => \$out,
      doctype => 'chapter',
      header => 0;
    $renderer->parse( \$text, default_pod=>1 );
    return wantarray ? (  $out, $renderer  ) : $out;

}


sub parse_to_latex {
    shift if ref($_[0]);
    my ( $text) = @_;
    my $out    = '';
    open( my $fd, ">", \$out );
    my $renderer = new Perl6::Pod::To::Latex::
      writer  => new Perl6::Pod::Writer::Latex( out => $fd, escape=>'latex' ),
      out_put => \$out,
      header => 0;
    $renderer->parse( \$text, default_pod=>1 );
    return wantarray ? (  $out, $renderer  ) : $out;
}

sub parse_to_xhtml {
    shift if ref($_[0]);
    my ( $text) = @_;
    my $out    = '';
    open( my $fd, ">", \$out );
    my $renderer = new Perl6::Pod::To::XHTML::
      writer  => new Perl6::Pod::Writer( out => $fd, escape=>'xml' ),
      out_put => \$out,
      doctype => 'xhtml',
      header => 0;
    $renderer->parse( \$text, default_pod=>1 );
    return wantarray ? (  $out, $renderer  ) : $out;
}

sub parse_to_test {
    shift if ref($_[0]);
    my ( $text, %args) = @_;
    my $out    = '';
    open( my $fd, ">", \$out );
    my $renderer = new Perl6::Pod::To::Test::
      writer  => new Perl6::Pod::Writer( out => $fd, escape=>'xml' ),
      out_put => \$out,
      doctype => 'xhtml',
      header => 0;
    $renderer->parse( \$text, default_pod=>1 ) unless exists $args{no_parse};
    return wantarray ? (  $out, $renderer  ) : $renderer;

}
sub new {
    my $class = shift;
    $class = ref $class if ref $class;
    my $self = bless( {@_}, $class );
    return $self;
}


=head2 is_deeply_xml ,,"text"

Check xml without attribute values and character data

=cut

sub _xml_to_ref {

    #    my $self = shift;
    my $xml = shift;
    my %tags;

    #collect tags names;
    map { $tags{$_}++ } $xml =~ m/<(\w+)/gis;

    #make handlers
    our $res;
    for ( keys %tags ) {
        my $name = $_;
        $tags{$_} = sub {
            my $attr = shift || {};
            return $res = {
                name    => $name,
                attr    => [ keys %$attr ],
                content => [ grep { ref $_ } @_ ]
            };
          }
    }
    my $rd = new XML::Flow:: \$xml;
    $rd->read( \%tags );
    $res;
}

sub xml_ref {
    my $self = shift;
    my $xml  = shift;
    my %tags;

    #collect tags names;
    map { $tags{$_}++ } $xml =~ m/<(\w+)/gis;

    #make handlers
    our $res;
    for ( keys %tags ) {
        my $name = $_;
        $tags{$_} = sub {
            my $attr = shift || {};
            return $res = {
                name    => $name,
                attr    => $attr,
                content => [ grep { ref $_ } @_ ]
            };
          }
    }
    my $rd = new XML::Flow:: \$xml;
    $rd->read( \%tags );
    $res;

}

sub is_deeply_xml {
    my $test = shift;
    my ( $got, $exp, @params ) = @_;
    unless ( is_deeply $test->xml_ref($got), $test->xml_ref($exp), @params ) {
        diag "got:", "<" x 40;
        diag $got;
        diag "expected:", ">" x 40;
        diag $exp;

    }
}

1;