#!/usr/bin/perl

use strict;
use warnings;
use Getopt::Long qw{:config posix_default no_ignore_case gnu_compat};
use IO::Socket;
use File::Spec;
use PPI::Document;
use PPI::Lexer;
use PPI::Dumper;
use Try::Tiny;
use POSIX ();
use PlSense::Logger;
use PlSense::Configure;
use PlSense::SocketClient;
use PlSense::Util;
use PlSense::Builtin;
use PlSense::ModuleKeeper;
use PlSense::AddressRouter;
use PlSense::AddressFinder;
use PlSense::CodeAssist;
use PlSense::Helper;

my %opthelp_of = ("-h, --help"      => "Show this message.",
                  "-c, --cachedir"  => "Path of directory caching information for Completion/Help.",
                  "--port1"         => "Port number for listening by main server process. Default is 33333.",
                  "--port2"         => "Port number for listening by work server process. Default is 33334.",
                  "--port3"         => "Port number for listening by resolve server process. Default is 33335.",
                  "--loglevel"      => "Level of logging. Its value is for Log::Handler.",
                  "--logfile"       => "Path of log file.",
                  "--never-give-up" => "Never give up to listen port", );

my %function_of = (status        => \&get_status,
                   pid           => \&get_own_pid,
                   init          => \&initialize,
                   remove        => \&remove,
                   removeall     => \&remove_all,
                   removeprojall => \&remove_project_all,
                   modhelp       => \&help_module,
                   subhelp       => \&help_method,
                   varhelp       => \&help_variable,
                   assisthelp    => \&help_last_assist,
                   codehelp      => \&help_code,
                   subinfo       => \&get_method_information,
                   onfile        => \&set_currentfile,
                   onmod         => \&set_currentmodule,
                   onsub         => \&set_currentmethod,
                   location      => \&get_current_location,
                   codeassist    => \&assist_coding,
                   ready         => \&is_ready,
                   debugstk      => \&debug_stocked,
                   debugmod      => \&debug_module,
                   debugrt       => \&debug_routing,
                   debuglex      => \&debug_lexer,
                   uninit        => \&uninitialize_module,
                   builtin       => \&setup_builtin,
                   found         => \&setup_found_module,
                   foundp        => \&setup_found_project_module,
                   built         => \&setup_built_module,
                   resolved      => \&setup_resolved,
                   loglvl        => \&update_loglevel,
                   explore       => \&explore_package,
                   );

my ($cachedir, $port1, $port2, $port3, $loglvl, $logfile, $never_give_up);
GetOptions ('help|h'        => sub { show_usage(); exit 0; },
            'cachedir|c=s'  => \$cachedir,
            'port1=i'       => \$port1,
            'port2=i'       => \$port2,
            'port3=i'       => \$port3,
            'loglevel=s'    => \$loglvl,
            'logfile=s'     => \$logfile,
            'never-give-up' => \$never_give_up, );

setup_logger($loglvl, $logfile);
if ( ! $cachedir || ! -d $cachedir ) {
    logger->fatal("Not exist cache directory [$cachedir]");
    exit 1;
}
set_primary_config( cachedir => $cachedir,
                    port1    => $port1,
                    port2    => $port2,
                    port3    => $port3,
                    loglevel => $loglvl,
                    logfile  => $logfile, );
setup_config() or exit 1;

my $scli = PlSense::SocketClient->new({ retryinterval => 0.2, maxretry => 5 });
my ($assist, $helper, $currfilepath, $currmdlnm, $currmtdnm);
set_builtin( PlSense::Builtin->new() );
set_mdlkeeper( PlSense::ModuleKeeper->new() );
set_addrrouter( PlSense::AddressRouter->new({ with_build => 0, }) );
set_addrfinder( PlSense::AddressFinder->new({ with_build => 0, }) );
$assist = PlSense::CodeAssist->new();
$helper = PlSense::Helper->new();

my $sock;
my $myport = get_config("port1");
SOCK_OPEN:
until ( $sock = IO::Socket::INET->new( LocalAddr => "localhost",
                                       LocalPort => $myport,
                                       Proto     => "tcp",
                                       Listen    => 1,
                                       ReUse     => 1, ) ) {
    if ( ! $never_give_up ) { last SOCK_OPEN; }
    logger->debug("Wait for releasing port : $myport");
    sleep 5;
}
if ( ! $sock ) {
    logger->fatal("Can't create socket : $!");
    exit 1;
}
if ( ! $sock->listen ) {
    logger->fatal("Can't listening port [$myport] : $!");
    exit 1;
}

