File Coverage

lib/Lingua/YaTeA/TestifiedTermParser.yp

Criterion	Covered	Total	%
statement	15	102	14.7
branch	0	34	0.0
condition	0	9	0.0
subroutine	5	28	17.8
pod	0	1	0.0
total	20	174	11.4

#
# TestifiedTermParser.yp
#
#  used to generate Lingua::YaTeA::TestifiedTermParser.pm
#
#  Use: yapp -m 'Lingua::YaTeA::TestifiedTermParser' -o lib/Lingua/YaTeA/TestifiedTermParser.pm lib/Lingua/YaTeA/TestifiedTermParser.yp
#
# Parse::Yapp input grammar for parsing the yatea testified terms
#
#
#
%{
    use Lingua::YaTeA;
    use Data::Dumper;
    use warnings;
    use UNIVERSAL;
    use Scalar::Util qw(blessed);
    my @words;
    my $word;
    my $item;
    my @infos;
    my @IF;
    my @POS;
    my @LF;
    my $src;
    my @lex_items;
    my $testified;
    my $i;
    my $tree;
    my $node_set;
    my $node;
    my $edge;
    my $index = 0;
    my @uncomplete;
    my $level = 0;
    my $num_line =1;
%}
%%
input:  #empty
        |   input line  {  #print STDERR "\n INPUT  \n";
                      }
;

line:     '\n' { # print "VIDE: " . $_[1]
          $num_line++;
          }
          | testified {
	      $num_line++;
	      @lex_items = ();
	      @words= ();
	      my $testified;
	      # print STDERR "=>$_[1]\n";
	      my $testified_infos;
	      if($_[0]->YYData->{TTS}->getTestifiedInfos(\$testified_infos,\@IF,\@POS,\@LF,$src,\@lex_items,$_[0]->YYData->{MATCH},$_[0]->YYData->{FILTERING_LEXICON},$_[0]->YYData->{TAGSET}) == 1) {
		  if(scalar @lex_items > 1) {
		      $testified = Lingua::YaTeA::MultiWordTestifiedTerm->new($testified_infos->{"NUM_CONTENT_WORDS"},\@lex_items,$_[0]->YYData->{TAGSET},$src,$_[0]->YYData->{MATCH});
		  }
	      }
	      if ((blessed($testified)) && ($testified->isa('Lingua::YaTeA::TestifiedTerm'))) {
		  #print STDERR "ajout tt: " . $testified->getIF . "\n";
		  $_[0]->YYData->{TTS}->addTestified($testified);

		  if ((blessed($testified)) && ($testified->isa('Lingua::YaTeA::MultiWordTestifiedTerm'))) {
		      $tree =  Lingua::YaTeA::Tree->new;
		      $tree->setNodeSet($node_set);
		      # $tree->print($testified_infos->{"WORDS"});
		      $tree->setIndexSet($testified->getIndexSet);
		      $tree->setHead;
		      $testified->addTree($tree);
		      $testified->setParsingMethod("USER");
		  }
	      }
	      # print "fin creation :" . $testified->getIF . "\n";
	      $level = 0;
	      $index = 0;
          }
;


testified: {
                $node_set = Lingua::YaTeA::NodeSet->new;
           }
           OPEN parsing END infos { #print "trouve testified2 $_[1]\n";
           }
           | error '\nTESTIFIED: ' { $_[0]->YYErrok }
;

infos: INFOS {
           # print "infos $_[1]\n";
           @infos = split /\t/, $_[1];
           @IF = split / /, $infos[0];
           @POS = split / /, $infos[1];
           @LF = split / /, $infos[2];
           $src = $infos[3];
       }
;



parsing: CANDIDATE PREP DET CANDIDATE
         | CANDIDATE PREP CANDIDATE
         | CANDIDATE PREP PREP CANDIDATE
         | CANDIDATE DET CANDIDATE
         | CANDIDATE CANDIDATE {
           # print STDERR "PARSING $_[1]\n"
           }
         |
         | error '\nPARSING: ' { $_[0]->YYErrok }
;


PREP: WORD P_STATUS {
       # print STDERR "PREP $_[1] $_[2]\n";
         $node->{"PREP"} = Lingua::YaTeA::TermLeaf->new($index);
         $index++;
      };

DET: WORD D_STATUS {
       # print STDERR "DET $_[1] $_[2]\n";
       $node->{"DET"} = Lingua::YaTeA::TermLeaf->new($index);
       $index++;
};

CANDIDATE: WORD C_STATUS{
           # print STDERR "CANDIDATE1 $_[1] $_[2]\n";
           $edge = Lingua::YaTeA::TermLeaf->new($index);
           $node->addEdge($edge,$_[2]);
           # print "ajout du edge :" ;
           # print Dumper($edge) . "\n";
           $index++;
           }
           | OPEN parsing CLOSE {
             #print STDERR "CANDIDATE2 $_[1]\n";
             }
           | error '\nCANDIDATE: ' { $_[0]->YYErrok }
