File Coverage

blib/lib/Pandoc/Walker.pm
Criterion Covered Total %
statement 83 84 98.8
branch 25 28 89.2
condition 19 27 70.3
subroutine 16 17 94.1
pod 4 4 100.0
total 147 160 91.8


line stmt bran cond sub pod time code
1             package Pandoc::Walker;
2 30     30   77434 use strict;
  30         88  
  30         1143  
3 30     30   206 use warnings;
  30         76  
  30         998  
4 30     30   592 use 5.010;
  30         137  
5              
6             our $VERSION = '0.34';
7              
8 30     30   203 use Scalar::Util qw(reftype blessed);
  30         71  
  30         1610  
9 30     30   214 use Carp;
  30         62  
  30         1780  
10              
11 30     30   13414 use parent 'Exporter';
  30         9191  
  30         204  
12             our @EXPORT = qw(walk query transform);
13             our @EXPORT_OK = ( @EXPORT, 'action' );
14              
15             sub _simple_action {
16 3542   50 0   6828 my $action = shift // return sub { };
        3542      
17              
18 3542 100 66     15350 if ( blessed $action and $action->isa('Pandoc::Filter') ) {
    50 33        
19 2         9 $action = $action->action;
20             }
21             elsif ( !ref $action or ref $action ne 'CODE' ) {
22 0   0     0 croak "expected code reference, got: " . ( $action // 'undef' );
23             }
24              
25 3542 100       6266 if (@_) {
26 1765         3664 my @args = @_;
27 1765     1478   6655 return sub { local $_ = $_[0]; $action->( $_[0], @args ) };
  1478         2244  
  1478         2647  
28             }
29             else {
30 1777         3649 return $action;
31             }
32             }
33              
34             sub action {
35 3526     3526 1 4998 my @actions;
36             my @args;
37              
38             # $selector => $action [, @arguments ]
39 3526 100       8234 if ( !ref $_[0] ) {
    100          
40 6   100 1   41 @actions = ( shift, shift // sub { $_ } );
  1         3  
41 6         17 @args = @_;
42             }
43              
44             # { $selector => $code, ... } [, @arguments ]
45             elsif ( ref $_[0] eq 'HASH' ) {
46 20         43 @actions = %{ shift @_ };
  20         111  
47 20         64 @args = @_;
48              
49             # code [, @arguments ]
50             }
51             else {
52 3500         5764 return _simple_action(@_);
53             }
54              
55 26         114 my $n = ( scalar @actions ) / 2 - 1;
56              
57             # check action functions and add arguments
58             $actions[ $_ * 2 + 1 ] = _simple_action( $actions[ $_ * 2 + 1 ], @args )
59 26         170 for 0 .. $n;
60              
61             # TODO: compile selectors for performance
62              
63             sub {
64 104     104   161 my $element = $_[0];
65              
66             # get all matching actions
67             my @matching =
68 69         243 map { $actions[ $_ * 2 + 1 ] }
69 104         237 grep { $element->match( $actions[ $_ * 2 ] ) } 0 .. $n;
  150         649  
70              
71 104         188 my @return = ();
72              
73 104         209 foreach my $action (@matching) {
74 69         120 local $_ = $_[0]; # FIXME: $doc->walk( Section => sub { $_->id } )
75 69         197 @return = ( $action->(@_) );
76             }
77              
78 104 50       332 wantarray ? @return : $return[0];
79             }
80 26         192 }
81              
82             sub transform {
83 3436     3436 1 6064 my $ast = shift;
84 3436         5602 my $action = action(@_);
85              
86 3436   100     10049 my $reftype = reftype($ast) || '';
87              
88 3436 100       7618 if ( $reftype eq 'ARRAY' ) {
    100          
89 1062         2366 for ( my $i = 0 ; $i < @$ast ; ) {
90 1606         2665 my $item = $ast->[$i];
91              
92 1606 100 100     5877 if ( ( reftype $item || '' ) eq 'HASH' and $item->{t} ) {
      100        
93 700         1429 my $res = $action->($item);
94              
95 700 100       1735 if ( defined $res ) {
96             # stop traversal
97 21 100       103 if ( $res eq \undef ) {
98 1         2 $i++;
99             # replace current item with result element(s)
100             } else {
101 20 100 50     140 my @elements = #map { transform($_, $action, @_) }
102             ( reftype $res || '' ) eq 'ARRAY' ? @$res : $res;
103 20         70 splice @$ast, $i, 1, @elements;
104 20         59 $i += scalar @elements;
105             }
106 21         184 next;
107             }
108             }
109 1585         3751 transform( $item, $action );
110 1585         3316 $i++;
111             }
112             }
113             elsif ( $reftype eq 'HASH' ) {
114              
115             # TODO: directly transform an element.
116             # if (blessed $ast and $ast->isa('Pandoc::Elements::Element')) {
117             # } else {
118 890         2972 foreach ( keys %$ast ) {
119 1755         3980 transform( $ast->{$_}, $action, @_ );
120             }
121              
122             # }
123             }
124              
125 3436         8238 $ast;
126             }
127              
128             sub walk(@) { ## no critic
129 50     50 1 1550 my $ast = shift;
130 50         191 my $action = action(@_);
131             transform( $ast, sub {
132 467     467   742 local $_ = $_[0];
133 467         1139 my $q = $action->(@_);
134 467 50 66     2541 return (defined $q and $q eq \undef) ? \undef : undef
135 50         401 } );
136             }
137              
138             sub query(@) { ## no critic
139 30     30 1 1135 my $ast = shift;
140 30         112 my $action = action(@_);
141              
142 30         82 my $list = [];
143             transform( $ast, sub {
144 164     164   249 local $_ = $_[0];
145 164         338 my $q = $action->(@_);
146 164 100 100     748 return $q if !defined $q or $q eq \undef;
147 69         163 push @$list, $q;
148             return
149 30         181 } );
  69         173  
150 30         431 return $list;
151             }
152              
153             1;
154             __END__