set_signal_handler();
if ( ! initialize() ) {
    logger->fatal("Failed initialize");
    exit 1;
}
accept_client();
exit 0;


sub show_usage {
    my $optstr = "";
    OPTHELP:
    foreach my $key ( sort keys %opthelp_of ) {
        $optstr .= sprintf("  %-25s %s\n", $key, $opthelp_of{$key});
    }

    print <<"EOF";
Run PlSense Main Server.
Main Server handles request about Completion/Help.

Usage:
  plsense-server-main [Option]

Option:
$optstr
EOF
    return;
}

sub set_signal_handler {
    logger->debug("Start set signal handler");
    my $set_stop = POSIX::SigSet->new( &POSIX::SIGINT, &POSIX::SIGTERM );
    my $act_stop = POSIX::SigAction->new(
        sub {
            logger->notice("Receive SIGINT/SIGTERM");
            exit 0;
        }, $set_stop, &POSIX::SA_NODEFER);

    my $set_restart = POSIX::SigSet->new( &POSIX::SIGUSR1, &POSIX::SIGHUP );
    my $act_restart = POSIX::SigAction->new(
        sub {
            logger->notice("Receive SIGUSR1/SIGHUP");
            exec $0, get_common_options(), "--never-give-up";
            exit 0;
        }, $set_restart, &POSIX::SA_NODEFER);

    POSIX::sigprocmask( &POSIX::SIG_UNBLOCK, $set_stop );
    POSIX::sigprocmask( &POSIX::SIG_UNBLOCK, $set_restart );

    POSIX::sigaction( &POSIX::SIGINT,  $act_stop );
    POSIX::sigaction( &POSIX::SIGTERM, $act_stop );
    POSIX::sigaction( &POSIX::SIGUSR1, $act_restart );
    POSIX::sigaction( &POSIX::SIGHUP,  $act_restart );
}

sub initialize {
    logger->debug("Start initialize");
    setup_config() or return;
    $currfilepath = "";
    $currmdlnm = "";
    $currmtdnm = "";
    builtin->reset;
    mdlkeeper->reset;
    addrrouter->reset;
    builtin->setup_without_reload();
    mdlkeeper->setup_without_reload();
    addrrouter->setup_without_reload();
    addrrouter->load_current_project;
    return 1;
}

sub accept_client {
    logger->info("Starting main server");

    ACCEPT_CLIENT:
    while ( my $cli = $sock->accept ) {
        logger->debug("Waiting client ...");

        my $line = $cli->getline || "";
        chomp $line;
        logger->info("Receive request : $line");
        my $cmdnm = $line =~ s{ ^ \s* ([a-z]+) }{}xms ? $1 : "";
        if ( $cmdnm eq "quit" ) {
            $cli->close;
            next ACCEPT_CLIENT;
        }
        elsif ( $cmdnm eq "stop" ) {
            $cli->close;
            last ACCEPT_CLIENT;
        }
        elsif ( exists $function_of{$cmdnm} ) {
            try {
                my $fnc = $function_of{$cmdnm};
                my $ret = &$fnc($line) || "";
                $cli->print($ret);
                $cli->flush;
            }
            catch {
                my $e = shift;
                logger->error("Failed do $cmdnm : $e");
            };
        }
        else {
            logger->error("Unknown command [$cmdnm]");
        }
        $cli->close;

    }
    $sock->close;

    logger->info("Stopping main server");
}

