view release on metacpan or  search on metacpan

lib/Treex/Core/Scenario.pm  view on Meta::CPAN

sub _build_loaded_blocks {
    my $self        = shift;
    my @block_items = @{ $self->block_items };
    my $block_count = scalar @block_items;
    my $i           = 0;
    my @loaded_blocks;

    my $sequence_from = 0;
    my $sequence_hash = "";
    foreach my $block_item (@block_items) {
        $i++;
        my $params = '';
        if ( $block_item->{block_parameters} ) {
            $params = join ' ', @{ $block_item->{block_parameters} };
        }
        log_info("Loading block $block_item->{block_name} $params ($i/$block_count)");
        my $new_block = $self->_load_block($block_item);

        if ( $new_block->does('Treex::Core::DocumentReader') ) {
            log_fatal("Only one DocumentReader per scenario is permitted ($block_item->{block_name})")
                if $self->_has_document_reader;
            $self->_set_document_reader($new_block);
        }
        elsif ( $new_block->isa('Treex::Block::Write::BaseWriter') ) {
            push( @{ $self->writers }, $new_block );
            push @loaded_blocks, $new_block;    # duplicity
        }
        else {
            if ( ref($new_block) eq "Treex::Core::CacheBlock" ) {
                $sequence{$sequence_from}{from} = $sequence_from;
                $sequence{$sequence_from}{to}   = $i;
                $sequence{$sequence_from}{hash} = $sequence_hash;

                $sequence{$i}{_from} = $sequence_from;
                $sequence_from = $i;
                push( @{ $sequence{$sequence_from}{block} }, $new_block->get_hash() );
                $sequence_hash = $new_block->get_hash();
            }
            elsif ($self->cache) {
                $sequence_hash = md5_hex( $sequence_hash . $new_block->get_hash() );
                if ( defined( $sequence{$sequence_from} ) ) {
                    push( @{ $sequence{$sequence_from}{block} }, $new_block->get_hash() );
                }
            }

            push @loaded_blocks, $new_block;
        }
    }

    log_info('ALL BLOCKS SUCCESSFULLY LOADED.');
    return \@loaded_blocks;
}

sub _load_parser {
    my $self = shift;
    require Treex::Core::ScenarioParser;
    return Treex::Core::ScenarioParser->new();
}

sub _my_dir {
    return dirname( (caller)[1] );
}

sub _build_parser {
    my $self = shift;
    my $parser;
    eval {
        $parser = $self->_load_parser();
        1;
    } and return $parser;
    log_info("Cannot find precompiled scenario parser, trying to build it from grammar");
    my $dir  = $self->_my_dir();             #get module's directory
    my $file = "$dir/ScenarioParser.rdg";    #find grammar file
    log_fatal("Cannot find grammar file") if !-e $file;

    #in fact we should never reach this
    log_warn('We should NOT reach this place. Treex distribution may be corrupted.');

    my $grammar = read_file($file);          #load it
    eval {
        log_info("Trying to precompile it for you");
        require Parse::RecDescent;
        local $CWD = $dir;
        Parse::RecDescent->Precompile( { -standalone => 1 }, $grammar, 'Treex::Core::ScenarioParser' );
        $parser = $self->_load_parser();
        1;
    } or eval {
        log_info("Cannot precompile, loading directly from grammar. Consider precompiling it manually");
        require Parse::RecDescent;
        $parser = Parse::RecDescent->new($grammar);    #create parser
        1;
    } or log_fatal("Cannot create Scenario parser");
    return $parser;
}

sub _build_cache {
    my $self = shift;

    if ( $self->runner && $self->runner->cache ) {

        require Treex::Core::CacheBlock;
        require Treex::Tool::Memcached::Memcached;

        return Treex::Tool::Memcached::Memcached::get_connection(
            "documents-cache"
        );
    }

    return;
}

sub _load_scenario_file {
    my ( $self, $scenario_filename ) = @_;
    log_info "Loading scenario description $scenario_filename";
    my $scenario_string = read_file( $scenario_filename, binmode => ':utf8', err_mode => 'quiet' )
        or log_fatal "Can't open scenario file $scenario_filename";
    return $scenario_string;
}

sub parse_scenario_string {
    my $self            = shift;