File Coverage

blib/lib/Lingua/EN/GeniaTagger.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Lingua::EN::GeniaTagger;
2              
3 1     1   46972 use strict;
  1         7  
  1         655  
4 1     1   2030 use Class::Spiffy;
  0            
  0            
5             use Exporter::Lite;
6             use IPC::Open2;
7             use Data::Dumper;
8              
9             our $VERSION = '0.01';
10              
11             our @EXPORT = qw(
12             start_genia
13             tag
14             chunk
15             stringify_chunks
16             );
17              
18             our $PATH;
19             $PATH = '/home/xern/tmp/geniatagger-2.0.1';
20             our ($I_GENIA, $O_GENIA);
21              
22             sub start_genia {
23             chdir( $_[0] || $PATH || die "Please specify the path of GENIA") or die $!;
24             my $pid = open2($I_GENIA, $O_GENIA, './geniatagger');
25             }
26              
27             END {
28             close $I_GENIA;
29             close $O_GENIA;
30             }
31              
32             sub tag {
33             my $text = shift or die "Please input text";
34             print {$O_GENIA} $text."\n";
35             local $_;
36             my $result;
37             while($_ = <$I_GENIA>){
38             last if /\A\n\z/;
39             $result .= $_;
40             }
41             return $result;
42             }
43              
44             sub chunk {
45             my $sentence = shift;
46             my $idx = -1;
47             my @chunk = ();
48             foreach my $line (split /\n+/, $sentence){
49             my ($word, $base, $pos, $chunk) = split /\t/, $line;
50             my $entry = [ $word, $base, $pos, $chunk ];
51             # print "[ $word, $base, $pos, $chunk ]\n";
52              
53             if($chunk =~ /^B-(.+)/){
54             push @{$chunk[++$idx]}, $1, $entry;
55             }
56             elsif($chunk =~ /^I/){
57             push @{$chunk[$idx]}, $entry;
58             }
59             elsif($chunk =~ /^O/){
60             if($entry->[2] =~ /\w/){
61             push @{$chunk[++$idx]}, $entry->[2], $entry;
62             }
63             else {
64             push @{$chunk[++$idx]}, 'PUNCT', $entry;
65             }
66             }
67             }
68             return \@chunk;
69             }
70              
71             sub stringify_chunks {
72             my $chunk = ref($_[0]) ? shift : chunk($_[0]);
73             my $ret;
74             foreach my $c (@$chunk){
75             my $tag = shift @$c;
76             my @token = @$c;
77             $ret .= "[$tag ".join (q/ /, map{"$_->[0]/$_->[2]"} @token)." $tag] ";
78             }
79             $ret;
80             }
81              
82              
83              
84              
85              
86             1;
87              
88             __END__