File Coverage

blib/lib/Brat/Handler/File.pm

Criterion	Covered	Total	%
statement	244	336	72.6
branch	43	114	37.7
condition	3	9	33.3
subroutine	29	35	82.8
pod	14	14	100.0
total	333	508	65.5

package Brat::Handler::File;


use utf8;
use strict;
use warnings;
use open qw(:utf8 :std);

our $VERSION='0.11';

sub new {

    my ($class, $filename) = @_;
    my $annotationFilename;
    my $textFilename;
    my $textSize = 0;
    my @annFiles;
    my @textFiles;
    my @files;
    my $f;
    my $line;

    # print STDERR "\n==> $filename - " . ref($filename) . ";\n";
    if (defined $filename) {
	if (ref($filename) eq "") {
	    push @files, $filename;
	} elsif (ref($filename) eq "ARRAY") {
	    push @files, @$filename;
	}
    }
    foreach $f (@files) {
	# warn "$f\n";
	$annotationFilename = $f;
	$annotationFilename =~ s/\.txt$/.ann/;
	$textFilename = $f;
	$textFilename =~ s/\.ann$/.txt/;
	$textSize = 0;
	open FILE, $textFilename or die "no such file $textFilename\n";
	while($line = ) {
	    $textSize += length($line);
	}
	close FILE;
	# my @s = stat($textFilename);
	# $textSize += $s[7];
	push @annFiles, $annotationFilename;
	push @textFiles, $textFilename;
    }
    my $bratfile = {
	'annotationFilename' => [@annFiles],
	'textFilename' => [@textFiles],
	'terms' => {},
	'relations' => {},
	'attributes' => {},
	'maxTermId' => 0,
	'maxRelationId' => 0,
	'maxAttributeId' => 0,
	'textSize' => $textSize,
    };

    bless($bratfile, $class);

    if (defined $filename) {
	if (ref($filename) eq "") {
	    $bratfile->loadBratFile;
	} elsif (ref($filename) eq "ARRAY") {
	    warn "load of several brat files not implemented\n";
	}
    }
    return($bratfile);
}

sub _textFilename {
    my $self = shift;

    if (@_) {
	my $arg = shift;
	push @{$self->{'textFilename'}}, $arg;
    }
    return($self->{'textFilename'});
}

sub _textSize {
    my $self = shift;

    if (@_) {
	$self->{'textSize'} = shift;
    }
    return($self->{'textSize'});
}

sub _annotationFilename {
    my $self = shift;
    if (@_) {
	my $arg = shift;
	if ($arg =~ /^\d+$/) {
	    return($self->{'annotationFilename'}->[$arg]);
	} else {
	    push @{$self->{'annotationFilename'}}, $arg;
	}
    }
    return($self->{'annotationFilename'});
}

sub _terms {
    my $self = shift;

    if (@_) {
	my $list = shift;
	my $term;
	foreach $term (@$list) {
	    $self->_addTerm($term->{'id'}, $term);
	}
	# $self->{'terms'} = shift;

	# max Term Id
    }
    return($self->{'terms'});
}

sub _addTerm {
    my $self = shift;

    if (@_) {
	my $id = shift;
	$self->_terms->{$id} = shift;
	# max Term Id
	if ($self->_maxTermId < $self->_terms->{$id}->{'numId'}) {
	    $self->_maxTermId($self->_terms->{$id}->{'numId'});
	}
	return($self->_getTermFromId($id));
    }
    return(undef);
}

sub _maxTermId {
    my $self = shift;

    if (@_) {
	$self->{'maxTermId'} = shift;
    }
    return($self->{'maxTermId'});
}

sub _getTermFromId {
    my $self = shift;
    my $id = shift;

    if ((defined $id) && (exists $self->_terms->{$id})) {
	return($self->_terms->{$id});
    }
}

sub _relations {
    my $self = shift;

    if (@_) {
	my $list = shift;
	my $relation;
	foreach $relation (@$list) {
	    $self->_addRelation($relation->{'id'}, $relation);
	}
	# $self->{'relations'} = shift;
	# max Relation Id
    }
    return($self->{'relations'});
}

