######################### # Test pod blocks # package Perl6::Pod::To::Dump; use base 'Perl6::Pod::Utl::AbstractVisiter'; use strict; use warnings; sub new { my $class = shift; my $self = bless( ( $#_ == 0 ) ? shift : {@_}, ref($class) || $class ); $self; } sub _dump_ { my $self = shift; my $el = shift; ( my $type = ref($el) ) =~ s/.*:://; my %dump = ( class => $type ); unless ( UNIVERSAL::isa( $el, 'Perl6::Pod::Lex::Block' ) || ref($el) eq 'HASH' ) { use Data::Dumper; die "NOT VALIDE" . Dumper($el); } $dump{name} = $el->{name} if exists $el->{name}; $dump{block_name} = $el->{block_name} if exists $el->{block_name}; $dump{encode_name} = $el->{encode_name} if exists $el->{encode_name}; $dump{alias_name} = $el->{alias_name} if exists $el->{alias_name}; $dump{level} = $el->{level} if exists $el->{level}; if ( my $attr = $el->{attr} ) { # my @attr_dump = map { $_->dump() } @$attr; my @attr_dump = map { my $value = $_->{items}; if ( $_->{type} eq 'hash' ) { my %hash = (); foreach my $item ( @{$value} ) { $hash{ $item->{key} } = $item->{value}; } $value = \%hash; } { name => $_->{name}, value => $value } } @$attr; if (@attr_dump) { $dump{attr} = \@attr_dump; } } unless ( UNIVERSAL::can( $el, 'childs' ) ) { use Data::Dumper; die 'bad element: ' . Dumper($el); } if ( my $content = $el->childs ) { warn Dumper($el) unless ref($content) eq 'ARRAY'; $dump{content} = [ map { ref($_) ? $self->_dump_($_) : $_ =~ /^\s+/ ? 'CODE' : 'TEXT' } @{ $el->childs } ]; } \%dump; } sub __default_method { my $self = shift; my $n = shift; if ( ref($n) and ( ref($n) eq 'ARRAY' ) ) { return [ map { $self->_dump_($_) } @{$n} ]; } return $self->_dump_($n); } 1; package main; use strict; use warnings; use Test::More tests => 13; # last test to print use Perl6::Pod::Utl; use Perl6::Pod::Lex; use v5.10; use Data::Dumper; my $r = do { use Regexp::Grammars; use Perl6::Pod::Grammars; qr{ # \A \Z }xms; }; my @t; my $STOP_TREE = 1; @t = ( ' text =begin pod =for Test :1 bracket sequence. For example: =end pod ' ); package main; $STOP_TREE = 2; $STOP_TREE = 0; @t = (); my @grammars = ( '=begin pod =for item dd d sdsdsd =end pod ', [ { 'content' => [ { 'content' => ['TEXT'], 'name' => 'item', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], '=pod + text', '=begin pod =begin para =end para =end pod ', [ { 'content' => [ { 'name' => 'para', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], 'para insite =pod', '=begin pod =begin para =begin para text =end para =end para =end pod ', [ { 'content' => [ { 'content' => [ { 'content' => ['TEXT'], 'name' => 'para', 'class' => 'Block' } ], 'name' => 'para', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], 'para inside para', '=begin pod =begin Sode asd =end Sode =begin code asd =end code asdasd =end pod ', [ { 'content' => [ { 'content' => ['CODE'], 'name' => 'Sode', 'class' => 'Block' }, { 'content' => ['CODE'], 'name' => 'code', 'class' => 'Block' }, { 'content' => ['TEXT'], 'name' => 'para', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], 'raw content', '=begin pod =for Para asd =for code sd =for para re =end pod ', [ { 'content' => [ { 'content' => ['TEXT'], 'name' => 'Para', 'class' => 'Block' }, { 'content' => ['TEXT'], 'name' => 'code', 'class' => 'Block' }, { 'content' => ['TEXT'], 'name' => 'para', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], 'paragraph_block (with text and raw)', '=begin pod :test = :t :r[1,2, "r"] :s<1 2 3322> = :!t d =end pod ', [ { 'content' => [ { 'content' => ['TEXT'], 'name' => 'para', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block', 'attr' => [ { 'value' => 1, 'name' => 'test' }, { 'value' => 1, 'name' => 't' }, { 'value' => [ '1', '2', 'r' ], 'name' => 'r' }, { 'value' => [ '1', '2', '3322' ], 'name' => 's' }, { 'value' => 0, 'name' => 't' } ] } ], 'attributes', '=begin pod :r :name{ t=>1, t2=>1} s =end pod ', [ { 'content' => [ { 'content' => ['TEXT'], 'name' => 'para', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block', 'attr' => [ { 'value' => 'test', 'name' => 'r' }, { 'value' => { 't2' => '1', 't' => '1' }, 'name' => 'name' } ] } ], 'attrs: hash', '=begin pod =begin OO ed =end OO sdsd d sdsdsds =end pod ', [ { 'content' => [ { 'content' => [ { 'content' => [ 'CODE' ], 'name' => 'code', 'class' => 'Block' } ], 'name' => 'OO', 'class' => 'Block' }, { 'content' => [ 'TEXT' ], 'name' => 'para', 'class' => 'Block' }, { 'content' => [ 'CODE' ], 'name' => 'code', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], 'text and verbatim blocks', 'some parar parapar =begin pod asdasd =end pod ', [ { 'content' => [ { 'content' => ['TEXT'], 'name' => 'para', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], 'ambient text', '=begin pod =begin para =config name :like = :t =end para =end pod ', [ { 'content' => [ { 'content' => [ { 'block_name' => 'name', 'name' => 'config', 'class' => 'Block', 'attr' => [ { 'value' => 'head1', 'name' => 'like' }, { 'value' => 1, 'name' => 't' } ] } ], 'name' => 'para', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], '=config directive', '=begin pod =encoding Macintosh =encoding KOI8-R =end pod ', [ { 'content' => [ { 'encode_name' => 'Macintosh', 'name' => 'encoding', 'class' => 'Block' }, { 'encode_name' => 'KOI8-R', 'name' => 'encoding', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], '=encoding directive', '=begin pod =alias PROGNAME Earl Irradiatem Eventually = =item Also text =end pod ', [ { 'content' => [ { 'alias_name' => 'PROGNAME', 'name' => 'alias', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' } ], '=alias directive' ); @grammars = @t if scalar(@t); while ( my ( $src, $extree, $name ) = splice( @grammars, 0, 3 ) ) { $name //= $src; my $dump; if ( $src =~ $r ) { my $tree = Perl6::Pod::Lex->new->make_tree( $/{File} ); if ( $STOP_TREE == 2 ) { say Dumper($tree); exit; } $dump = Perl6::Pod::To::Dump->new->visit($tree); } else { fail($name); die "Can't parse: \n" . $src; } if ( $STOP_TREE == 1 ) { say Dumper($dump); exit; } is_deeply( $dump, $extree, $name ) || do { say "fail deeply" . Dumper( $dump, $extree, ); exit; }; } #check not ambient @grammars = ( 'para texxt =begin pod text =end pod codesd ', [ { 'content' => ['TEXT'], 'name' => 'para', 'class' => 'Block' }, { 'content' => [ { 'content' => ['TEXT'], 'name' => 'para', 'class' => 'Block' } ], 'name' => 'pod', 'class' => 'Block' }, { 'content' => ['CODE'], 'name' => 'code', 'class' => 'Block' } ], 'check default pod content' ); while ( my ( $src, $extree, $name ) = splice( @grammars, 0, 3 ) ) { $name //= $src; my $dump; if ( $src =~ $r ) { my $tree = Perl6::Pod::Lex->new(default_pod=>1)->make_tree( $/{File} ); if ( $STOP_TREE == 2 ) { say Dumper($tree); exit; } $dump = Perl6::Pod::To::Dump->new->visit($tree); } else { fail($name); die "Can't parse: \n" . $src; } if ( $STOP_TREE == 1 ) { say Dumper($dump); exit; } is_deeply( $dump, $extree, $name ) || do { say "fail deeply" . Dumper( $dump, $extree, ); exit; }; }