File Coverage

blib/lib/Brat/Handler.pm

Criterion	Covered	Total	%
statement	130	143	90.9
branch	12	16	75.0
condition	6	6	100.0
subroutine	18	18	100.0
pod	5	5	100.0
total	171	188	90.9

package Brat::Handler;


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

use Brat::Handler::File;

our $VERSION='0.1';

sub new {

    my ($class) = @_;

    my $bratHandler = {
	'inputDir' => undef,
#	'outputFile' => undef,
	'inputFiles' => [],
	'bratAnnotations' => [],
    };
    bless($bratHandler, $class);

    return($bratHandler);
}

# sub _inputDir {
#     my $self = shift;

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

sub _scanDir {
    my $self = shift;
    my $inputDir = shift;
    my $file;
    if (defined ($inputDir)) {
	opendir DIR, $inputDir or die "no such dir $inputDir\n";
	while($file = readdir DIR) {
	    if (($file ne ".") && ($file ne "..") && ($file =~ /\.ann$/)) {
		$self->_inputFiles($inputDir . "/$file");
	    }
	}
	closedir DIR;
    }
}


#  sub _outputFile {
#     my $self = shift;

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


sub _inputFiles {
    my $self = shift;

    if (@_) {
	my $fileList = shift;
	if (ref($fileList) eq 'ARRAY') {
	push @{$self->{'inputFiles'}}, @$fileList;
	} else {
	push @{$self->{'inputFiles'}}, $fileList;
	}
    }
    return($self->{'inputFiles'});
}

sub _bratAnnotations {
    my $self = shift;

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

sub _bratAnnotationSize {
    my $self = shift;

    return(scalar(@{$self->_bratAnnotations}));
}

sub _getBratAnnotationsFromId {
    my $self = shift;

    if (@_) {
	my $id = shift;
	return $self->{'bratAnnotations'}->[$id];
    }
    return(undef);
}

sub loadDir {
    my ($self, $inputDir) = @_;
    my $file;

    $self->_scanDir($inputDir);
    foreach $file (@{$self->_inputFiles}) {
	$self->_bratAnnotations($self->loadFile($file));
    }
}

sub loadList {
    my ($self, $list) = @_;
    my $file;
    my @files;
    open LIST, $list or die "no such file $list\n";
    @files = ;
    map {chomp;} @files;
    close LIST;
    $self->_inputFiles(\@files);
    foreach $file (@{$self->_inputFiles}) {
	$self->_bratAnnotations($self->loadFile($file));
    }
}

sub loadFile {
    my ($self, $file) = @_;

    my $ann = Brat::Handler::File->new($file);
    return($ann);
}

sub concat {
    my ($self) = @_;
    my $i;
    my $offset = 0;
    my $termIdOffset = 0;
    my $relationIdOffset = 0;
    my $attributeIdOffset = 0;
    my $currentBratAnnotations;
    my $concatAnn = Brat::Handler::File->new();
    my %Term2newTerm;
    for($i=0; $i < $self->_bratAnnotationSize; $i++) {
	%Term2newTerm = ();
	$currentBratAnnotations = $self->_getBratAnnotationsFromId($i);
	# warn "Read file: " . $currentBratAnnotations->_textFilename . "\n";
	$self->_copyTermsWithOffsetShift($currentBratAnnotations, $concatAnn, $termIdOffset, $offset, \%Term2newTerm);
	$self->_copyAttributesWithOffsetShift($currentBratAnnotations, $concatAnn, $attributeIdOffset, $offset, \%Term2newTerm);
	$self->_copyRelationsWithOffsetShift($currentBratAnnotations, $concatAnn, $relationIdOffset, $offset, \%Term2newTerm);
	$offset += $currentBratAnnotations->_textSize;
	$termIdOffset += $currentBratAnnotations->_maxTermId;
	$attributeIdOffset += $currentBratAnnotations->_maxAttributeId;
	$relationIdOffset += $currentBratAnnotations->_maxRelationId;
	$concatAnn->_textFilename(@{$currentBratAnnotations->_textFilename});
	$concatAnn->_annotationFilename(@{$currentBratAnnotations->_annotationFilename});
    }
    $concatAnn->_textSize($offset);


    return($concatAnn);
}

sub _copyTermsWithOffsetShift {
    my ($self, $ann, $concatAnn, $termIdOffset, $offset, $Term2newTerm) = @_;
    my $elt;
    my $id;
    my $newNumId;
    my @starts;
    my @ends;
    my @newStarts;
    my @newEnds;
    my $s;
    my $e;
    my $i = 0;

    foreach $id (keys %{$ann->_terms}) {
	@newStarts = ();
	@newEnds = ();
	$elt = $ann->_getTermFromId($id);
	$newNumId = $elt->{'numId'} + $termIdOffset;
	$Term2newTerm->{$elt->{'id'}} = "T$newNumId";
	foreach $s (@{$elt->{'start'}}) {
	    push @newStarts, ($s+$offset);
	}
	foreach $e (@{$elt->{'end'}}) {
	    push @newEnds, ($e+$offset);
	}

	$concatAnn->_addTerm("T$newNumId", {
		'id' => "T$newNumId",
		'numId' => $newNumId,
		'type' => $elt->{'type'},
		'start' => [@newStarts],
		'end' => [@newEnds],
		'str' => $elt->{'str'},
		'attrlst' => [], # TODO
			});
	$i++;
    }
    return($i);
}

sub _copyAttributesWithOffsetShift {
    my ($self, $ann, $concatAnn, $attributeIdOffset, $offset, $Term2newTerm) = @_;
    my $attr;
    my $id;
    my $newNumId;
    my $newTermId;

    foreach $id (keys %{$ann->_attributes}) {
	$attr = $ann->_getAttributeFromId($id);
	$newNumId = $attr->{'numId'} + $attributeIdOffset;
	$concatAnn->_addAttribute("A$newNumId", {
	    'id' => "A$newNumId",
	    'numId' => $newNumId,
	    'type' => $attr->{'type'},
	    'termId' => $Term2newTerm->{$attr->{'termId'}},
	    'value' => $attr->{'value'},
			     });
	    # warn "termId: $start\n";
	push @{$concatAnn->_getTermFromId($Term2newTerm->{$attr->{'termId'}})->{'attrlst'}}, "A$newNumId";
    }
}

sub _copyRelationsWithOffsetShift {
    my ($self, $ann, $concatAnn, $relationIdOffset, $offset, $Term2newTerm) = @_;
    my $relation;
    my $id;
    my $newNumId;
    my $newTermId1;
    my $newTermId2;

    foreach $id (keys %{$ann->_relations}) {
	$relation = $ann->_getRelationFromId($id);
	$newNumId = $relation->{'numId'} + $relationIdOffset;
	$concatAnn->_addRelation("R$newNumId", {
	    'id' => "R$newNumId",
	    'numId' => $newNumId,
	    'type' => $relation->{'type'},
	    'arg1' => $Term2newTerm->{$relation->{'arg1'}},
	    'arg2' => $Term2newTerm->{$relation->{'arg2'}},
			    });
    }

}


1;

__END__