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

package Pandoc::Walker;
use strict;
use warnings;
use 5.010;

our $VERSION = '0.34';

use Scalar::Util qw(reftype blessed);
use Carp;

use parent 'Exporter';
our @EXPORT = qw(walk query transform);
our @EXPORT_OK = ( @EXPORT, 'action' );

sub _simple_action {
    my $action = shift // return sub { };

    if ( blessed $action and $action->isa('Pandoc::Filter') ) {
        $action = $action->action;
    }
    elsif ( !ref $action or ref $action ne 'CODE' ) {
        croak "expected code reference, got: " . ( $action // 'undef' );
    }

    if (@_) {
        my @args = @_;
        return sub { local $_ = $_[0]; $action->( $_[0], @args ) };
    }
    else {
        return $action;
    }
}

sub action {
    my @actions;
    my @args;

    # $selector => $action [, @arguments ]
    if ( !ref $_[0] ) {
        @actions = ( shift, shift // sub { $_ } );
        @args = @_;
    }

    # { $selector => $code, ... } [, @arguments ]
    elsif ( ref $_[0] eq 'HASH' ) {
        @actions = %{ shift @_ };
        @args    = @_;

        # code [, @arguments ]
    }
    else {
        return _simple_action(@_);
    }

    my $n = ( scalar @actions ) / 2 - 1;

    # check action functions and add arguments
    $actions[ $_ * 2 + 1 ] = _simple_action( $actions[ $_ * 2 + 1 ], @args )
      for 0 .. $n;

    # TODO: compile selectors for performance

    sub {
        my $element = $_[0];

        # get all matching actions
        my @matching =
          map  { $actions[ $_ * 2 + 1 ] }
          grep { $element->match( $actions[ $_ * 2 ] ) } 0 .. $n;

        my @return = ();

        foreach my $action (@matching) {
            local $_ = $_[0];    # FIXME: $doc->walk( Section => sub { $_->id } )
            @return = ( $action->(@_) );
        }

        wantarray ? @return : $return[0];
    }
}

sub transform {
    my $ast    = shift;
    my $action = action(@_);

    my $reftype = reftype($ast) || '';

    if ( $reftype eq 'ARRAY' ) {
        for ( my $i = 0 ; $i < @$ast ; ) {
            my $item = $ast->[$i];

            if ( ( reftype $item || '' ) eq 'HASH' and $item->{t} ) {
                my $res = $action->($item);

                if ( defined $res ) {
                    # stop traversal
                    if ( $res eq \undef ) {
                        $i++;
                    # replace current item with result element(s)
                    } else {
                        my @elements =    #map { transform($_, $action, @_) }
                          ( reftype $res || '' ) eq 'ARRAY' ? @$res : $res;
                        splice @$ast, $i, 1, @elements;
                        $i += scalar @elements;
                    }
                    next;
                }
            }
            transform( $item, $action );
            $i++;
        }
    }
    elsif ( $reftype eq 'HASH' ) {

        # TODO: directly transform an element.
        # if (blessed $ast and $ast->isa('Pandoc::Elements::Element')) {
        # } else {
        foreach ( keys %$ast ) {
            transform( $ast->{$_}, $action, @_ );
        }

        # }
    }

    $ast;
}

sub walk(@) {    ## no critic
    my $ast    = shift;
    my $action = action(@_);
    transform( $ast, sub {
        local $_ = $_[0];
        my $q = $action->(@_);
        return (defined $q and $q eq \undef) ? \undef : undef
    } );
}

sub query(@) {    ## no critic
    my $ast    = shift;
    my $action = action(@_);

    my $list = [];
    transform( $ast, sub {
        local $_ = $_[0];
        my $q = $action->(@_);
        return $q if !defined $q or $q eq \undef;
        push @$list, $q;
        return
    } );
    return $list;
}

1;
__END__