sub _addRelation {
    my $self = shift;

    if (@_) {
	my $id = shift;
	$self->_relations->{$id} = shift;
	# max Relation Id
	# warn $self->_maxRelationId . " < " . $self->_relations->{$id}->{'numId'} . "\n";
	if ($self->_maxRelationId < $self->_relations->{$id}->{'numId'}) {
	    $self->_maxRelationId($self->_relations->{$id}->{'numId'});
	}
	return($self->_getRelationFromId($id));
    }
    return(undef);
}

sub _maxRelationId {
    my $self = shift;

    if (@_) {
	$self->{'maxRelationId'} = shift;
    }
    return($self->{'maxRelationId'});
}

sub _getRelationFromId {
    my $self = shift;
    my $id = shift;

    if ((defined $id) && (exists $self->_relations->{$id})) {
	return($self->_relations->{$id});
    }
}

sub _attributes {
    my $self = shift;

    if (@_) {
	my $list = shift;
	my $attribute;
	foreach $attribute (@$list) {
	    $self->_addAttribute($attribute->{'id'}, $attribute);
	}
	# $self->{'attributes'} = shift;
	# max Attribute Id
    }
    return($self->{'attributes'});
}

sub _addAttribute {
    my $self = shift;

    if (@_) {
	my $id = shift;
	$self->_attributes->{$id} = shift;
	# max Attribute Id
	if ($self->_maxAttributeId < $self->_attributes->{$id}->{'numId'}) {
	    $self->_maxAttributeId($self->_attributes->{$id}->{'numId'});
	}
	return($self->_getAttributeFromId($id));
    }
    return(undef);
}

sub _maxAttributeId {
    my $self = shift;

    if (@_) {
	$self->{'maxAttributeId'} = shift;
    }
    return($self->{'maxAttributeId'});
}

sub _getAttributeFromId {
    my $self = shift;
    my $id = shift;

    if ((defined $id) && (exists $self->_attributes->{$id})) {
	return($self->_attributes->{$id});
    }
}

sub loadBratFile {
    my ($self) = @_;
    my $line;
    my $id;
    my $info;
    my $str;
    my $type;
    my $termId;
    my $value;
    my $arg1;
    my $arg2;
    my $o;
    my $s;
    my $e;
    my @starts;
    my @ends;
    my $numId;
#    warn "===> " . $self->_filename . "\n";
    open FILE, "<:utf8", $self->_annotationFilename(0) or die "no such file " . $self->_annotationFilename(0) . "\n";
    while($line = ) {
	chomp $line;
	@starts = ();
	@ends = ();

	($id, $info, $str) = split /\t/, $line;
	if ($id =~ /^TS?(?[\d]+)/) {
	    $numId = $+{numid};
#	    ($type, $start, $end) = split / /, $info;
#	    warn "info: $info\n";
	    if ($info =~ /^(?[^ ]+) (?.*)/) {
		$type = $+{type};
		foreach $o (split /;/, $+{offsets}) {
		    ($s, $e) = split / /, $o;
#		    warn "\t$s : $e\n";
		    push @starts, $s;
		    push @ends, $e;
		}
	    # warn "->$id\n";
	    $self->_addTerm($id, {
		'id' => $id,
		'numId' => $numId,
		'type' => $type,
		'start' => [@starts],
		'end' => [@ends],
		'str' => $str,
		'attrlst' => [],
			    });
	    }
	}
	if ($id =~ /^A(?\d+)/) {
	    $numId = $+{numid};
	    ($type, $termId, $value) = split / /, $info;
	    $self->_addAttribute($id, {
		'id' => $id,
                'numId' => $numId,
		'type' => $type,
		'termId' => $termId,
		'value' => $value,
			       });
	    # warn "termId: $start\n";
	    push @{$self->_getTermFromId($termId)->{'attrlst'}}, $id;

	}
	if ($id =~ /^R(?\d+)/) {
	    # warn "==> $id " . $+{numid} . "\n";
	    $numId = $+{numid};
	    ($type, $arg1, $arg2) = split / /, $info;
	    $arg1 =~ s/^Arg1://;
	    $arg2 =~ s/^Arg2://;
	    $self->_addRelation($id, {
		'id' => $id,
                'numId' => $numId,
		'type' => $type,
		'arg1' => $arg1,
		'arg2' => $arg2,
			      });
	}
    }
    close FILE;
}

