File Coverage

blib/lib/RDF/NLP/SPARQLQuery.pm

Criterion	Covered	Total	%
statement	179	204	87.7
branch	54	64	84.3
condition	8	15	53.3
subroutine	24	24	100.0
pod	13	13	100.0
total	278	320	86.8

package RDF::NLP::SPARQLQuery;

use utf8;
use strict;
use warnings;

our $VERSION='0.1';

use Data::Dumper;
use Config::General;

use RDF::NLP::SPARQLQuery::Question;

# DOC
sub new {
    my $class = shift;
    my %args = @_;

    binmode(STDERR, ":utf8");
    binmode(STDOUT, ":utf8");
    binmode(STDIN, ":utf8");

    my $NLQuestion = {
	"files" => {
	    'config' => undef,
	    # 'questions' => undef,
	    'semtypecorresp' => undef,
	},
	'config' => undef,
	'questions' => undef,
	'semtypecorresp' => {},
	'format' => "XML",
	'verbose' => 0,
    };

    bless $NLQuestion, $class;
    return($NLQuestion);
}

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

    return($self->{'files'});
}

sub configFile {
    my $self = shift;

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

sub format {
    my $self = shift;

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

# DOC
sub verbose {
    my $self = shift;

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

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

    return($self->{'config'});
}

# sub _questionsFile {
#     my $self = shift;

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

sub _semtypecorrespFile {
    my $self = shift;
    my $lang = shift;

    return($self->config->{'NLQUESTION'}->{'language="'. uc($lang) . '"'}->{'SEMANTICTYPECORRESPONDANCE'});
}

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

    if (!defined $self->{'semtypecorresp'}) {
	$self->{'semtypecorresp'} ={};
    }

    return($self->{'semtypecorresp'});
}

# DOC
sub loadConfig {

    my ($self, ) = @_;
    my $language;

    my $cg = new Config::General('-ConfigFile' => $self->configFile,
				 '-InterPolateVars' => 1,
				 '-InterPolateEnv' => 1
	);

    my %config = $cg->getall;

    $self->_printVerbose(Dumper(\%config),2);

    $self->{'config'} = \%config;

    foreach $language (keys %{$config{'NLQUESTION'}}) {
	if ($language =~ /language=\"?(?[^"]+)\"?/) {
	    $self->_loadSemtypecorresp(lc($+{lang}));
	}
    }

    return($self->config);
}