sub update_instance_condition {
    my $force = shift;
    my $currmdl = addrfinder->get_currentmodule;
    if ( $force || ! $currmdl || $currmdl->get_name ne $currmdlnm || $currmdl->get_filepath ne $currfilepath ) {
        my $mdl = mdlkeeper->get_module($currmdlnm, $currfilepath);
        if ( ! $mdl ) {
            if ( ! $currmdlnm ) {
                logger->error("Not yet set current file/module by onfile/onmod command");
            }
            else {
                logger->error("Not yet exist [$currmdlnm] of [$currfilepath]");
                logger->error("Check the module status is not 'Nothing' by ready command.");
            }
            return 0;
        }
        addrfinder->set_currentmodule($mdl);
        $currmdl = $mdl;
    }
    my $currmtd = addrfinder->get_currentmethod;
    if ( $currmtdnm ) {
        if ( $force || ! $currmtd || $currmtd->get_name ne $currmtdnm ) {
            my $mtd = $currmdl->get_method($currmtdnm);
            if ( ! $mtd ) {
                logger->error("Not found [$currmtdnm] in [$currmdlnm] of [$currfilepath]");
                logger->error("Check the module status is 'Yes' by ready command.");
                return 0;
            }
            addrfinder->set_currentmethod($mtd);
        }
    }
    elsif ( $currmtd ) {
        addrfinder->init_currentmethod;
    }
    return 1;
}



sub get_status {
    return "Running\n";
}

sub get_own_pid {
    return $$."\n";
}

sub remove {
    my $mdl_or_files = shift || "";
    my @mdl_or_files = split m{ \| }xms, $mdl_or_files;
    ENTRY:
    foreach my $mdl_or_file ( @mdl_or_files ) {
        $mdl_or_file =~ s{ ^\s+ }{}xms;
        $mdl_or_file =~ s{ \s+$ }{}xms;
        if ( ! $mdl_or_file ) { next ENTRY; }
        my ($mdlnm, $filepath) = -f $mdl_or_file ? ("main", File::Spec->rel2abs($mdl_or_file))
                               :                   ($mdl_or_file, "");
        my $mdl = mdlkeeper->get_module($mdlnm, $filepath) or next ENTRY;
        if ( $filepath ) {
            foreach my $m ( mdlkeeper->get_bundle_modules($filepath) ) {
                mdlkeeper->remove_module($m->get_name, $m->get_filepath, $m->get_projectnm);
            }
        }
        else {
            mdlkeeper->remove_module($mdlnm, $filepath, $mdl->get_projectnm);
        }
    }
    return "Done\n";
}

sub remove_all {
    mdlkeeper->remove_all_module;
    return "Done\n";
}

sub remove_project_all {
    mdlkeeper->remove_project_all_module;
    return "Done\n";
}

sub help_module {
    my $mdlnm = shift || "";
    $mdlnm =~ s{ ^\s+ }{}xms;
    $mdlnm =~ s{ \s+$ }{}xms;
    my $mdl = mdlkeeper->get_module($mdlnm);
    if ( ! $mdl ) {
        logger->error("Not found module[$mdlnm]");
        return;
    }
    return $helper->get_symbol_help_text($mdl);
}

sub help_method {
    my $arg = shift || "";
    $arg =~ s{ ^\s+ }{}xms;
    my @e = split m{ \s+ }xms, $arg;
    my $mtdnm = shift @e || "";
    my $mdlnm = shift @e || "";
    my $mdl = mdlkeeper->get_module($mdlnm);
    my $mtd = $mdl ? $mdl->get_any_method($mtdnm) : undef;
    if ( $mtd ) { return $helper->get_symbol_help_text($mtd); }
    if ( builtin->exist_method($mtdnm) ) {
        my $mtd = builtin->get_method($mtdnm);
        return $helper->get_symbol_help_text($mtd);
    }
    my $fullnm = $mdlnm ? $mdlnm."::".$mtdnm : $mtdnm;
    logger->error("Not found method[$fullnm]");
    return;
}

sub help_variable {
    my $arg = shift || "";
    $arg =~ s{ ^\s+ }{}xms;
    my @e = split m{ \s+ }xms, $arg;
    my $varnm = shift @e || "";
    my $mdlnm = shift @e || "";
    my $mdl = mdlkeeper->get_module($mdlnm);
    my $var = $mdl && $mdl->exist_member($varnm) ? $mdl->get_member($varnm) : undef;
    if ( $var ) { return $helper->get_symbol_help_text($var); }
    if ( builtin->exist_variable($varnm) ) {
        my $var = builtin->get_variable($varnm);
        return $helper->get_symbol_help_text($var);
    }
    my $fullnm = $mdlnm ? $mdlnm."::".$varnm : $varnm;
    logger->error("Not found variable[$fullnm]");
    return;
}

