Skip to content
Browse files

add type of block; disable autoaction

  • Loading branch information...
1 parent 785b853 commit ef32b75ba5103c670e393d5cd5d58f49164bc8cd Aliaksandr Zahatski committed Apr 26, 2012
Showing with 147 additions and 13 deletions.
  1. +5 −5 lib/Perl6/Pod/Autoactions.pm
  2. +6 −2 lib/Perl6/Pod/Grammars.pm
  3. +5 −2 lib/Perl6/Pod/Utl.pm
  4. +1 −1 scripts/pod6any
  5. +130 −3 t/02.reg.t
View
10 lib/Perl6/Pod/Autoactions.pm
@@ -108,16 +108,16 @@ sub make_block {
#is first para if item|defn ?
my $is_first = 1;
- warn "###do for pod".Dumper (\%ref) if $name eq 'pod';
+# warn "###do for pod".Dumper (\%ref) if $name eq 'pod';
#convert paragraph's to blocks
foreach my $node (@$childs) {
next
unless UNIVERSAL::isa( $node, 'Perl6::Pod::Lex::Text' )
|| UNIVERSAL::isa( $node, 'Perl6::Pod::Lex::RawText' );
- if ( $node->{matchline} == 21 ) {
-# warn Dumper( [ map {[caller($_)]} (0..2)]);
-# warn "*** $name". Dumper (\%ref)
- }
+# if ( $node->{matchline} == 21 ) {
+## warn Dumper( [ map {[caller($_)]} (0..2)]);
+## warn "*** $name". Dumper (\%ref)
+# }
my $content = delete $node->{''};
use Perl6::Pod::Utl;
#remove virual margin
View
8 lib/Perl6/Pod/Grammars.pm
@@ -18,7 +18,7 @@ qr{
<token: newline> <.hs1>* \n
<token: emptyline> ^ <.hs> \n
- <rule: File><[content=block_content]>+
+ <rule: File>(?{$MATCH{type}="file"})<[content=block_content]>+
<rule: directives> begin | for | END | end | config
<rule: raw_content_blocks>
code
@@ -36,7 +36,7 @@ qr{
(?{ $MATCH{type} = "raw"})
<rule: block_content>
- <MATCH=paragraph_block>
+ <MATCH=paragraph_block>
| <MATCH=delimblock_raw>
| <MATCH=delimblock>
| <MATCH=config_directive>
@@ -94,6 +94,7 @@ qr{
})
<token: delimblock_raw> <matchpos><matchline>
+ (?{ $MATCH{type} = "block"})
^ <spaces=hs>? =begin <.hs> <!directives> <name=raw_content_blocks>
( ( <.newline> = )? <.hs> <[attr=pair]>+ % <.hs> )* <.newline>
@@ -102,13 +103,15 @@ qr{
^ <spacesend=hs>? =end <.hsp> <\name> <.hs> <.newline>
<token: delimblock> <matchpos><matchline>
+ (?{ $MATCH{type} = "block"})
^ <spaces=hsp>? =begin <.hs> <!directives> <name=(\w+)>
( ( <.newline> = )? <.hs> <[attr=pair]>+ % <.hs> )* <.newline>
<[content=block_content]>*
<.emptyline>*
^ <spacesend=hs>? =end <.hs> <\name> <.hs> <.newline>
<token: paragraph_block> <matchpos><matchline>
+ (?{ $MATCH{type} = "block"})
^ <spaces=hsp>? =for <.hs> <!directives>
( <name=raw_content_blocks>
(?{ $MATCH{content_type} = "raw"})
@@ -129,6 +132,7 @@ qr{
<token: abbr_block> <matchpos><matchline>
+ (?{ $MATCH{type} = "block"})
^ <spaces=hsp>? =<!directives> ( <name=raw_content_blocks>
(?{ $MATCH{content_type} = "raw" })
| <name=(\w+)> ) <hs> <.newline>?
View
7 lib/Perl6/Pod/Utl.pm
@@ -32,12 +32,15 @@ sub parse_pod {
\A <File> \Z
}xms;
- if ( $src =~ $r->with_actions( Perl6::Pod::Autoactions->new (%args) ) ) {
- return {%/}->{File};
+ my $tree ;
+ if ( $src =~ $r ) {
+# if ( $src =~ $r->with_actions( Perl6::Pod::Autoactions->new (%args) ) ) {
+ $tree = {%/}->{File};
}
else {
return undef;
}
+
}
=head2 strip_vmargin $vmargin, $txt
View
2 scripts/pod6any
@@ -39,8 +39,8 @@ my $str;
{local $/;
$str = <$in_fd>};
my $tree = Perl6::Pod::Utl::parse_pod($str);
+#die Dumper ($tree);
die $tree ? 'OK' : "BAD";
-die Dumper ($tree);
my $p = Perl6::Pod::To::to_abstract( 'Perl6::Pod::To::XML', \*STDOUT );
$p->parse($in_fd);
View
133 t/02.reg.t
@@ -17,13 +17,24 @@ sub _dump_ {
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};
if ( my $attr = $el->{attr} ) {
- my @attr_dump = map { $_->dump() } @$attr;
+# my @attr_dump = map { $_->dump() } @$attr;
+ my @attr_dump = map { {
+ name => $_->{name},
+ value => $_->{items}
+ } } @$attr;
if (@attr_dump) {
$dump{attr} = \@attr_dump;
}
@@ -51,6 +62,9 @@ sub _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);
}
@@ -82,10 +96,120 @@ my @t;
my $STOP_TREE = 1;
@t = (
+'
+text
+
+=begin pod
+=for Test :1
+bracket sequence. For example:
+=end pod
+'
);
+package Perl6::Pod::Lex1;
+use Perl6::Pod::Lex;
+use base 'Perl6::Pod::Lex';
+sub make_block {
+ my $self = shift;
+ my %ref = @_;
+ my $name = $ref{name};
+ my $is_implicit_code_and_para_blocks =
+ $ref{force_implicit_code_and_para_blocks}
+ || $name =~ /(pod|item|defn|nested|finish|\U $name\E )/x
+ ;
+
+ my $childs = $ref{content} || [];
+ my $vmargin = length( $ref{spaces} // '' );
+
+ #is first para if item|defn ?
+ my $is_first = 1;
+ #convert paragraph's to blocks
+ foreach my $node (@$childs) {
+ if ( $node->{type} eq 'block') {
+ $node = $self->make_block(%$node);
+
+ } elsif ($node->{type} =~ /text|raw/ ) {
+ my $type = $node->{type};
+ if ($type eq 'text') {
+ $node = Perl6::Pod::Lex::Text->new( %$node );
+ } else {
+ $node = Perl6::Pod::Lex::RawText->new ( %$node);
+ }
+
+ } else { die "Unknown". Dumper($node) };
+ next
+ unless UNIVERSAL::isa( $node, 'Perl6::Pod::Lex::Text' )
+ || UNIVERSAL::isa( $node, 'Perl6::Pod::Lex::RawText' );
+ use Perl6::Pod::Utl;
+ my $content = delete $node->{''};
+ #remove virual margin
+ $content = Perl6::Pod::Utl::strip_vmargin($vmargin, $content);
+ #skip first text block for item| defn
+ if ( $name =~ 'item|defn' and $is_first ) {
+
+ #always ordinary text
+ $content =~ s/^\s+//;
+ $node = $content;
+ next;
+
+ }
+ if ($is_implicit_code_and_para_blocks) {
+ my $block_name = $content =~ /^\s+/ ? 'code' : 'para';
+ $node = Perl6::Pod::Lex::Block->new(
+ %$node,
+ name => $block_name,
+ srctype => 'implicit',
+ content => [$content]
+ );
+
+ }
+ else {
+ if ( $name eq 'para' ) {
+
+ #para blocks always
+ # ordinary text
+ $content =~ s/^\s+//;
+ }
+ $node = $content;
+ }
+ }
+ return Perl6::Pod::Lex::Block->new(%ref);
+
+}
+sub process_file {
+ my $self = shift;
+ my $ref = shift;
+ #clear all ambient blocks
+ if ( 1 || $self->{default_pod} ) {
+ $ref->{force_implicit_code_and_para_blocks} = 1;
+ }
+ my $block = $self->make_block(%$ref, name=>'File');
+ return $block->childs;
+}
+
+
+sub process_block {
+
+}
+
+sub make_tree {
+ use Data::Dumper;
+ my $self = shift;
+ my $tree = shift;
+ my $type = $tree->{type};
+ my $method = "process_" . $type;
+ return $self->$method($tree);
+};
+1;
+package main;
$STOP_TREE = 2;
$STOP_TREE = 0;
+@t=();
+#if ( $t[0] =~ $r ) {
+# die Dumper( Perl6::Pod::Lex1->new->make_tree($/{File}) );
+#}
+#die Dumper Perl6::Pod::Utl::parse_pod($t[0]);
+
my @grammars = (
'=begin pod
=for item
@@ -501,9 +625,12 @@ asdasd
while ( my ( $src, $extree, $name ) = splice( @grammars, 0, 3 ) ) {
$name //= $src;
my $dump;
- if ( $src =~ $r->with_actions( Perl6::Pod::Autoactions->new ) ) {
+# if ( $src =~ $r->with_actions( Perl6::Pod::Autoactions->new ) ) {
+ if ( $src =~ $r ) {
+ my $tree = Perl6::Pod::Lex1->new->make_tree($/{File});
if ( $STOP_TREE == 2 ) { say Dumper( {%/}->{File} ); exit; }
- $dump = Perl6::Pod::To::Dump->new->visit( {%/}->{File} );
+ $dump = Perl6::Pod::To::Dump->new->visit( $tree );
+# $dump = Perl6::Pod::To::Dump->new->visit( {%/}->{File} );
# if ( my $tree = Perl6::Pod::Utl::parse_pod($src) ) {
# if ( $STOP_TREE == 2 ) { say Dumper($tree ); exit; }

0 comments on commit ef32b75

Please sign in to comment.
Something went wrong with that request. Please try again.