sub printStats {
    my ($self, $filename, $addmode) = @_;

    my $id;
    my %terms;
    my %termTypes;
    my %relations;
    my %relationTypes;

    my $fh;
    if ($filename eq "-") {
	$fh = \*STDOUT;
    } else {
	if (defined $addmode) {
	    open $fh, ">>:utf8", $filename or die "no such file " . $filename . "\n";
	} else {
	    open $fh, ">:utf8", $filename or die "no such file " . $filename . "\n";
	}
    }

    print $fh $self->getStats;

    if ($filename ne "-") {
	close $fh;
    }
}

sub getTermTypes {
    my ($self) = @_;

    my $id;
    my %termTypes;
    foreach $id (keys %{$self->_terms}) {
	$termTypes{$self->_getTermFromId($id)->{'type'}}++;
    }
    return(%termTypes);
}

sub getRelationTypes {
    my ($self) = @_;

    my $id;
    my %relationTypes;
    foreach $id (keys %{$self->_relations}) {
	$relationTypes{$self->_getRelationFromId($id)->{'type'}}++;
    }
    return(%relationTypes);
}

sub getStats {
    my ($self) = @_;

    my $id;
    my %terms;
    my %termTypes;
    my %relations;
    my %relationTypes;
    my $stats;

    foreach $id (keys %{$self->_terms}) {
	$terms{$self->_getTermFromId($id)->{'str'}}++;
	$termTypes{$self->_getTermFromId($id)->{'type'}}++;
    }

    foreach $id (keys %{$self->_relations}) {
	$relations{$self->_getTermFromId($self->_getRelationFromId($id)->{'arg1'})->{'str'} . " : " . $self->_getTermFromId($self->_getRelationFromId($id)->{'arg2'})->{'str'}}++;
	$relationTypes{$self->_getRelationFromId($id)->{'type'}}++;
    }


    $stats = "number of annotated terms: " . scalar(keys %{$self->_terms}) . "\n";
    $stats .= "number of annotated relations: " . scalar(keys %{$self->_relations}) . "\n";

    $stats .= "number of terms: " . scalar(keys %terms) . "\n";
    $stats .= "number of term type: " . scalar(keys %termTypes) . "\n";

    $stats .= "number of relations: " . scalar(keys %relations) . "\n";
    $stats .= "number of relation type: " . scalar(keys %relationTypes) . "\n";
    return($stats);
    # print "number of relations: " . scalar(keys %{$data->{'relations'}}) . "\n";
}


sub printTermList {
    my ($self, $filename, $addmode) = @_;
    my $id;

    my $fh;
    if ($filename eq "-") {
	$fh = \*STDOUT;
    } else {

	if (defined $addmode) {
	    open $fh, ">>:utf8", $filename or die "no such file " . $filename . "\n";
	} else {
	    open $fh, ">:utf8", $filename or die "no such file " . $filename . "\n";
	}
    }
    # foreach $id (keys %{$self->_terms}) {
    # 	print $fh $self->_getTermFromId($id)->{'str'} . " : : " . $self->_getTermFromId($id)->{$id}->{'type'} . " :\n";
    # }
    print $fh $self->getTermList;

    if ($filename ne "-") {
	close $fh;
    }

}

sub getTermList {
    my ($self) = @_;
    my $id;
    my $termlistStr = "";

    foreach $id (keys %{$self->_terms}) {
	$termlistStr .= $self->_getTermFromId($id)->{'str'} . " : : " . $self->_getTermFromId($id)->{'type'} . " :\n";
    }
    return($termlistStr);
}


sub getTerms {
    my ($self) = @_;
    my $id;
    my @terms;

    foreach $id (keys %{$self->_terms}) {
	push @terms, {"str" => $self->_getTermFromId($id)->{'str'}, "lmstr" => undef, "type" => $self->_getTermFromId($id)->{'type'}};
    }
    return(\@terms);
}

sub printRelationList {
    my ($self, $filename, $addmode) = @_;
    my $fh;

    if ($filename eq "-") {
	$fh = \*STDOUT;
    } else {
	if (defined $addmode) {
	    open $fh, ">>:utf8", $filename or die "no such file " . $filename . "\n";
	} else {
	    open $fh, ">:utf8", $filename or die "no such file " . $filename . "\n";
	}
    }
    print $fh $self->getRelationList;
    if ($filename ne "-") {
	close $fh;
    }
}