sub help_last_assist {
    my $candidate = shift || "";
    $candidate =~ s{ ^\s+ }{}xms;
    $candidate =~ s{ \s+$ }{}xms;
    my $any = $assist->get_last_candidate_instance($candidate);
    return $helper->get_any_help_text($any);
}

sub help_code {
    my $code = shift || "";
    update_instance_condition() or return;
    return $helper->get_help_text_by_code($code);
}

sub get_method_information {
    my $code = shift || "";
    update_instance_condition() or return;
    return $helper->get_method_info_by_code($code);
}

sub set_currentfile {
    my $filepath = shift || "";
    $filepath =~ s{ ^\s+ }{}xms;
    $filepath =~ s{ \s+$ }{}xms;
    if ( ! -f $filepath ) {
        logger->error("Not exist file[$filepath]");
        return "Failed\n";
    }
    $currfilepath = File::Spec->rel2abs($filepath);
    $currmdlnm = "main";
    $currmtdnm = "";
    logger->notice("Set current file is [$currfilepath]");
    setup_config($currfilepath);
    builtin->setup();
    mdlkeeper->setup();
    addrrouter->setup();
    return "Done\n";
}

sub set_currentmodule {
    my $mdlnm = shift || "";
    $mdlnm =~ s{ ^\s+ }{}xms;
    $mdlnm =~ s{ \s+$ }{}xms;
    $currmdlnm = $mdlnm;
    $currmtdnm = "";
    logger->notice("Set current module is [$currmdlnm]");
    return "Done\n";
}

sub set_currentmethod {
    my $mtdnm = shift || "";
    $mtdnm =~ s{ ^\s+ }{}xms;
    $mtdnm =~ s{ \s+$ }{}xms;
    $currmtdnm = $mtdnm;
    logger->notice("Set current method is [$currmtdnm]");
    return "Done\n";
}

sub get_current_location {
    my $ret = "Project: ".get_config("name")."\n";
    $ret .= "File: $currfilepath\n";
    $ret .= "Module: $currmdlnm\n";
    $ret .= "Sub: $currmtdnm\n";
    return $ret;
}

sub assist_coding {
    my $code = shift || "";
    update_instance_condition() or return;
    return join("\n", $assist->get_assist($code))."\n";
}

sub is_ready {
    my $mdl_or_file = shift || "";
    $mdl_or_file =~ s{ ^\s+ }{}xms;
    $mdl_or_file =~ s{ \s+$ }{}xms;
    if ( ! $mdl_or_file ) {
        return join("\n", map { $_->get_name } mdlkeeper->get_built_modules)."\n";
    }
    my ($mdlnm, $filepath) = -f $mdl_or_file ? ("main", File::Spec->rel2abs($mdl_or_file))
                           :                   ($mdl_or_file, "");
    my $mdl = mdlkeeper->get_module($mdlnm, $filepath) or return "Not Found\n";
    if ( ! $mdl->is_initialized ) { return "No\n"; }
    return "Yes\n";
}

sub debug_stocked {
    my $ret = mdlkeeper->describe_keep_value;
    $ret .= addrrouter->describe_keep_value;
    return $ret;
}

sub debug_module {
    my $mdl_or_file = shift || "";
    $mdl_or_file =~ s{ ^\s+ }{}xms;
    $mdl_or_file =~ s{ \s+$ }{}xms;
    my ($mdlnm, $filepath) = -f $mdl_or_file ? ("main", File::Spec->rel2abs($mdl_or_file))
                           :                   ($mdl_or_file, "");
    my $mdl = mdlkeeper->get_module($mdlnm, $filepath) or return;
    return $mdl->to_detail_string;
}

sub debug_routing {
    my $regexp = shift || "";
    return addrrouter->to_string_by_regexp($regexp);
}

sub debug_lexer {
    my $code_or_file = shift || "";
    $code_or_file =~ s{ \A\s+ }{}xms;
    my $doc = -f $code_or_file ? PPI::Document->new( $code_or_file, readonly => 1 )
            :                    PPI::Lexer->new()->lex_source($code_or_file)
            or return;
    my $dumper = PPI::Dumper->new($doc) or return;
    return $dumper->string;
}