# DOC
sub loadInput {

    my ($self, $filename) = @_;
    my $line;
    my $docId;
    my $language;
    my @sentences;
    my @postags;
    my @semanticUnits;
    my $word;
    my $postag;
    my $lemma;
    my $start_offset;
    my $semanticUnit;
    my $canonical_form;
    my $semanticTypes;
    my %semTypes;
    my $end_offset;
    my $semf;
    my $question;
    my $id;

    open FILE, "<:utf8", $filename or die "No such file $filename\n";
#    warn "filename: $filename\n";
    while($line = ) {
	chomp($line);
	if ($line !~ /^\s*#/) {
	    if ($line =~ /^DOC:\s?(?.*)/) {
		$docId = $+{id}; #'
		# warn "docId: $docId\n";
	    }
	    if ($line =~ /^language:\s?(?.*)/) {
		$language = $+{lang}; #'
	    }
	    if ($line =~ /^sentence:\s/) {
		while($line = ) {
		    chomp($line);
		    if (($line !~ /^\s*#/) && ($line !~ /^\s*$/)) {
			if ($line ne "_END_SENT_") {
			    push @sentences, $line;
			} else {
			    last;
			}
		    }
		}
	    }
#	    warn "line: $line\n";
	    if ($line =~ /^word information:/) {
		$id=0;
		while($line = ) {
		    chomp($line);
		    if (($line !~ /^\s*#/) && ($line !~ /^\s*$/)) {
			if ($line ne "_END_POSTAG_") {
			    ($word, $postag, $lemma, $start_offset) = split /\t/, $line;
#			    push @postags, $line;
			    push @postags, {
				"id" => $id,
				"word" => $word,
				"postag" => $postag,
				"lemma" => $lemma,
				"start_offset" => $start_offset,
				"line" => $line,
			    };
			    $id++;
			} else {
			    last;
			}
		    }
		}
	    }
	    if ($line =~ /^semantic units:/) {
		$id = 0;
		my %lines;
		while($line = ) {
		    chomp($line);
		    if (($line !~ /^\s*#/) && ($line !~ /^\s*$/)&&(!exists $lines{$line})) {
			if ($line ne "_END_SEM_UNIT_") {
			$lines{$line}++;
			($semanticUnit, $canonical_form, $semanticTypes, $start_offset, $end_offset) = split /\t/, $line;
#			    push @semanticUnits, $line;
			    %semTypes=();
			    foreach $semf (split /:/, $semanticTypes) {
				$semTypes{$semf} = [split /\//, $semf];
			    }
			    # warn $semanticUnit . " ($semanticTypes)\n";
			    # warn "\t" . join('::', keys(%semTypes)) . "\n";
			    push @semanticUnits, {
				"id" => $id,
				"semanticUnit" => $semanticUnit,
				"canonical_form" => $canonical_form,
				"semanticTypes" => {%semTypes},
				"start_offset" => $start_offset,
				"end_offset" => $end_offset,
				"line" => $line,
			    };
			    $id++;
			} else {
			    last;
			}
		    }
		}
	    }
	    if ($line eq "_END_DOC_") {
		$question = RDF::NLP::SPARQLQuery::Question->new("docId" => $docId,
								       'verbose' => $self->verbose,
								       "language" => uc($language),
								       "sentences" => \@sentences,
								       "postags" => \@postags,
								       "semanticUnits" => \@semanticUnits,
								       "config" => $self->config,
		    );
		$self->_addQuestion($question->{'docId'}, $question);
		$docId = undef;
		$language = undef;
		@sentences = ();
		@postags = ();
		@semanticUnits = ();
	    }
	}

    }

    close FILE;

    return(scalar($self->questionIds));
}

sub questions {
    my $self = shift;

    if (!(defined $self->{'questions'})) {
	$self->{'questions'} = {};
    }
    return($self->{'questions'});
}

sub getQuestionList {
    my $self = shift;

    return(values %{$self->{'questions'}});
}

sub questionIds {
    my $self = shift;

    return(keys %{$self->{'questions'}});
}

sub getQuestionFromId {
    my $self = shift;
    my $docId;

    if (@_) {
	$docId = shift;
	if (exists $self->questions->{$docId}) {
	    return($self->questions->{$docId});
	}
    }
    return(undef);
}

sub _addQuestion {
    my $self = shift;
    my $docId = shift;

    if (!defined $docId) {
	return(undef);
    }

    if (@_) {
	$self->questions->{$docId} = shift;
    }

    return($self->questions->{$docId});
}


sub _loadSemtypecorresp {
    my ($self, $lang) = @_;

    my $cg = new Config::General('-ConfigFile' => $self->_semtypecorrespFile($lang),
				 '-InterPolateVars' => 1,
				 '-InterPolateEnv' => 1
	);

    my %resource = $cg->getall;

    $self->semtypecorresp->{uc($lang)} = \%resource;

    $self->_printVerbose( Dumper($self->semtypecorresp->{uc($lang)}), 3);

    return($self->semtypecorresp->{uc($lang)});
}

# DOC
sub Questions2Queries {
    my $self = shift;
    my $outStr = shift;
    my $question;
    my $questionCount = 0;
    my $docHeadId;
    my $docId;
    my $outStr2;
    my $answer;

    if ($self->format eq "XML") {
	$$outStr = '' . "\n";
	# warn $self->getQuestionList;
	$docId = ($self->getQuestionList)[0]->docId;
	# warn $docId;
	$docId =~ /\-([\d\w]+)$/;
	$docHeadId = $`;

	$$outStr .= '' . "\n";
    }
    foreach $question ($self->getQuestionList) {
#	warn $self->semtypecorresp;
	# $self->format,
	$self->_printVerbose($question->docId . "\n");
	$questionCount += $question->Question2Query($self->semtypecorresp);
	$self->_printVerbose($question->query->queryString);
	# $$outStr .= $outStr2;
	if ($self->format eq "XML") {
	    # warn $question->query->queryXMLString;
	    $$outStr .= $question->query->queryXMLString;
	}
	if ($self->format eq "SPARQL") {
	    # warn $question->query->queryString;
	    $$outStr .= $question->query->queryString;
	}
	if ($self->format eq "SPARQLANSWERS") {
	    $question->query->getQueryAnswers;
	    $$outStr .= "\n" . $question->docId . "\n";
	    $$outStr .= join("\n",keys(%{$question->query->queryAnswers}));
	}
	if ($self->format eq "XMLANSWERS") {
	    $$outStr .= $question->query->queryXMLString;
	    $$outStr =~ s!\n!!;

	    $question->query->getQueryAnswers;
	    $$outStr .= "\n";
	    foreach $answer (keys(%{$question->query->queryAnswers})) {
		$$outStr .= "\n";
		$$outStr .= "$answer\n";
		$$outStr .= "\n";
	    }
	    $$outStr .= "\n";
	    $$outStr .= "\n";
	}
    }
    if ($self->format eq "XML") {
	$$outStr .= '' . "\n";
    }

    return($questionCount);
}

sub _printVerbose {
    my($self, $msg, $level) = @_;

    if (!defined $level) {
	$level = 1;
    }

    if (($self->verbose > 0) && ($self->verbose >= $level)) {
	warn "$msg";
    }

}




1;

__END__