root/lang/perl/Text-Nyarlax/trunk/t/TestNyarlax.pm @ 474

package t::TestNyarlax;

use strict;
use warnings;

use Test::Base -Base;
use Text::Nyarlax;
use FindBin;
use File::Spec;
use FileHandle;
use DirHandle;

our @EXPORT = qw(
    set_parser
    set_test_elements
    run_test_parse
);

our $nyarlax = Text::Nyarlax->new;

our ( $BaseDir, $SpecDir );
{
    my @path = File::Spec->splitdir( $FindBin::Bin );
    while ( defined( my $dir = pop @path ) ) {
        if ( $dir eq 't' ) {
            $BaseDir = File::Spec->catdir( @path );
            $SpecDir = File::Spec->catdir( $BaseDir, qw( t parser spec ) );
        }
    }
}

sub set_parser() {
    my ( $parser, $config ) = @_;
    $nyarlax->parser(
        class => $parser,
        %{ $config },
    );
}

sub set_test_elements() {
    my ( @elements ) = @_;

    if ( @elements > 0 ) {
        $_ = "$_.tb" for @elements;
    }
    else {
        my $dh = DirHandle->new( $SpecDir ) or croak $!;
        @elements = grep { $_ =~ m{\.tb$} } $dh->read;
        $dh->close;
    }

    my $spec_data = q{};
    my $fh = FileHandle->new;
    for my $name ( @elements ) {
        my $file = File::Spec->catfile( $SpecDir, $name );
        $fh->open( $file, '<' );
        $spec_data .= do { local $/; <$fh> } . "\n\n";
        $fh->close;
    }

    spec_string( $spec_data );
}

sub run_test_parse() {
    my ( $input, $expected ) = @_;

    filters {
        $input      => [qw( parse )],
        $expected   => [qw( yaml element )],
    };

    run_compare( $input => $expected );
}

1;
package t::TestNyarlax::Filter;

use base qw( Test::Base::Filter );

use Text::Nyarlax::Element;

sub element {
    my $data = shift;
    $data ||= [];
    $data = [ $data ] if ( ref $data ne 'ARRAY' );

    my $elements = [];

    for my $item ( @{ $data } ) {
        if ( ref $item eq 'HASH' ) {
            my $name = $item->{'name'};
            my $attr = $item->{'attr'};
            my $content = $self->element( $item->{'content'} );
            my $element = Text::Nyarlax::Element->new(
                name    => $name,
                attr    => $attr,
                content => $content,
            );
            push @{ $elements }, $element;
        }
        else {
            push @{ $elements }, $item;
        }
    }

    return $elements;
}

sub parse {
    my $text = shift;
    return $t::TestNyarlax::nyarlax->parse( $text );
}

1;
__END__