sub uninitialize_module {
    my $mdl_or_file = shift || "";
    $mdl_or_file =~ s{ ^\s+ }{}xms;
    $mdl_or_file =~ s{ \s+$ }{}xms;
    my ($mdlnm, $filepath) = -f $mdl_or_file ? ("main", File::Spec->rel2abs($mdl_or_file))
                           :                   ($mdl_or_file, "");
    my $mdl = mdlkeeper->get_module($mdlnm, $filepath) or return;
    if ( $filepath ) {
        foreach my $m ( mdlkeeper->get_bundle_modules($filepath) ) {
            $m->uninitialized;
        }
    }
    else {
        $mdl->uninitialized;
    }

    return;
}

sub setup_builtin {
    builtin->load;
    return;
}

sub setup_found_module {
    my $mdl_or_files = shift || "";
    my $is_project = shift || 0;
    my @mdl_or_files = split m{ \| }xms, $mdl_or_files;
    ENTRY:
    foreach my $mdl_or_file ( @mdl_or_files ) {
        $mdl_or_file =~ s{ ^\s+ }{}xms;
        $mdl_or_file =~ s{ \s+$ }{}xms;
        if ( ! $mdl_or_file ) { next ENTRY; }
        my ($mdlnm, $filepath) = -f $mdl_or_file ? ("main", File::Spec->rel2abs($mdl_or_file))
                               :                   ($mdl_or_file, "");
        $is_project ? mdlkeeper->get_project_module($mdlnm, $filepath)
                    : mdlkeeper->get_module($mdlnm, $filepath);
    }
    $is_project ? logger->info("Finished setup found project module")
                : logger->info("Finished setup found module");
    return;
}

sub setup_found_project_module {
    my $mdl_or_files = shift || "";
    setup_found_module($mdl_or_files, 1);
}

sub setup_built_module {
    my $mdl_or_files = shift || "";
    my @mdl_or_files = split m{ \| }xms, $mdl_or_files;
    ENTRY:
    foreach my $mdl_or_file ( @mdl_or_files ) {
        $mdl_or_file =~ s{ ^\s+ }{}xms;
        $mdl_or_file =~ s{ \s+$ }{}xms;
        if ( ! $mdl_or_file ) { next ENTRY; }
        my ($mdlnm, $filepath) = -f $mdl_or_file ? ("main", File::Spec->rel2abs($mdl_or_file))
                               :                   ($mdl_or_file, "");
        my $mdl = mdlkeeper->load_module($mdlnm, $filepath) or next ENTRY;
        logger->notice("Finished reload module of '$mdl_or_file'");
    }
    update_instance_condition(1);
    return;
}

sub setup_resolved {
    addrrouter->load_current_project;
    return;
}

sub update_loglevel {
    my $loglvl = shift || "";
    $loglvl =~ s{ ^\s+ }{}xms;
    $loglvl =~ s{ \s+$ }{}xms;
    update_logger_level($loglvl);
    set_primary_config(loglevel => $loglvl);
    return;
}

sub explore_package {
    my $pkg_regexp = shift || "";
    $pkg_regexp =~ s{ ^\s+ }{}xms;
    $pkg_regexp =~ s{ \s+$ }{}xms;
    my $ret = "";
    PKG:
    foreach my $pkg ( grep { ! $pkg_regexp || $_->get_fullnm =~ m{ $pkg_regexp }xms } mdlkeeper->get_packages(1) ) {
        $ret .= $pkg->get_name." ".$pkg->get_filepath." ".$pkg->get_linenumber.":".$pkg->get_colnumber."\n";
        PARENT:
        for my $i ( 1..$pkg->count_parent ) {
            $ret .= "  > ".$pkg->get_parent($i)->get_name."\n";
        }
        USINGMDL:
        for my $i ( 1..$pkg->count_usingmdl ) {
            $ret .= "  < ".$pkg->get_usingmdl($i)->get_name."\n";
        }
        MTD:
        foreach my $mtd ( $pkg->get_own_methods ) {
            $ret .= "  &".$mtd->get_name." ".$mtd->get_linenumber.":".$mtd->get_colnumber."\n";
        }
        $ret .= "\n";
    }
    return $ret;
}
