plsense 0.3.1-1 / usr / bin / plsense-worker-build

#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

use strict;
use warnings;
use Getopt::Long qw{:config posix_default no_ignore_case gnu_compat};
use IO::Socket;
use List::AllUtils qw{ uniq };
use Try::Tiny;
use PlSense::Logger;
use PlSense::Configure;
use PlSense::SocketClient;
use PlSense::Util;
use PlSense::Builtin;
use PlSense::ModuleKeeper;
use PlSense::AddressRouter;
use PlSense::SubstituteKeeper;
use PlSense::SubstituteBuilder;
use PlSense::ModuleSrcUpdater;
use PlSense::ModuleBuilder::XrefBuilder;
use PlSense::ModuleBuilder::InheritBuilder;
use PlSense::ModuleBuilder::DocBuilder;
use PlSense::ModuleBuilder::PPIBuilder;

my ($cachedir, $port1, $port2, $port3, $confpath, $mdl_or_file, $recursive, $force, $loglvl, $logfile);
GetOptions ('cachedir=s' => \$cachedir,
            'port1=i'    => \$port1,
            'port2=i'    => \$port2,
            'port3=i'    => \$port3,
            'confpath=s' => \$confpath,
            'target=s'   => \$mdl_or_file,
            'recursive'  => \$recursive,
            'force'      => \$force,
            'loglevel=s' => \$loglvl,
            'logfile=s'  => \$logfile, );

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

set_builtin( PlSense::Builtin->new() );
set_mdlkeeper( PlSense::ModuleKeeper->new() );
set_addrrouter( PlSense::AddressRouter->new({ with_build => 1, }) );
set_substkeeper( PlSense::SubstituteKeeper->new() );
set_substbuilder( PlSense::SubstituteBuilder->new() );

my $scli           = PlSense::SocketClient->new({ retryinterval => 0.5, maxretry => 300 });
my $srcupdater     = PlSense::ModuleSrcUpdater->new();
my $xrefbuilder    = PlSense::ModuleBuilder::XrefBuilder->new();
my $inheritbuilder = PlSense::ModuleBuilder::InheritBuilder->new();
my $docbuilder     = PlSense::ModuleBuilder::DocBuilder->new();
my $ppibuilder     = PlSense::ModuleBuilder::PPIBuilder->new();
my (@builtmdls, @builtmdlkeys, @extmdls);

$SIG{INT}  = sub { logger->notice("Receive SIGINT");  interrupt_build(); exit 0; };
$SIG{TERM} = sub { logger->notice("Receive SIGTERM"); interrupt_build(); exit 0; };

try {
    builtin->setup_without_reload();
    builtin->build();
    mdlkeeper->setup_without_reload();
    addrrouter->setup_without_reload();
    substkeeper->setup_without_reload();

    my ($filepath, $mdl);
    if ( -f $mdl_or_file ) {
        $filepath = $mdl_or_file;
        $mdl = mdlkeeper->get_module("main", $filepath);
    }
    else {
        $mdl = mdlkeeper->get_module($mdl_or_file);
        if ( ! $mdl ) {
            logger->warn("Not found module named [$mdl_or_file]");
            finish_build();
            exit 1;
        }
        $filepath = $mdl->get_filepath;
        if ( ! $filepath || ! -f $filepath ) {
            mdlkeeper->remove_module($mdl->get_name, $mdl->get_filepath, $mdl->get_projectnm);
            finish_build();
            exit 1;
        }
    }

    my @attr = stat $filepath;
    my $lastmodified = $attr[9];

    if ( ! $force && $mdl && $mdl->is_initialized && $lastmodified == $mdl->get_lastmodified ) {
        logger->info("Already build [$mdl_or_file]");
        finish_build(get_extmodules($mdl));
        exit 0;
    }

    my $perl = get_config("perl");
    my $libopt = get_config("lib-path") ? "-I'".get_config("lib-path")."'" : "";
    if ( system("$perl $libopt -c '$filepath' 2>/dev/null") ) {
        logger->error("Failed compile '$filepath'");
        finish_build();
        exit 1;
    }

    my @mdls = $srcupdater->update_or_create_modules($filepath, $mdl ? $mdl->get_projectnm : get_config("name"));
    if ( ! -f $mdl_or_file ) { @mdls = ($mdl); }

    MDL:
    foreach my $mdl ( @mdls ) {

        my $mdlkey = $mdl->get_name eq "main" ? $mdl->get_filepath : $mdl->get_name;
        substkeeper->reset;

        logger->notice("Start build [".$mdl->get_name."] : XRef part");
        $xrefbuilder->build($mdl);
        logger->notice("Start build [".$mdl->get_name."] : Inherit part");
        $inheritbuilder->build($mdl);
        logger->notice("Start build [".$mdl->get_name."] : Perldoc part");
        $docbuilder->build($mdl);
        logger->notice("Start build [".$mdl->get_name."] : PPI part");
        $ppibuilder->build($mdl);

        if ( ! $scli->get_resolve_server_response("remove $mdlkey") ) { next MDL; }

        $mdl->set_source(undef);
        $mdl->initialized;
        mdlkeeper->store_module($mdl);
        substkeeper->resolve_unknown_argument;
        substkeeper->store($mdl->get_name, $mdl->get_filepath, $mdl->get_projectnm);
        push @builtmdls, $mdl;
        push @builtmdlkeys, $mdlkey;
        push @extmdls, get_extmodules($mdl);
        logger->notice("Finished build [".$mdl->get_name."]\n".$mdl->to_detail_string);

    }
}
catch {
    my $e = shift;
    logger->error("Failed build '$mdl_or_file' : $e");
};

@extmdls = uniq(sort @extmdls);
if ( $#builtmdlkeys >= 0 ) {
    logger->notice("Request reload modules : ".join(", ", @builtmdlkeys));
    $scli->request_main_server("built ".join("|", @builtmdlkeys));
    if ( ! $scli->request_resolve_server("built ".join("|", @builtmdlkeys)) ) { interrupt_build(); }
}

finish_build(@extmdls);
exit 0;


sub finish_build {
    my @extmdls = @_;

    if ( $#extmdls >= 0 ) {
        logger->notice("Request build extmodules : ".join(", ", @extmdls));
        $scli->request_work_server("buildr ".join("|", @extmdls));
    }

    $scli->request_work_server("finbuild $mdl_or_file");
}

sub get_extmodules {
    my ($mdl, $found_is) = @_;

    my @ret;
    if ( ! $recursive ) { return @ret; }
    if ( ! $found_is ) { $found_is = {}; }
    if ( $found_is->{$mdl->get_name} ) { return @ret; }
    $found_is->{$mdl->get_name} = 1;

    PARENT:
    for my $i ( 1..$mdl->count_parent ) {
        my $parent = $mdl->get_parent($i);
        my $m = mdlkeeper->get_module($parent->get_name);
        if ( $m->is_initialized ) {
            push @ret, get_extmodules($m, $found_is);
        }
        else {
            push @ret, $parent->get_name;
        }
    }
    USINGMODULE:
    for my $i ( 1..$mdl->count_usingmdl ) {
        my $usingmdl = $mdl->get_usingmdl($i);
        my $m = mdlkeeper->get_module($usingmdl->get_name);
        if ( $m->is_initialized ) {
            push @ret, get_extmodules($m, $found_is);
        }
        else {
            push @ret, $usingmdl->get_name;
        }
    }

    return uniq(sort @ret);
}

sub interrupt_build {
    BUILTMDL:
    foreach my $mdl ( @builtmdls ) {
        $mdl->uninitialized;
        mdlkeeper->store_module($mdl);
    }
}