The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -X
use Data::Dumper;
use JSON;
use Digest::MD5 qw(md5_hex);


my ($words,$debug)=0;
if( grep{/\bdebug\b/} @ARGV ){$debug = 1; cleanArgs("debug"); };
if( grep{/\bwords\b/} @ARGV ){$words = 1; cleanArgs("words"); };


sub cleanArgs{
    my ($key) = @_;
    my @tmp=();
    foreach(@ARGV){
    push @tmp,$_ unless($_=~/$key/);}

    @ARGV=@tmp;
}



my $add={};
my $m = my $body = my $sense = my $name = my $type = my $entity = "";
my $mysense = 0;
my $i = 0;
# convert to lower case, translate ' ' to '_' and eliminate any
# syntactic marker
sub lower#
{
    my $word = shift;
    $word =~ tr/A-Z /a-z_/;
    $word =~ s/\(.*\)$//;
    return $word;
}

# translate ' ' to '_'
sub underscore#
{
    $_[0] =~ tr/ /_/;
    return $_[0];
}

# Eliminate any syntactic marker
sub delMarker#
{
    $_[0] =~ s/\(.*\)$//;
    return $_[0];
}


sub trim
{
  my $string = shift;
  if($string && $string =~ /of (verb|noun)/){
#    return "";
  }

  $string =  "" unless  $string;
  $string =~ s/^\s+//;
  $string =~ s/\s+$//;
  $string =~ s/\t//;
  $string =~ s/^\s//;
  $string =~ s/^->//;
  $string =~ s/^=>//;

  return $string;
}
$body = "
[/zero/]
0
[/zero/]
[/zero/]
0
[/zero/]
[/mask/]
Perl Safe error
[/mask/]
[/Other division error/]
1
[/Other division error/]
[/catch/]
1
[/catc/]
";

$m = $ARGV[0];
$mysense = $ARGV[1] unless(!$ARGV[1]);
$m = `micro any` unless($m);
$m =~s/\n//g unless(!$m);
#print  Dumper `wn  hydra  -over -hypen -hypon -synsn -smemn -membn -subsn -meron -holon -derin -domnn -famln -coorn -hmern -grepn`;# unless(!$m);
$body = "wn $m -over -hypen -hypon -synsn -smemn -membn -subsn -meron -holon -derin -domnn -famln -coorn -hmern -grepn" unless(!$m);
exit(0) unless($m);


my @found=();
$body = `$body`;
my @base;
$add = {};
my ($more0,$more1,$more2,$more3,$more4,$more5,$more6,$more7);
my $string;
while($body =~ s{Sense*(.*?)\n(.*?)\n(.*?)\n(.*?)\n(.*?)\n(.*?)\n(.*?)\n(.*?)\n(.*?)}{}x){


 @base = ();

 $sense   = trim($1);
 
 if($mysense){
 
  next unless($sense == $mysense);
 }
 
 $name    = trim($2);
 $type    = trim($3);
 $entity  = trim($4);

 $more0    = trim($5);
 $more1    = trim($6);

 $more2    = trim($7);
 $more3    = trim($8);


 $more4    = trim($9);
 $more5    = trim($10);

 $more6    = trim($11);
 $more7    = trim($12);

 $string = sprintf "\n%s#%s#%s#%s#%s#%s#%s#%s#%s#%s#%s#%s#", $sense,$name,$type,$entity,$more0,$more1,$more2,$more3,$more4,$more5,$more6,$more7;
 $test = $string;
 while($test =~ s{([A-Z][A-Z].*?) (.*?)\#}{}x){

  
  push @{$add->{$sense}},trim($1).trim($2);

 }


$base->{$sense}->{$i}=[] unless($sense eq '');

push @{$base->{$sense}->{$i}},$name unless($name eq '');

push @{$base->{$sense}->{$i}},$type unless($type eq '');

push @{$base->{$sense}->{$i}},$entity unless($entity eq '');

push  @found,$base->{$sense}->{$i};


$i++;
}

my $data = {"rows"=>\@found,"parts"=>$add,"ontology"=>importOntology($add)};
my $utf8_encoded_json_text = encode_json($data);

sub importOntology {

  my $ontology = {};

  foreach(keys %$add){

    $ontology->{counts}->{$_}= [map{$_= $_;}grep{/[A-Z]/}@{$add->{$_}}];
  }

  return $ontology;
}




sub importOntology2 {
  my $add = shift;
  my $ontology = {};
  my @sets = <DATA>;
  my $ix = 0;
  foreach my $sense (keys %$add){

    my $tmp={};
    push @{$ontology->{$sense}},grep{join("|",@sets)}@{$add->{$sense}};

    my $i=0;
        $tmp->{search}=join("\|",<DATA>);
    
    foreach(@{$ontology->{$sense}}){
        $b=$_;
        $b=~s/$tmp->{search}//g;

        $tmp->{$b}=$i++;

    }
    unlink($tmp->{search});
    $ix+=$i;
    @{$ontology->{$sense}} = [sort keys $tmp,$i];
  }

  #}
  $ontology->{count}=$ix;

  return $ontology;
}

   my $utf8 = encode_json(importOntology2($add));#,importOntology2($add)]

   print $utf8;

1;
__DATA__
HAS INSTANCE
TOPIC
RELATED TO
INSTANCE OF
HAS PART
MEMBER OF
HAS MEMBER
USAGE
HAS SUBSTANCE
PART OF