sub getRelationList {
    my ($self, $addmode) = @_;
    my $id;
    my $relationList = "";

    foreach $id (keys %{$self->_relations}) {
	$relationList .= $self->_getTermFromId($self->_getRelationFromId($id)->{'arg1'})->{'str'} . " : " . $self->_getTermFromId($self->_getRelationFromId($id)->{'arg2'})->{'str'} . " : " . $self->_getRelationFromId($id)->{'type'} . "\n";
    }
    return($relationList);
}


sub getRelations {
    my ($self, $addmode) = @_;
    my $id;
    my $relationList = "";
    my @relations;

    foreach $id (keys %{$self->_relations}) {
	push @relations, {'str1' => $self->_getTermFromId($self->_getRelationFromId($id)->{'arg1'})->{'str'},
			  'str2' => $self->_getTermFromId($self->_getRelationFromId($id)->{'arg2'})->{'str'},
			  'type' => $self->_getRelationFromId($id)->{'type'}};
	# $relationList .= $self->_getTermFromId($self->_getRelationFromId($id)->{'arg1'})->{'str'} . " : " . $self->_getTermFromId($self->_getRelationFromId($id)->{'arg2'})->{'str'} . " : " . $self->_getRelationFromId($id)->{'type'} . "\n";
    }
    return(\@relations);
}


sub getAnnotationList {
    my ($self) = @_;
    my $id;
    my $attrId;
    my $elt;
    my $attr;
    my $annotations = "";
    my $i;

    foreach $id (sort {&_sortId($a,$b)} keys %{$self->_terms}) {
	$elt = $self->_getTermFromId($id);
	$annotations .= $elt->{'id'} . "\t";
	$annotations .= $elt->{'type'} . " ";
	for($i=0; $i < scalar(@{$elt->{'start'}}); $i++) {
	    $annotations .= $elt->{'start'}->[$i] . " " . $elt->{'end'}->[$i] . ";";
	}
	chop $annotations;

	$annotations .= "\t" . $elt->{'str'} . "\n";
	foreach $attrId (sort {&_sortId($a,$b)} @{$elt->{'attrlst'}}) {
	    $attr = $self->_getAttributeFromId($attrId);
	    $annotations .= $attr->{'id'} . "\t";
	    $annotations .= $attr->{'type'} . " " . $attr->{'termId'} . " " . $attr->{'value'} . "\n";
	}
    }
    foreach $id (sort {&_sortId($a,$b)} keys %{$self->_relations}) {
	$elt = $self->_getRelationFromId($id);
	$annotations .= $elt->{'id'} . "\t";
	$annotations .= $elt->{'type'} . " Arg1:" . $elt->{'arg1'} . " Arg2:" . $elt->{'arg2'} . "\n";
    }
    return($annotations);
}

sub _sortId {
    my ($A, $B) = @_;

    my $idA = $a;
    $idA =~ s/^[TAR]//;
    my $idB = $b;
    $idB =~ s/^[TAR]//;
    return($idA <=> $idB);
}

sub print {
    my ($self, $filename, $addmode) = @_;
    my $fh;
    my $line;
    my $file;
    my $annotationFilename = $filename;
    $annotationFilename =~ s/\.txt$/.ann/;
    my $textFilename = $filename;
    $textFilename =~ s/\.ann$/.txt/;

    # print/copy text
    if ($filename eq "-") {
	$fh = \*STDOUT;
    } else {
	if (defined $addmode) {
	    open $fh, ">>:utf8", $textFilename or die "no such file $textFilename\n";
	} else {
	    open $fh, ">:utf8", $textFilename or die "no such file $textFilename\n";
	}
    }
    foreach $file (@{$self->_textFilename}) {
	open FILE, $file or die "no such file " . $file . "\n";
	while($line = ) {
	    print $fh $line;
	}
	close FILE;
    }
    if ($filename ne "-") {
	close $fh;
    }

    # print annotations
    if ($filename eq "-") {
	$fh = \*STDOUT;
    } else {
	if (defined $addmode) {
	    open $fh, ">>:utf8", $annotationFilename or die "no such file $annotationFilename\n";
	} else {
	    open $fh, ">:utf8", $annotationFilename or die "no such file $annotationFilename\n";
	}
    }
    print $fh $self->getAnnotationList;
    if ($filename ne "-") {
	close $fh;
    }
}

1;

__END__