;

OPEN: OPEN_TAG {
               # print STDERR "OPEN $_[1]\n";
               if ($level == 0)
                {
                    $node = Lingua::YaTeA::RootNode->new($level);
                }
                else
                {
                    $node = Lingua::YaTeA::InternalNode->new($level);
                }
                $node_set->addNode($node);
                     push @uncomplete, $node;
                $level++;
                }
             |        error '\nOPEN: ' { $_[0]->YYErrok }
;


END: END_TAG {
             # print STDERR "END $_[1]\n";
             }
             |        error '\nEND: ' { $_[0]->YYErrok }
;

CLOSE: END_TAG C_STATUS {
       # print STDERR "CLOSE_TAG $_[1] $_[2]\n";
                pop @uncomplete;
         $node->linkToFather(\@uncomplete,$_[2]);
         $node = $uncomplete[$#uncomplete];
         $level--;
        }
        |        error '\nCLOSE: ' { $_[0]->YYErrok }
;


%%

sub _Error {
        exists $_[0]->YYData->{ERRMSG}
    and do {
        print $_[0]->YYData->{ERRMSG};
        delete $_[0]->YYData->{ERRMSG};
        return;
    };
    print  "EXPECT: ";
    print $_[0]->YYExpect . "\n";
    print  "CURTOK: ";
    print "-" . $_[0]->YYCurtok . "-\n";
    print  "CURVAL: ";
    print $_[0]->YYCurval . "\n";
    print  "Lexer: ";
    print Dumper($_[0]->YYLexer) . "\n";
   print "Syntax error.\n";
}

sub _Lexer {
    my($parser)=shift;
    my $fh = $parser->YYData->{FH};


    my $open = '(\()';
    my $word = $parser->YYData->{WORD};;
    my $close = '(\)<=[MH]>)';
    my $end = '(\))';
    my $d_status = '<=(D)>';
    my $p_status = '<=(P)>';
    my $c_status = '<=([MH])>';
    my $infos = '\t(.+)';


     $parser->YYData->{INPUT}
     or  $parser->YYData->{INPUT} = <$fh>
    or  return('',undef);

     $parser->YYData->{INPUT}=~s/^[ \t]*#.*//;


    for ($parser->YYData->{INPUT}) {
        #print "TEST-" .$parser->YYData->{INPUT}. "-\n";
        s/^$open\s*// and return ('OPEN_TAG', $1);
        s/^$end// and return('END_TAG', $1);
        s/^$word\s*// and return ('WORD', $1);
        s/^$c_status\s*// and return ('C_STATUS', $1);
        s/^$d_status\s*// and return ('D_STATUS', $1);
        s/^$p_status\s*// and return ('P_STATUS', $1);
        s/^$close\s*// and return('CLOSE_TAG', $1);
        s/^$infos\s*// and return('INFOS', $1, $2);
        s/^.+//s  and return($1,$1);
        }
}

=head1 NAME

Lingua::YaTeA::TestifiedTermParser - Perl extension for the parser of testified term file (based on Parse::Yapp)

=head1 SYNOPSIS

  use Lingua::YaTeA::TestifiedTermParser;

  my $fh = FileHandle->new("<$file_path");

  my $parser = Lingua::YaTeA::TestifiedTermParser->new();

  $parser->YYData->{TTS} = $this;
  $parser->YYData->{WORD} = $word_characters_regexp;
  $parser->YYData->{TAGSET} = $tag_set;
  $parser->YYData->{MATCH} = $match_type;
  $parser->YYData->{FH} = $fh;
  $parser->YYData->{FILTERING_LEXICON} = $filtering_lexicon_h;

  $parser->YYParse(yylex => \&Lingua::YaTeA::ParsingPatternParser::_Lexer, yyerror => \&Lingua::YaTeA::ParsingPatternParser::_Error);


=head1 DESCRIPTION

The module implements a parser for analysing testified term file.

The parser takes into account several information: the word character
list (field C) i.e. all the possible characters in a word, the
Part-of-Speech tagset (field C), the type of matching (field
C), the file handler to read (field C), and the lexicon of
the corpus (field C).

=head1 METHODS

=head2 _Error()

    _Error($error_objet);

The method is used to manage the parsing error and prints a message
explaining the error.

=head2 _Lexer()

    _Lexer($parser_info);

The method applies the parser on the data contains in the structure
C<$parser_info> (field C).

=head1 SEE ALSO

Sophie Aubin and Thierry Hamon. Improving Term Extraction with
Terminological Resources. In Advances in Natural Language Processing
(5th International Conference on NLP, FinTAL 2006). pages
380-387. Tapio Salakoski, Filip Ginter, Sampo Pyysalo, Tapio Pahikkala
(Eds). August 2006. LNAI 4139.


=head1 AUTHOR

Thierry Hamon  and Sophie Aubin

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005 by Thierry Hamon and Sophie Aubin

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.

=cut