#===============================================================================
#
# DESCRIPTION: Test format codes
#
# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
#===============================================================================
package main;
use strict;
use warnings;
use Data::Dumper;
use v5.10;
use Regexp::Grammars;
use Perl6::Pod::Codeactions;
use Perl6::Pod::Grammars;
use Test::More tests => 16; # last test to print
my %delim = ( '<' => '>', '«' => '»', '<<' => '>>' );
my %allow = ( '*' => 1 );
my $r = qr{
<extends: Perl6::Pod::Grammar::FormattingCodes>
<matchline>
# <debug:step>
\A <Text> \Z
<token: Text> <[content]>+
<token: text> .+?
<token: hs>[ \t]*
<token: content> <MATCH=C_code>
| <MATCH=D_code>
| <MATCH=L_code>
| <MATCH=X_code>
| <MATCH=P_code>
| <MATCH=default_formatting_code>
| <.text>
<token: ldelim> <%delim>
<token: rdelim> (??{ quotemeta $delim{$ARG{ldelim}} })
<token: isValideFCode>
<require: (?{
( $ARG{name} && ( $ARG{name} eq uc($ARG{name} ) ) )
&&
( exists $allow{'*'} || exists $allow{$ARG{name}} )
})>
<rule: C_code>(?! \s+)
<name=([C])><isValideFCode(:name)>
<ldelim> <content=( .*? )> <rdelim(:ldelim)>
<rule: D_code>(?! \s+)
<name=([D])><isValideFCode(:name)>
<ldelim> <term=([^\|]*?)> (?: \| <[syns=(\S+)]>+ % ;)? <rdelim(:ldelim)>
<rule: LL_code>(?! \s+)
<name=(L)><isValideFCode(:name)>
<ldelim> <content=(.*?)> <rdelim(:ldelim)>
<rule: L_code>(?! \s+)
# <ws: ( [^\n] | \s++ )* >
<ws: ([ \t])*>
# <ws: (?: [^\n]|\s+)* >
<name=(L)><isValideFCode(:name)>
<ldelim>
#alternate presentation
(?: <alt_text=([^\n\|]*?)> \| )? #hack1: not work for
#L< http://cpan.org > B<sd > L< haname | http:perl.html >
# '' => 'L< http://cpan.org > B<sd > L< haname | http:perl.html >'
# (?:<alt_text=(.*?)>)? #hack
<scheme=([^|\s:]+:)>? #scheme specifier
(?: <is_external=(//)> )?
<address=([^\|]*?)>? #for hack1
(?: \# <section=(.*?)> )? #internal addresses
<rdelim(:ldelim)>
<rule: X_code_entry> <[entry=([^,\;]+?)]>* % (\s*,\s*)
<rule: X_code>(?! \s+)
<name=(X)><isValideFCode(:name)>
<ldelim>
# X<text>
( <text=([^\n\|]*?)>(?{$MATCH{entry}=$MATCH{text}; $MATCH{form} = 1 })
|
<text=([^\n\|]*?)>? \| <[entries=X_code_entry]>* % (\s*\;\s*)
(?{$MATCH{form} = 2})
)
<rdelim(:ldelim)>
<rule: P_code>
<name=(P)><isValideFCode(:name)>
<ldelim> <.hs>
<scheme=([^|\s:]+:)>? #scheme specifier
(?: <is_external=(//)> )?
<address=([^\|]*?)>
<.hs> <rdelim(:ldelim)>
<token: default_formatting_code>
<name=(\w)><isValideFCode(:name)>
<ldelim> <.hs> <[content]>*? <.hs> <rdelim(:ldelim)>
}xms;
sub parse_para {
my $src = shift;
use Perl6::Pod::Utl;
return Perl6::Pod::Utl::parse_para($src, reg=>$r);
}
my @t;
my $STOP_TREE = 2;
@t = ( ' sd C<<<s B<s>>ss» sB<d>' );
@t=('D<test>, and D<word | synonym1 ;synonym2>');
@t=('C<as> asds B<asdasI<d>sad >');
my @grammars;
#### test L<>
is parse_para('L<http://example.com>')->[0]->{scheme},'http:', 'L: scheme http://example.com';
#=pod
my $t1 = parse_para('L<http://example.com/test#test>')->[0];
#print Dumper $t1;exit;
is $t1->{section}, 'test', 'L: section';
ok $t1->{is_external}, 'L: external';
$t1 = parse_para('L<#test>')->[0];
is $t1->{section}, 'test', 'L: only section';
$t1 = parse_para('L<text | #test>')->[0];
is $t1->{alt_text}, 'text', 'L: alternate text';
$t1 = parse_para('L<mailto:devnull@rt.cpan.org>')->[0];
is $t1->{scheme},'mailto:','L: mailto';
$t1 = parse_para('L<issn:1087-903X>')->[0];
is $t1->{scheme},'issn:','L: issn';
$t1 = parse_para('L<OK |file://sdsd/config#test>')->[0];
is $t1->{scheme},'file:','L: file';
$t1 = parse_para('L<file:./cpan.org >
B<sd > L<< haname | http:perl.html >>')->[0];
is $t1->{scheme},'file:','L: L<> L<|>';
$t1 = parse_para('L<B<test1>|http://example.com> test')->[0];
is $t1->{alt_text}, 'B<test1>','nested formatting codes';
$t1 = parse_para('X< array >')->[0];
is $t1->{text}, $t1->{entry}, 'X<array>';
is $t1->{text}, 'array', 'check text X<array>';
$t1 = parse_para('X< arrays | array1, array2; use array >')->[0];
is @{$t1->{entries}}, 2, "more than one entries";
is $t1->{text}, 'arrays', 'check text: X< arrays | array1, array2; use array >';
$t1 = parse_para('X<| array1, array2; use array >')->[0];
is $t1->{text},'', 'empty text';
$t1 = parse_para('P<http://example.com>')->[0];
is $t1->{'scheme'},'http:', 'P: scheme';
#diag Dumper $t1;
#diag Dumper $t1;
#diag Dumper parse_para('L<http://example.com/test#test>');
#diag Dumper parse_para('C«E<nbsp>»');
exit;
#@t = ();
@grammars = @t if scalar(@t);
while ( my ( $src, $extree, $name ) = splice( @grammars, 0, 3 ) ) {
$name //= $src;
my $dump;
use Perl6::Pod::Utl;
my $res = Perl6::Pod::Utl::parse_para($src, reg=>$r);
diag Dumper $res; exit;
# use Perl6::Pod::Autoactions;
# if ( $src =~ $r->with_actions( Perl6::Pod::Codeactions->new ) ) {
if ( $src =~ $r ) {
if ( $STOP_TREE == 2 ) { say Dumper( {%/}->{Text} ); exit; }
# $dump = Perl6::Pod::To::Dump->new->visit( {%/}->{File} );
}
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 Deeeple" . Dumper( $dump, $extree, ); exit; };
}