The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use Cwd;
use strict;
use warnings;
use JSON::XS;
use Config::Auto;
use Data::Dumper;
use Data::Printer;
use AI::MicroStructure;
use AI::MicroStructure::Util;
use Storable::CouchDB;
use IO::Async::Loop;
use Digest::MD5;
use Net::Async::WebSocket::Server;
use JSON::XS;
use Env qw/PWD/;

push @ARGV,3001 unless(@ARGV);

my @symbols = ();
my $DEBUG = 10;
my $DEBUG_TO_SYSLOG=1;
my $LOGGER_EXE="/usr/bin/logger";
my $PORT = shift @ARGV;
my $JSON = {};
my $pwd = $PWD;


my @ARGVX = ();


our $json_main =  {lang=>"C",category=>"no",name=>"santex",size=>1,children=>[]};

@ARGVX=("user",
      "pass",
      "localhost",
      "nav") unless($#ARGVX>2);



our $x = AI::MicroStructure->new;


sub getAll {
  my $key =shift;

  require LWP::UserAgent;
  my $ua = LWP::UserAgent->new;
  my ($server,$db) = ($x->{state}->{cfg}->{couchdb},"table");
  my $res = $ua->get(sprintf('%s/%s/_design/base/_view/instances?reduce=false&start_key=["%s"]&end_key=["%sZZZ"]',
                              $server,
                              $db,
                              $key,
                              $key));


my $cc= {};
my $content = decode_json($res->content);
my @all;
my @book;

foreach(@{$content->{rows}}){

  if(@{$_->{key}}){
    push @all,@{$_->{key}};
  }
}
if(!$#all){

my $wn = `micrownet $key`;

@all = split(/(\,|.|\)|\n|=>|[ ])/,$wn);

}

return {set=>[@all]};


}




#$ARGV[0] = "" unless($ARGV[0]);
#my $key = sprintf("%s_%s",join("",@ARGVX),$ARGV[0]);
#my @datax = getAll($ARGV[0]);

#if($#datax){


#foreach my $i(0..$#datax) {

 # printf("%s\n","".$datax[$i]) unless(!$datax[$i]);

#}
#}
sub search {
  my $search = shift;


    my $date = `micrownet $search`;

    return {$search=>$date};

  }

sub printer {
  my ($msg,$dorel) = @_;
  my $cmd = {};

     $msg = "space" unless($msg);

     my $data = getAll($msg);

    my @data = @{$data->{set}};

     @data  = @data[0..5000] unless($#data<10000);
     $cmd->{q} = join(" ",@data);

     $cmd->{action} =
      [map{my @a= [split(":",$_)]; $a[0][0]=~ s/ //g;
                    $_={nb => $a[0][1], sp => $a[0][0]}}
                    split ("\n",`echo "$cmd->{q}" | tr " " "\n" | data-freq --limit 100`)];





     my @rel = split("\n",` micro-relation $msg`);

     my $rel = join(" ",@rel);

     $cmd->{"DensityMap"} =[split ("\n",`echo "$rel" | tr " " "\n" | data-freq --limit 200`)];
#map{my @a= [split(":",$_)]; $a[0][0]=~ s/ //g;
#                    $_={nb => $a[0][1], sp => $a[0][0]}}



     $cmd->{json} = JSON::XS->new->pretty(0)->encode({ "query" => $msg,
                                                      "callback" => "makeList",
                                                      "DensityMap"=> $cmd->{"DensityMap"},
                                                      "responce" =>
                                                      [$cmd->{action}]});

      $cmd->{rel}=\@rel;

      return $cmd;

}


my $server = Net::Async::WebSocket::Server->new(
   on_client => sub {
      my ( undef, $client ) = @_;
      my $list;

      $client->configure(
         on_frame => sub {
            my ( $self, $frame ) = @_;

            my $list = printer($frame) unless(!$frame);

            my %args = (max_payload_size=>9999999,buffer=> $list);


            $self->send_frame(%args);
            my @rel = @{$list->{rel}};


     #       foreach(@rel){

  #            $list = search($_);
   #           if(defined($list->{$_}) and $list->{$_}){
 #             %args = (max_payload_size=>9999999,buffer=>  JSON::XS->new->pretty(0)->encode({cmd=>$list}));


#              $self->send_frame(%args);
    #          }
      #      }

#          p $list;


         },
      );



   }
);

my $loop = IO::Async::Loop->new(max_payload_size=>11110);

$loop->add( $server );

$server->listen(
   family => "inet",
   service => $PORT,
   ip=>"127.0.0.1",

   on_listen => sub { print Dumper "Cannot listen - ",$_[-1];  },
   on_resolve => sub { print Dumper "Cannot resolve - ",$_[-1];},
   on_listen_error => sub { die "Cannot listen - $_[-1]" },
   on_resolve_error => sub { die "Cannot resolve - $_[-1]" },
);

$loop->loop_forever;

1;

__END__