xref: /trunk/main/solenv/bin/build.pl (revision cdf0e10c)
1*cdf0e10cSrcweir:
2*cdf0e10cSrcweir    eval 'exec perl -S $0 ${1+"$@"}'
3*cdf0e10cSrcweir        if 0;
4*cdf0e10cSrcweir#*************************************************************************
5*cdf0e10cSrcweir#
6*cdf0e10cSrcweir# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
7*cdf0e10cSrcweir#
8*cdf0e10cSrcweir# Copyright 2000, 2010 Oracle and/or its affiliates.
9*cdf0e10cSrcweir#
10*cdf0e10cSrcweir# OpenOffice.org - a multi-platform office productivity suite
11*cdf0e10cSrcweir#
12*cdf0e10cSrcweir# This file is part of OpenOffice.org.
13*cdf0e10cSrcweir#
14*cdf0e10cSrcweir# OpenOffice.org is free software: you can redistribute it and/or modify
15*cdf0e10cSrcweir# it under the terms of the GNU Lesser General Public License version 3
16*cdf0e10cSrcweir# only, as published by the Free Software Foundation.
17*cdf0e10cSrcweir#
18*cdf0e10cSrcweir# OpenOffice.org is distributed in the hope that it will be useful,
19*cdf0e10cSrcweir# but WITHOUT ANY WARRANTY; without even the implied warranty of
20*cdf0e10cSrcweir# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21*cdf0e10cSrcweir# GNU Lesser General Public License version 3 for more details
22*cdf0e10cSrcweir# (a copy is included in the LICENSE file that accompanied this code).
23*cdf0e10cSrcweir#
24*cdf0e10cSrcweir# You should have received a copy of the GNU Lesser General Public License
25*cdf0e10cSrcweir# version 3 along with OpenOffice.org.  If not, see
26*cdf0e10cSrcweir# <http://www.openoffice.org/license.html>
27*cdf0e10cSrcweir# for a copy of the LGPLv3 License.
28*cdf0e10cSrcweir#
29*cdf0e10cSrcweir#*************************************************************************
30*cdf0e10cSrcweir#
31*cdf0e10cSrcweir# build - build entire project
32*cdf0e10cSrcweir#
33*cdf0e10cSrcweir    use strict;
34*cdf0e10cSrcweir    use Config;
35*cdf0e10cSrcweir    use POSIX;
36*cdf0e10cSrcweir    use Cwd qw (cwd);
37*cdf0e10cSrcweir    use File::Path;
38*cdf0e10cSrcweir    use File::Temp qw(tmpnam tempdir);
39*cdf0e10cSrcweir    use File::Find;
40*cdf0e10cSrcweir    use Socket;
41*cdf0e10cSrcweir    use IO::Socket::INET;
42*cdf0e10cSrcweir    use IO::Select;
43*cdf0e10cSrcweir    use Fcntl;
44*cdf0e10cSrcweir    use POSIX qw(:errno_h);
45*cdf0e10cSrcweir    use Sys::Hostname;
46*cdf0e10cSrcweir
47*cdf0e10cSrcweir    use lib ("$ENV{SOLARENV}/bin/modules");
48*cdf0e10cSrcweir    use SourceConfig;
49*cdf0e10cSrcweir    use RepositoryHelper;
50*cdf0e10cSrcweir    use Cwd 'chdir';
51*cdf0e10cSrcweir
52*cdf0e10cSrcweir    my $in_so_env = 0;
53*cdf0e10cSrcweir    if (defined $ENV{COMMON_ENV_TOOLS}) {
54*cdf0e10cSrcweir        unshift(@INC, "$ENV{COMMON_ENV_TOOLS}/modules");
55*cdf0e10cSrcweir        $in_so_env++;
56*cdf0e10cSrcweir    };
57*cdf0e10cSrcweir    if (defined $ENV{CWS_WORK_STAMP}) {
58*cdf0e10cSrcweir        require GenInfoParser; import GenInfoParser;
59*cdf0e10cSrcweir        require IO::Handle; import IO::Handle;
60*cdf0e10cSrcweir    };
61*cdf0e10cSrcweir    my $verbose_mode = 0;
62*cdf0e10cSrcweir    if (defined $ENV{verbose} || defined $ENV{VERBOSE}) {
63*cdf0e10cSrcweir        $verbose_mode = ($ENV{verbose} =~ /^t\S*$/i);
64*cdf0e10cSrcweir    }
65*cdf0e10cSrcweir    my $enable_multiprocessing = 1;
66*cdf0e10cSrcweir    ### for XML file format
67*cdf0e10cSrcweir    eval { require XMLBuildListParser; import XMLBuildListParser; };
68*cdf0e10cSrcweir    my $enable_xml = 0;
69*cdf0e10cSrcweir    my @modes_array = ();
70*cdf0e10cSrcweir    if (!$@) {
71*cdf0e10cSrcweir        $enable_xml = 1;
72*cdf0e10cSrcweir        @modes_array = split('\s' , $ENV{BUILD_TYPE});
73*cdf0e10cSrcweir    };
74*cdf0e10cSrcweir#### script id #####
75*cdf0e10cSrcweir
76*cdf0e10cSrcweir    ( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
77*cdf0e10cSrcweir    my $id_str = ' $Revision: 275224 $ ';
78*cdf0e10cSrcweir    my $script_rev = 0;
79*cdf0e10cSrcweir    $id_str =~ /Revision:\s+(\S+)\s+\$/
80*cdf0e10cSrcweir      ? ($script_rev = $1) : ($script_rev = "-");
81*cdf0e10cSrcweir
82*cdf0e10cSrcweir    print "$script_name -- version: $script_rev\n";
83*cdf0e10cSrcweir
84*cdf0e10cSrcweir#########################
85*cdf0e10cSrcweir#                       #
86*cdf0e10cSrcweir#   Globale Variablen   #
87*cdf0e10cSrcweir#                       #
88*cdf0e10cSrcweir#########################
89*cdf0e10cSrcweir
90*cdf0e10cSrcweir    my $modules_number++;
91*cdf0e10cSrcweir    my $perl = 'perl';
92*cdf0e10cSrcweir    my $remove_command = 'rm -rf';
93*cdf0e10cSrcweir    my $nul = '> /dev/null';
94*cdf0e10cSrcweir
95*cdf0e10cSrcweir    my $processes_to_run = 0;
96*cdf0e10cSrcweir# delete $pid when not needed
97*cdf0e10cSrcweir    my %projects_deps_hash = ();   # hash of projects with no dependencies,
98*cdf0e10cSrcweir                                # that could be built now
99*cdf0e10cSrcweir    my %broken_build = ();         # hash of hashes of the modules,
100*cdf0e10cSrcweir                                # where build was broken (error occurred)
101*cdf0e10cSrcweir    my %folders_hashes = ();
102*cdf0e10cSrcweir    my %running_children = ();
103*cdf0e10cSrcweir    my $dependencies_hash = 0;
104*cdf0e10cSrcweir    my $cmd_file = '';
105*cdf0e10cSrcweir    my $build_all_parents = 0;
106*cdf0e10cSrcweir    my $show = 0;
107*cdf0e10cSrcweir    my $checkparents = 0;
108*cdf0e10cSrcweir    my $deliver = 0;
109*cdf0e10cSrcweir    my $pre_custom_job = '';
110*cdf0e10cSrcweir    my $custom_job = '';
111*cdf0e10cSrcweir    my $post_custom_job = '';
112*cdf0e10cSrcweir    my %local_deps_hash = ();
113*cdf0e10cSrcweir    my %path_hash = ();
114*cdf0e10cSrcweir    my %platform_hash = ();
115*cdf0e10cSrcweir    my %alive_dependencies = ();
116*cdf0e10cSrcweir    my %global_deps_hash = (); # hash of dependencies of the all modules
117*cdf0e10cSrcweir    my %global_deps_hash_backup = (); # backup hash of external dependencies of the all modules
118*cdf0e10cSrcweir    my %module_deps_hash_backup = (); # backup hash of internal dependencies for aech module
119*cdf0e10cSrcweir    my @broken_module_names = ();   # array of modules, which cannot be built further
120*cdf0e10cSrcweir    my @dmake_args = ();
121*cdf0e10cSrcweir    my %dead_parents = ();
122*cdf0e10cSrcweir    my $initial_module = '';
123*cdf0e10cSrcweir    my $all_dependent = 1;  # a flag indicating if the hash has independent keys
124*cdf0e10cSrcweir    my $build_from_with_branches = '';
125*cdf0e10cSrcweir    my $build_all_cont = '';
126*cdf0e10cSrcweir    my $build_since = '';
127*cdf0e10cSrcweir    my $dlv_switch = '';
128*cdf0e10cSrcweir    my $child = 0;
129*cdf0e10cSrcweir    my %processes_hash = ();
130*cdf0e10cSrcweir    my %module_announced = ();
131*cdf0e10cSrcweir    my $prepare = ''; # prepare for following incompatible build
132*cdf0e10cSrcweir    my $ignore = '';
133*cdf0e10cSrcweir    my $html = '';
134*cdf0e10cSrcweir    my @ignored_errors = ();
135*cdf0e10cSrcweir    my %incompatibles = ();
136*cdf0e10cSrcweir    my %skip_modules = ();
137*cdf0e10cSrcweir    my %exclude_branches = ();
138*cdf0e10cSrcweir    my $only_platform = ''; # the only platform to prepare
139*cdf0e10cSrcweir    my $only_common = ''; # the only common output tree to delete when preparing
140*cdf0e10cSrcweir    my %build_modes = ();
141*cdf0e10cSrcweir    my $maximal_processes = 0; # the max number of the processes run
142*cdf0e10cSrcweir    my %modules_types = (); # modules types ('mod', 'img', 'lnk') hash
143*cdf0e10cSrcweir    my %platforms = (); # platforms available or being working with
144*cdf0e10cSrcweir    my %platforms_to_copy = (); # copy output trees for the platforms when --prepare
145*cdf0e10cSrcweir    my $tmp_dir = get_tmp_dir(); # temp directory for checkout and other actions
146*cdf0e10cSrcweir#    $dmake_batch = undef;     #
147*cdf0e10cSrcweir    my @possible_build_lists = ('build.lst', 'build.xlist'); # build lists names
148*cdf0e10cSrcweir    my %build_list_paths = (); # build lists names
149*cdf0e10cSrcweir    my %build_lists_hash = (); # hash of arrays $build_lists_hash{$module} = \($path, $xml_list_object)
150*cdf0e10cSrcweir    my $pre_job = 'announce'; # job to add for not-single module build
151*cdf0e10cSrcweir    my $post_job = '';        # -"-
152*cdf0e10cSrcweir    my @warnings = (); # array of warnings to be shown at the end of the process
153*cdf0e10cSrcweir    my @errors = (); # array of errors to be shown at the end of the process
154*cdf0e10cSrcweir    my %html_info = (); # hash containing all necessary info for generating of html page
155*cdf0e10cSrcweir    my %module_by_hash = (); # hash containing all modules names as values and correspondent hashes as keys
156*cdf0e10cSrcweir    my %build_in_progress = (); # hash of modules currently being built
157*cdf0e10cSrcweir    my %build_is_finished = (); # hash of already built modules
158*cdf0e10cSrcweir    my %modules_with_errors = (); # hash of modules with build errors
159*cdf0e10cSrcweir    my %build_in_progress_shown = ();  # hash of modules being built,
160*cdf0e10cSrcweir                                    # and shown last time (to keep order)
161*cdf0e10cSrcweir    my $build_time = time;
162*cdf0e10cSrcweir    my $html_last_updated = 0;
163*cdf0e10cSrcweir    my %jobs_hash = ();
164*cdf0e10cSrcweir    my $html_path = undef;
165*cdf0e10cSrcweir    my $build_finished = 0;
166*cdf0e10cSrcweir    my $html_file = '';
167*cdf0e10cSrcweir    my %had_error = (); # hack for misteriuos windows problems - try run dmake 2 times if first time there was an error
168*cdf0e10cSrcweir    my $mkout = correct_path("$ENV{SOLARENV}/bin/mkout.pl");
169*cdf0e10cSrcweir    my %weights_hash = (); # hash contains info about how many modules are dependent from one module
170*cdf0e10cSrcweir#    %weight_stored = ();
171*cdf0e10cSrcweir    my $grab_output = 1;
172*cdf0e10cSrcweir    my $stop_build_on_error = 0; # for multiprocessing mode: do not build further module if there is an error
173*cdf0e10cSrcweir    my $interactive = 0; # for interactive mode... (for testing purpose enabled by default)
174*cdf0e10cSrcweir    my $parent_process = 1;
175*cdf0e10cSrcweir    my $server_mode = 0;
176*cdf0e10cSrcweir    my $setenv_string = ''; # string for configuration of the client environment
177*cdf0e10cSrcweir    my $ports_string = ''; # string with possible ports for server
178*cdf0e10cSrcweir    my @server_ports = ();
179*cdf0e10cSrcweir    my $html_port = 0;
180*cdf0e10cSrcweir    my $server_socket_obj = undef; # socket object for server
181*cdf0e10cSrcweir    my $html_socket_obj = undef; # socket object for server
182*cdf0e10cSrcweir    my %clients_jobs = ();
183*cdf0e10cSrcweir    my %clients_times = ();
184*cdf0e10cSrcweir    my $client_timeout = 0; # time for client to build (in sec)...
185*cdf0e10cSrcweir                            # The longest time period after that
186*cdf0e10cSrcweir                            # the server considered as an error/client crash
187*cdf0e10cSrcweir    my %lost_client_jobs = (); # hash containing lost jobs
188*cdf0e10cSrcweir    my %job_jobdir = (); # hash containing job-dir pairs
189*cdf0e10cSrcweir    my $reschedule_queue = 0;
190*cdf0e10cSrcweir    my %module_build_queue = ();
191*cdf0e10cSrcweir    my %reversed_dependencies = ();
192*cdf0e10cSrcweir    my %module_paths = (); # hash with absolute module paths
193*cdf0e10cSrcweir    my %active_modules = ();
194*cdf0e10cSrcweir    my $generate_config = 0;
195*cdf0e10cSrcweir    my %add_to_config = ();
196*cdf0e10cSrcweir    my %remove_from_config = ();
197*cdf0e10cSrcweir    my $clear_config = 0;
198*cdf0e10cSrcweir    my $finisched_children = 0;
199*cdf0e10cSrcweir    my $debug = 0;
200*cdf0e10cSrcweir    my %module_deps_hash_pids = ();
201*cdf0e10cSrcweir    my @argv = @ARGV;
202*cdf0e10cSrcweir    my $source_config_file;
203*cdf0e10cSrcweir    my @modules_built = ();
204*cdf0e10cSrcweir    my $deliver_command = $ENV{DELIVER};
205*cdf0e10cSrcweir    my %prj_platform = ();
206*cdf0e10cSrcweir    my $check_error_string = '';
207*cdf0e10cSrcweir    my $dmake = '';
208*cdf0e10cSrcweir    my $dmake_args = '';
209*cdf0e10cSrcweir    my $echo = '';
210*cdf0e10cSrcweir    my $new_line = "\n";
211*cdf0e10cSrcweir    my $incompatible = 0;
212*cdf0e10cSrcweir    my $local_host_ip = 'localhost';
213*cdf0e10cSrcweir### main ###
214*cdf0e10cSrcweir
215*cdf0e10cSrcweir    get_options();
216*cdf0e10cSrcweir
217*cdf0e10cSrcweir#    my $temp_html_file = correct_path($tmp_dir. '/' . $ENV{INPATH}. '.build.html');
218*cdf0e10cSrcweir    get_build_modes();
219*cdf0e10cSrcweir    my %deliver_env = ();
220*cdf0e10cSrcweir    if ($prepare) {
221*cdf0e10cSrcweir        get_platforms(\%platforms);
222*cdf0e10cSrcweir
223*cdf0e10cSrcweir        $deliver_env{'BUILD_SOSL'}++;
224*cdf0e10cSrcweir        $deliver_env{'COMMON_OUTDIR'}++;
225*cdf0e10cSrcweir        $deliver_env{'GUI'}++;
226*cdf0e10cSrcweir        $deliver_env{'INPATH'}++;
227*cdf0e10cSrcweir        $deliver_env{'OFFENV_PATH'}++;
228*cdf0e10cSrcweir        $deliver_env{'OUTPATH'}++;
229*cdf0e10cSrcweir        $deliver_env{'L10N_framework'}++;
230*cdf0e10cSrcweir    };
231*cdf0e10cSrcweir    my $workspace_path = get_workspace_path();   # This also sets $initial_module
232*cdf0e10cSrcweir    my $source_config = SourceConfig -> new($workspace_path);
233*cdf0e10cSrcweir    check_partial_gnumake_build($initial_module);
234*cdf0e10cSrcweir
235*cdf0e10cSrcweir    if ($html) {
236*cdf0e10cSrcweir        if (defined $html_path) {
237*cdf0e10cSrcweir            $html_file = correct_path($html_path . '/' . $ENV{INPATH}. '.build.html');
238*cdf0e10cSrcweir        } else {
239*cdf0e10cSrcweir            my $log_directory = Cwd::realpath(correct_path($workspace_path . '/..')) . '/log';
240*cdf0e10cSrcweir            if ((!-d $log_directory) && (!mkdir($log_directory))) {
241*cdf0e10cSrcweir                print_error("Cannot create $log_directory for writing html file\n");
242*cdf0e10cSrcweir            };
243*cdf0e10cSrcweir            $html_file = $log_directory . '/' . $ENV{INPATH}. '.build.html';
244*cdf0e10cSrcweir            print "\nPath to html status page: $html_file\n";
245*cdf0e10cSrcweir        };
246*cdf0e10cSrcweir    };
247*cdf0e10cSrcweir
248*cdf0e10cSrcweir    if ($generate_config && ($clear_config || (scalar keys %remove_from_config)||(scalar keys %add_to_config))) {
249*cdf0e10cSrcweir        generate_config_file();
250*cdf0e10cSrcweir        exit 0;
251*cdf0e10cSrcweir    }
252*cdf0e10cSrcweir    get_module_and_buildlist_paths();
253*cdf0e10cSrcweir    provide_consistency() if (defined $ENV{CWS_WORK_STAMP} && defined($ENV{COMMON_ENV_TOOLS}));
254*cdf0e10cSrcweir
255*cdf0e10cSrcweir    $deliver_command .= ' -verbose' if ($html);
256*cdf0e10cSrcweir    $deliver_command .= ' '. $dlv_switch if ($dlv_switch);
257*cdf0e10cSrcweir    $ENV{mk_tmp}++;
258*cdf0e10cSrcweir
259*cdf0e10cSrcweir    get_commands();
260*cdf0e10cSrcweir    unlink ($cmd_file);
261*cdf0e10cSrcweir    if ($cmd_file) {
262*cdf0e10cSrcweir        if (open (CMD_FILE, ">>$cmd_file")) {
263*cdf0e10cSrcweir            select CMD_FILE;
264*cdf0e10cSrcweir            $echo = 'echo ';
265*cdf0e10cSrcweir            if ($ENV{GUI} ne 'UNX') {
266*cdf0e10cSrcweir                $new_line = "echo.\n";
267*cdf0e10cSrcweir                print "\@$echo off\npushd\n";
268*cdf0e10cSrcweir            } else {
269*cdf0e10cSrcweir                $new_line = $echo."\"\"\n";
270*cdf0e10cSrcweir            };
271*cdf0e10cSrcweir        } else {
272*cdf0e10cSrcweir            print_error ("Cannot open file $cmd_file");
273*cdf0e10cSrcweir        };
274*cdf0e10cSrcweir#    } elsif ($show) {
275*cdf0e10cSrcweir#        select STDOUT;
276*cdf0e10cSrcweir    };
277*cdf0e10cSrcweir
278*cdf0e10cSrcweir    print $new_line;
279*cdf0e10cSrcweir    get_server_ports();
280*cdf0e10cSrcweir    start_interactive() if ($interactive);
281*cdf0e10cSrcweir
282*cdf0e10cSrcweir    if ($checkparents) {
283*cdf0e10cSrcweir	    get_parent_deps( $initial_module, \%global_deps_hash );
284*cdf0e10cSrcweir    } else {
285*cdf0e10cSrcweir	    build_all();
286*cdf0e10cSrcweir    }
287*cdf0e10cSrcweir    if (scalar keys %broken_build) {
288*cdf0e10cSrcweir        cancel_build();
289*cdf0e10cSrcweir#    } elsif (!$custom_job && $post_custom_job) {
290*cdf0e10cSrcweir#        do_post_custom_job(correct_path($workspace_path.$initial_module));
291*cdf0e10cSrcweir    };
292*cdf0e10cSrcweir    print_warnings();
293*cdf0e10cSrcweir    if (scalar keys %active_modules) {
294*cdf0e10cSrcweir        foreach (keys %dead_parents) {
295*cdf0e10cSrcweir            delete $dead_parents{$_} if (!defined $active_modules{$_});
296*cdf0e10cSrcweir        };
297*cdf0e10cSrcweir    };
298*cdf0e10cSrcweir    if (scalar keys %dead_parents) {
299*cdf0e10cSrcweir        print $new_line.$new_line;
300*cdf0e10cSrcweir        print $echo."WARNING! Project(s):\n";
301*cdf0e10cSrcweir        foreach (keys %dead_parents) {
302*cdf0e10cSrcweir            print $echo."$_\n";
303*cdf0e10cSrcweir        };
304*cdf0e10cSrcweir        print $new_line;
305*cdf0e10cSrcweir        print $echo."not found and couldn't be built. dependencies on that module(s) ignored. Maybe you should correct build lists.\n";
306*cdf0e10cSrcweir        print $new_line;
307*cdf0e10cSrcweir        do_exit(1) if ($checkparents);
308*cdf0e10cSrcweir    };
309*cdf0e10cSrcweir    if (($ENV{GUI} ne 'UNX') && $cmd_file) {
310*cdf0e10cSrcweir        print "popd\n";
311*cdf0e10cSrcweir    };
312*cdf0e10cSrcweir    $ENV{mk_tmp} = '';
313*cdf0e10cSrcweir    if ($cmd_file) {
314*cdf0e10cSrcweir        close CMD_FILE;
315*cdf0e10cSrcweir        print STDOUT "Script $cmd_file generated\n";
316*cdf0e10cSrcweir    };
317*cdf0e10cSrcweir    if ($ignore && scalar @ignored_errors) {
318*cdf0e10cSrcweir        print STDERR "\nERROR: next directories could not be built:\n";
319*cdf0e10cSrcweir        foreach (@ignored_errors) {
320*cdf0e10cSrcweir            print STDERR "\t$_\n";
321*cdf0e10cSrcweir        };
322*cdf0e10cSrcweir        print STDERR "\nERROR: please check these directories and build the corresponding module(s) anew!!\n\n";
323*cdf0e10cSrcweir        do_exit(1);
324*cdf0e10cSrcweir    };
325*cdf0e10cSrcweir    do_exit(0);
326*cdf0e10cSrcweir
327*cdf0e10cSrcweir
328*cdf0e10cSrcweir#########################
329*cdf0e10cSrcweir#                       #
330*cdf0e10cSrcweir#      Procedures       #
331*cdf0e10cSrcweir#                       #
332*cdf0e10cSrcweir#########################
333*cdf0e10cSrcweir
334*cdf0e10cSrcweirsub print_warnings {
335*cdf0e10cSrcweir    if (scalar @warnings) {
336*cdf0e10cSrcweir        print STDERR "\nWARNING(S):\n";
337*cdf0e10cSrcweir        print STDERR $_ foreach (@warnings);
338*cdf0e10cSrcweir    };
339*cdf0e10cSrcweir};
340*cdf0e10cSrcweir
341*cdf0e10cSrcweirsub rename_file {
342*cdf0e10cSrcweir    my ($old_file_name, $new_file_name, $throw_error) = @_;
343*cdf0e10cSrcweir
344*cdf0e10cSrcweir    if(-e $old_file_name) {
345*cdf0e10cSrcweir        rename($old_file_name, $new_file_name) or system("mv", $old_file_name, $new_file_name);
346*cdf0e10cSrcweir        if (-e $old_file_name) {
347*cdf0e10cSrcweir            system("rm -rf $old_file_name") if (!unlink $old_file_name);
348*cdf0e10cSrcweir        };
349*cdf0e10cSrcweir    } elsif ($throw_error) {
350*cdf0e10cSrcweir        print_error("No such file $old_file_name");
351*cdf0e10cSrcweir    };
352*cdf0e10cSrcweir};
353*cdf0e10cSrcweir
354*cdf0e10cSrcweirsub generate_config_file {
355*cdf0e10cSrcweir    $source_config->add_active_modules([keys %add_to_config], 1) if (scalar %add_to_config);
356*cdf0e10cSrcweir    $source_config->remove_activated_modules([keys %remove_from_config], 1) if (scalar %remove_from_config);
357*cdf0e10cSrcweir    $source_config->remove_all_activated_modules() if ($clear_config);
358*cdf0e10cSrcweir};
359*cdf0e10cSrcweir
360*cdf0e10cSrcweir
361*cdf0e10cSrcweirsub start_interactive {
362*cdf0e10cSrcweir    my $pid = open(HTML_PIPE, "-|");
363*cdf0e10cSrcweir    print "Pipe is open\n";
364*cdf0e10cSrcweir
365*cdf0e10cSrcweir    if ($pid) {   # parent
366*cdf0e10cSrcweir        # make file handle non-blocking
367*cdf0e10cSrcweir        my $flags = '';
368*cdf0e10cSrcweir        fcntl(HTML_PIPE, F_GETFL, $flags);
369*cdf0e10cSrcweir        $flags |= O_NONBLOCK;
370*cdf0e10cSrcweir        fcntl(HTML_PIPE, F_SETFL, $flags);
371*cdf0e10cSrcweir    } else {      # child
372*cdf0e10cSrcweir        $parent_process = 0;
373*cdf0e10cSrcweir        start_html_listener();
374*cdf0e10cSrcweir    };
375*cdf0e10cSrcweir};
376*cdf0e10cSrcweir
377*cdf0e10cSrcweirsub start_html_listener {
378*cdf0e10cSrcweir    $html_port = $server_ports[$#server_ports];
379*cdf0e10cSrcweir    do {
380*cdf0e10cSrcweir        $html_port++
381*cdf0e10cSrcweir    } while (start_server_on_port($html_port, \$html_socket_obj));
382*cdf0e10cSrcweir    print "html_port:$html_port html_socket_obj: $html_socket_obj\n";
383*cdf0e10cSrcweir    my $new_socket_obj;
384*cdf0e10cSrcweir    do {
385*cdf0e10cSrcweir        $new_socket_obj = accept_html_connection();
386*cdf0e10cSrcweir        if (defined $new_socket_obj) {
387*cdf0e10cSrcweir            my $html_message;
388*cdf0e10cSrcweir            $html_message = <$new_socket_obj>;
389*cdf0e10cSrcweir            chomp $html_message;
390*cdf0e10cSrcweir            print $html_message . "\n";
391*cdf0e10cSrcweir            my $socket_message = '';
392*cdf0e10cSrcweir            for my $action ('rebuild', 'delete') {
393*cdf0e10cSrcweir                if ($html_message =~ /$action=(\S+)/) {
394*cdf0e10cSrcweir                    print $new_socket_obj "Module $1 is scheduled for $action";
395*cdf0e10cSrcweir                };
396*cdf0e10cSrcweir            };
397*cdf0e10cSrcweir            close($new_socket_obj);
398*cdf0e10cSrcweir        } else {
399*cdf0e10cSrcweir            sleep(10);
400*cdf0e10cSrcweir        };
401*cdf0e10cSrcweir    } while(1);
402*cdf0e10cSrcweir};
403*cdf0e10cSrcweir
404*cdf0e10cSrcweirsub start_html_message_trigger {
405*cdf0e10cSrcweir	my $child_id=fork(); ### VG: for windows there is a "simulation of the "fork"", no new procs... One can use Win32::Process::Create
406*cdf0e10cSrcweir
407*cdf0e10cSrcweir	if ($child_id) {
408*cdf0e10cSrcweir	    # parent
409*cdf0e10cSrcweir#	    print "started listener trigger\n";
410*cdf0e10cSrcweir	} else {
411*cdf0e10cSrcweir        my $buffer_size = 1024;
412*cdf0e10cSrcweir        my $buffer;
413*cdf0e10cSrcweir        my $rv;
414*cdf0e10cSrcweir        my $full_buffer = '';
415*cdf0e10cSrcweir        my %modules_to_rebuild = ();
416*cdf0e10cSrcweir        my $paddr;
417*cdf0e10cSrcweir        while ($rv = sysread(HTML_PIPE, $buffer, $buffer_size)) {
418*cdf0e10cSrcweir            $full_buffer .= $buffer;
419*cdf0e10cSrcweir        };
420*cdf0e10cSrcweir        if (length $full_buffer) {
421*cdf0e10cSrcweir            print "**********Got message $full_buffer\n";
422*cdf0e10cSrcweir            socket(SOCKET, PF_INET, SOCK_STREAM, getprotobyname('tcp')) or die "socket: $!";
423*cdf0e10cSrcweir            if (connect(SOCKET, $paddr)) {
424*cdf0e10cSrcweir                $full_buffer .= "\n";
425*cdf0e10cSrcweir                syswrite SOCKET, $full_buffer, length $full_buffer;
426*cdf0e10cSrcweir#                close SOCKET or die "Child close socket: $!";
427*cdf0e10cSrcweir            } else {
428*cdf0e10cSrcweir                die "Child connect: $!";
429*cdf0e10cSrcweir            };
430*cdf0e10cSrcweir        }
431*cdf0e10cSrcweir        _exit(0);
432*cdf0e10cSrcweir	};
433*cdf0e10cSrcweir};
434*cdf0e10cSrcweir
435*cdf0e10cSrcweirsub get_html_orders {
436*cdf0e10cSrcweir    return if (!$interactive);
437*cdf0e10cSrcweir    my $buffer_size = 1024;
438*cdf0e10cSrcweir    my $buffer;
439*cdf0e10cSrcweir    my $rv;
440*cdf0e10cSrcweir    my $full_buffer = '';
441*cdf0e10cSrcweir    my %modules_to_rebuild = ();
442*cdf0e10cSrcweir    my %modules_to_delete = ();
443*cdf0e10cSrcweir        while ($rv = sysread(HTML_PIPE, $buffer, $buffer_size)) {
444*cdf0e10cSrcweir            $full_buffer .= $buffer;
445*cdf0e10cSrcweir        };
446*cdf0e10cSrcweir#    };
447*cdf0e10cSrcweir    my @html_messages = split(/\n/, $full_buffer);
448*cdf0e10cSrcweir    foreach (@html_messages) {
449*cdf0e10cSrcweir        if (/^html_port:(\d+)/) {
450*cdf0e10cSrcweir            $html_port = $1;
451*cdf0e10cSrcweir            print "Html port is: $html_port\n";
452*cdf0e10cSrcweir            next;
453*cdf0e10cSrcweir        };# GET /rebuild=officenames HTTP/1.0
454*cdf0e10cSrcweir        print "Message: $_\n";
455*cdf0e10cSrcweir        chomp;
456*cdf0e10cSrcweir        if (/GET\s+\/delete=(\S+)[:(\S+)]*\s*HTTP/) {
457*cdf0e10cSrcweir            $modules_to_delete{$1} = $2;
458*cdf0e10cSrcweir            print "$1 scheduled for removal from build for \n";
459*cdf0e10cSrcweir        }
460*cdf0e10cSrcweir        if (/GET\s+\/rebuild=(\S+)[:(\S+)]*\s*HTTP/) {
461*cdf0e10cSrcweir            if (defined $global_deps_hash{$1}) {
462*cdf0e10cSrcweir                print "!!! /tarModule $1 has not been built. Html order ignored\n";
463*cdf0e10cSrcweir            } else {
464*cdf0e10cSrcweir                $modules_to_rebuild{$1} = $2;
465*cdf0e10cSrcweir                print "Scheduled $1 for rebuild\n";
466*cdf0e10cSrcweir            }
467*cdf0e10cSrcweir        }
468*cdf0e10cSrcweir    };
469*cdf0e10cSrcweir    if (scalar keys %modules_to_delete) {
470*cdf0e10cSrcweir        $reschedule_queue++;
471*cdf0e10cSrcweir        schedule_delete(\%modules_to_delete);
472*cdf0e10cSrcweir        generate_html_file();
473*cdf0e10cSrcweir    };
474*cdf0e10cSrcweir    if (scalar keys %modules_to_rebuild) {
475*cdf0e10cSrcweir        $reschedule_queue++;
476*cdf0e10cSrcweir        schedule_rebuild(\%modules_to_rebuild);
477*cdf0e10cSrcweir        generate_html_file();
478*cdf0e10cSrcweir    };
479*cdf0e10cSrcweir};
480*cdf0e10cSrcweir
481*cdf0e10cSrcweirsub schedule_delete {
482*cdf0e10cSrcweir    my $modules_to_delete = shift;
483*cdf0e10cSrcweir    foreach (keys %$modules_to_delete) {
484*cdf0e10cSrcweir        print "Schedule module $_ for delete\n";
485*cdf0e10cSrcweir        delete ($global_deps_hash{$_});
486*cdf0e10cSrcweir        delete ($global_deps_hash_backup{$_});
487*cdf0e10cSrcweir        if (scalar keys %{$module_deps_hash_pids{$projects_deps_hash{$_}}}) {
488*cdf0e10cSrcweir            kill 9, keys %{$module_deps_hash_pids{$projects_deps_hash{$_}}};
489*cdf0e10cSrcweir            handle_dead_children(0);
490*cdf0e10cSrcweir        };
491*cdf0e10cSrcweir        remove_from_dependencies($_, \%global_deps_hash);
492*cdf0e10cSrcweir        remove_from_dependencies($_, \%global_deps_hash_backup);
493*cdf0e10cSrcweir        delete $reversed_dependencies{$_};
494*cdf0e10cSrcweir        delete $build_is_finished{$_} if defined $build_is_finished{$_};
495*cdf0e10cSrcweir        delete $modules_with_errors{$_} if defined $modules_with_errors{$_};
496*cdf0e10cSrcweir        delete $module_announced{$_} if defined $module_announced{$_};
497*cdf0e10cSrcweir        delete $html_info{$_} if defined $html_info{$_};
498*cdf0e10cSrcweir        delete $projects_deps_hash{$_} if defined $projects_deps_hash{$_};
499*cdf0e10cSrcweir    };
500*cdf0e10cSrcweir};
501*cdf0e10cSrcweir
502*cdf0e10cSrcweirsub schedule_rebuild {
503*cdf0e10cSrcweir    my $modules_to_rebuild = shift;
504*cdf0e10cSrcweir    foreach (keys %$modules_to_rebuild) {
505*cdf0e10cSrcweir        if (defined $$modules_to_rebuild{$_}) {
506*cdf0e10cSrcweir            print "Schedule directory for rebuild";
507*cdf0e10cSrcweir        } else {
508*cdf0e10cSrcweir            print "Schedule complete $_ module for rebuild\n";
509*cdf0e10cSrcweir            if (scalar keys %{$module_deps_hash_pids{$projects_deps_hash{$_}}}) {
510*cdf0e10cSrcweir                kill 9, keys %{$module_deps_hash_pids{$projects_deps_hash{$_}}};
511*cdf0e10cSrcweir                handle_dead_children(0);
512*cdf0e10cSrcweir            };
513*cdf0e10cSrcweir            delete $build_is_finished{$_} if defined $build_is_finished{$_};
514*cdf0e10cSrcweir            delete $modules_with_errors{$_} if defined $modules_with_errors{$_};
515*cdf0e10cSrcweir            delete $module_announced{$_};
516*cdf0e10cSrcweir            initialize_html_info($_);
517*cdf0e10cSrcweir
518*cdf0e10cSrcweir            foreach my $waiter (keys %{$reversed_dependencies{$_}}) {
519*cdf0e10cSrcweir                # for rebuild_all_dependent - refacture "if" condition
520*cdf0e10cSrcweir                ${$global_deps_hash{$waiter}}{$_}++ if (!defined $build_is_finished{$waiter});
521*cdf0e10cSrcweir            };
522*cdf0e10cSrcweir            delete $projects_deps_hash{$_} if defined $projects_deps_hash{$_};
523*cdf0e10cSrcweir            my %single_module_dep_hash = ();
524*cdf0e10cSrcweir            foreach my $module (keys %{$global_deps_hash_backup{$_}}) {
525*cdf0e10cSrcweir                if (defined ${$global_deps_hash_backup{$_}}{$module} && (!defined $build_is_finished{$module})) {
526*cdf0e10cSrcweir                    $single_module_dep_hash{$module}++;
527*cdf0e10cSrcweir                };
528*cdf0e10cSrcweir            };
529*cdf0e10cSrcweir            $global_deps_hash{$_} = \%single_module_dep_hash;
530*cdf0e10cSrcweir        };
531*cdf0e10cSrcweir    };
532*cdf0e10cSrcweir};
533*cdf0e10cSrcweir
534*cdf0e10cSrcweir
535*cdf0e10cSrcweir#
536*cdf0e10cSrcweir# procedure retrieves build list path
537*cdf0e10cSrcweir# (all possibilities are taken into account)
538*cdf0e10cSrcweir#
539*cdf0e10cSrcweirsub get_build_list_path {
540*cdf0e10cSrcweir    my $module = shift;
541*cdf0e10cSrcweir    return $build_list_paths{$module} if (defined $build_list_paths{$module});
542*cdf0e10cSrcweir    my @possible_dirs = ($module, $module. '.lnk', $module. '.link');
543*cdf0e10cSrcweir    return $build_list_paths{$module} if (defined $build_list_paths{$module});
544*cdf0e10cSrcweir    foreach (@possible_dirs) {
545*cdf0e10cSrcweir        my $possible_dir_path = $module_paths{$_}.'/prj/';
546*cdf0e10cSrcweir        if (-d $possible_dir_path) {
547*cdf0e10cSrcweir            foreach my $build_list (@possible_build_lists) {
548*cdf0e10cSrcweir                my $possible_build_list_path = correct_path($possible_dir_path . $build_list);
549*cdf0e10cSrcweir                if (-f $possible_build_list_path) {
550*cdf0e10cSrcweir                    $build_list_paths{$module} = $possible_build_list_path;
551*cdf0e10cSrcweir                    return $possible_build_list_path;
552*cdf0e10cSrcweir                };
553*cdf0e10cSrcweir            }
554*cdf0e10cSrcweir            print_error("There's no build list for $module");
555*cdf0e10cSrcweir        };
556*cdf0e10cSrcweir    };
557*cdf0e10cSrcweir    $dead_parents{$module}++;
558*cdf0e10cSrcweir    $build_list_paths{$module} = correct_path(retrieve_build_list($module)) if (!defined $build_list_paths{$module});
559*cdf0e10cSrcweir    return $build_list_paths{$module};
560*cdf0e10cSrcweir};
561*cdf0e10cSrcweir
562*cdf0e10cSrcweir#
563*cdf0e10cSrcweir# Get dependencies hash of the current and all parent projects
564*cdf0e10cSrcweir#
565*cdf0e10cSrcweirsub get_parent_deps {
566*cdf0e10cSrcweir    my $prj_dir = shift;
567*cdf0e10cSrcweir    my $deps_hash = shift;
568*cdf0e10cSrcweir    my @unresolved_parents = ($prj_dir);
569*cdf0e10cSrcweir    my %skipped_branches = ();
570*cdf0e10cSrcweir    while (my $module = pop(@unresolved_parents)) {
571*cdf0e10cSrcweir        next if (defined $$deps_hash{$module});
572*cdf0e10cSrcweir        my %parents_deps_hash = ();
573*cdf0e10cSrcweir        foreach (get_parents_array($module)) {
574*cdf0e10cSrcweir            if (defined $exclude_branches{$_}) {
575*cdf0e10cSrcweir                $skipped_branches{$_}++;
576*cdf0e10cSrcweir                next;
577*cdf0e10cSrcweir            };
578*cdf0e10cSrcweir            $parents_deps_hash{$_}++;
579*cdf0e10cSrcweir        }
580*cdf0e10cSrcweir        $$deps_hash{$module} = \%parents_deps_hash;
581*cdf0e10cSrcweir        foreach my $parent (keys %parents_deps_hash) {
582*cdf0e10cSrcweir            if (!defined($$deps_hash{$parent}) && (!defined $exclude_branches{$module})) {
583*cdf0e10cSrcweir                push (@unresolved_parents, $parent);
584*cdf0e10cSrcweir            };
585*cdf0e10cSrcweir        };
586*cdf0e10cSrcweir    };
587*cdf0e10cSrcweir    check_deps_hash($deps_hash);
588*cdf0e10cSrcweir    foreach (keys %skipped_branches) {
589*cdf0e10cSrcweir        print $echo . "Skipping module's $_ branch\n";
590*cdf0e10cSrcweir        delete $exclude_branches{$_};
591*cdf0e10cSrcweir    };
592*cdf0e10cSrcweir    my @missing_branches = keys %exclude_branches;
593*cdf0e10cSrcweir    if (scalar @missing_branches) {
594*cdf0e10cSrcweir        print_error("For $prj_dir branche(s): \"@missing_branches\" not found\n");
595*cdf0e10cSrcweir    };
596*cdf0e10cSrcweir};
597*cdf0e10cSrcweir
598*cdf0e10cSrcweirsub store_weights {
599*cdf0e10cSrcweir    my $deps_hash = shift;
600*cdf0e10cSrcweir    foreach (keys %$deps_hash) {
601*cdf0e10cSrcweir        foreach my $module_deps_hash ($$deps_hash{$_}) {
602*cdf0e10cSrcweir            foreach my $dependency (keys %$module_deps_hash) {
603*cdf0e10cSrcweir                $weights_hash{$dependency}++;
604*cdf0e10cSrcweir            };
605*cdf0e10cSrcweir        };
606*cdf0e10cSrcweir    };
607*cdf0e10cSrcweir};
608*cdf0e10cSrcweir
609*cdf0e10cSrcweir#
610*cdf0e10cSrcweir# This procedure builds comlete dependency for each module, ie if the deps look like:
611*cdf0e10cSrcweir# mod1 -> mod2 -> mod3 -> mod4,mod5,
612*cdf0e10cSrcweir# than mod1 get mod3,mod4,mod5 as eplicit list of deps, not only mod2 as earlier
613*cdf0e10cSrcweir#
614*cdf0e10cSrcweirsub expand_dependencies {
615*cdf0e10cSrcweir    my $deps_hash = shift;
616*cdf0e10cSrcweir
617*cdf0e10cSrcweir    foreach my $module1 (keys %$deps_hash) {
618*cdf0e10cSrcweir        foreach my $module2 (keys %$deps_hash) {
619*cdf0e10cSrcweir            next if ($module1 eq $module2);
620*cdf0e10cSrcweir            if (defined ${$$deps_hash{$module2}}{$module1}) {
621*cdf0e10cSrcweir                ${$$deps_hash{$module2}}{$_}++ foreach (keys %{$$deps_hash{$module1}})
622*cdf0e10cSrcweir            };
623*cdf0e10cSrcweir        };
624*cdf0e10cSrcweir    };
625*cdf0e10cSrcweir};
626*cdf0e10cSrcweir
627*cdf0e10cSrcweir#
628*cdf0e10cSrcweir# This procedure fills the second hash with reversed dependencies,
629*cdf0e10cSrcweir# ie, with info about modules "waiting" for the module
630*cdf0e10cSrcweir#
631*cdf0e10cSrcweirsub reverse_dependensies {
632*cdf0e10cSrcweir    my ($deps_hash, $reversed) = @_;
633*cdf0e10cSrcweir    foreach my $module (keys %$deps_hash) {
634*cdf0e10cSrcweir        foreach (keys %{$$deps_hash{$module}}) {
635*cdf0e10cSrcweir            if (defined $$reversed{$_}) {
636*cdf0e10cSrcweir                ${$$reversed{$_}}{$module}++
637*cdf0e10cSrcweir            } else {
638*cdf0e10cSrcweir                my %single_module_dep_hash = ($module => 1);
639*cdf0e10cSrcweir                $$reversed{$_} = \%single_module_dep_hash;
640*cdf0e10cSrcweir            };
641*cdf0e10cSrcweir        };
642*cdf0e10cSrcweir    };
643*cdf0e10cSrcweir};
644*cdf0e10cSrcweir
645*cdf0e10cSrcweir#
646*cdf0e10cSrcweir# Build everything that should be built
647*cdf0e10cSrcweir#
648*cdf0e10cSrcweirsub build_all {
649*cdf0e10cSrcweir    if ($build_all_parents) {
650*cdf0e10cSrcweir        my ($prj, $prj_dir, $orig_prj);
651*cdf0e10cSrcweir        get_parent_deps( $initial_module, \%global_deps_hash);
652*cdf0e10cSrcweir        if (scalar keys %active_modules) {
653*cdf0e10cSrcweir            $active_modules{$initial_module}++;
654*cdf0e10cSrcweir            $modules_types{$initial_module} = 'mod';
655*cdf0e10cSrcweir        };
656*cdf0e10cSrcweir        modules_classify(keys %global_deps_hash);
657*cdf0e10cSrcweir        expand_dependencies (\%global_deps_hash);
658*cdf0e10cSrcweir        prepare_incompatible_build(\%global_deps_hash) if ($incompatible && (!$build_from_with_branches));
659*cdf0e10cSrcweir        if ($build_from_with_branches) {
660*cdf0e10cSrcweir            my %reversed_full_deps_hash = ();
661*cdf0e10cSrcweir            reverse_dependensies(\%global_deps_hash, \%reversed_full_deps_hash);
662*cdf0e10cSrcweir            prepare_build_from_with_branches(\%global_deps_hash, \%reversed_full_deps_hash);
663*cdf0e10cSrcweir        }
664*cdf0e10cSrcweir        if ($build_all_cont || $build_since) {
665*cdf0e10cSrcweir            store_weights(\%global_deps_hash);
666*cdf0e10cSrcweir            prepare_build_all_cont(\%global_deps_hash);
667*cdf0e10cSrcweir            %weights_hash = ();
668*cdf0e10cSrcweir        };
669*cdf0e10cSrcweir        if ($generate_config) {
670*cdf0e10cSrcweir            %add_to_config = %global_deps_hash;
671*cdf0e10cSrcweir            generate_config_file();
672*cdf0e10cSrcweir            exit 0;
673*cdf0e10cSrcweir        } elsif ($incompatible) {
674*cdf0e10cSrcweir            my @missing_modules = ();
675*cdf0e10cSrcweir            foreach (sort keys %global_deps_hash) {
676*cdf0e10cSrcweir                push(@missing_modules, $_) if (!defined $active_modules{$_});
677*cdf0e10cSrcweir            };
678*cdf0e10cSrcweir            if (scalar @missing_modules) {
679*cdf0e10cSrcweir                push(@warnings, "The modules: \"@missing_modules\" should be have been built, but they are not activated and have been skipped. Be aware, that can cause compatibility problems. Maybe you should verify your $source_config_file.\n");
680*cdf0e10cSrcweir            };
681*cdf0e10cSrcweir        };
682*cdf0e10cSrcweir        foreach my $module (keys %dead_parents, keys %skip_modules) {
683*cdf0e10cSrcweir            remove_from_dependencies($module, \%global_deps_hash);
684*cdf0e10cSrcweir            delete ($global_deps_hash{$module}) if (defined $global_deps_hash{$module});
685*cdf0e10cSrcweir        };
686*cdf0e10cSrcweir        store_weights(\%global_deps_hash);
687*cdf0e10cSrcweir        backup_deps_hash(\%global_deps_hash, \%global_deps_hash_backup);
688*cdf0e10cSrcweir        reverse_dependensies(\%global_deps_hash_backup, \%reversed_dependencies);
689*cdf0e10cSrcweir        $modules_number = scalar keys %global_deps_hash;
690*cdf0e10cSrcweir        initialize_html_info($_) foreach (keys %global_deps_hash);
691*cdf0e10cSrcweir        if ($processes_to_run) {
692*cdf0e10cSrcweir            build_multiprocessing();
693*cdf0e10cSrcweir            return;
694*cdf0e10cSrcweir        };
695*cdf0e10cSrcweir        if ($server_mode) {
696*cdf0e10cSrcweir            run_server();
697*cdf0e10cSrcweir        };
698*cdf0e10cSrcweir        while ($prj = pick_prj_to_build(\%global_deps_hash)) {
699*cdf0e10cSrcweir            if (!defined $dead_parents{$prj}) {
700*cdf0e10cSrcweir                if (scalar keys %broken_build) {
701*cdf0e10cSrcweir                    print $echo . "Skipping project $prj because of error(s)\n";
702*cdf0e10cSrcweir                    remove_from_dependencies($prj, \%global_deps_hash);
703*cdf0e10cSrcweir                    $build_is_finished{$prj}++;
704*cdf0e10cSrcweir                    next;
705*cdf0e10cSrcweir                };
706*cdf0e10cSrcweir
707*cdf0e10cSrcweir                $prj_dir = $module_paths{$prj};
708*cdf0e10cSrcweir                get_module_dep_hash($prj, \%local_deps_hash);
709*cdf0e10cSrcweir                my $info_hash = $html_info{$prj};
710*cdf0e10cSrcweir                $$info_hash{DIRS} = check_deps_hash(\%local_deps_hash, $prj);
711*cdf0e10cSrcweir                $module_by_hash{\%local_deps_hash} = $prj;
712*cdf0e10cSrcweir                build_dependent(\%local_deps_hash);
713*cdf0e10cSrcweir                print $check_error_string;
714*cdf0e10cSrcweir            };
715*cdf0e10cSrcweir
716*cdf0e10cSrcweir            remove_from_dependencies($prj, \%global_deps_hash);
717*cdf0e10cSrcweir            $build_is_finished{$prj}++;
718*cdf0e10cSrcweir        };
719*cdf0e10cSrcweir    } else {
720*cdf0e10cSrcweir        store_build_list_content($initial_module);
721*cdf0e10cSrcweir        get_module_dep_hash($initial_module, \%local_deps_hash);
722*cdf0e10cSrcweir        initialize_html_info($initial_module);
723*cdf0e10cSrcweir        my $info_hash = $html_info{$initial_module};
724*cdf0e10cSrcweir        $$info_hash{DIRS} = check_deps_hash(\%local_deps_hash, $initial_module);
725*cdf0e10cSrcweir        $module_by_hash{\%local_deps_hash} = $initial_module;
726*cdf0e10cSrcweir        if ($server_mode) {
727*cdf0e10cSrcweir            run_server();
728*cdf0e10cSrcweir        } else {
729*cdf0e10cSrcweir            build_dependent(\%local_deps_hash);
730*cdf0e10cSrcweir        };
731*cdf0e10cSrcweir    };
732*cdf0e10cSrcweir};
733*cdf0e10cSrcweir
734*cdf0e10cSrcweirsub backup_deps_hash {
735*cdf0e10cSrcweir    my $source_hash = shift;
736*cdf0e10cSrcweir    my $backup_hash = shift;
737*cdf0e10cSrcweir    foreach my $key (keys %$source_hash) {
738*cdf0e10cSrcweir        my %values_hash = %{$$source_hash{$key}};
739*cdf0e10cSrcweir        $$backup_hash{$key} = \%values_hash;
740*cdf0e10cSrcweir    };
741*cdf0e10cSrcweir};
742*cdf0e10cSrcweir
743*cdf0e10cSrcweirsub initialize_html_info {
744*cdf0e10cSrcweir    my $module = shift;
745*cdf0e10cSrcweir    return if (defined $dead_parents{$module});
746*cdf0e10cSrcweir    $html_info{$module} = { 'DIRS' => [],
747*cdf0e10cSrcweir                            'ERRORFUL' => [],
748*cdf0e10cSrcweir                            'SUCCESSFUL' => [],
749*cdf0e10cSrcweir                            'BUILD_TIME' => 0};
750*cdf0e10cSrcweir}
751*cdf0e10cSrcweir
752*cdf0e10cSrcweir#
753*cdf0e10cSrcweir# Do job
754*cdf0e10cSrcweir#
755*cdf0e10cSrcweirsub dmake_dir {
756*cdf0e10cSrcweir    my ($new_job_name, $error_code);
757*cdf0e10cSrcweir    my $job_name = shift;
758*cdf0e10cSrcweir    $jobs_hash{$job_name}->{START_TIME} = time();
759*cdf0e10cSrcweir    $jobs_hash{$job_name}->{STATUS} = 'building';
760*cdf0e10cSrcweir    if ($job_name =~ /(\s)/o && (!-d $job_name)) {
761*cdf0e10cSrcweir        $error_code = do_custom_job($job_name, \%local_deps_hash);
762*cdf0e10cSrcweir    } else {
763*cdf0e10cSrcweir        html_store_job_info(\%local_deps_hash, $job_name);
764*cdf0e10cSrcweir        print_error("$job_name not found!!\n") if (!-d $job_name);
765*cdf0e10cSrcweir        if (!-d $job_name) {
766*cdf0e10cSrcweir            $new_job_name = $job_name;
767*cdf0e10cSrcweir            $new_job_name =~ s/_simple//g;
768*cdf0e10cSrcweir            if ((-d $new_job_name)) {
769*cdf0e10cSrcweir                print("\nTrying $new_job_name, $job_name not found!!\n");
770*cdf0e10cSrcweir                $job_name = $new_job_name;
771*cdf0e10cSrcweir            } else {
772*cdf0e10cSrcweir                print_error("\n$job_name not found!!\n");
773*cdf0e10cSrcweir            }
774*cdf0e10cSrcweir        }
775*cdf0e10cSrcweir        if ($cmd_file) {
776*cdf0e10cSrcweir            print "cd $job_name\n";
777*cdf0e10cSrcweir            print $check_error_string;
778*cdf0e10cSrcweir            print $echo.$job_name."\n";
779*cdf0e10cSrcweir            print "$dmake\n";
780*cdf0e10cSrcweir            print $check_error_string;
781*cdf0e10cSrcweir        } else {
782*cdf0e10cSrcweir            print "\n" if ( ! $show );
783*cdf0e10cSrcweir            print "Entering $job_name\n";
784*cdf0e10cSrcweir        };
785*cdf0e10cSrcweir        remove_from_dependencies($job_name, \%local_deps_hash) if (!$child);
786*cdf0e10cSrcweir        return if ($cmd_file || $show);
787*cdf0e10cSrcweir        $error_code = run_job($dmake, $job_name);
788*cdf0e10cSrcweir        html_store_job_info(\%local_deps_hash, $job_name, $error_code) if (!$child);
789*cdf0e10cSrcweir    };
790*cdf0e10cSrcweir
791*cdf0e10cSrcweir    if ($error_code && $ignore) {
792*cdf0e10cSrcweir        push(@ignored_errors, $job_name);
793*cdf0e10cSrcweir        $error_code = 0;
794*cdf0e10cSrcweir    };
795*cdf0e10cSrcweir    if ($child) {
796*cdf0e10cSrcweir        my $oldfh = select STDERR;
797*cdf0e10cSrcweir        $| = 1;
798*cdf0e10cSrcweir        select $oldfh;
799*cdf0e10cSrcweir        $| =1;
800*cdf0e10cSrcweir        if ($error_code) {
801*cdf0e10cSrcweir            _exit($error_code >> 8);
802*cdf0e10cSrcweir        } else {
803*cdf0e10cSrcweir            _exit($? >> 8) if ($? && ($? != -1));
804*cdf0e10cSrcweir        };
805*cdf0e10cSrcweir        _exit(0);
806*cdf0e10cSrcweir    } elsif ($error_code && ($error_code != -1)) {
807*cdf0e10cSrcweir        $broken_build{$job_name} = $error_code;
808*cdf0e10cSrcweir        return $error_code;
809*cdf0e10cSrcweir    };
810*cdf0e10cSrcweir};
811*cdf0e10cSrcweir
812*cdf0e10cSrcweir#
813*cdf0e10cSrcweir# Procedure stores information about build list (and)
814*cdf0e10cSrcweir# build list object in build_lists_hash
815*cdf0e10cSrcweir#
816*cdf0e10cSrcweirsub store_build_list_content {
817*cdf0e10cSrcweir    my $module = shift;
818*cdf0e10cSrcweir    my $build_list_path = get_build_list_path($module);
819*cdf0e10cSrcweir    return undef if (!defined $build_list_path);
820*cdf0e10cSrcweir    return if (!$build_list_path);
821*cdf0e10cSrcweir    my $xml_list = undef;
822*cdf0e10cSrcweir    if ($build_list_path =~ /\.xlist$/o) {
823*cdf0e10cSrcweir        print_error("XMLBuildListParser.pm couldn\'t be found, so XML format for build lists is not enabled") if (!defined $enable_xml);
824*cdf0e10cSrcweir        $xml_list = XMLBuildListParser->new();
825*cdf0e10cSrcweir        if (!$xml_list->loadXMLFile($build_list_path)) {
826*cdf0e10cSrcweir            print_error("Cannot use $build_list_path");
827*cdf0e10cSrcweir        };
828*cdf0e10cSrcweir        $build_lists_hash{$module} = $xml_list;
829*cdf0e10cSrcweir    } else {
830*cdf0e10cSrcweir        if (open (BUILD_LST, $build_list_path)) {
831*cdf0e10cSrcweir            my @build_lst = <BUILD_LST>;
832*cdf0e10cSrcweir            $build_lists_hash{$module} = \@build_lst;
833*cdf0e10cSrcweir            close BUILD_LST;
834*cdf0e10cSrcweir            return;
835*cdf0e10cSrcweir        }
836*cdf0e10cSrcweir        $dead_parents{$module}++;
837*cdf0e10cSrcweir    };
838*cdf0e10cSrcweir}
839*cdf0e10cSrcweir#
840*cdf0e10cSrcweir# Get string (list) of parent projects to build
841*cdf0e10cSrcweir#
842*cdf0e10cSrcweirsub get_parents_array {
843*cdf0e10cSrcweir    my $module = shift;
844*cdf0e10cSrcweir    store_build_list_content($module);
845*cdf0e10cSrcweir    my $build_list_ref = $build_lists_hash{$module};
846*cdf0e10cSrcweir
847*cdf0e10cSrcweir    if (ref($build_list_ref) eq 'XMLBuildListParser') {
848*cdf0e10cSrcweir        return $build_list_ref->getModuleDependencies(\@modes_array);
849*cdf0e10cSrcweir    };
850*cdf0e10cSrcweir    foreach (@$build_list_ref) {
851*cdf0e10cSrcweir        if ($_ =~ /#/) {
852*cdf0e10cSrcweir            if ($`) {
853*cdf0e10cSrcweir                $_ = $`;
854*cdf0e10cSrcweir            } else {
855*cdf0e10cSrcweir                next;
856*cdf0e10cSrcweir            };
857*cdf0e10cSrcweir        };
858*cdf0e10cSrcweir        s/\r\n//;
859*cdf0e10cSrcweir        if ($_ =~ /\:+\s+/) {
860*cdf0e10cSrcweir            return pick_for_build_type($');
861*cdf0e10cSrcweir        };
862*cdf0e10cSrcweir    };
863*cdf0e10cSrcweir    return ();
864*cdf0e10cSrcweir};
865*cdf0e10cSrcweir
866*cdf0e10cSrcweir#
867*cdf0e10cSrcweir# get folders' platform infos
868*cdf0e10cSrcweir#
869*cdf0e10cSrcweirsub get_prj_platform {
870*cdf0e10cSrcweir    my $build_list_ref = shift;
871*cdf0e10cSrcweir    my ($prj_alias, $line);
872*cdf0e10cSrcweir    foreach(@$build_list_ref) {
873*cdf0e10cSrcweir        s/\r\n//;
874*cdf0e10cSrcweir        $line++;
875*cdf0e10cSrcweir        if ($_ =~ /\snmake\s/) {
876*cdf0e10cSrcweir            if ($' =~ /\s*-\s+(\w+)[,\S+]*\s+(\S+)/ ) {
877*cdf0e10cSrcweir                my $platform = $1;
878*cdf0e10cSrcweir                my $alias = $2;
879*cdf0e10cSrcweir                print_error ("There is no correct alias set in the line $line!") if ($alias eq 'NULL');
880*cdf0e10cSrcweir                mark_platform($alias, $platform);
881*cdf0e10cSrcweir            } else {
882*cdf0e10cSrcweir                print_error("Misspelling in line: \n$_");
883*cdf0e10cSrcweir            };
884*cdf0e10cSrcweir        };
885*cdf0e10cSrcweir    };
886*cdf0e10cSrcweir};
887*cdf0e10cSrcweir
888*cdf0e10cSrcweir#
889*cdf0e10cSrcweir# Procedure populate the dependencies hash with
890*cdf0e10cSrcweir# information from XML build list object
891*cdf0e10cSrcweir#
892*cdf0e10cSrcweirsub get_deps_from_object {
893*cdf0e10cSrcweir    my ($module, $build_list_object, $dependencies_hash) = @_;
894*cdf0e10cSrcweir
895*cdf0e10cSrcweir    foreach my $dir ($build_list_object->getJobDirectories("make", $ENV{GUI})) {
896*cdf0e10cSrcweir        $path_hash{$dir} = $module_paths{$module};
897*cdf0e10cSrcweir        $path_hash{$dir} .= $dir if ($dir ne '/');
898*cdf0e10cSrcweir        my %deps_hash = ();
899*cdf0e10cSrcweir
900*cdf0e10cSrcweir        foreach my $dep ($build_list_object->getJobDependencies($dir, "make", $ENV{GUI})) {
901*cdf0e10cSrcweir            $deps_hash{$dep}++;
902*cdf0e10cSrcweir        };
903*cdf0e10cSrcweir        $$dependencies_hash{$dir} = \%deps_hash;
904*cdf0e10cSrcweir    };
905*cdf0e10cSrcweir};
906*cdf0e10cSrcweir
907*cdf0e10cSrcweir#
908*cdf0e10cSrcweir# this function wraps the get_module_dep_hash and backups the resultung hash
909*cdf0e10cSrcweir#
910*cdf0e10cSrcweirsub get_module_dep_hash {
911*cdf0e10cSrcweir    my ($module, $module_dep_hash) = @_;
912*cdf0e10cSrcweir    if (defined $module_deps_hash_backup{$module}) {
913*cdf0e10cSrcweir        backup_deps_hash($module_deps_hash_backup{$module}, $module_dep_hash);
914*cdf0e10cSrcweir    } else {
915*cdf0e10cSrcweir        get_deps_hash($module, $module_dep_hash);
916*cdf0e10cSrcweir        my %values_hash = ();
917*cdf0e10cSrcweir        backup_deps_hash($module_dep_hash, \%values_hash);
918*cdf0e10cSrcweir        $module_deps_hash_backup{$module} = \%values_hash;
919*cdf0e10cSrcweir    }
920*cdf0e10cSrcweir};
921*cdf0e10cSrcweir
922*cdf0e10cSrcweir#
923*cdf0e10cSrcweir# Getting hashes of all internal dependencies and additional
924*cdf0e10cSrcweir# information for given project
925*cdf0e10cSrcweir#
926*cdf0e10cSrcweirsub get_deps_hash {
927*cdf0e10cSrcweir    my ($dummy, $module_to_build);
928*cdf0e10cSrcweir    my %dead_dependencies = ();
929*cdf0e10cSrcweir    $module_to_build = shift;
930*cdf0e10cSrcweir    my $dependencies_hash = shift;
931*cdf0e10cSrcweir    if ($custom_job) {
932*cdf0e10cSrcweir        if ($modules_types{$module_to_build} ne 'lnk') {
933*cdf0e10cSrcweir            add_prerequisite_job($dependencies_hash, $module_to_build, $pre_custom_job);
934*cdf0e10cSrcweir            add_prerequisite_job($dependencies_hash, $module_to_build, $pre_job);
935*cdf0e10cSrcweir            add_dependent_job($dependencies_hash, $module_to_build, $custom_job);
936*cdf0e10cSrcweir            add_dependent_job($dependencies_hash, $module_to_build, $post_job);
937*cdf0e10cSrcweir            add_dependent_job($dependencies_hash, $module_to_build, $post_custom_job);
938*cdf0e10cSrcweir        };
939*cdf0e10cSrcweir        return;
940*cdf0e10cSrcweir    };
941*cdf0e10cSrcweir    if ( defined $modules_types{$module_to_build} && $modules_types{$module_to_build} ne 'mod') {
942*cdf0e10cSrcweir        add_prerequisite_job($dependencies_hash, $module_to_build, $pre_job);
943*cdf0e10cSrcweir        return;
944*cdf0e10cSrcweir    };
945*cdf0e10cSrcweir
946*cdf0e10cSrcweir    my  $build_list_ref = $build_lists_hash{$module_to_build};
947*cdf0e10cSrcweir#    delete $build_lists_hash{$module_to_build};
948*cdf0e10cSrcweir    if (ref($build_list_ref) eq 'XMLBuildListParser') {
949*cdf0e10cSrcweir        get_deps_from_object($module_to_build, $build_list_ref, $dependencies_hash);
950*cdf0e10cSrcweir    } else {
951*cdf0e10cSrcweir        get_prj_platform($build_list_ref);
952*cdf0e10cSrcweir        foreach (@$build_list_ref) {
953*cdf0e10cSrcweir            if ($_ =~ /#/o) {
954*cdf0e10cSrcweir                next if (!$`);
955*cdf0e10cSrcweir                $_ = $`;
956*cdf0e10cSrcweir            };
957*cdf0e10cSrcweir            s/\r\n//;
958*cdf0e10cSrcweir            if ($_ =~ /\s+nmake\s+/o) {
959*cdf0e10cSrcweir                my ($platform, $dependencies, $dir, $dir_alias);
960*cdf0e10cSrcweir                my %deps_hash = ();
961*cdf0e10cSrcweir                $dependencies = $';
962*cdf0e10cSrcweir                $dummy = $`;
963*cdf0e10cSrcweir                $dummy =~ /(\S+)\s+(\S*)/o;
964*cdf0e10cSrcweir                $dir = $2;
965*cdf0e10cSrcweir                $dependencies =~ /(\w+)/o;
966*cdf0e10cSrcweir                $platform = $1;
967*cdf0e10cSrcweir                $dependencies = $';
968*cdf0e10cSrcweir                while ($dependencies =~ /,(\w+)/o) {
969*cdf0e10cSrcweir                    $dependencies = $';
970*cdf0e10cSrcweir                };
971*cdf0e10cSrcweir                $dependencies =~ /\s+(\S+)\s+/o;
972*cdf0e10cSrcweir                $dir_alias = $1;
973*cdf0e10cSrcweir                if (!check_platform($platform)) {
974*cdf0e10cSrcweir                    next if (defined $platform_hash{$dir_alias});
975*cdf0e10cSrcweir                    $dead_dependencies{$dir_alias}++;
976*cdf0e10cSrcweir                    next;
977*cdf0e10cSrcweir                };
978*cdf0e10cSrcweir                delete $dead_dependencies{$dir_alias} if (defined $dead_dependencies{$dir_alias});
979*cdf0e10cSrcweir                print_error("Directory alias $dir_alias is defined at least twice!! Please, correct build.lst in module $module_to_build") if (defined $$dependencies_hash{$dir_alias});
980*cdf0e10cSrcweir                $platform_hash{$dir_alias}++;
981*cdf0e10cSrcweir                $dependencies = $';
982*cdf0e10cSrcweir                print_error("$module_to_build/prj/build.lst has wrongly written dependencies string:\n$_\n") if (!$dependencies);
983*cdf0e10cSrcweir                $deps_hash{$_}++ foreach (get_dependency_array($dependencies));
984*cdf0e10cSrcweir                $$dependencies_hash{$dir_alias} = \%deps_hash;
985*cdf0e10cSrcweir                my $local_dir = '';
986*cdf0e10cSrcweir                if ($dir =~ /(\\|\/)/o) {
987*cdf0e10cSrcweir                    $local_dir = "/$'";
988*cdf0e10cSrcweir                };
989*cdf0e10cSrcweir                $path_hash{$dir_alias} = correct_path($module_paths{$module_to_build} . $local_dir);
990*cdf0e10cSrcweir            } elsif ($_ !~ /^\s*$/ && $_ !~ /^\w*\s/o) {
991*cdf0e10cSrcweir                chomp;
992*cdf0e10cSrcweir                push(@errors, $_);
993*cdf0e10cSrcweir            };
994*cdf0e10cSrcweir        };
995*cdf0e10cSrcweir        if (scalar @errors) {
996*cdf0e10cSrcweir            my $message = "$module_to_build/prj/build.lst has wrongly written string(s):\n";
997*cdf0e10cSrcweir            $message .= "$_\n" foreach(@errors);
998*cdf0e10cSrcweir            if ($processes_to_run) {
999*cdf0e10cSrcweir                $broken_build{$module_to_build} = $message;
1000*cdf0e10cSrcweir                $dependencies_hash = undef;
1001*cdf0e10cSrcweir                return;
1002*cdf0e10cSrcweir            } else {
1003*cdf0e10cSrcweir                print_error($message);
1004*cdf0e10cSrcweir            };
1005*cdf0e10cSrcweir        };
1006*cdf0e10cSrcweir        foreach my $alias (keys %dead_dependencies) {
1007*cdf0e10cSrcweir            next if defined $alive_dependencies{$alias};
1008*cdf0e10cSrcweir#            if (!IsHashNative($alias)) {
1009*cdf0e10cSrcweir                remove_from_dependencies($alias, $dependencies_hash);
1010*cdf0e10cSrcweir                delete $dead_dependencies{$alias};
1011*cdf0e10cSrcweir#            };
1012*cdf0e10cSrcweir        };
1013*cdf0e10cSrcweir    };
1014*cdf0e10cSrcweir    resolve_aliases($dependencies_hash, \%path_hash);
1015*cdf0e10cSrcweir    if (!$prepare) {
1016*cdf0e10cSrcweir        add_prerequisite_job($dependencies_hash, $module_to_build, $pre_custom_job);
1017*cdf0e10cSrcweir        add_prerequisite_job($dependencies_hash, $module_to_build, $pre_job);
1018*cdf0e10cSrcweir        add_dependent_job($dependencies_hash, $module_to_build, $custom_job);
1019*cdf0e10cSrcweir        add_dependent_job($dependencies_hash, $module_to_build, $post_job) if ($module_to_build ne $initial_module);
1020*cdf0e10cSrcweir        add_dependent_job($dependencies_hash, $module_to_build, $post_custom_job);
1021*cdf0e10cSrcweir    };
1022*cdf0e10cSrcweir    store_weights($dependencies_hash);
1023*cdf0e10cSrcweir};
1024*cdf0e10cSrcweir
1025*cdf0e10cSrcweir#
1026*cdf0e10cSrcweir# procedure adds which is independent from anothers, but anothers are dependent from it
1027*cdf0e10cSrcweir#
1028*cdf0e10cSrcweirsub add_prerequisite_job {
1029*cdf0e10cSrcweir    my ($dependencies_hash, $module, $job) = @_;
1030*cdf0e10cSrcweir    return if (!$job);
1031*cdf0e10cSrcweir    $job = "$module $job";
1032*cdf0e10cSrcweir    foreach (keys %$dependencies_hash) {
1033*cdf0e10cSrcweir        my $deps_hash = $$dependencies_hash{$_};
1034*cdf0e10cSrcweir        $$deps_hash{$job}++;
1035*cdf0e10cSrcweir    };
1036*cdf0e10cSrcweir    $$dependencies_hash{$job} = {};
1037*cdf0e10cSrcweir};
1038*cdf0e10cSrcweir
1039*cdf0e10cSrcweir#
1040*cdf0e10cSrcweir# procedure adds a job wich is dependent from all already registered jobs
1041*cdf0e10cSrcweir#
1042*cdf0e10cSrcweirsub add_dependent_job {
1043*cdf0e10cSrcweir    # $post_job is dependent from all jobs
1044*cdf0e10cSrcweir    my ($dependencies_hash, $module, $job) = @_;
1045*cdf0e10cSrcweir    return if (!$job);
1046*cdf0e10cSrcweir    my %deps_hash = ();
1047*cdf0e10cSrcweir    $deps_hash{$_}++ foreach (keys %$dependencies_hash);
1048*cdf0e10cSrcweir    $$dependencies_hash{"$module $job"} = \%deps_hash;
1049*cdf0e10cSrcweir};
1050*cdf0e10cSrcweir
1051*cdf0e10cSrcweir#
1052*cdf0e10cSrcweir# this procedure converts aliases to absolute paths
1053*cdf0e10cSrcweir#
1054*cdf0e10cSrcweirsub resolve_aliases {
1055*cdf0e10cSrcweir    my ($dependencies_hash, $path_hash) = @_;
1056*cdf0e10cSrcweir    foreach my $dir_alias (keys %$dependencies_hash) {
1057*cdf0e10cSrcweir        my $aliases_hash_ref = $$dependencies_hash{$dir_alias};
1058*cdf0e10cSrcweir        my %paths_hash = ();
1059*cdf0e10cSrcweir        foreach (keys %$aliases_hash_ref) {
1060*cdf0e10cSrcweir            $paths_hash{$$path_hash{$_}}++;
1061*cdf0e10cSrcweir        };
1062*cdf0e10cSrcweir        delete $$dependencies_hash{$dir_alias};
1063*cdf0e10cSrcweir        $$dependencies_hash{$$path_hash{$dir_alias}} = \%paths_hash;
1064*cdf0e10cSrcweir    };
1065*cdf0e10cSrcweir};
1066*cdf0e10cSrcweir
1067*cdf0e10cSrcweir#
1068*cdf0e10cSrcweir# mark platform in order to prove if alias has been used according to specs
1069*cdf0e10cSrcweir#
1070*cdf0e10cSrcweirsub mark_platform {
1071*cdf0e10cSrcweir    my $prj_alias = shift;
1072*cdf0e10cSrcweir    if (exists $prj_platform{$prj_alias}) {
1073*cdf0e10cSrcweir        $prj_platform{$prj_alias} = 'all';
1074*cdf0e10cSrcweir    } else {
1075*cdf0e10cSrcweir        $prj_platform{$prj_alias} = shift;
1076*cdf0e10cSrcweir    };
1077*cdf0e10cSrcweir};
1078*cdf0e10cSrcweir
1079*cdf0e10cSrcweir#
1080*cdf0e10cSrcweir# Convert path from abstract (with '\' and/or '/' delimiters)
1081*cdf0e10cSrcweir# to system-independent
1082*cdf0e10cSrcweir#
1083*cdf0e10cSrcweirsub correct_path {
1084*cdf0e10cSrcweir    $_ = shift;
1085*cdf0e10cSrcweir    s/\\/\//g;
1086*cdf0e10cSrcweir    return $_;
1087*cdf0e10cSrcweir};
1088*cdf0e10cSrcweir
1089*cdf0e10cSrcweir
1090*cdf0e10cSrcweirsub check_dmake {
1091*cdf0e10cSrcweir#print "Checking dmake...";
1092*cdf0e10cSrcweir    if (open(DMAKEVERSION, "dmake -V |")) {
1093*cdf0e10cSrcweir#    if (open(DMAKEVERSION, "dmake -V |")) {
1094*cdf0e10cSrcweir        my @dmake_version = <DMAKEVERSION>;
1095*cdf0e10cSrcweir        close DMAKEVERSION;
1096*cdf0e10cSrcweir#       if ($dmake_version[0] =~ /^dmake\s\-\sCopyright\s\(c\)/) {
1097*cdf0e10cSrcweir#            print " Using version $1\n" if ($dmake_version[0] =~ /Version\s(\d+\.*\d*)/);
1098*cdf0e10cSrcweir#        };
1099*cdf0e10cSrcweir        return;
1100*cdf0e10cSrcweir    };
1101*cdf0e10cSrcweir    my $error_message = 'dmake: Command not found.';
1102*cdf0e10cSrcweir    $error_message .= ' Please rerun bootstrap' if (!defined $ENV{COMMON_ENV_TOOLS});
1103*cdf0e10cSrcweir    print_error($error_message);
1104*cdf0e10cSrcweir};
1105*cdf0e10cSrcweir
1106*cdf0e10cSrcweir#
1107*cdf0e10cSrcweir# Get platform-dependent commands
1108*cdf0e10cSrcweir#
1109*cdf0e10cSrcweirsub get_commands {
1110*cdf0e10cSrcweir    my $arg = '';
1111*cdf0e10cSrcweir    # Setting alias for dmake
1112*cdf0e10cSrcweir    $dmake = 'dmake';
1113*cdf0e10cSrcweir    check_dmake();
1114*cdf0e10cSrcweir
1115*cdf0e10cSrcweir    if ($cmd_file) {
1116*cdf0e10cSrcweir        if ($ENV{GUI} eq 'UNX') {
1117*cdf0e10cSrcweir            $check_error_string = "if \"\$?\" != \"0\" exit\n";
1118*cdf0e10cSrcweir        } else {
1119*cdf0e10cSrcweir            $check_error_string = "if \"\%?\" != \"0\" quit\n";
1120*cdf0e10cSrcweir        };
1121*cdf0e10cSrcweir    };
1122*cdf0e10cSrcweir
1123*cdf0e10cSrcweir    $dmake_args = join(' ', 'dmake', @dmake_args);
1124*cdf0e10cSrcweir
1125*cdf0e10cSrcweir    while ($arg = pop(@dmake_args)) {
1126*cdf0e10cSrcweir        $dmake .= ' '.$arg;
1127*cdf0e10cSrcweir    };
1128*cdf0e10cSrcweir    $dmake .= ' verbose=true' if ($html);
1129*cdf0e10cSrcweir};
1130*cdf0e10cSrcweir
1131*cdf0e10cSrcweir#
1132*cdf0e10cSrcweir# Procedure retrieves list of projects to be built from build.lst
1133*cdf0e10cSrcweir#
1134*cdf0e10cSrcweirsub get_workspace_path {
1135*cdf0e10cSrcweir    if (!defined $ENV{GUI}) {
1136*cdf0e10cSrcweir        $ENV{mk_tmp} = '';
1137*cdf0e10cSrcweir        die "No environment set\n";
1138*cdf0e10cSrcweir    };
1139*cdf0e10cSrcweir    my $repository_helper = RepositoryHelper->new();
1140*cdf0e10cSrcweir    my $workspace_path = $repository_helper->get_repository_root();
1141*cdf0e10cSrcweir    my $initial_dir = $repository_helper->get_initial_directory();
1142*cdf0e10cSrcweir    if ($workspace_path eq $initial_dir) {
1143*cdf0e10cSrcweir        print_error('Found no project to build');
1144*cdf0e10cSrcweir    };
1145*cdf0e10cSrcweir    $initial_module = substr($initial_dir, length($workspace_path) + 1);
1146*cdf0e10cSrcweir    if ($initial_module =~ /(\\|\/)/) {
1147*cdf0e10cSrcweir        $initial_module = $`;
1148*cdf0e10cSrcweir    };
1149*cdf0e10cSrcweir    $module_paths{$initial_module} = $workspace_path . "/$initial_module";
1150*cdf0e10cSrcweir    return $workspace_path;
1151*cdf0e10cSrcweir};
1152*cdf0e10cSrcweir
1153*cdf0e10cSrcweir#
1154*cdf0e10cSrcweir# Picks project which can be built now from hash and then deletes it from hash
1155*cdf0e10cSrcweir#
1156*cdf0e10cSrcweirsub pick_prj_to_build {
1157*cdf0e10cSrcweir    my $deps_hash = shift;
1158*cdf0e10cSrcweir    get_html_orders();
1159*cdf0e10cSrcweir    my $prj = find_indep_prj($deps_hash);
1160*cdf0e10cSrcweir    if ($prj) {
1161*cdf0e10cSrcweir        delete $$deps_hash{$prj};
1162*cdf0e10cSrcweir        generate_html_file();
1163*cdf0e10cSrcweir    };
1164*cdf0e10cSrcweir    return $prj;
1165*cdf0e10cSrcweir};
1166*cdf0e10cSrcweir
1167*cdf0e10cSrcweir#
1168*cdf0e10cSrcweir# Make a decision if the project should be built on this platform
1169*cdf0e10cSrcweir#
1170*cdf0e10cSrcweirsub check_platform {
1171*cdf0e10cSrcweir    my $platform = shift;
1172*cdf0e10cSrcweir    return 1 if ($platform eq 'all');
1173*cdf0e10cSrcweir    return 1 if (($ENV{GUI} eq 'WIN') && ($platform eq 'w'));
1174*cdf0e10cSrcweir    return 1 if (($ENV{GUI} eq 'UNX') && ($platform eq 'u'));
1175*cdf0e10cSrcweir    return 1 if (($ENV{GUI} eq 'OS2') && ($platform eq 'p'));
1176*cdf0e10cSrcweir    return 1 if (($ENV{GUI} eq 'WNT') &&
1177*cdf0e10cSrcweir                 (($platform eq 'w') || ($platform eq 'n')));
1178*cdf0e10cSrcweir    return 0;
1179*cdf0e10cSrcweir};
1180*cdf0e10cSrcweir
1181*cdf0e10cSrcweir#
1182*cdf0e10cSrcweir# Remove project to build ahead from dependencies and make an array
1183*cdf0e10cSrcweir# of all from given project dependent projects
1184*cdf0e10cSrcweir#
1185*cdf0e10cSrcweirsub remove_from_dependencies {
1186*cdf0e10cSrcweir    my ($exclude_prj, $i, $prj, $dependencies);
1187*cdf0e10cSrcweir    $exclude_prj = shift;
1188*cdf0e10cSrcweir    my $exclude_prj_orig = '';
1189*cdf0e10cSrcweir    $exclude_prj_orig = $` if (($exclude_prj =~ /\.lnk$/o) || ($exclude_prj =~ /\.link$/o));
1190*cdf0e10cSrcweir    $dependencies = shift;
1191*cdf0e10cSrcweir    foreach $prj (keys %$dependencies) {
1192*cdf0e10cSrcweir        my $prj_deps_hash = $$dependencies{$prj};
1193*cdf0e10cSrcweir        delete $$prj_deps_hash{$exclude_prj} if (defined $$prj_deps_hash{$exclude_prj});
1194*cdf0e10cSrcweir    };
1195*cdf0e10cSrcweir};
1196*cdf0e10cSrcweir
1197*cdf0e10cSrcweir
1198*cdf0e10cSrcweir#
1199*cdf0e10cSrcweir# Check the hash for consistency
1200*cdf0e10cSrcweir#
1201*cdf0e10cSrcweirsub check_deps_hash {
1202*cdf0e10cSrcweir    my ($deps_hash_ref, $module) = @_;
1203*cdf0e10cSrcweir    my @possible_order;
1204*cdf0e10cSrcweir    my $module_path = $module_paths{$module} if (defined $module);
1205*cdf0e10cSrcweir    return if (!scalar keys %$deps_hash_ref);
1206*cdf0e10cSrcweir    my %deps_hash = ();
1207*cdf0e10cSrcweir    my $consistent;
1208*cdf0e10cSrcweir    backup_deps_hash($deps_hash_ref, \%deps_hash);
1209*cdf0e10cSrcweir    my $string;
1210*cdf0e10cSrcweir    my $log_name;
1211*cdf0e10cSrcweir    my $build_number = 0;
1212*cdf0e10cSrcweir
1213*cdf0e10cSrcweir    do {
1214*cdf0e10cSrcweir        $consistent = '';
1215*cdf0e10cSrcweir        foreach my $key (sort keys %deps_hash) {
1216*cdf0e10cSrcweir            my $local_deps_ref = $deps_hash{$key};
1217*cdf0e10cSrcweir            if (!scalar keys %$local_deps_ref) {
1218*cdf0e10cSrcweir                if (defined $module) {
1219*cdf0e10cSrcweir                    $build_number++;
1220*cdf0e10cSrcweir                    $string = undef;
1221*cdf0e10cSrcweir                    if ($key =~ /(\s)/o) {
1222*cdf0e10cSrcweir                        $string = $key;
1223*cdf0e10cSrcweir                    } else {
1224*cdf0e10cSrcweir                        if (length($key) == length($module_path)) {
1225*cdf0e10cSrcweir                            $string = './';
1226*cdf0e10cSrcweir                        } else {
1227*cdf0e10cSrcweir                            $string = substr($key, length($module_path) + 1);
1228*cdf0e10cSrcweir                            $string =~ s/\\/\//go;
1229*cdf0e10cSrcweir                        };
1230*cdf0e10cSrcweir                    };
1231*cdf0e10cSrcweir                    $log_name = $string;
1232*cdf0e10cSrcweir                    if ($log_name eq "$module $custom_job") {
1233*cdf0e10cSrcweir                        $log_name = "custom_job";
1234*cdf0e10cSrcweir                    };
1235*cdf0e10cSrcweir                    if ($log_name eq "$module $pre_custom_job") {
1236*cdf0e10cSrcweir                        $log_name = "pre_custom_job";
1237*cdf0e10cSrcweir                    };
1238*cdf0e10cSrcweir                    if ($log_name eq "$module $post_custom_job") {
1239*cdf0e10cSrcweir                        $log_name = "post_custom_job";
1240*cdf0e10cSrcweir                    };
1241*cdf0e10cSrcweir                    $log_name =~ s/\\|\//\./g;
1242*cdf0e10cSrcweir                    $log_name =~ s/\s/_/g;
1243*cdf0e10cSrcweir                    $log_name = $module if ($log_name =~ /^\.+$/);
1244*cdf0e10cSrcweir                    $log_name .= '.txt';
1245*cdf0e10cSrcweir                    push(@possible_order, $key);
1246*cdf0e10cSrcweir                    $jobs_hash{$key} = {    SHORT_NAME => $string,
1247*cdf0e10cSrcweir                                            BUILD_NUMBER => $build_number,
1248*cdf0e10cSrcweir                                            STATUS => 'waiting',
1249*cdf0e10cSrcweir                                            LOG_PATH => '../' . $source_config->get_module_repository($module) . "/$module/$ENV{INPATH}/misc/logs/$log_name",
1250*cdf0e10cSrcweir                                            LONG_LOG_PATH => correct_path($module_paths{$module} . "/$ENV{INPATH}/misc/logs/$log_name"),
1251*cdf0e10cSrcweir                                            START_TIME => 0,
1252*cdf0e10cSrcweir                                            FINISH_TIME => 0,
1253*cdf0e10cSrcweir                                            CLIENT => '-'
1254*cdf0e10cSrcweir                    };
1255*cdf0e10cSrcweir                };
1256*cdf0e10cSrcweir                remove_from_dependencies($key, \%deps_hash);
1257*cdf0e10cSrcweir                delete $deps_hash{$key};
1258*cdf0e10cSrcweir                $consistent++;
1259*cdf0e10cSrcweir            };
1260*cdf0e10cSrcweir        };
1261*cdf0e10cSrcweir    } while ($consistent && (scalar keys %deps_hash));
1262*cdf0e10cSrcweir    return \@possible_order if ($consistent);
1263*cdf0e10cSrcweir    print STDERR "Fatal error:";
1264*cdf0e10cSrcweir    foreach (keys %deps_hash) {
1265*cdf0e10cSrcweir        print STDERR "\n\t$_ depends on: ";
1266*cdf0e10cSrcweir        foreach my $i (keys %{$deps_hash{$_}}) {
1267*cdf0e10cSrcweir            print STDERR (' ', $i);
1268*cdf0e10cSrcweir        };
1269*cdf0e10cSrcweir    };
1270*cdf0e10cSrcweir    if ($child) {
1271*cdf0e10cSrcweir        my $oldfh = select STDERR;
1272*cdf0e10cSrcweir        $| = 1;
1273*cdf0e10cSrcweir        _do_exit(1);
1274*cdf0e10cSrcweir    } else {
1275*cdf0e10cSrcweir        print_error("There are dead or circular dependencies\n");
1276*cdf0e10cSrcweir    };
1277*cdf0e10cSrcweir};
1278*cdf0e10cSrcweir
1279*cdf0e10cSrcweir#
1280*cdf0e10cSrcweir# Find project with no dependencies left.
1281*cdf0e10cSrcweir#
1282*cdf0e10cSrcweirsub find_indep_prj {
1283*cdf0e10cSrcweir    my ($dependencies, $i);
1284*cdf0e10cSrcweir    my @candidates = ();
1285*cdf0e10cSrcweir    $all_dependent = 1;
1286*cdf0e10cSrcweir    handle_dead_children(0) if ($processes_to_run);
1287*cdf0e10cSrcweir    my $children = children_number();
1288*cdf0e10cSrcweir    return '' if (!$server_mode && $children && ($children >= $processes_to_run));
1289*cdf0e10cSrcweir    $dependencies = shift;
1290*cdf0e10cSrcweir    if (scalar keys %$dependencies) {
1291*cdf0e10cSrcweir        foreach my $job (keys %$dependencies) {
1292*cdf0e10cSrcweir            if (!scalar keys %{$$dependencies{$job}}) {
1293*cdf0e10cSrcweir                push(@candidates, $job);
1294*cdf0e10cSrcweir                last if (!$processes_to_run);
1295*cdf0e10cSrcweir            };
1296*cdf0e10cSrcweir        };
1297*cdf0e10cSrcweir        if (scalar @candidates) {
1298*cdf0e10cSrcweir            $all_dependent = 0;
1299*cdf0e10cSrcweir            my $best_candidate = undef;
1300*cdf0e10cSrcweir            my $best_weight = 0;
1301*cdf0e10cSrcweir            if (scalar @candidates > 1) {
1302*cdf0e10cSrcweir                foreach my $candidate (@candidates) {
1303*cdf0e10cSrcweir                    my $candidate_weight = get_waiters_number($candidate);
1304*cdf0e10cSrcweir                    if ($candidate_weight > $best_weight) {
1305*cdf0e10cSrcweir                        $best_candidate = $candidate;
1306*cdf0e10cSrcweir                        $best_weight = $candidate_weight;
1307*cdf0e10cSrcweir                    };
1308*cdf0e10cSrcweir                };
1309*cdf0e10cSrcweir                if (defined $best_candidate) {
1310*cdf0e10cSrcweir                    return $best_candidate;
1311*cdf0e10cSrcweir                }
1312*cdf0e10cSrcweir            }
1313*cdf0e10cSrcweir            my @sorted_candidates = sort(@candidates);
1314*cdf0e10cSrcweir            return $sorted_candidates[0];
1315*cdf0e10cSrcweir        };
1316*cdf0e10cSrcweir    };
1317*cdf0e10cSrcweir    return '';
1318*cdf0e10cSrcweir};
1319*cdf0e10cSrcweir
1320*cdf0e10cSrcweirsub get_waiters_number {
1321*cdf0e10cSrcweir    my $module = shift;
1322*cdf0e10cSrcweir    if (defined $weights_hash{$module}) {
1323*cdf0e10cSrcweir        return $weights_hash{$module};
1324*cdf0e10cSrcweir    };
1325*cdf0e10cSrcweir    if (defined $reversed_dependencies{$module}) {
1326*cdf0e10cSrcweir        return scalar keys %{$reversed_dependencies{$module}};
1327*cdf0e10cSrcweir    };
1328*cdf0e10cSrcweir    return 0;
1329*cdf0e10cSrcweir};
1330*cdf0e10cSrcweir
1331*cdf0e10cSrcweir#
1332*cdf0e10cSrcweir# Check if given entry is HASH-native, that is not a user-defined data
1333*cdf0e10cSrcweir#
1334*cdf0e10cSrcweir#sub IsHashNative {
1335*cdf0e10cSrcweir#    my $prj = shift;
1336*cdf0e10cSrcweir#    return 1 if ($prj =~ /^HASH\(0x[\d | a | b | c | d | e | f]{6,}\)/);
1337*cdf0e10cSrcweir#    return 0;
1338*cdf0e10cSrcweir#};
1339*cdf0e10cSrcweir
1340*cdf0e10cSrcweir#
1341*cdf0e10cSrcweir# Getting array of dependencies from the string given
1342*cdf0e10cSrcweir#
1343*cdf0e10cSrcweirsub get_dependency_array {
1344*cdf0e10cSrcweir    my ($dep_string, @dependencies, $parent_prj, $prj, $string);
1345*cdf0e10cSrcweir    @dependencies = ();
1346*cdf0e10cSrcweir    $dep_string = shift;
1347*cdf0e10cSrcweir    $string = $dep_string;
1348*cdf0e10cSrcweir    $prj = shift;
1349*cdf0e10cSrcweir    while ($dep_string !~ /^NULL/o) {
1350*cdf0e10cSrcweir        print_error("Project $prj has wrongly written dependencies string:\n $string") if (!$dep_string);
1351*cdf0e10cSrcweir        $dep_string =~ /(\S+)\s*/o;
1352*cdf0e10cSrcweir        $parent_prj = $1;
1353*cdf0e10cSrcweir        $dep_string = $';
1354*cdf0e10cSrcweir        if ($parent_prj =~ /\.(\w+)$/o) {
1355*cdf0e10cSrcweir            $parent_prj = $`;
1356*cdf0e10cSrcweir            if (($prj_platform{$parent_prj} ne $1) &&
1357*cdf0e10cSrcweir                ($prj_platform{$parent_prj} ne 'all')) {
1358*cdf0e10cSrcweir                print_error ("$parent_prj\.$1 is a wrongly dependency identifier!\nCheck if it is platform dependent");
1359*cdf0e10cSrcweir            };
1360*cdf0e10cSrcweir            $alive_dependencies{$parent_prj}++ if (check_platform($1));
1361*cdf0e10cSrcweir            push(@dependencies, $parent_prj);
1362*cdf0e10cSrcweir        } else {
1363*cdf0e10cSrcweir            if ((exists($prj_platform{$parent_prj})) &&
1364*cdf0e10cSrcweir                ($prj_platform{$parent_prj} ne 'all') ) {
1365*cdf0e10cSrcweir                print_error("$parent_prj is a wrongly used dependency identifier!\nCheck if it is platform dependent");
1366*cdf0e10cSrcweir            };
1367*cdf0e10cSrcweir            push(@dependencies, $parent_prj);
1368*cdf0e10cSrcweir        };
1369*cdf0e10cSrcweir    };
1370*cdf0e10cSrcweir    return @dependencies;
1371*cdf0e10cSrcweir};
1372*cdf0e10cSrcweir
1373*cdf0e10cSrcweir
1374*cdf0e10cSrcweir#
1375*cdf0e10cSrcweir# Getting current directory list
1376*cdf0e10cSrcweir#
1377*cdf0e10cSrcweirsub get_directory_list {
1378*cdf0e10cSrcweir    my $path = shift;
1379*cdf0e10cSrcweir    opendir(CurrentDirList, $path);
1380*cdf0e10cSrcweir    my @directory_list = readdir(CurrentDirList);
1381*cdf0e10cSrcweir    closedir(CurrentDirList);
1382*cdf0e10cSrcweir    return @directory_list;
1383*cdf0e10cSrcweir};
1384*cdf0e10cSrcweir
1385*cdf0e10cSrcweirsub print_error {
1386*cdf0e10cSrcweir    my $message = shift;
1387*cdf0e10cSrcweir    my $force = shift;
1388*cdf0e10cSrcweir    $modules_number -= scalar keys %global_deps_hash;
1389*cdf0e10cSrcweir    $modules_number -= 1;
1390*cdf0e10cSrcweir    print STDERR "\nERROR: $message\n";
1391*cdf0e10cSrcweir    $ENV{mk_tmp} = '';
1392*cdf0e10cSrcweir    if ($cmd_file) {
1393*cdf0e10cSrcweir        close CMD_FILE;
1394*cdf0e10cSrcweir        unlink ($cmd_file);
1395*cdf0e10cSrcweir    };
1396*cdf0e10cSrcweir    if (!$child) {
1397*cdf0e10cSrcweir        $ENV{mk_tmp} = '';
1398*cdf0e10cSrcweir        close CMD_FILE if ($cmd_file);
1399*cdf0e10cSrcweir        unlink ($cmd_file);
1400*cdf0e10cSrcweir        do_exit(1);
1401*cdf0e10cSrcweir    };
1402*cdf0e10cSrcweir    do_exit(1) if (defined $force);
1403*cdf0e10cSrcweir};
1404*cdf0e10cSrcweir
1405*cdf0e10cSrcweirsub usage {
1406*cdf0e10cSrcweir    print STDERR "\nbuild\n";
1407*cdf0e10cSrcweir    print STDERR "Syntax:    build    [--all|-a[:prj_name]]|[--from|-f prj_name1[:prj_name2] [prj_name3 [...]]]|[--since|-c prj_name] [--with_branches prj_name1[:prj_name2] [--skip prj_name1[:prj_name2] [prj_name3 [...]] [prj_name3 [...]|-b]|[--prepare|-p][:platform] [--deliver|-d [--dlv_switch deliver_switch]]] [-P processes|--server [--setenvstring \"string\"] [--client_timeout MIN] [--port port1[:port2:...:portN]]] [--show|-s] [--help|-h] [--file|-F] [--ignore|-i] [--version|-V] [--mode|-m OOo[,SO[,EXT]] [--html [--html_path html_file_path] [--dontgraboutput]] [--pre_job=pre_job_sring] [--job=job_string|-j] [--post_job=post_job_sring] [--stoponerror] [--genconf [--removeall|--clear|--remove|--add [module1,module2[,...,moduleN]]]] [--exclude_branch_from prj_name1[:prj_name2] [prj_name3 [...]]] [--interactive]\n";
1408*cdf0e10cSrcweir    print STDERR "Example1:    build --from sfx2\n";
1409*cdf0e10cSrcweir    print STDERR "                     - build all projects dependent from sfx2, starting with sfx2, finishing with the current module\n";
1410*cdf0e10cSrcweir    print STDERR "Example2:    build --all:sfx2\n";
1411*cdf0e10cSrcweir    print STDERR "                     - the same as --all, but skip all projects that have been already built when using \"--all\" switch before sfx2\n";
1412*cdf0e10cSrcweir    print STDERR "Example3:    build --all --server\n";
1413*cdf0e10cSrcweir    print STDERR "                     - build all projects in server mode, use first available port from default range 7890-7894 (running clients required!!)\n";
1414*cdf0e10cSrcweir    print STDERR "Example4(for unixes):\n";
1415*cdf0e10cSrcweir    print STDERR "             build --all --pre_job=echo\\ Starting\\ job\\ in\\ \\\$PWD --job=some_script.sh --post_job=echo\\ Job\\ in\\ \\\$PWD\\ is\\ made\n";
1416*cdf0e10cSrcweir    print STDERR "                     - go through all projects, echo \"Starting job in \$PWD\" in each module, execute script some_script.sh, and finally echo \"Job in \$PWD is made\"\n";
1417*cdf0e10cSrcweir    print STDERR "\nSwitches:\n";
1418*cdf0e10cSrcweir    print STDERR "        --all        - build all projects from very beginning till current one\n";
1419*cdf0e10cSrcweir    print STDERR "        --from       - build all projects dependent from the specified (including it) till current one\n";
1420*cdf0e10cSrcweir    print STDERR "        --exclude_branch_from    - exclude module(s) and its branch from the build\n";
1421*cdf0e10cSrcweir    print STDERR "        --mode OOo   - build only projects needed for OpenOffice.org\n";
1422*cdf0e10cSrcweir    print STDERR "        --prepare    - clear all projects for incompatible build from prj_name till current one [for platform] (cws version)\n";
1423*cdf0e10cSrcweir    print STDERR "        --with_branches- the same as \"--from\" but with build all projects in neighbour branches\n";
1424*cdf0e10cSrcweir    print STDERR "        --skip       - do not build certain module(s)\n";
1425*cdf0e10cSrcweir    print STDERR "        --since      - build all projects beginning from the specified till current one (the same as \"--all:prj_name\", but skipping prj_name)\n";
1426*cdf0e10cSrcweir    print STDERR "        --checkmodules      - check if all required parent projects are availlable\n";
1427*cdf0e10cSrcweir    print STDERR "        --show       - show what is going to be built\n";
1428*cdf0e10cSrcweir    print STDERR "        --file       - generate command file file_name\n";
1429*cdf0e10cSrcweir    print STDERR "        --deliver    - only deliver, no build (usable for \'-all\' and \'-from\' keys)\n";
1430*cdf0e10cSrcweir    print STDERR "        -P           - start multiprocessing build, with number of processes passed\n";
1431*cdf0e10cSrcweir    print STDERR "        --server     - start build in server mode (clients required)\n";
1432*cdf0e10cSrcweir    print STDERR "          --setenvstring  - string for configuration of the client environment\n";
1433*cdf0e10cSrcweir    print STDERR "          --port          - set server port, default is 7890. You may pass several ports, the server will be started on the first available\n";
1434*cdf0e10cSrcweir    print STDERR "                            otherwise the server will be started on first available port from the default range 7890-7894\n";
1435*cdf0e10cSrcweir    print STDERR "          --client_timeout  - time frame after which the client/job is considered to be lost. Default is 120 min\n";
1436*cdf0e10cSrcweir    print STDERR "        --dlv_switch - use deliver with the switch specified\n";
1437*cdf0e10cSrcweir    print STDERR "        --help       - print help info\n";
1438*cdf0e10cSrcweir    print STDERR "        --ignore     - force tool to ignore errors\n";
1439*cdf0e10cSrcweir    print STDERR "        --html       - generate html page with build status\n";
1440*cdf0e10cSrcweir    print STDERR "                       file named $ENV{INPATH}.build.html will be generated in $ENV{SOLARSRC}\n";
1441*cdf0e10cSrcweir    print STDERR "          --html_path      - set html page path\n";
1442*cdf0e10cSrcweir    print STDERR "          --dontgraboutput - do not grab console output when generating html page\n";
1443*cdf0e10cSrcweir    print STDERR "        --genconf    - generate/modify workspace configuration file\n";
1444*cdf0e10cSrcweir    print STDERR "          --add            - add active module(s) to configuration file\n";
1445*cdf0e10cSrcweir    print STDERR "          --remove         - removeactive  modules(s) from configuration file\n";
1446*cdf0e10cSrcweir    print STDERR "          --removeall|--clear          - remove all active modules(s) from configuration file\n";
1447*cdf0e10cSrcweir
1448*cdf0e10cSrcweir    print STDERR "        --stoponerror      - stop build when error occurs (for mp builds)\n";
1449*cdf0e10cSrcweir    print STDERR "        --interactive      - start interactive build process (process can be managed via html page)\n";
1450*cdf0e10cSrcweir    print STDERR "   Custom jobs:\n";
1451*cdf0e10cSrcweir    print STDERR "        --job=job_string        - execute custom job in (each) module. job_string is a shell script/command to be executed instead of regular dmake jobs\n";
1452*cdf0e10cSrcweir    print STDERR "        --pre_job=pre_job_string        - execute preliminary job in (each) module. pre_job_string is a shell script/command to be executed before regular job in the module\n";
1453*cdf0e10cSrcweir    print STDERR "        --post_job=job_string        - execute a postprocess job in (each) module. post_job_string is a shell script/command to be executed after regular job in the module\n";
1454*cdf0e10cSrcweir    print STDERR "Default:             - build current project\n";
1455*cdf0e10cSrcweir    print STDERR "Unknown switches passed to dmake\n";
1456*cdf0e10cSrcweir};
1457*cdf0e10cSrcweir
1458*cdf0e10cSrcweir#
1459*cdf0e10cSrcweir# Get all options passed
1460*cdf0e10cSrcweir#
1461*cdf0e10cSrcweirsub get_options {
1462*cdf0e10cSrcweir    my ($arg, $dont_grab_output);
1463*cdf0e10cSrcweir    while ($arg = shift @ARGV) {
1464*cdf0e10cSrcweir        $arg =~ /^-P$/            and $processes_to_run = shift @ARGV     and next;
1465*cdf0e10cSrcweir        $arg =~ /^-P(\d+)$/            and $processes_to_run = $1 and next;
1466*cdf0e10cSrcweir        $arg =~ /^--all$/        and $build_all_parents = 1             and next;
1467*cdf0e10cSrcweir        $arg =~ /^-a$/        and $build_all_parents = 1             and next;
1468*cdf0e10cSrcweir        $arg =~ /^--show$/        and $show = 1                         and next;
1469*cdf0e10cSrcweir        $arg =~ /^--checkmodules$/       and $checkparents = 1 and $ignore = 1 and next;
1470*cdf0e10cSrcweir        $arg =~ /^-s$/        and $show = 1                         and next;
1471*cdf0e10cSrcweir        $arg =~ /^--deliver$/    and $deliver = 1                     and next;
1472*cdf0e10cSrcweir        $arg =~ /^(--job=)/       and $custom_job = $' and next;
1473*cdf0e10cSrcweir        $arg =~ /^(--pre_job=)/       and $pre_custom_job = $' and next;
1474*cdf0e10cSrcweir        $arg =~ /^(--post_job=)/       and $post_custom_job = $' and next;
1475*cdf0e10cSrcweir        $arg =~ /^-d$/    and $deliver = 1                     and next;
1476*cdf0e10cSrcweir        $arg =~ /^--dlv_switch$/    and $dlv_switch = shift @ARGV    and next;
1477*cdf0e10cSrcweir        $arg =~ /^--file$/        and $cmd_file = shift @ARGV             and next;
1478*cdf0e10cSrcweir        $arg =~ /^-F$/        and $cmd_file = shift @ARGV             and next;
1479*cdf0e10cSrcweir        $arg =~ /^--skip$/    and get_modules_passed(\%skip_modules)      and next;
1480*cdf0e10cSrcweir
1481*cdf0e10cSrcweir        if ($arg =~ /^--with_branches$/ || $arg =~ /^-b$/) {
1482*cdf0e10cSrcweir                                    $build_from_with_branches = 1;
1483*cdf0e10cSrcweir                                    $build_all_parents = 1;
1484*cdf0e10cSrcweir                                    get_modules_passed(\%incompatibles);
1485*cdf0e10cSrcweir                                    next;
1486*cdf0e10cSrcweir        };
1487*cdf0e10cSrcweir        $arg =~ /^--all:(\S+)$/ and $build_all_parents = 1
1488*cdf0e10cSrcweir                                and $build_all_cont = $1            and next;
1489*cdf0e10cSrcweir        $arg =~ /^-a:(\S+)$/ and $build_all_parents = 1
1490*cdf0e10cSrcweir                                and $build_all_cont = $1            and next;
1491*cdf0e10cSrcweir        if ($arg =~ /^--from$/ || $arg =~ /^-f$/) {
1492*cdf0e10cSrcweir                                    $build_all_parents = 1;
1493*cdf0e10cSrcweir                                    get_modules_passed(\%incompatibles);
1494*cdf0e10cSrcweir                                    next;
1495*cdf0e10cSrcweir        };
1496*cdf0e10cSrcweir        if ($arg =~ /^--exclude_branch_from$/) {
1497*cdf0e10cSrcweir                                    get_modules_passed(\%exclude_branches);
1498*cdf0e10cSrcweir                                    next;
1499*cdf0e10cSrcweir        };
1500*cdf0e10cSrcweir        $arg =~ /^--prepare$/    and $prepare = 1 and next;
1501*cdf0e10cSrcweir        $arg =~ /^-p$/            and $prepare = 1 and next;
1502*cdf0e10cSrcweir        $arg =~ /^--prepare:/    and $prepare = 1 and $only_platform = $' and next;
1503*cdf0e10cSrcweir        $arg =~ /^-p:/            and $prepare = 1 and $only_platform = $' and next;
1504*cdf0e10cSrcweir        $arg =~ /^--since$/        and $build_all_parents = 1
1505*cdf0e10cSrcweir                                and $build_since = shift @ARGV         and next;
1506*cdf0e10cSrcweir        $arg =~ /^-c$/        and $build_all_parents = 1
1507*cdf0e10cSrcweir                                and $build_since = shift @ARGV         and next;
1508*cdf0e10cSrcweir        $arg =~ /^-s$/            and $build_all_parents = 1
1509*cdf0e10cSrcweir                                and $build_since = shift @ARGV         and next;
1510*cdf0e10cSrcweir        $arg =~ /^--help$/        and usage()                            and do_exit(0);
1511*cdf0e10cSrcweir        $arg =~ /^-h$/        and usage()                            and do_exit(0);
1512*cdf0e10cSrcweir        $arg =~ /^--ignore$/        and $ignore = 1                            and next;
1513*cdf0e10cSrcweir        $arg =~ /^--genconf$/        and $generate_config = 1                  and next;
1514*cdf0e10cSrcweir        if ($arg =~ /^--add$/)      {
1515*cdf0e10cSrcweir                                        get_list_of_modules(\%add_to_config);
1516*cdf0e10cSrcweir                                        next;
1517*cdf0e10cSrcweir        };
1518*cdf0e10cSrcweir        if ($arg =~ /^--remove$/)   {
1519*cdf0e10cSrcweir                                        get_list_of_modules(\%remove_from_config);
1520*cdf0e10cSrcweir                                        if (!scalar %remove_from_config) {
1521*cdf0e10cSrcweir                                            print_error('No module list supplied!!');
1522*cdf0e10cSrcweir                                        };
1523*cdf0e10cSrcweir                                        next;
1524*cdf0e10cSrcweir        };
1525*cdf0e10cSrcweir        ($arg =~ /^--clear$/ || $arg =~ /^--removeall$/)  and $clear_config = 1 and next;
1526*cdf0e10cSrcweir        $arg =~ /^--html$/        and $html = 1                            and next;
1527*cdf0e10cSrcweir        $arg =~ /^--dontgraboutput$/        and $dont_grab_output = 1      and next;
1528*cdf0e10cSrcweir        $arg =~ /^--html_path$/ and $html_path = shift @ARGV  and next;
1529*cdf0e10cSrcweir        $arg =~ /^-i$/        and $ignore = 1                            and next;
1530*cdf0e10cSrcweir        $arg =~ /^--server$/        and $server_mode = 1                      and next;
1531*cdf0e10cSrcweir        $arg =~ /^--client_timeout$/ and $client_timeout = (shift @ARGV)*60  and next;
1532*cdf0e10cSrcweir        $arg =~ /^--setenvstring$/            and $setenv_string =  shift @ARGV         and next;
1533*cdf0e10cSrcweir        $arg =~ /^--port$/            and $ports_string =  shift @ARGV         and next;
1534*cdf0e10cSrcweir        $arg =~ /^--version$/   and do_exit(0);
1535*cdf0e10cSrcweir        $arg =~ /^-V$/          and do_exit(0);
1536*cdf0e10cSrcweir        $arg =~ /^-m$/            and get_modes()         and next;
1537*cdf0e10cSrcweir        $arg =~ /^--mode$/        and get_modes()         and next;
1538*cdf0e10cSrcweir        $arg =~ /^--stoponerror$/        and $stop_build_on_error = 1         and next;
1539*cdf0e10cSrcweir        $arg =~ /^--interactive$/        and $interactive = 1         and next;
1540*cdf0e10cSrcweir        if ($arg =~ /^--$/) {
1541*cdf0e10cSrcweir            push (@dmake_args, get_dmake_args()) if (!$custom_job);
1542*cdf0e10cSrcweir            next;
1543*cdf0e10cSrcweir        };
1544*cdf0e10cSrcweir        push (@dmake_args, $arg);
1545*cdf0e10cSrcweir    };
1546*cdf0e10cSrcweir    if (!$html) {
1547*cdf0e10cSrcweir        print_error("\"--html_path\" switch is used only with \"--html\"") if ($html_path);
1548*cdf0e10cSrcweir        print_error("\"--dontgraboutput\" switch is used only with \"--html\"") if ($dont_grab_output);
1549*cdf0e10cSrcweir    };
1550*cdf0e10cSrcweir    if ((scalar keys %exclude_branches) && !$build_all_parents) {
1551*cdf0e10cSrcweir        print_error("\"--exclude_branch_from\" is not applicable for one module builds!!");
1552*cdf0e10cSrcweir    };
1553*cdf0e10cSrcweir    $grab_output = 0 if ($dont_grab_output);
1554*cdf0e10cSrcweir    print_error('Switches --with_branches and --all collision') if ($build_from_with_branches && $build_all_cont);
1555*cdf0e10cSrcweir    print_error('Switch --skip is for building multiple modules only!!') if ((scalar keys %skip_modules) && (!$build_all_parents));
1556*cdf0e10cSrcweir#    print_error('Please prepare the workspace on one of UNIX platforms') if ($prepare && ($ENV{GUI} ne 'UNX'));
1557*cdf0e10cSrcweir    print_error('Switches --with_branches and --since collision') if ($build_from_with_branches && $build_since);
1558*cdf0e10cSrcweir    if ($show) {
1559*cdf0e10cSrcweir        $processes_to_run = 0;
1560*cdf0e10cSrcweir        $cmd_file = '';
1561*cdf0e10cSrcweir    };
1562*cdf0e10cSrcweir    print_error('Switches --job and --deliver collision') if ($custom_job && $deliver);
1563*cdf0e10cSrcweir    $custom_job = 'deliver' if $deliver;
1564*cdf0e10cSrcweir    $post_job = 'deliver' if (!$custom_job);
1565*cdf0e10cSrcweir    $incompatible = scalar keys %incompatibles;
1566*cdf0e10cSrcweir    if ($prepare) {
1567*cdf0e10cSrcweir        print_error("--prepare is for use with --from switch only!\n") if (!$incompatible);
1568*cdf0e10cSrcweir    };
1569*cdf0e10cSrcweir    if ($processes_to_run) {
1570*cdf0e10cSrcweir        if ($ignore && !$html) {
1571*cdf0e10cSrcweir            print_error("Cannot ignore errors in multiprocessing build");
1572*cdf0e10cSrcweir        };
1573*cdf0e10cSrcweir        if (!$enable_multiprocessing) {
1574*cdf0e10cSrcweir            print_error("Cannot load Win32::Process module for multiprocessing build");
1575*cdf0e10cSrcweir        };
1576*cdf0e10cSrcweir        if ($server_mode) {
1577*cdf0e10cSrcweir            print_error("Switches -P and --server collision");
1578*cdf0e10cSrcweir        };
1579*cdf0e10cSrcweir    } elsif ($stop_build_on_error) {
1580*cdf0e10cSrcweir        print_error("Switch --stoponerror is only for multiprocessing builds");
1581*cdf0e10cSrcweir    };
1582*cdf0e10cSrcweir    if ($server_mode) {
1583*cdf0e10cSrcweir        $html++;
1584*cdf0e10cSrcweir        $client_timeout = 60 * 60 * 2 if (!$client_timeout);
1585*cdf0e10cSrcweir    } else {
1586*cdf0e10cSrcweir        print_error("--ports switch is for server mode only!!") if ($ports_string);
1587*cdf0e10cSrcweir        print_error("--setenvstring switch is for server mode only!!") if ($setenv_string);
1588*cdf0e10cSrcweir        print_error("--client_timeout switch is for server mode only!!") if ($client_timeout);
1589*cdf0e10cSrcweir    };
1590*cdf0e10cSrcweir
1591*cdf0e10cSrcweir    if (!$generate_config) {
1592*cdf0e10cSrcweir        my $error_message = ' switch(es) should be used only with "--genconf"';
1593*cdf0e10cSrcweir        print_error('"--removeall" ("--clear")' . $error_message) if ($clear_config);
1594*cdf0e10cSrcweir        if ((scalar %add_to_config) || (scalar %remove_from_config)) {
1595*cdf0e10cSrcweir            print_error('"--add" or/and "--remove"' . $error_message);
1596*cdf0e10cSrcweir        };
1597*cdf0e10cSrcweir    } elsif ((!scalar %add_to_config) && !$clear_config && (!scalar %remove_from_config) && !$build_all_parents){
1598*cdf0e10cSrcweir        print_error('Please supply necessary switch for "--genconf" (--add|--remove|--removeall). --add can be used with --from and such');
1599*cdf0e10cSrcweir    };
1600*cdf0e10cSrcweir
1601*cdf0e10cSrcweir    if ($only_platform) {
1602*cdf0e10cSrcweir        $only_common = 'common';
1603*cdf0e10cSrcweir        $only_common .= '.pro' if ($only_platform =~ /\.pro$/);
1604*cdf0e10cSrcweir    };
1605*cdf0e10cSrcweir    if ($interactive) {
1606*cdf0e10cSrcweir        $html++; # enable html page generation...
1607*cdf0e10cSrcweir        my $local_host_name = hostname();
1608*cdf0e10cSrcweir        $local_host_ip = inet_ntoa(scalar(gethostbyname($local_host_name)) || 'localhost');
1609*cdf0e10cSrcweir    }
1610*cdf0e10cSrcweir    # Default build modes(for OpenOffice.org)
1611*cdf0e10cSrcweir    $ENV{BUILD_TYPE} = 'OOo EXT' if (!defined $ENV{BUILD_TYPE});
1612*cdf0e10cSrcweir    @ARGV = @dmake_args;
1613*cdf0e10cSrcweir	foreach $arg (@dmake_args) {
1614*cdf0e10cSrcweir        $arg =~ /^verbose=(\S+)$/i and $verbose_mode = ($1 =~ /^t\S*$/i);
1615*cdf0e10cSrcweir	}
1616*cdf0e10cSrcweir};
1617*cdf0e10cSrcweir
1618*cdf0e10cSrcweirsub get_module_and_buildlist_paths {
1619*cdf0e10cSrcweir    if ($build_all_parents || $checkparents) {
1620*cdf0e10cSrcweir        $source_config_file = $source_config->get_config_file_path();
1621*cdf0e10cSrcweir        $active_modules{$_}++ foreach ($source_config->get_active_modules());
1622*cdf0e10cSrcweir        my %active_modules_copy = %active_modules;
1623*cdf0e10cSrcweir        foreach ($source_config->get_all_modules()) {
1624*cdf0e10cSrcweir            delete $active_modules_copy{$_} if defined($active_modules_copy{$_});
1625*cdf0e10cSrcweir            next if ($_ eq $initial_module);
1626*cdf0e10cSrcweir            $module_paths{$_} = $source_config->get_module_path($_);
1627*cdf0e10cSrcweir            $build_list_paths{$_} = $source_config->get_module_build_list($_)
1628*cdf0e10cSrcweir        }
1629*cdf0e10cSrcweir        $dead_parents{$_}++ foreach (keys %active_modules_copy);
1630*cdf0e10cSrcweir    };
1631*cdf0e10cSrcweir};
1632*cdf0e10cSrcweir
1633*cdf0e10cSrcweir
1634*cdf0e10cSrcweirsub get_dmake_args {
1635*cdf0e10cSrcweir    my $arg;
1636*cdf0e10cSrcweir    my @job_args = ();
1637*cdf0e10cSrcweir    while ($arg = shift @ARGV) {
1638*cdf0e10cSrcweir        next if ($arg =~ /^--$/);
1639*cdf0e10cSrcweir        push (@job_args, $arg);
1640*cdf0e10cSrcweir    };
1641*cdf0e10cSrcweir    return @job_args;
1642*cdf0e10cSrcweir};
1643*cdf0e10cSrcweir
1644*cdf0e10cSrcweir#
1645*cdf0e10cSrcweir# get all options without '-'
1646*cdf0e10cSrcweir#
1647*cdf0e10cSrcweirsub get_switch_options {
1648*cdf0e10cSrcweir    my $string = '';
1649*cdf0e10cSrcweir    my $option = '';
1650*cdf0e10cSrcweir    while ($option = shift @ARGV) {
1651*cdf0e10cSrcweir        if (!($option =~ /^-+/)) {
1652*cdf0e10cSrcweir            $string .= '-' . $option;
1653*cdf0e10cSrcweir            $string .= ' ';
1654*cdf0e10cSrcweir        } else {
1655*cdf0e10cSrcweir            unshift(@ARGV, $option);
1656*cdf0e10cSrcweir            last;
1657*cdf0e10cSrcweir        };
1658*cdf0e10cSrcweir    };
1659*cdf0e10cSrcweir    $string =~ s/\s$//;
1660*cdf0e10cSrcweir    return $string;
1661*cdf0e10cSrcweir};
1662*cdf0e10cSrcweir
1663*cdf0e10cSrcweir#
1664*cdf0e10cSrcweir# cancel build when one of children has error exit code
1665*cdf0e10cSrcweir#
1666*cdf0e10cSrcweirsub cancel_build {
1667*cdf0e10cSrcweir#    close_server_socket();
1668*cdf0e10cSrcweir    my $broken_modules_number = scalar @broken_module_names;
1669*cdf0e10cSrcweir    my $message_part = 'build ';
1670*cdf0e10cSrcweir    if (scalar keys %incompatibles) {
1671*cdf0e10cSrcweir        my @incompatible_modules = keys %incompatibles;
1672*cdf0e10cSrcweir        if ($stop_build_on_error) {
1673*cdf0e10cSrcweir            $message_part .= "--from @incompatible_modules:@broken_module_names\n";
1674*cdf0e10cSrcweir        } else {
1675*cdf0e10cSrcweir            $message_part .= "--from @broken_module_names\n";
1676*cdf0e10cSrcweir        };
1677*cdf0e10cSrcweir    } else {
1678*cdf0e10cSrcweir        if ($processes_to_run) {
1679*cdf0e10cSrcweir            $message_part .= "--from ";
1680*cdf0e10cSrcweir        } else {
1681*cdf0e10cSrcweir            $message_part .= "--all:";
1682*cdf0e10cSrcweir        };
1683*cdf0e10cSrcweir        $message_part .= "@broken_module_names\n";
1684*cdf0e10cSrcweir
1685*cdf0e10cSrcweir    };
1686*cdf0e10cSrcweir    if ($broken_modules_number && $build_all_parents) {
1687*cdf0e10cSrcweir        print STDERR "\n";
1688*cdf0e10cSrcweir        print STDERR $broken_modules_number;
1689*cdf0e10cSrcweir        print STDERR " module(s): ";
1690*cdf0e10cSrcweir        foreach (@broken_module_names) {
1691*cdf0e10cSrcweir            print STDERR "\n\t$_";
1692*cdf0e10cSrcweir        };
1693*cdf0e10cSrcweir        print STDERR "\nneed(s) to be rebuilt\n\nReason(s):\n\n";
1694*cdf0e10cSrcweir        foreach (keys %broken_build) {
1695*cdf0e10cSrcweir            print STDERR "ERROR: error " . $broken_build{$_} . " occurred while making $_\n";
1696*cdf0e10cSrcweir        };
1697*cdf0e10cSrcweir        print STDERR "\nAttention: if you fix the errors in above module(s) you may prolongue your the build issuing command:\n\n\t" . $message_part;
1698*cdf0e10cSrcweir    } else {
1699*cdf0e10cSrcweir        while (children_number()) {
1700*cdf0e10cSrcweir            handle_dead_children(1);
1701*cdf0e10cSrcweir        }
1702*cdf0e10cSrcweir        foreach (keys %broken_build) {
1703*cdf0e10cSrcweir            print STDERR "ERROR: error " . $broken_build{$_} . " occurred while making $_\n";
1704*cdf0e10cSrcweir        };
1705*cdf0e10cSrcweir    };
1706*cdf0e10cSrcweir    print "\n";
1707*cdf0e10cSrcweir    do_exit(1);
1708*cdf0e10cSrcweir};
1709*cdf0e10cSrcweir
1710*cdf0e10cSrcweir#
1711*cdf0e10cSrcweir# Function for storing errors in multiprocessing AllParents build
1712*cdf0e10cSrcweir#
1713*cdf0e10cSrcweirsub store_error {
1714*cdf0e10cSrcweir    my ($pid, $error_code) = @_;
1715*cdf0e10cSrcweir    return 0 if (!$error_code);
1716*cdf0e10cSrcweir    my $child_nick = $processes_hash{$pid};
1717*cdf0e10cSrcweir    if ($ENV{GUI} eq 'WNT') {
1718*cdf0e10cSrcweir        if (!defined $had_error{$child_nick}) {
1719*cdf0e10cSrcweir            $had_error{$child_nick}++;
1720*cdf0e10cSrcweir            return 1;
1721*cdf0e10cSrcweir        };
1722*cdf0e10cSrcweir    };
1723*cdf0e10cSrcweir    $modules_with_errors{$folders_hashes{$child_nick}}++;
1724*cdf0e10cSrcweir    $broken_build{$child_nick} = $error_code;
1725*cdf0e10cSrcweir    if ($stop_build_on_error) {
1726*cdf0e10cSrcweir        clear_from_child($pid);
1727*cdf0e10cSrcweir        # Let all children finish their work
1728*cdf0e10cSrcweir        while (children_number()) {
1729*cdf0e10cSrcweir            handle_dead_children(1);
1730*cdf0e10cSrcweir        };
1731*cdf0e10cSrcweir        cancel_build();
1732*cdf0e10cSrcweir    };
1733*cdf0e10cSrcweir    return 0;
1734*cdf0e10cSrcweir};
1735*cdf0e10cSrcweir
1736*cdf0e10cSrcweir#
1737*cdf0e10cSrcweir# child handler (clears (or stores info about) the terminated child)
1738*cdf0e10cSrcweir#
1739*cdf0e10cSrcweirsub handle_dead_children {
1740*cdf0e10cSrcweir    my $running_children = children_number();
1741*cdf0e10cSrcweir    return if (!$running_children);
1742*cdf0e10cSrcweir    my $force_wait = shift;
1743*cdf0e10cSrcweir    my $try_once_more = 0;
1744*cdf0e10cSrcweir    do {
1745*cdf0e10cSrcweir        my $pid = 0;
1746*cdf0e10cSrcweir        if (children_number() >= $processes_to_run ||
1747*cdf0e10cSrcweir                ($force_wait && ($running_children == children_number()))) {
1748*cdf0e10cSrcweir            $pid = wait();
1749*cdf0e10cSrcweir        } else {
1750*cdf0e10cSrcweir            $pid = waitpid( -1, &WNOHANG);
1751*cdf0e10cSrcweir        };
1752*cdf0e10cSrcweir        if ($pid > 0) {
1753*cdf0e10cSrcweir            $try_once_more = store_error($pid, $?);
1754*cdf0e10cSrcweir            if ($try_once_more) {
1755*cdf0e10cSrcweir                give_second_chance($pid);
1756*cdf0e10cSrcweir            } else {
1757*cdf0e10cSrcweir                clear_from_child($pid);
1758*cdf0e10cSrcweir            };
1759*cdf0e10cSrcweir            $finisched_children++;
1760*cdf0e10cSrcweir        };
1761*cdf0e10cSrcweir    } while(children_number() >= $processes_to_run);
1762*cdf0e10cSrcweir};
1763*cdf0e10cSrcweir
1764*cdf0e10cSrcweirsub give_second_chance {
1765*cdf0e10cSrcweir    my $pid = shift;
1766*cdf0e10cSrcweir    # A malicious hack for misterious windows problems - try 2 times
1767*cdf0e10cSrcweir    # to run dmake in the same directory if errors occurs
1768*cdf0e10cSrcweir    my $child_nick = $processes_hash{$pid};
1769*cdf0e10cSrcweir    $running_children{$folders_hashes{$child_nick}}--;
1770*cdf0e10cSrcweir    delete $processes_hash{$pid};
1771*cdf0e10cSrcweir    start_child($child_nick, $folders_hashes{$child_nick});
1772*cdf0e10cSrcweir};
1773*cdf0e10cSrcweir
1774*cdf0e10cSrcweirsub clear_from_child {
1775*cdf0e10cSrcweir    my $pid = shift;
1776*cdf0e10cSrcweir    my $child_nick = $processes_hash{$pid};
1777*cdf0e10cSrcweir    my $error_code = 0;
1778*cdf0e10cSrcweir    if (defined $broken_build{$child_nick}) {
1779*cdf0e10cSrcweir        $error_code = $broken_build{$child_nick};
1780*cdf0e10cSrcweir    } else {
1781*cdf0e10cSrcweir        remove_from_dependencies($child_nick,
1782*cdf0e10cSrcweir                            $folders_hashes{$child_nick});
1783*cdf0e10cSrcweir    };
1784*cdf0e10cSrcweir    foreach (keys %module_deps_hash_pids) {
1785*cdf0e10cSrcweir        delete ${$module_deps_hash_pids{$_}}{$pid} if defined (${$module_deps_hash_pids{$_}}{$pid});
1786*cdf0e10cSrcweir    };
1787*cdf0e10cSrcweir    my $module = $module_by_hash{$folders_hashes{$child_nick}};
1788*cdf0e10cSrcweir    html_store_job_info($folders_hashes{$child_nick}, $child_nick, $error_code);
1789*cdf0e10cSrcweir    $running_children{$folders_hashes{$child_nick}}--;
1790*cdf0e10cSrcweir    delete $processes_hash{$pid};
1791*cdf0e10cSrcweir    $verbose_mode && print 'Running processes: ' . children_number() . "\n";
1792*cdf0e10cSrcweir};
1793*cdf0e10cSrcweir
1794*cdf0e10cSrcweir#
1795*cdf0e10cSrcweir# Build the entire project according to queue of dependencies
1796*cdf0e10cSrcweir#
1797*cdf0e10cSrcweirsub build_dependent {
1798*cdf0e10cSrcweir    $dependencies_hash = shift;
1799*cdf0e10cSrcweir    my $pid = 0;
1800*cdf0e10cSrcweir    my $child_nick = '';
1801*cdf0e10cSrcweir    $running_children{$dependencies_hash} = 0 if (!defined $running_children{$dependencies_hash});
1802*cdf0e10cSrcweir    while ($child_nick = pick_prj_to_build($dependencies_hash)) {
1803*cdf0e10cSrcweir        if ($processes_to_run) {
1804*cdf0e10cSrcweir            do {
1805*cdf0e10cSrcweir                if (defined $modules_with_errors{$dependencies_hash} && !$ignore) {
1806*cdf0e10cSrcweir                    return 0 if ($build_all_parents);
1807*cdf0e10cSrcweir                    last;
1808*cdf0e10cSrcweir                };
1809*cdf0e10cSrcweir                # start current child & all
1810*cdf0e10cSrcweir                # that could be started now
1811*cdf0e10cSrcweir                if ($child_nick) {
1812*cdf0e10cSrcweir                    start_child($child_nick, $dependencies_hash);
1813*cdf0e10cSrcweir                    return 1 if ($build_all_parents);
1814*cdf0e10cSrcweir                } else {
1815*cdf0e10cSrcweir                    return 0 if ($build_all_parents);
1816*cdf0e10cSrcweir                    if (scalar keys %$dependencies_hash) {
1817*cdf0e10cSrcweir                        handle_dead_children(1);
1818*cdf0e10cSrcweir                    };
1819*cdf0e10cSrcweir                };
1820*cdf0e10cSrcweir                $child_nick = pick_prj_to_build($dependencies_hash);
1821*cdf0e10cSrcweir            } while (scalar keys %$dependencies_hash || $child_nick);
1822*cdf0e10cSrcweir            while (children_number()) {
1823*cdf0e10cSrcweir                handle_dead_children(1);
1824*cdf0e10cSrcweir            };
1825*cdf0e10cSrcweir
1826*cdf0e10cSrcweir            if (defined $modules_with_errors{$dependencies_hash}) {
1827*cdf0e10cSrcweir                cancel_build();
1828*cdf0e10cSrcweir            }
1829*cdf0e10cSrcweir            mp_success_exit();
1830*cdf0e10cSrcweir        } else {
1831*cdf0e10cSrcweir            if (dmake_dir($child_nick)) {
1832*cdf0e10cSrcweir                push(@broken_module_names, $module_by_hash{$dependencies_hash});
1833*cdf0e10cSrcweir                cancel_build();
1834*cdf0e10cSrcweir            };
1835*cdf0e10cSrcweir        };
1836*cdf0e10cSrcweir        $child_nick = '';
1837*cdf0e10cSrcweir    };
1838*cdf0e10cSrcweir};
1839*cdf0e10cSrcweir
1840*cdf0e10cSrcweirsub children_number {
1841*cdf0e10cSrcweir    return scalar keys %processes_hash;
1842*cdf0e10cSrcweir};
1843*cdf0e10cSrcweir
1844*cdf0e10cSrcweirsub start_child {
1845*cdf0e10cSrcweir    my ($job_dir, $dependencies_hash) = @_;
1846*cdf0e10cSrcweir    $jobs_hash{$job_dir}->{START_TIME} = time();
1847*cdf0e10cSrcweir    $jobs_hash{$job_dir}->{STATUS} = 'building';
1848*cdf0e10cSrcweir    if ($job_dir =~ /(\s)/o) {
1849*cdf0e10cSrcweir        my $error_code = undef;
1850*cdf0e10cSrcweir        if ($job_dir !~ /\sdeliver$/o) {
1851*cdf0e10cSrcweir            $error_code = do_custom_job($job_dir, $dependencies_hash);
1852*cdf0e10cSrcweir            return;
1853*cdf0e10cSrcweir        }
1854*cdf0e10cSrcweir    };
1855*cdf0e10cSrcweir    $build_in_progress{$module_by_hash{$dependencies_hash}}++;
1856*cdf0e10cSrcweir    html_store_job_info($dependencies_hash, $job_dir);
1857*cdf0e10cSrcweir    my $pid = undef;
1858*cdf0e10cSrcweir    my $children_running;
1859*cdf0e10cSrcweir    my $oldfh = select STDOUT;
1860*cdf0e10cSrcweir    $| = 1;
1861*cdf0e10cSrcweir    if ($pid = fork) { # parent
1862*cdf0e10cSrcweir        select $oldfh;
1863*cdf0e10cSrcweir        $processes_hash{$pid} = $job_dir;
1864*cdf0e10cSrcweir        $children_running = children_number();
1865*cdf0e10cSrcweir        $verbose_mode && print 'Running processes: ', $children_running, "\n";
1866*cdf0e10cSrcweir        $maximal_processes = $children_running if ($children_running > $maximal_processes);
1867*cdf0e10cSrcweir        $folders_hashes{$job_dir} = $dependencies_hash;
1868*cdf0e10cSrcweir        store_pid($dependencies_hash, $pid);
1869*cdf0e10cSrcweir        $running_children{$dependencies_hash}++;
1870*cdf0e10cSrcweir    } elsif (defined $pid) { # child
1871*cdf0e10cSrcweir        select $oldfh;
1872*cdf0e10cSrcweir        $child = 1;
1873*cdf0e10cSrcweir        dmake_dir($job_dir);
1874*cdf0e10cSrcweir        do_exit(1);
1875*cdf0e10cSrcweir    };
1876*cdf0e10cSrcweir};
1877*cdf0e10cSrcweir
1878*cdf0e10cSrcweirsub store_pid {
1879*cdf0e10cSrcweir    my ($deps_hash, $pid) = @_;
1880*cdf0e10cSrcweir    if (!defined $module_deps_hash_pids{$deps_hash}) {
1881*cdf0e10cSrcweir        my %module_hash_pids = ();
1882*cdf0e10cSrcweir        $module_deps_hash_pids{$deps_hash} = \%module_hash_pids;
1883*cdf0e10cSrcweir    };
1884*cdf0e10cSrcweir    ${$module_deps_hash_pids{$deps_hash}}{$pid}++;
1885*cdf0e10cSrcweir};
1886*cdf0e10cSrcweir
1887*cdf0e10cSrcweir#
1888*cdf0e10cSrcweir# Build everything that should be built multiprocessing version
1889*cdf0e10cSrcweir#
1890*cdf0e10cSrcweirsub build_multiprocessing {
1891*cdf0e10cSrcweir    my $prj;
1892*cdf0e10cSrcweir    do {
1893*cdf0e10cSrcweir        my $got_module = 0;
1894*cdf0e10cSrcweir        $finisched_children = 0;
1895*cdf0e10cSrcweir        while ($prj = pick_prj_to_build(\%global_deps_hash)) {
1896*cdf0e10cSrcweir            if (!defined $projects_deps_hash{$prj}) {
1897*cdf0e10cSrcweir                $projects_deps_hash{$prj} = {};
1898*cdf0e10cSrcweir                get_module_dep_hash($prj, $projects_deps_hash{$prj});
1899*cdf0e10cSrcweir                my $info_hash = $html_info{$prj};
1900*cdf0e10cSrcweir                $$info_hash{DIRS} = check_deps_hash($projects_deps_hash{$prj}, $prj);
1901*cdf0e10cSrcweir                $module_by_hash{$projects_deps_hash{$prj}} = $prj;
1902*cdf0e10cSrcweir            }
1903*cdf0e10cSrcweir            $module_build_queue{$prj}++;
1904*cdf0e10cSrcweir            $got_module++;
1905*cdf0e10cSrcweir        };
1906*cdf0e10cSrcweir        if (!$got_module) {
1907*cdf0e10cSrcweir            cancel_build() if ((!scalar keys %module_build_queue) && !children_number());
1908*cdf0e10cSrcweir            if (!$finisched_children) {
1909*cdf0e10cSrcweir#                print "#### 1979: Starting waiting for dead child\n";
1910*cdf0e10cSrcweir                handle_dead_children(1);
1911*cdf0e10cSrcweir            };
1912*cdf0e10cSrcweir        };
1913*cdf0e10cSrcweir        build_actual_queue(\%module_build_queue);
1914*cdf0e10cSrcweir    } while (scalar keys %global_deps_hash);
1915*cdf0e10cSrcweir    # Let the last module be built till the end
1916*cdf0e10cSrcweir    while (scalar keys %module_build_queue) {
1917*cdf0e10cSrcweir        build_actual_queue(\%module_build_queue);
1918*cdf0e10cSrcweir#        print "#### 1988: Starting waiting for dead child\n";
1919*cdf0e10cSrcweir        handle_dead_children(1);
1920*cdf0e10cSrcweir    };
1921*cdf0e10cSrcweir    # Let all children finish their work
1922*cdf0e10cSrcweir    while (children_number()) {
1923*cdf0e10cSrcweir        handle_dead_children(1);
1924*cdf0e10cSrcweir    };
1925*cdf0e10cSrcweir    cancel_build() if (scalar keys %broken_build);
1926*cdf0e10cSrcweir    mp_success_exit();
1927*cdf0e10cSrcweir};
1928*cdf0e10cSrcweir
1929*cdf0e10cSrcweirsub mp_success_exit {
1930*cdf0e10cSrcweir#    close_server_socket();
1931*cdf0e10cSrcweir#    if (!$custom_job && $post_custom_job) {
1932*cdf0e10cSrcweir#        do_post_custom_job(correct_path($workspace_path.$initial_module));
1933*cdf0e10cSrcweir#    };
1934*cdf0e10cSrcweir    print "\nMultiprocessing build is finished\n";
1935*cdf0e10cSrcweir    print "Maximal number of processes run: $maximal_processes\n";
1936*cdf0e10cSrcweir    do_exit(0);
1937*cdf0e10cSrcweir};
1938*cdf0e10cSrcweir
1939*cdf0e10cSrcweir#
1940*cdf0e10cSrcweir# Here the built queue is built as long as possible
1941*cdf0e10cSrcweir#
1942*cdf0e10cSrcweirsub build_actual_queue {
1943*cdf0e10cSrcweir    my $build_queue = shift;
1944*cdf0e10cSrcweir    my $finished_projects = 0;
1945*cdf0e10cSrcweir    do {
1946*cdf0e10cSrcweir        my @sorted_queue = sort {(scalar keys %{$projects_deps_hash{$a}}) <=> (scalar keys %{$projects_deps_hash{$b}})} keys %$build_queue;
1947*cdf0e10cSrcweir        my $started_children = 0;
1948*cdf0e10cSrcweir        foreach my $prj (keys %$build_queue) {
1949*cdf0e10cSrcweir            get_html_orders();
1950*cdf0e10cSrcweir            if ($reschedule_queue) {
1951*cdf0e10cSrcweir                $reschedule_queue = 0;
1952*cdf0e10cSrcweir                foreach (keys %$build_queue) {
1953*cdf0e10cSrcweir                    # Remove the module from the build queue if there is a dependency emerged
1954*cdf0e10cSrcweir                    if ((defined $global_deps_hash{$_}) && (scalar keys %{$global_deps_hash{$_}})) {
1955*cdf0e10cSrcweir                        delete $$build_queue{$_};
1956*cdf0e10cSrcweir                    };
1957*cdf0e10cSrcweir                    delete $$build_queue{$_} if (!defined $global_deps_hash_backup{$_})
1958*cdf0e10cSrcweir                };
1959*cdf0e10cSrcweir                return;
1960*cdf0e10cSrcweir            };
1961*cdf0e10cSrcweir            if (defined $modules_with_errors{$projects_deps_hash{$prj}} && !$ignore) {
1962*cdf0e10cSrcweir                push (@broken_module_names, $prj);
1963*cdf0e10cSrcweir                delete $$build_queue{$prj};
1964*cdf0e10cSrcweir                next;
1965*cdf0e10cSrcweir            };
1966*cdf0e10cSrcweir            $started_children += build_dependent($projects_deps_hash{$prj});
1967*cdf0e10cSrcweir            if ((!scalar keys %{$projects_deps_hash{$prj}}) &&
1968*cdf0e10cSrcweir                !$running_children{$projects_deps_hash{$prj}}) {
1969*cdf0e10cSrcweir                if (!defined $modules_with_errors{$projects_deps_hash{$prj}} || $ignore)
1970*cdf0e10cSrcweir                {
1971*cdf0e10cSrcweir                    remove_from_dependencies($prj, \%global_deps_hash);
1972*cdf0e10cSrcweir                    $build_is_finished{$prj}++;
1973*cdf0e10cSrcweir                    delete $$build_queue{$prj};
1974*cdf0e10cSrcweir                    $finished_projects++;
1975*cdf0e10cSrcweir                };
1976*cdf0e10cSrcweir            };
1977*cdf0e10cSrcweir        };
1978*cdf0e10cSrcweir        # trigger wait
1979*cdf0e10cSrcweir        if (!$started_children) {
1980*cdf0e10cSrcweir            if ($finished_projects) {
1981*cdf0e10cSrcweir                return;
1982*cdf0e10cSrcweir            } else {
1983*cdf0e10cSrcweir                handle_dead_children(1);
1984*cdf0e10cSrcweir            };
1985*cdf0e10cSrcweir        };
1986*cdf0e10cSrcweir    } while (scalar keys %$build_queue);
1987*cdf0e10cSrcweir};
1988*cdf0e10cSrcweir
1989*cdf0e10cSrcweirsub run_job {
1990*cdf0e10cSrcweir    my ($job, $path, $registered_name) = @_;
1991*cdf0e10cSrcweir    my $job_to_do = $job;
1992*cdf0e10cSrcweir    my $error_code = 0;
1993*cdf0e10cSrcweir    print "$registered_name\n";
1994*cdf0e10cSrcweir    return 0 if ( $show );
1995*cdf0e10cSrcweir    $job_to_do = $deliver_command if ($job eq 'deliver');
1996*cdf0e10cSrcweir    $registered_name = $path if (!defined $registered_name);
1997*cdf0e10cSrcweir    chdir $path;
1998*cdf0e10cSrcweir    getcwd();
1999*cdf0e10cSrcweir
2000*cdf0e10cSrcweir    if ($html) {
2001*cdf0e10cSrcweir        my $log_file = $jobs_hash{$registered_name}->{LONG_LOG_PATH};
2002*cdf0e10cSrcweir        my $log_dir = File::Basename::dirname($log_file);
2003*cdf0e10cSrcweir        if (!-d $log_dir) {
2004*cdf0e10cSrcweir             system("$perl $mkout");
2005*cdf0e10cSrcweir        };
2006*cdf0e10cSrcweir        $error_code = system ("$job_to_do > $log_file 2>&1");
2007*cdf0e10cSrcweir        if (!$grab_output && -f $log_file) {
2008*cdf0e10cSrcweir            system("cat $log_file");
2009*cdf0e10cSrcweir        };
2010*cdf0e10cSrcweir    } else {
2011*cdf0e10cSrcweir        $error_code = system ("$job_to_do");
2012*cdf0e10cSrcweir    };
2013*cdf0e10cSrcweir    return $error_code;
2014*cdf0e10cSrcweir};
2015*cdf0e10cSrcweir
2016*cdf0e10cSrcweirsub do_custom_job {
2017*cdf0e10cSrcweir    my ($module_job, $dependencies_hash) = @_;
2018*cdf0e10cSrcweir    $module_job =~ /(\s)/o;
2019*cdf0e10cSrcweir    my $module = $`;
2020*cdf0e10cSrcweir    my $job = $';
2021*cdf0e10cSrcweir    html_store_job_info($dependencies_hash, $module_job);
2022*cdf0e10cSrcweir    my $error_code = 0;
2023*cdf0e10cSrcweir    if ($job eq $pre_job) {
2024*cdf0e10cSrcweir        announce_module($module);
2025*cdf0e10cSrcweir#        html_store_job_info($dependencies_hash, $job_dir);
2026*cdf0e10cSrcweir        remove_from_dependencies($module_job, $dependencies_hash);
2027*cdf0e10cSrcweir    } else {
2028*cdf0e10cSrcweir        $error_code = run_job($job, $module_paths{$module}, $module_job);
2029*cdf0e10cSrcweir        if ($error_code) {
2030*cdf0e10cSrcweir            # give windows one more chance
2031*cdf0e10cSrcweir            if ($ENV{GUI} eq 'WNT') {
2032*cdf0e10cSrcweir                $error_code = run_job($job, $module_paths{$module}, $module_job);
2033*cdf0e10cSrcweir            };
2034*cdf0e10cSrcweir        };
2035*cdf0e10cSrcweir        if ($error_code && $ignore) {
2036*cdf0e10cSrcweir            push(@ignored_errors, $module_job);
2037*cdf0e10cSrcweir            $error_code = 0;
2038*cdf0e10cSrcweir        };
2039*cdf0e10cSrcweir        if ($error_code) {
2040*cdf0e10cSrcweir            $modules_with_errors{$dependencies_hash}++;
2041*cdf0e10cSrcweir#            $broken_build{$module_job} = $error_code;
2042*cdf0e10cSrcweir        } else {
2043*cdf0e10cSrcweir            remove_from_dependencies($module_job, $dependencies_hash);
2044*cdf0e10cSrcweir        };
2045*cdf0e10cSrcweir    };
2046*cdf0e10cSrcweir    html_store_job_info($dependencies_hash, $module_job, $error_code);
2047*cdf0e10cSrcweir    return $error_code;
2048*cdf0e10cSrcweir};
2049*cdf0e10cSrcweir
2050*cdf0e10cSrcweir#
2051*cdf0e10cSrcweir# Print announcement for module just started
2052*cdf0e10cSrcweir#
2053*cdf0e10cSrcweirsub announce_module {
2054*cdf0e10cSrcweir    my $prj = shift;
2055*cdf0e10cSrcweir    $build_in_progress{$prj}++;
2056*cdf0e10cSrcweir    print_announce($prj);
2057*cdf0e10cSrcweir};
2058*cdf0e10cSrcweir
2059*cdf0e10cSrcweirsub print_announce {
2060*cdf0e10cSrcweir    my $prj = shift;
2061*cdf0e10cSrcweir    return if (defined $module_announced{$prj});
2062*cdf0e10cSrcweir    my $prj_type = '';
2063*cdf0e10cSrcweir    $prj_type = $modules_types{$prj} if (defined $modules_types{$prj});
2064*cdf0e10cSrcweir    my $text;
2065*cdf0e10cSrcweir    if ($prj_type eq 'lnk') {
2066*cdf0e10cSrcweir        if (!defined $active_modules{$prj}) {
2067*cdf0e10cSrcweir            $text = "Skipping module $prj\n";
2068*cdf0e10cSrcweir        } else {
2069*cdf0e10cSrcweir            $text = "Skipping link to $prj\n";
2070*cdf0e10cSrcweir        };
2071*cdf0e10cSrcweir        $build_is_finished{$prj}++;
2072*cdf0e10cSrcweir    } elsif ($prj_type eq 'img') {
2073*cdf0e10cSrcweir        $text = "Skipping incomplete $prj\n";
2074*cdf0e10cSrcweir        $build_is_finished{$prj}++;
2075*cdf0e10cSrcweir    } elsif ($custom_job) {
2076*cdf0e10cSrcweir        $text = "Running custom job \"$custom_job\" in module $prj\n";
2077*cdf0e10cSrcweir    } else {
2078*cdf0e10cSrcweir        $text = "Building module $prj\n";
2079*cdf0e10cSrcweir    };
2080*cdf0e10cSrcweir    my $announce_string = $new_line;
2081*cdf0e10cSrcweir    $announce_string .= $echo . "=============\n";
2082*cdf0e10cSrcweir    $announce_string .= $echo . $text;
2083*cdf0e10cSrcweir    $announce_string .= $echo . "=============\n";
2084*cdf0e10cSrcweir    print $announce_string;
2085*cdf0e10cSrcweir    $module_announced{$prj}++;
2086*cdf0e10cSrcweir};
2087*cdf0e10cSrcweir
2088*cdf0e10cSrcweirsub are_all_dependent {
2089*cdf0e10cSrcweir    my $build_queue = shift;
2090*cdf0e10cSrcweir    my $folder = '';
2091*cdf0e10cSrcweir    my $first_candidate = undef;
2092*cdf0e10cSrcweir    foreach my $prj (keys %$build_queue) {
2093*cdf0e10cSrcweir        $folder = find_indep_prj($projects_deps_hash{$prj});
2094*cdf0e10cSrcweir        $first_candidate = $folder if (!defined $first_candidate);
2095*cdf0e10cSrcweir    };
2096*cdf0e10cSrcweir    $folder = $first_candidate;
2097*cdf0e10cSrcweir    return '' if ($first_candidate);
2098*cdf0e10cSrcweir    return '1';
2099*cdf0e10cSrcweir};
2100*cdf0e10cSrcweir
2101*cdf0e10cSrcweir
2102*cdf0e10cSrcweir#
2103*cdf0e10cSrcweir# Procedure defines if the local directory is a
2104*cdf0e10cSrcweir# complete module, an image or a link
2105*cdf0e10cSrcweir# return values: lnk link
2106*cdf0e10cSrcweir#                img incomplete (image)
2107*cdf0e10cSrcweir#                mod complete (module)
2108*cdf0e10cSrcweir#
2109*cdf0e10cSrcweirsub modules_classify {
2110*cdf0e10cSrcweir    my @modules = @_;
2111*cdf0e10cSrcweir    foreach my $module (sort @modules) {
2112*cdf0e10cSrcweir        if (!defined $module_paths{$module}) {
2113*cdf0e10cSrcweir            $modules_types{$module} = 'img';
2114*cdf0e10cSrcweir            next;
2115*cdf0e10cSrcweir        };
2116*cdf0e10cSrcweir        if (( $module_paths{$module} =~ /\.lnk$/) || ($module_paths{$module} =~ /\.link$/)
2117*cdf0e10cSrcweir                || (!defined $active_modules{$module})) {
2118*cdf0e10cSrcweir            $modules_types{$module} = 'lnk';
2119*cdf0e10cSrcweir            next;
2120*cdf0e10cSrcweir        };
2121*cdf0e10cSrcweir        $modules_types{$module} = 'mod';
2122*cdf0e10cSrcweir    };
2123*cdf0e10cSrcweir};
2124*cdf0e10cSrcweir
2125*cdf0e10cSrcweir#
2126*cdf0e10cSrcweir# This procedure provides consistency for cws
2127*cdf0e10cSrcweir# and optimized build (ie in case of --with_branches, -all:prj_name
2128*cdf0e10cSrcweir# and -since switches)
2129*cdf0e10cSrcweir#
2130*cdf0e10cSrcweirsub provide_consistency {
2131*cdf0e10cSrcweir    check_dir();
2132*cdf0e10cSrcweir    foreach my $var_ref (\$build_all_cont, \$build_since) {
2133*cdf0e10cSrcweir        if ($$var_ref) {
2134*cdf0e10cSrcweir            return if (defined $module_paths{$$var_ref});
2135*cdf0e10cSrcweir            print_error("Cannot find module '$$var_ref'", 9);
2136*cdf0e10cSrcweir            return;
2137*cdf0e10cSrcweir        };
2138*cdf0e10cSrcweir    };
2139*cdf0e10cSrcweir};
2140*cdf0e10cSrcweir
2141*cdf0e10cSrcweir#
2142*cdf0e10cSrcweir# Get the workspace list ('stand.lst'), either from 'localini'
2143*cdf0e10cSrcweir# or, if this is not possible, from 'globalini.
2144*cdf0e10cSrcweir# (Heiner's proprietary :)
2145*cdf0e10cSrcweir#
2146*cdf0e10cSrcweirsub get_workspace_lst
2147*cdf0e10cSrcweir{
2148*cdf0e10cSrcweir    my $home = $ENV{HOME};
2149*cdf0e10cSrcweir    my $inifile = $ENV{HOME}. '/localini/stand.lst';
2150*cdf0e10cSrcweir    if (-f $inifile) {
2151*cdf0e10cSrcweir        return $inifile;
2152*cdf0e10cSrcweir    };
2153*cdf0e10cSrcweir    return '';
2154*cdf0e10cSrcweir}
2155*cdf0e10cSrcweir
2156*cdf0e10cSrcweir#
2157*cdf0e10cSrcweir# Procedure clears up module for incompatible build
2158*cdf0e10cSrcweir#
2159*cdf0e10cSrcweirsub ensure_clear_module {
2160*cdf0e10cSrcweir    my $module = shift;
2161*cdf0e10cSrcweir    if ($modules_types{$module} eq 'mod') {
2162*cdf0e10cSrcweir         clear_module($module);
2163*cdf0e10cSrcweir         return;
2164*cdf0e10cSrcweir    };
2165*cdf0e10cSrcweir    if ($modules_types{$module} eq 'lnk' && (File::Basename::basename($module_paths{$module}) ne $module)) {
2166*cdf0e10cSrcweir        if(rename($module_paths{$module}, File::Basename::dirname($module_paths{$module}) ."/$module")) {
2167*cdf0e10cSrcweir            $module_paths{$module} = File::Basename::dirname($module_paths{$module}) ."/$module";
2168*cdf0e10cSrcweir            clear_module($module);
2169*cdf0e10cSrcweir        } else {
2170*cdf0e10cSrcweir            print_error("Cannot rename link to $module. Please rename it manually");
2171*cdf0e10cSrcweir        };
2172*cdf0e10cSrcweir    };
2173*cdf0e10cSrcweir};
2174*cdf0e10cSrcweir
2175*cdf0e10cSrcweir#
2176*cdf0e10cSrcweir# Procedure removes output tree from the module (without common trees)
2177*cdf0e10cSrcweir#
2178*cdf0e10cSrcweirsub clear_module {
2179*cdf0e10cSrcweir    my $module = shift;
2180*cdf0e10cSrcweir    print "Removing module's $module output trees...\n";
2181*cdf0e10cSrcweir    print "\n" and return if ($show);
2182*cdf0e10cSrcweir    opendir DIRHANDLE, $module_paths{$module};
2183*cdf0e10cSrcweir    my @dir_content = readdir(DIRHANDLE);
2184*cdf0e10cSrcweir    closedir(DIRHANDLE);
2185*cdf0e10cSrcweir    foreach (@dir_content) {
2186*cdf0e10cSrcweir        next if (/^\.+$/);
2187*cdf0e10cSrcweir        my $dir = correct_path($module_paths{$module}.'/'.$_);
2188*cdf0e10cSrcweir        if ((!-d $dir.'/.svn') && is_output_tree($dir)) {
2189*cdf0e10cSrcweir            #print "I would delete $dir\n";
2190*cdf0e10cSrcweir            rmtree("$dir", 0, 1);
2191*cdf0e10cSrcweir            if (-d $dir) {
2192*cdf0e10cSrcweir                system("$remove_command $dir");
2193*cdf0e10cSrcweir                if (-d $dir) {
2194*cdf0e10cSrcweir                    push(@warnings, "Cannot delete $dir");
2195*cdf0e10cSrcweir#print_error("Cannot delete $dir");
2196*cdf0e10cSrcweir                } else {
2197*cdf0e10cSrcweir                    print STDERR (">>> Removed $dir by force\n");
2198*cdf0e10cSrcweir                };
2199*cdf0e10cSrcweir            };
2200*cdf0e10cSrcweir        };
2201*cdf0e10cSrcweir    };
2202*cdf0e10cSrcweir};
2203*cdf0e10cSrcweir
2204*cdf0e10cSrcweir#
2205*cdf0e10cSrcweir# Figure out if the directory is an output tree
2206*cdf0e10cSrcweir#
2207*cdf0e10cSrcweirsub is_output_tree {
2208*cdf0e10cSrcweir    my $dir = shift;
2209*cdf0e10cSrcweir    $dir =~ /([\w\d\.]+)$/;
2210*cdf0e10cSrcweir    $_ = $1;
2211*cdf0e10cSrcweir    return '1' if (defined $platforms{$_});
2212*cdf0e10cSrcweir    if ($only_common) {
2213*cdf0e10cSrcweir        return '1' if ($_ eq $only_common);
2214*cdf0e10cSrcweir    } else {
2215*cdf0e10cSrcweir        if (scalar keys %platforms < scalar keys %platforms_to_copy) {
2216*cdf0e10cSrcweir            return '';
2217*cdf0e10cSrcweir        };
2218*cdf0e10cSrcweir        return '1' if (/^common$/);
2219*cdf0e10cSrcweir        return '1' if (/^common\.pro$/);
2220*cdf0e10cSrcweir    };
2221*cdf0e10cSrcweir    return '';
2222*cdf0e10cSrcweir};
2223*cdf0e10cSrcweirsub get_tmp_dir {
2224*cdf0e10cSrcweir    my $tmp_dir;
2225*cdf0e10cSrcweir    if( defined($ENV{TMPDIR}) ) {
2226*cdf0e10cSrcweir       $tmp_dir = $ENV{TMPDIR} . '/';
2227*cdf0e10cSrcweir    } elsif( defined($ENV{TMP}) ) {
2228*cdf0e10cSrcweir       $tmp_dir = $ENV{TMP} . '/';
2229*cdf0e10cSrcweir    } else {
2230*cdf0e10cSrcweir       $tmp_dir = '/tmp/';
2231*cdf0e10cSrcweir    }
2232*cdf0e10cSrcweir    $tmp_dir = tempdir ( DIR => $tmp_dir );
2233*cdf0e10cSrcweir    if (!-d $tmp_dir) {
2234*cdf0e10cSrcweir        print_error("Cannot create temporary directory for checkout in $tmp_dir") if ($@);
2235*cdf0e10cSrcweir    };
2236*cdf0e10cSrcweir    return $tmp_dir;
2237*cdf0e10cSrcweir};
2238*cdf0e10cSrcweir
2239*cdf0e10cSrcweirsub retrieve_build_list {
2240*cdf0e10cSrcweir    my $module = shift;
2241*cdf0e10cSrcweir    my $old_fh = select(STDOUT);
2242*cdf0e10cSrcweir
2243*cdf0e10cSrcweir    # Try to get global depencies from solver's build.lst if such exists
2244*cdf0e10cSrcweir    my $solver_inc_dir = "$ENV{SOLARVER}/$ENV{OUTPATH}";
2245*cdf0e10cSrcweir    $solver_inc_dir .= $ENV{PROEXT} if (defined $ENV{PROEXT});
2246*cdf0e10cSrcweir    $solver_inc_dir .= '/inc';
2247*cdf0e10cSrcweir    $solver_inc_dir .= $ENV{UPDMINOREXT} if (defined $ENV{UPDMINOREXT});
2248*cdf0e10cSrcweir    $solver_inc_dir .= "/$module";
2249*cdf0e10cSrcweir    $solver_inc_dir = correct_path($solver_inc_dir);
2250*cdf0e10cSrcweir    $dead_parents{$module}++;
2251*cdf0e10cSrcweir    print "Fetching dependencies for module $module from solver...";
2252*cdf0e10cSrcweir    foreach my $onelist (@possible_build_lists) {
2253*cdf0e10cSrcweir        my $build_list_candidate = "$solver_inc_dir/$onelist";
2254*cdf0e10cSrcweir        if (-e $build_list_candidate) {
2255*cdf0e10cSrcweir            print " ok\n";
2256*cdf0e10cSrcweir            select($old_fh);
2257*cdf0e10cSrcweir            return $build_list_candidate;
2258*cdf0e10cSrcweir        };
2259*cdf0e10cSrcweir    }
2260*cdf0e10cSrcweir    print(" failed\n");
2261*cdf0e10cSrcweir    print_error("incomplete dependencies!\n");
2262*cdf0e10cSrcweir    return undef;
2263*cdf0e10cSrcweir};
2264*cdf0e10cSrcweir
2265*cdf0e10cSrcweirsub fix_permissions {
2266*cdf0e10cSrcweir     my $file = $File::Find::name;
2267*cdf0e10cSrcweir     return unless -f $file;
2268*cdf0e10cSrcweir     chmod '0664', $file;
2269*cdf0e10cSrcweir};
2270*cdf0e10cSrcweir
2271*cdf0e10cSrcweirsub prepare_build_from_with_branches {
2272*cdf0e10cSrcweir    my ($full_deps_hash, $reversed_full_deps_hash) = @_;
2273*cdf0e10cSrcweir    foreach my $prerequisite (keys %$full_deps_hash) {
2274*cdf0e10cSrcweir        foreach my $dependent_module (keys %incompatibles) {
2275*cdf0e10cSrcweir            if (defined ${$$reversed_full_deps_hash{$prerequisite}}{$dependent_module}) {
2276*cdf0e10cSrcweir                remove_from_dependencies($prerequisite, $full_deps_hash);
2277*cdf0e10cSrcweir                delete $$full_deps_hash{$prerequisite};
2278*cdf0e10cSrcweir#                print "Removed $prerequisite\n";
2279*cdf0e10cSrcweir                last;
2280*cdf0e10cSrcweir            };
2281*cdf0e10cSrcweir        };
2282*cdf0e10cSrcweir    };
2283*cdf0e10cSrcweir};
2284*cdf0e10cSrcweir
2285*cdf0e10cSrcweir#
2286*cdf0e10cSrcweir# Removes projects which it is not necessary to build
2287*cdf0e10cSrcweir# in incompatible build
2288*cdf0e10cSrcweir#
2289*cdf0e10cSrcweirsub prepare_incompatible_build {
2290*cdf0e10cSrcweir    my ($prj, $deps_hash, @missing_modules);
2291*cdf0e10cSrcweir    $deps_hash = shift;
2292*cdf0e10cSrcweir    foreach my $module (keys %incompatibles) {
2293*cdf0e10cSrcweir        if (!defined $$deps_hash{$module}) {
2294*cdf0e10cSrcweir            print_error("The module $initial_module is independent from $module\n");
2295*cdf0e10cSrcweir        }
2296*cdf0e10cSrcweir        $incompatibles{$module} = $$deps_hash{$module};
2297*cdf0e10cSrcweir        delete $$deps_hash{$module};
2298*cdf0e10cSrcweir    }
2299*cdf0e10cSrcweir    while ($prj = pick_prj_to_build($deps_hash)) {
2300*cdf0e10cSrcweir        remove_from_dependencies($prj, $deps_hash);
2301*cdf0e10cSrcweir        remove_from_dependencies($prj, \%incompatibles);
2302*cdf0e10cSrcweir    };
2303*cdf0e10cSrcweir    foreach (keys %incompatibles) {
2304*cdf0e10cSrcweir        $$deps_hash{$_} = $incompatibles{$_};
2305*cdf0e10cSrcweir    };
2306*cdf0e10cSrcweir    if ($build_all_cont) {
2307*cdf0e10cSrcweir        prepare_build_all_cont($deps_hash);
2308*cdf0e10cSrcweir        delete $$deps_hash{$build_all_cont};
2309*cdf0e10cSrcweir    };
2310*cdf0e10cSrcweir    @modules_built = keys %$deps_hash;
2311*cdf0e10cSrcweir    %add_to_config = %$deps_hash;
2312*cdf0e10cSrcweir    if ($prepare) {
2313*cdf0e10cSrcweir        if ((!(defined $ENV{UPDATER} && (!defined $ENV{CWS_WORK_STAMP}))) || (defined $ENV{CWS_WORK_STAMP})) {
2314*cdf0e10cSrcweir            $source_config->add_active_modules([keys %add_to_config], 0);
2315*cdf0e10cSrcweir        }
2316*cdf0e10cSrcweir        clear_delivered();
2317*cdf0e10cSrcweir    }
2318*cdf0e10cSrcweir    my $old_output_tree = '';
2319*cdf0e10cSrcweir    foreach $prj (sort keys %$deps_hash) {
2320*cdf0e10cSrcweir        if ($prepare) {
2321*cdf0e10cSrcweir            ensure_clear_module($prj);
2322*cdf0e10cSrcweir        } else {
2323*cdf0e10cSrcweir            next if ($show);
2324*cdf0e10cSrcweir            if ($modules_types{$prj} ne 'mod') {
2325*cdf0e10cSrcweir                push(@missing_modules, $prj);
2326*cdf0e10cSrcweir            } elsif (-d $module_paths{$prj}. '/'. $ENV{INPATH}) {
2327*cdf0e10cSrcweir                $old_output_tree++;
2328*cdf0e10cSrcweir            };
2329*cdf0e10cSrcweir        };
2330*cdf0e10cSrcweir    };
2331*cdf0e10cSrcweir    if (scalar @missing_modules) {
2332*cdf0e10cSrcweir        my $warning_string = 'Following modules are inconsistent/missing: ' . "@missing_modules";
2333*cdf0e10cSrcweir        push(@warnings, $warning_string);
2334*cdf0e10cSrcweir    };
2335*cdf0e10cSrcweir    if ($build_all_cont) {
2336*cdf0e10cSrcweir        $$deps_hash{$build_all_cont} = ();
2337*cdf0e10cSrcweir        $build_all_cont = '';
2338*cdf0e10cSrcweir    };
2339*cdf0e10cSrcweir    if ($old_output_tree) {
2340*cdf0e10cSrcweir        push(@warnings, 'Some module(s) contain old output tree(s)!');
2341*cdf0e10cSrcweir    };
2342*cdf0e10cSrcweir    if (!$generate_config && scalar @warnings) {
2343*cdf0e10cSrcweir        print "WARNING(S):\n";
2344*cdf0e10cSrcweir        print STDERR "$_\n" foreach (@warnings);
2345*cdf0e10cSrcweir        print "\nATTENTION: If you are performing an incompatible build, please break the build with Ctrl+C and prepare the workspace with \"--prepare\" switch!\n\n" if (!$prepare);
2346*cdf0e10cSrcweir        sleep(10);
2347*cdf0e10cSrcweir    };
2348*cdf0e10cSrcweir    if ($prepare) {
2349*cdf0e10cSrcweir    print "\nPreparation finished";
2350*cdf0e10cSrcweir        if (scalar @warnings) {
2351*cdf0e10cSrcweir            print " with WARNINGS!!\n\n";
2352*cdf0e10cSrcweir        } else {print " successfully\n\n";}
2353*cdf0e10cSrcweir    }
2354*cdf0e10cSrcweir    do_exit(0) if ($prepare);
2355*cdf0e10cSrcweir};
2356*cdf0e10cSrcweir
2357*cdf0e10cSrcweir#
2358*cdf0e10cSrcweir# Removes projects which it is not necessary to build
2359*cdf0e10cSrcweir# with --all:prj_name or --since switch
2360*cdf0e10cSrcweir#
2361*cdf0e10cSrcweirsub prepare_build_all_cont {
2362*cdf0e10cSrcweir    my ($prj, $deps_hash, $border_prj);
2363*cdf0e10cSrcweir    $deps_hash = shift;
2364*cdf0e10cSrcweir    $border_prj = $build_all_cont if ($build_all_cont);
2365*cdf0e10cSrcweir    $border_prj = $build_since if ($build_since);
2366*cdf0e10cSrcweir    while ($prj = pick_prj_to_build($deps_hash)) {
2367*cdf0e10cSrcweir        my $orig_prj = '';
2368*cdf0e10cSrcweir        $orig_prj = $` if ($prj =~ /\.lnk$/o);
2369*cdf0e10cSrcweir        $orig_prj = $` if ($prj =~ /\.link$/o);
2370*cdf0e10cSrcweir        if (($border_prj ne $prj) &&
2371*cdf0e10cSrcweir            ($border_prj ne $orig_prj)) {
2372*cdf0e10cSrcweir            remove_from_dependencies($prj, $deps_hash);
2373*cdf0e10cSrcweir            next;
2374*cdf0e10cSrcweir        } else {
2375*cdf0e10cSrcweir            if ($build_all_cont) {
2376*cdf0e10cSrcweir                $$deps_hash{$prj} = ();
2377*cdf0e10cSrcweir            } else {
2378*cdf0e10cSrcweir                remove_from_dependencies($prj, $deps_hash);
2379*cdf0e10cSrcweir            };
2380*cdf0e10cSrcweir            return;
2381*cdf0e10cSrcweir        };
2382*cdf0e10cSrcweir    };
2383*cdf0e10cSrcweir};
2384*cdf0e10cSrcweir
2385*cdf0e10cSrcweirsub get_modes {
2386*cdf0e10cSrcweir    my $option = '';
2387*cdf0e10cSrcweir    while ($option = shift @ARGV) {
2388*cdf0e10cSrcweir        if ($option =~ /^-+/) {
2389*cdf0e10cSrcweir            unshift(@ARGV, $option);
2390*cdf0e10cSrcweir            return;
2391*cdf0e10cSrcweir        } else {
2392*cdf0e10cSrcweir            if ($option =~ /,/) {
2393*cdf0e10cSrcweir                $build_modes{$`}++;
2394*cdf0e10cSrcweir                unshift(@ARGV, $') if ($');
2395*cdf0e10cSrcweir            } else {$build_modes{$option}++;};
2396*cdf0e10cSrcweir        };
2397*cdf0e10cSrcweir    };
2398*cdf0e10cSrcweir    $build_modes{$option}++;
2399*cdf0e10cSrcweir};
2400*cdf0e10cSrcweir
2401*cdf0e10cSrcweirsub get_list_of_modules {
2402*cdf0e10cSrcweir    my $option = '';
2403*cdf0e10cSrcweir    my $hash_ref = shift;
2404*cdf0e10cSrcweir    while ($option = shift @ARGV) {
2405*cdf0e10cSrcweir        if ($option =~ /^-+/) {
2406*cdf0e10cSrcweir            unshift(@ARGV, $option);
2407*cdf0e10cSrcweir            return;
2408*cdf0e10cSrcweir        } else {
2409*cdf0e10cSrcweir            if ($option =~ /,/) {
2410*cdf0e10cSrcweir                foreach (split /,/, $option) {
2411*cdf0e10cSrcweir                    next if (!$_);
2412*cdf0e10cSrcweir                    $$hash_ref{$_}++;
2413*cdf0e10cSrcweir                };
2414*cdf0e10cSrcweir            } else {
2415*cdf0e10cSrcweir                $$hash_ref{$option}++;
2416*cdf0e10cSrcweir            };
2417*cdf0e10cSrcweir        };
2418*cdf0e10cSrcweir    };
2419*cdf0e10cSrcweir#    if (!scalar %$hash_ref) {
2420*cdf0e10cSrcweir#        print_error('No module list supplied!!');
2421*cdf0e10cSrcweir#    };
2422*cdf0e10cSrcweir};
2423*cdf0e10cSrcweir
2424*cdf0e10cSrcweirsub get_modules_passed {
2425*cdf0e10cSrcweir    my $hash_ref = shift;
2426*cdf0e10cSrcweir    my $option = '';
2427*cdf0e10cSrcweir    while ($option = shift @ARGV) {
2428*cdf0e10cSrcweir        if ($option =~ /^-+/) {
2429*cdf0e10cSrcweir            unshift(@ARGV, $option);
2430*cdf0e10cSrcweir            return;
2431*cdf0e10cSrcweir        } else {
2432*cdf0e10cSrcweir            if ($option =~ /(:)/) {
2433*cdf0e10cSrcweir                $option = $`;
2434*cdf0e10cSrcweir                print_error("\'--from\' switch collision") if ($build_all_cont);
2435*cdf0e10cSrcweir                $build_all_cont = $';
2436*cdf0e10cSrcweir            };
2437*cdf0e10cSrcweir            $$hash_ref{$option}++;
2438*cdf0e10cSrcweir        };
2439*cdf0e10cSrcweir    };
2440*cdf0e10cSrcweir};
2441*cdf0e10cSrcweir
2442*cdf0e10cSrcweirsub get_workspace_platforms {
2443*cdf0e10cSrcweir    my $workspace_patforms = shift;
2444*cdf0e10cSrcweir    my $solver_path = $ENV{SOLARVERSION};
2445*cdf0e10cSrcweir    opendir(SOLVERDIR, $solver_path);
2446*cdf0e10cSrcweir    my @dir_list = readdir(SOLVERDIR);
2447*cdf0e10cSrcweir    close SOLVERDIR;
2448*cdf0e10cSrcweir    foreach (@dir_list) {
2449*cdf0e10cSrcweir        next if /^common/;
2450*cdf0e10cSrcweir        next if /^\./;
2451*cdf0e10cSrcweir        if (open(LS, "ls $solver_path/$_/inc/*minor.mk 2>$nul |")) {
2452*cdf0e10cSrcweir            foreach my $string (<LS>) {
2453*cdf0e10cSrcweir                chomp $string;
2454*cdf0e10cSrcweir                if ($string =~ /minor.mk$/) {
2455*cdf0e10cSrcweir                    $$workspace_patforms{$_}++
2456*cdf0e10cSrcweir                };
2457*cdf0e10cSrcweir            };
2458*cdf0e10cSrcweir            close LS;
2459*cdf0e10cSrcweir        };
2460*cdf0e10cSrcweir    };
2461*cdf0e10cSrcweir};
2462*cdf0e10cSrcweir
2463*cdf0e10cSrcweirsub get_platforms {
2464*cdf0e10cSrcweir    my $platforms_ref = shift;
2465*cdf0e10cSrcweir    if ($only_platform) {
2466*cdf0e10cSrcweir        foreach (split(',', $only_platform)) {
2467*cdf0e10cSrcweir            $$platforms_ref{$_}++;
2468*cdf0e10cSrcweir        }
2469*cdf0e10cSrcweir        $platforms_ref = \%platforms_to_copy;
2470*cdf0e10cSrcweir    };
2471*cdf0e10cSrcweir
2472*cdf0e10cSrcweir    my $workspace_lst = get_workspace_lst();
2473*cdf0e10cSrcweir    if ($workspace_lst) {
2474*cdf0e10cSrcweir        my $workspace_db;
2475*cdf0e10cSrcweir        eval { $workspace_db = GenInfoParser->new(); };
2476*cdf0e10cSrcweir        if (!$@) {
2477*cdf0e10cSrcweir            my $success = $workspace_db->load_list($workspace_lst);
2478*cdf0e10cSrcweir            if ( !$success ) {
2479*cdf0e10cSrcweir                print_error("Can't load workspace list '$workspace_lst'.", 4);
2480*cdf0e10cSrcweir            }
2481*cdf0e10cSrcweir            my $access_path = $ENV{WORK_STAMP} . '/Environments';
2482*cdf0e10cSrcweir            my @platforms_available = $workspace_db->get_keys($access_path);
2483*cdf0e10cSrcweir            my $solver = $ENV{SOLARVERSION};
2484*cdf0e10cSrcweir            foreach (@platforms_available) {
2485*cdf0e10cSrcweir                my $s_path = $solver . '/' .  $_;
2486*cdf0e10cSrcweir                $$platforms_ref{$_}++ if (-d $s_path);
2487*cdf0e10cSrcweir            };
2488*cdf0e10cSrcweir        } else {
2489*cdf0e10cSrcweir            get_workspace_platforms(\%platforms);
2490*cdf0e10cSrcweir        };
2491*cdf0e10cSrcweir    };
2492*cdf0e10cSrcweir
2493*cdf0e10cSrcweir    if (!scalar keys %platforms) {
2494*cdf0e10cSrcweir        # An Auses wish - fallback to INPATH for new platforms
2495*cdf0e10cSrcweir        if (defined $ENV{INPATH}) {
2496*cdf0e10cSrcweir            $$platforms_ref{$ENV{INPATH}}++;
2497*cdf0e10cSrcweir        } else {
2498*cdf0e10cSrcweir            print_error("There is no platform found!!") ;
2499*cdf0e10cSrcweir        };
2500*cdf0e10cSrcweir    };
2501*cdf0e10cSrcweir};
2502*cdf0e10cSrcweir
2503*cdf0e10cSrcweir#
2504*cdf0e10cSrcweir# This procedure clears solver from delivered
2505*cdf0e10cSrcweir# by the modules to be build
2506*cdf0e10cSrcweir#
2507*cdf0e10cSrcweirsub clear_delivered {
2508*cdf0e10cSrcweir    my $message = 'Clearing up delivered';
2509*cdf0e10cSrcweir    my %backup_vars;
2510*cdf0e10cSrcweir    my $deliver_delete_switches = '-delete';
2511*cdf0e10cSrcweir    if (scalar keys %platforms < scalar keys %platforms_to_copy) {
2512*cdf0e10cSrcweir        $message .= ' without common trees';
2513*cdf0e10cSrcweir        $deliver_delete_switches .= ' -dontdeletecommon';
2514*cdf0e10cSrcweir        $only_common = '';
2515*cdf0e10cSrcweir    };
2516*cdf0e10cSrcweir    print "$message\n";
2517*cdf0e10cSrcweir
2518*cdf0e10cSrcweir    foreach my $platform (keys %platforms) {
2519*cdf0e10cSrcweir        print "\nRemoving files delivered for $platform\n";
2520*cdf0e10cSrcweir        my %solar_vars = ();
2521*cdf0e10cSrcweir        read_ssolar_vars($platform, \%solar_vars);
2522*cdf0e10cSrcweir        if (scalar keys %solar_vars) {
2523*cdf0e10cSrcweir            foreach (keys %solar_vars) {
2524*cdf0e10cSrcweir                if (!defined $backup_vars{$_}) {
2525*cdf0e10cSrcweir                    $backup_vars{$_} = $ENV{$_};
2526*cdf0e10cSrcweir                };
2527*cdf0e10cSrcweir                $ENV{$_} = $solar_vars{$_};
2528*cdf0e10cSrcweir            };
2529*cdf0e10cSrcweir        };
2530*cdf0e10cSrcweir        my $undeliver = "$deliver_command $deliver_delete_switches $nul";
2531*cdf0e10cSrcweir#        my $current_dir = getcwd();
2532*cdf0e10cSrcweir        foreach my $module (sort @modules_built) {
2533*cdf0e10cSrcweir            if (chdir($module_paths{$module})) {
2534*cdf0e10cSrcweir                print "Removing delivered from module $module\n";
2535*cdf0e10cSrcweir                next if ($show);
2536*cdf0e10cSrcweir                if (system($undeliver)) {
2537*cdf0e10cSrcweir                    $ENV{$_} = $backup_vars{$_} foreach (keys %backup_vars);
2538*cdf0e10cSrcweir                    print_error("Cannot run: $undeliver");
2539*cdf0e10cSrcweir                }
2540*cdf0e10cSrcweir            } else {
2541*cdf0e10cSrcweir                push(@warnings, "Could not remove delivered files from the module $module. Your build can become inconsistent.\n");
2542*cdf0e10cSrcweir            };
2543*cdf0e10cSrcweir        };
2544*cdf0e10cSrcweir#        chdir $current_dir;
2545*cdf0e10cSrcweir#        getcwd();
2546*cdf0e10cSrcweir    };
2547*cdf0e10cSrcweir    $ENV{$_} = $backup_vars{$_} foreach (keys %backup_vars);
2548*cdf0e10cSrcweir};
2549*cdf0e10cSrcweir
2550*cdf0e10cSrcweir#
2551*cdf0e10cSrcweir# Run setsolar for given platform and
2552*cdf0e10cSrcweir# write all variables needed in %solar_vars hash
2553*cdf0e10cSrcweir#
2554*cdf0e10cSrcweirsub read_ssolar_vars {
2555*cdf0e10cSrcweir    my ($setsolar, $tmp_file);
2556*cdf0e10cSrcweir    $setsolar = $ENV{ENV_ROOT} . '/etools/setsolar.pl';
2557*cdf0e10cSrcweir    my ($platform, $solar_vars) = @_;
2558*cdf0e10cSrcweir    $setsolar = '/net/jumbo2.germany/buildenv/r/etools/setsolar.pl' if ! -e $setsolar;
2559*cdf0e10cSrcweir    $tmp_file = $ENV{HOME} . "/.solar.env.$$.tmp";
2560*cdf0e10cSrcweir    if (!-e $setsolar) {
2561*cdf0e10cSrcweir        print STDERR "There is no setsolar found. Falling back to current platform settings\n";
2562*cdf0e10cSrcweir        return;
2563*cdf0e10cSrcweir    }
2564*cdf0e10cSrcweir    my $pro = "";
2565*cdf0e10cSrcweir    if ($platform =~ /\.pro$/) {
2566*cdf0e10cSrcweir        $pro = "-pro";
2567*cdf0e10cSrcweir        $platform = $`;
2568*cdf0e10cSrcweir    };
2569*cdf0e10cSrcweir
2570*cdf0e10cSrcweir    my ($verswitch, $source_root, $cwsname);
2571*cdf0e10cSrcweir	$verswitch = "-ver $ENV{UPDMINOR}" if (defined $ENV{UPDMINOR});
2572*cdf0e10cSrcweir    $source_root = '-sourceroot' if (defined $ENV{SOURCE_ROOT_USED});
2573*cdf0e10cSrcweir    my $cws_name = "-cwsname $ENV{CWS_WORK_STAMP}" if (defined $ENV{CWS_WORK_STAMP});
2574*cdf0e10cSrcweir
2575*cdf0e10cSrcweir    my $param = "-$ENV{WORK_STAMP} $verswitch $source_root $cws_name $pro $platform";
2576*cdf0e10cSrcweir    my $ss_command = "$perl $setsolar -file $tmp_file $param $nul";
2577*cdf0e10cSrcweir    if (system($ss_command)) {
2578*cdf0e10cSrcweir        unlink $tmp_file;
2579*cdf0e10cSrcweir        print_error("Cannot run command:\n$ss_command");
2580*cdf0e10cSrcweir    };
2581*cdf0e10cSrcweir    get_solar_vars($solar_vars, $tmp_file);
2582*cdf0e10cSrcweir};
2583*cdf0e10cSrcweir
2584*cdf0e10cSrcweir#
2585*cdf0e10cSrcweir# read variables to hash
2586*cdf0e10cSrcweir#
2587*cdf0e10cSrcweirsub get_solar_vars {
2588*cdf0e10cSrcweir    my ($solar_vars, $file) = @_;
2589*cdf0e10cSrcweir    my ($var, $value);
2590*cdf0e10cSrcweir    open SOLARTABLE, "<$file" or die "can�t open solarfile $file";
2591*cdf0e10cSrcweir    while(<SOLARTABLE>) {
2592*cdf0e10cSrcweir        s/\r\n//o;
2593*cdf0e10cSrcweir        next if(!/^\w+\s+(\w+)/o);
2594*cdf0e10cSrcweir        next if (!defined $deliver_env{$1});
2595*cdf0e10cSrcweir        $var = $1;
2596*cdf0e10cSrcweir        /\'(\S+)\'$/o;
2597*cdf0e10cSrcweir        $value = $1;
2598*cdf0e10cSrcweir        $$solar_vars{$var} = $value;
2599*cdf0e10cSrcweir    };
2600*cdf0e10cSrcweir    close SOLARTABLE;
2601*cdf0e10cSrcweir    unlink $file;
2602*cdf0e10cSrcweir}
2603*cdf0e10cSrcweir
2604*cdf0e10cSrcweir#
2605*cdf0e10cSrcweir# Procedure renames <module>.lnk (.link) into <module>
2606*cdf0e10cSrcweir#
2607*cdf0e10cSrcweirsub get_current_module {
2608*cdf0e10cSrcweir    my $module_name = shift;
2609*cdf0e10cSrcweir    my $link_name = $module_name . '.lnk';
2610*cdf0e10cSrcweir    $link_name .= '.link' if (-e $workspace_path.$module_name . '.link');
2611*cdf0e10cSrcweir    chdir $workspace_path;
2612*cdf0e10cSrcweir    getcwd();
2613*cdf0e10cSrcweir    print "\nBreaking link to module $module_name";
2614*cdf0e10cSrcweir    my $result = rename $link_name, $module_name;
2615*cdf0e10cSrcweir    if ( ! $result ) {
2616*cdf0e10cSrcweir        print_error("Cannot rename $module_name: $!\n");
2617*cdf0e10cSrcweir    }
2618*cdf0e10cSrcweir    if ( $initial_module eq $link_name) {
2619*cdf0e10cSrcweir        $initial_module = $module_name;
2620*cdf0e10cSrcweir    }
2621*cdf0e10cSrcweir    chdir $module_name;
2622*cdf0e10cSrcweir    getcwd();
2623*cdf0e10cSrcweir};
2624*cdf0e10cSrcweir
2625*cdf0e10cSrcweirsub check_dir {
2626*cdf0e10cSrcweir    my $start_dir = getcwd();
2627*cdf0e10cSrcweir    my @dir_entries = split(/[\\\/]/, $ENV{PWD});
2628*cdf0e10cSrcweir    my $current_module = $dir_entries[$#dir_entries];
2629*cdf0e10cSrcweir    if (($current_module =~ /(\.lnk)$/) || ($current_module =~ /(\.link)$/)) {
2630*cdf0e10cSrcweir        $current_module = $`;
2631*cdf0e10cSrcweir        # we're dealing with a link => fallback to SOLARSRC under UNIX
2632*cdf0e10cSrcweir        $workspace_path = $ENV{SOLARSRC}.'/';
2633*cdf0e10cSrcweir        get_current_module($current_module);
2634*cdf0e10cSrcweir        return;
2635*cdf0e10cSrcweir    } else {
2636*cdf0e10cSrcweir        chdir $start_dir;
2637*cdf0e10cSrcweir        getcwd();
2638*cdf0e10cSrcweir    };
2639*cdf0e10cSrcweir};
2640*cdf0e10cSrcweir
2641*cdf0e10cSrcweir#
2642*cdf0e10cSrcweir# Store all available build modi in %build_modes
2643*cdf0e10cSrcweir#
2644*cdf0e10cSrcweirsub get_build_modes {
2645*cdf0e10cSrcweir    return if (scalar keys %build_modes);
2646*cdf0e10cSrcweir    if (defined $ENV{BUILD_TYPE}) {
2647*cdf0e10cSrcweir        if ($ENV{BUILD_TYPE} =~ /\s+/o) {
2648*cdf0e10cSrcweir            my @build_modes = split (/\s+/, $ENV{BUILD_TYPE});
2649*cdf0e10cSrcweir            $build_modes{$_}++ foreach (@build_modes);
2650*cdf0e10cSrcweir        } else {
2651*cdf0e10cSrcweir            $build_modes{$ENV{BUILD_TYPE}}++;
2652*cdf0e10cSrcweir        };
2653*cdf0e10cSrcweir        return;
2654*cdf0e10cSrcweir    };
2655*cdf0e10cSrcweir};
2656*cdf0e10cSrcweir
2657*cdf0e10cSrcweir#
2658*cdf0e10cSrcweir# pick only the modules, that should be built for
2659*cdf0e10cSrcweir# build types from %build_modes
2660*cdf0e10cSrcweir#
2661*cdf0e10cSrcweirsub pick_for_build_type {
2662*cdf0e10cSrcweir    my $modules = shift;
2663*cdf0e10cSrcweir    my @mod_array = split(/\s+/, $modules);
2664*cdf0e10cSrcweir    print_error("Wrongly written dependencies string:\n $modules\n") if ($mod_array[$#mod_array] ne 'NULL');
2665*cdf0e10cSrcweir    pop @mod_array;
2666*cdf0e10cSrcweir    my @modules_to_build;
2667*cdf0e10cSrcweir    foreach (@mod_array) {
2668*cdf0e10cSrcweir        if (/(\w+):(\S+)/o) {
2669*cdf0e10cSrcweir            push(@modules_to_build, $2) if (defined $build_modes{$1});
2670*cdf0e10cSrcweir            next;
2671*cdf0e10cSrcweir        };
2672*cdf0e10cSrcweir        push(@modules_to_build, $_);
2673*cdf0e10cSrcweir    };
2674*cdf0e10cSrcweir    return @modules_to_build;
2675*cdf0e10cSrcweir};
2676*cdf0e10cSrcweir
2677*cdf0e10cSrcweirsub do_exit {
2678*cdf0e10cSrcweir#    close_server_socket();
2679*cdf0e10cSrcweir    my $exit_code = shift;
2680*cdf0e10cSrcweir    $build_finished++;
2681*cdf0e10cSrcweir    generate_html_file(1);
2682*cdf0e10cSrcweir    if ( $^O eq 'os2' )
2683*cdf0e10cSrcweir    {
2684*cdf0e10cSrcweir        # perl 5.10 returns 'resource busy' for rmtree
2685*cdf0e10cSrcweir        rmdir(correct_path($tmp_dir)) if ($tmp_dir);
2686*cdf0e10cSrcweir    }
2687*cdf0e10cSrcweir    rmtree(correct_path($tmp_dir), 0, 0) if ($tmp_dir);
2688*cdf0e10cSrcweir    print STDERR "Cannot delete $tmp_dir. Please remove it manually\n" if (-d $tmp_dir);
2689*cdf0e10cSrcweir    exit($exit_code);
2690*cdf0e10cSrcweir};
2691*cdf0e10cSrcweir
2692*cdf0e10cSrcweir#
2693*cdf0e10cSrcweir# Procedure sorts module in user-frendly order
2694*cdf0e10cSrcweir#
2695*cdf0e10cSrcweirsub sort_modules_appearance {
2696*cdf0e10cSrcweir    foreach (keys %dead_parents) {
2697*cdf0e10cSrcweir        delete $build_is_finished{$_} if (defined $build_is_finished{$_});
2698*cdf0e10cSrcweir        delete $build_in_progress{$_} if (defined $build_in_progress{$_});
2699*cdf0e10cSrcweir    };
2700*cdf0e10cSrcweir    foreach (keys %build_is_finished) {
2701*cdf0e10cSrcweir        delete $build_in_progress{$_} if (defined $build_in_progress{$_});
2702*cdf0e10cSrcweir        delete $build_in_progress_shown{$_} if (defined $build_in_progress_shown{$_});
2703*cdf0e10cSrcweir    };
2704*cdf0e10cSrcweir    my @modules_order = sort keys %modules_with_errors;
2705*cdf0e10cSrcweir    foreach (keys %modules_with_errors) {
2706*cdf0e10cSrcweir        delete $build_in_progress{$_} if (defined $build_in_progress{$_});
2707*cdf0e10cSrcweir        delete $build_is_finished{$_} if (defined $build_is_finished{$_});
2708*cdf0e10cSrcweir        delete $build_in_progress_shown{$_} if (defined $build_in_progress_shown{$_});
2709*cdf0e10cSrcweir    };
2710*cdf0e10cSrcweir    $build_in_progress_shown{$_}++ foreach (keys %build_in_progress);
2711*cdf0e10cSrcweir    push(@modules_order, $_) foreach (sort { $build_in_progress_shown{$b} <=> $build_in_progress_shown{$a} }  keys %build_in_progress_shown);
2712*cdf0e10cSrcweir    push(@modules_order, $_) foreach (sort keys %build_is_finished);
2713*cdf0e10cSrcweir    foreach(sort keys %html_info) {
2714*cdf0e10cSrcweir        next if (defined $build_is_finished{$_} || defined $build_in_progress{$_} || defined $modules_with_errors{$_});
2715*cdf0e10cSrcweir        push(@modules_order, $_);
2716*cdf0e10cSrcweir    };
2717*cdf0e10cSrcweir    return @modules_order;
2718*cdf0e10cSrcweir};
2719*cdf0e10cSrcweir
2720*cdf0e10cSrcweirsub generate_html_file {
2721*cdf0e10cSrcweir    return if (!$html);
2722*cdf0e10cSrcweir    my $force_update = shift;
2723*cdf0e10cSrcweir    $force_update++ if ($debug);
2724*cdf0e10cSrcweir    $html_last_updated = time;
2725*cdf0e10cSrcweir    my @modules_order = sort_modules_appearance();
2726*cdf0e10cSrcweir    my ($successes_percent, $errors_percent) = get_progress_percentage(scalar keys %html_info, scalar keys %build_is_finished, scalar keys %modules_with_errors);
2727*cdf0e10cSrcweir    my $build_duration = get_time_line(time - $build_time);
2728*cdf0e10cSrcweir    my $temp_html_file = File::Temp::tmpnam($tmp_dir);
2729*cdf0e10cSrcweir    my $title;
2730*cdf0e10cSrcweir    $title = $ENV{CWS_WORK_STAMP} . ': ' if (defined $ENV{CWS_WORK_STAMP});
2731*cdf0e10cSrcweir    $title .= $ENV{INPATH};
2732*cdf0e10cSrcweir    die("Cannot open $temp_html_file") if (!open(HTML, ">$temp_html_file"));
2733*cdf0e10cSrcweir    print HTML '<html><head>';
2734*cdf0e10cSrcweir    print HTML '<TITLE id=MainTitle>' . $title . '</TITLE>';
2735*cdf0e10cSrcweir    print HTML '<script type="text/javascript">' . "\n";
2736*cdf0e10cSrcweir    print HTML 'initFrames();' . "\n";
2737*cdf0e10cSrcweir    print HTML 'var IntervalID;' . "\n";
2738*cdf0e10cSrcweir    print HTML 'function loadFrame_0() {' . "\n";
2739*cdf0e10cSrcweir    print HTML '    document.write("<html>");' . "\n";
2740*cdf0e10cSrcweir    print HTML '    document.write("<head>");' . "\n";
2741*cdf0e10cSrcweir    print HTML '    document.write("</head>");' . "\n";
2742*cdf0e10cSrcweir    print HTML '    document.write("<body>");' . "\n";
2743*cdf0e10cSrcweir    if ($build_finished) {
2744*cdf0e10cSrcweir        print HTML 'document.write("<h3 align=center style=\"color:red\">Build process is finished</h3>");' . "\n";
2745*cdf0e10cSrcweir        print HTML '        top.frames[0].clearInterval(top.frames[0].IntervalID);' . "\n";
2746*cdf0e10cSrcweir    } elsif ($interactive) {
2747*cdf0e10cSrcweir        print HTML 'document.write("    <div id=divContext style=\"border: 1px solid; display: none; position: absolute\">");' . "\n";
2748*cdf0e10cSrcweir        print HTML 'document.write("        <ul style=\"margin: 0; padding: 0.3em; list-style-type: none; background-color: lightgrey;\" :li:hover {} :hr {border: 0; border-bottom: 1px solid grey; margin: 3px 0px 3px 0px; width: 10em;} :a {border: 0 !important;} >");' . "\n";
2749*cdf0e10cSrcweir        print HTML 'document.write("            <li><a onmouseover=\"this.style.color=\'red\'\" onmouseout=\"this.style.color=\'black\'\" id=aRebuild href=\"#\">Rebuild module</a></li>");' . "\n";
2750*cdf0e10cSrcweir        print HTML 'document.write("            <li><a onmouseover=\"this.style.color=\'red\'\" onmouseout=\"this.style.color=\'black\'\" id=aDelete href=\"#\" >Remove module</a></li>");' . "\n";
2751*cdf0e10cSrcweir        print HTML 'document.write("        </ul>");' . "\n";
2752*cdf0e10cSrcweir        print HTML 'document.write("    </div>");' . "\n";
2753*cdf0e10cSrcweir    };
2754*cdf0e10cSrcweir    if ($build_all_parents) {
2755*cdf0e10cSrcweir        print HTML 'document.write("<table valign=top cellpadding=0 hspace=0 vspace=0 cellspacing=0 border=0>");' . "\n";
2756*cdf0e10cSrcweir        print HTML 'document.write("    <tr>");' . "\n";
2757*cdf0e10cSrcweir        print HTML 'document.write("        <td><a id=ErroneousModules href=\"javascript:top.Error(\'\', \'';
2758*cdf0e10cSrcweir        print HTML join('<br>', sort keys %modules_with_errors);
2759*cdf0e10cSrcweir        print HTML '\', \'\')\"); title=\"';
2760*cdf0e10cSrcweir        print HTML scalar keys %modules_with_errors;
2761*cdf0e10cSrcweir        print HTML ' module(s) with errors\">Total Progress:</a></td>");' . "\n";
2762*cdf0e10cSrcweir        print HTML 'document.write("        <td>");' . "\n";
2763*cdf0e10cSrcweir        print HTML 'document.write("            <table width=100px valign=top cellpadding=0 hspace=0 vspace=0 cellspacing=0 border=0>");' . "\n";
2764*cdf0e10cSrcweir        print HTML 'document.write("                <tr>");' . "\n";
2765*cdf0e10cSrcweir        print HTML 'document.write("                    <td height=20px width=';
2766*cdf0e10cSrcweir        print HTML $successes_percent + $errors_percent;
2767*cdf0e10cSrcweir        if (scalar keys %modules_with_errors) {
2768*cdf0e10cSrcweir            print HTML '% bgcolor=red valign=top></td>");' . "\n";
2769*cdf0e10cSrcweir        } else {
2770*cdf0e10cSrcweir            print HTML '% bgcolor=#25A528 valign=top></td>");' . "\n";
2771*cdf0e10cSrcweir        };
2772*cdf0e10cSrcweir        print HTML 'document.write("                    <td width=';
2773*cdf0e10cSrcweir        print HTML 100 - ($successes_percent + $errors_percent);
2774*cdf0e10cSrcweir        print HTML '% bgcolor=lightgrey valign=top></td>");' . "\n";
2775*cdf0e10cSrcweir        print HTML 'document.write("                </tr>");' . "\n";
2776*cdf0e10cSrcweir        print HTML 'document.write("            </table>");' . "\n";
2777*cdf0e10cSrcweir        print HTML 'document.write("        </td>");' . "\n";
2778*cdf0e10cSrcweir        print HTML 'document.write("        <td align=right>&nbsp Build time: ' . $build_duration .'</td>");' . "\n";
2779*cdf0e10cSrcweir        print HTML 'document.write("    </tr>");' . "\n";
2780*cdf0e10cSrcweir        print HTML 'document.write("</table>");' . "\n";
2781*cdf0e10cSrcweir    };
2782*cdf0e10cSrcweir
2783*cdf0e10cSrcweir    print HTML 'document.write("<table width=100% bgcolor=white>");' . "\n";
2784*cdf0e10cSrcweir    print HTML 'document.write("    <tr>");' . "\n";
2785*cdf0e10cSrcweir    print HTML 'document.write("        <td width=30% align=\"center\"><strong style=\"color:blue\">Module</strong></td>");' . "\n";
2786*cdf0e10cSrcweir    print HTML 'document.write("        <td width=* align=\"center\"><strong style=\"color:blue\">Status</strong></td>");' . "\n";
2787*cdf0e10cSrcweir    print HTML 'document.write("        <td width=15% align=\"center\"><strong style=\"color:blue\">CPU Time</strong></td>");' . "\n";
2788*cdf0e10cSrcweir    print HTML 'document.write("    </tr>");' . "\n";
2789*cdf0e10cSrcweir
2790*cdf0e10cSrcweir    foreach (@modules_order) {
2791*cdf0e10cSrcweir        next if ($modules_types{$_} eq 'lnk');
2792*cdf0e10cSrcweir        next if (!defined $active_modules{$_});
2793*cdf0e10cSrcweir        my ($errors_info_line, $dirs_info_line, $errors_number, $successes_percent, $errors_percent, $time) = get_html_info($_);
2794*cdf0e10cSrcweir#<one module>
2795*cdf0e10cSrcweir        print HTML 'document.write("    <tr>");' . "\n";
2796*cdf0e10cSrcweir        print HTML 'document.write("        <td width=*>");' . "\n";
2797*cdf0e10cSrcweir
2798*cdf0e10cSrcweir        if (defined $dirs_info_line) {
2799*cdf0e10cSrcweir            print HTML 'document.write("            <a id=';
2800*cdf0e10cSrcweir            print HTML $_;
2801*cdf0e10cSrcweir            print HTML ' href=\"javascript:top.Error(\'';
2802*cdf0e10cSrcweir            print HTML $_ , '\', ' ;
2803*cdf0e10cSrcweir            print HTML $errors_info_line;
2804*cdf0e10cSrcweir            print HTML ',';
2805*cdf0e10cSrcweir            print HTML $dirs_info_line;
2806*cdf0e10cSrcweir            print HTML ')\"); title=\"';
2807*cdf0e10cSrcweir            print HTML $errors_number;
2808*cdf0e10cSrcweir            print HTML ' error(s)\">', $_, '</a>");' . "\n";
2809*cdf0e10cSrcweir        } else {
2810*cdf0e10cSrcweir#            print HTML 'document.write("<em style=color:gray>' . $_ . '</em>");';
2811*cdf0e10cSrcweir####            print HTML 'document.write("<em style=color:gray>' . $_ ."href=\'http://$local_host_ip:$html_port/delete=\'$_". '</em>");';
2812*cdf0e10cSrcweir
2813*cdf0e10cSrcweir            print HTML 'document.write("            <a target=\'infoframe\' id=';
2814*cdf0e10cSrcweir            print HTML $_;
2815*cdf0e10cSrcweir            print HTML ' href=\"javascript:void(0)\"; title=\"Remove module\">' . $_ . '</a>");' . "\n";
2816*cdf0e10cSrcweir        };
2817*cdf0e10cSrcweir
2818*cdf0e10cSrcweir
2819*cdf0e10cSrcweir        print HTML 'document.write("        </td>");' . "\n";
2820*cdf0e10cSrcweir        print HTML 'document.write("        <td>");' . "\n";
2821*cdf0e10cSrcweir        print HTML 'document.write("            <table width=100% valign=top cellpadding=0 hspace=0 vspace=0 cellspacing=0 border=0>");' . "\n";
2822*cdf0e10cSrcweir        print HTML 'document.write("                <tr>");' . "\n";
2823*cdf0e10cSrcweir        print HTML 'document.write("                    <td height=15* width=';
2824*cdf0e10cSrcweir
2825*cdf0e10cSrcweir        print HTML $successes_percent + $errors_percent;
2826*cdf0e10cSrcweir        if ($errors_number) {
2827*cdf0e10cSrcweir            print HTML '% bgcolor=red valign=top></td>");' . "\n";
2828*cdf0e10cSrcweir        } else {
2829*cdf0e10cSrcweir            print HTML '% bgcolor=#25A528 valign=top></td>");' . "\n";
2830*cdf0e10cSrcweir        };
2831*cdf0e10cSrcweir        print HTML 'document.write("                    <td width=';
2832*cdf0e10cSrcweir
2833*cdf0e10cSrcweir        print HTML 100 - ($successes_percent + $errors_percent);
2834*cdf0e10cSrcweir        print HTML '% bgcolor=lightgrey valign=top></td>");' . "\n";
2835*cdf0e10cSrcweir        print HTML 'document.write("                </tr>");' . "\n";
2836*cdf0e10cSrcweir        print HTML 'document.write("            </table>");' . "\n";
2837*cdf0e10cSrcweir        print HTML 'document.write("        </td>");' . "\n";
2838*cdf0e10cSrcweir        print HTML 'document.write("        <td align=\"center\">', $time, '</td>");' . "\n";
2839*cdf0e10cSrcweir        print HTML 'document.write("    </tr>");' . "\n";
2840*cdf0e10cSrcweir# </one module>
2841*cdf0e10cSrcweir    }
2842*cdf0e10cSrcweir    print HTML 'document.write("        </table>");' . "\n";
2843*cdf0e10cSrcweir    print HTML 'document.write("    </body>");' . "\n";
2844*cdf0e10cSrcweir    print HTML 'document.write("</html>");' . "\n";
2845*cdf0e10cSrcweir    print HTML 'document.close();' . "\n";
2846*cdf0e10cSrcweir    print HTML 'refreshInfoFrames();' . "\n";
2847*cdf0e10cSrcweir    print HTML '}' . "\n";
2848*cdf0e10cSrcweir
2849*cdf0e10cSrcweir
2850*cdf0e10cSrcweir    if (!$build_finished && $interactive ) {
2851*cdf0e10cSrcweir        print HTML 'var _replaceContext = false;' . "\n";
2852*cdf0e10cSrcweir        print HTML 'var _mouseOverContext = false;' . "\n";
2853*cdf0e10cSrcweir        print HTML 'var _noContext = false;' . "\n";
2854*cdf0e10cSrcweir        print HTML 'var _divContext = $(\'divContext\');' . "\n";
2855*cdf0e10cSrcweir        print HTML 'var activeElement = 0;' . "\n";
2856*cdf0e10cSrcweir        print HTML 'function $(id) {return document.getElementById(id);}' . "\n";
2857*cdf0e10cSrcweir        print HTML 'InitContext();' . "\n";
2858*cdf0e10cSrcweir        print HTML 'function InitContext()' . "\n";
2859*cdf0e10cSrcweir        print HTML '{' . "\n";
2860*cdf0e10cSrcweir        print HTML '    $(\'aRebuild\').target = \'infoframe\';' . "\n";
2861*cdf0e10cSrcweir        print HTML '    $(\'aDelete\').target = \'infoframe\';' . "\n";
2862*cdf0e10cSrcweir        print HTML '    $(\'aRebuild\').style.color = \'black\';' . "\n";
2863*cdf0e10cSrcweir        print HTML '    $(\'aDelete\').style.color = \'black\';' . "\n";
2864*cdf0e10cSrcweir        print HTML '    _divContext.onmouseover = function() { _mouseOverContext = true; };' . "\n";
2865*cdf0e10cSrcweir        print HTML '    _divContext.onmouseout = function() { _mouseOverContext = false; };' . "\n";
2866*cdf0e10cSrcweir        print HTML '    _divContext.onclick = function() { _divContext.style.display = \'none\'; };' . "\n";
2867*cdf0e10cSrcweir        print HTML '    document.body.onmousedown = ContextMouseDown;' . "\n";
2868*cdf0e10cSrcweir        print HTML '    document.body.oncontextmenu = ContextShow;' . "\n";
2869*cdf0e10cSrcweir        print HTML '}' . "\n";
2870*cdf0e10cSrcweir        print HTML 'function ContextMouseDown(event) {' . "\n";
2871*cdf0e10cSrcweir        print HTML '    if (_noContext || _mouseOverContext) return;' . "\n";
2872*cdf0e10cSrcweir        print HTML '    if (event == null) event = window.event;' . "\n";
2873*cdf0e10cSrcweir        print HTML '    var target = event.target != null ? event.target : event.srcElement;' . "\n";
2874*cdf0e10cSrcweir        print HTML '    if (event.button == 2 && target.tagName.toLowerCase() == \'a\')' . "\n";
2875*cdf0e10cSrcweir        print HTML '        _replaceContext = true;' . "\n";
2876*cdf0e10cSrcweir        print HTML '    else if (!_mouseOverContext)' . "\n";
2877*cdf0e10cSrcweir        print HTML '        _divContext.style.display = \'none\';' . "\n";
2878*cdf0e10cSrcweir        print HTML '}' . "\n";
2879*cdf0e10cSrcweir        print HTML 'function ContextShow(event) {' . "\n";
2880*cdf0e10cSrcweir        print HTML '    if (_noContext || _mouseOverContext) return;' . "\n";
2881*cdf0e10cSrcweir        print HTML '    if (event == null) event = window.event;' . "\n";
2882*cdf0e10cSrcweir        print HTML '    var target = event.target != null ? event.target : event.srcElement;' . "\n";
2883*cdf0e10cSrcweir        print HTML '    if (_replaceContext) {' . "\n";
2884*cdf0e10cSrcweir        print HTML '        $(\'aRebuild\').href = \'http://'. $local_host_ip .':' . $html_port . '/rebuild=\' + target.id;' . "\n";
2885*cdf0e10cSrcweir        print HTML '        $(\'aDelete\').href = \'http://'. $local_host_ip .':' . $html_port . '/delete=\' + target.id' . "\n";
2886*cdf0e10cSrcweir        print HTML '        var scrollTop = document.body.scrollTop ? document.body.scrollTop : ';
2887*cdf0e10cSrcweir        print HTML 'document.documentElement.scrollTop;' . "\n";
2888*cdf0e10cSrcweir        print HTML '        var scrollLeft = document.body.scrollLeft ? document.body.scrollLeft : ';
2889*cdf0e10cSrcweir        print HTML 'document.documentElement.scrollLeft;' . "\n";
2890*cdf0e10cSrcweir        print HTML '        _divContext.style.display = \'none\';' . "\n";
2891*cdf0e10cSrcweir        print HTML '        _divContext.style.left = event.clientX + scrollLeft + \'px\';' . "\n";
2892*cdf0e10cSrcweir        print HTML '        _divContext.style.top = event.clientY + scrollTop + \'px\';' . "\n";
2893*cdf0e10cSrcweir        print HTML '        _divContext.style.display = \'block\';' . "\n";
2894*cdf0e10cSrcweir        print HTML '        _replaceContext = false;' . "\n";
2895*cdf0e10cSrcweir        print HTML '        return false;' . "\n";
2896*cdf0e10cSrcweir        print HTML '    }' . "\n";
2897*cdf0e10cSrcweir        print HTML '}' . "\n";
2898*cdf0e10cSrcweir    };
2899*cdf0e10cSrcweir
2900*cdf0e10cSrcweir    print HTML 'function refreshInfoFrames() {        ' . "\n";
2901*cdf0e10cSrcweir    print HTML '    var ModuleNameObj = top.innerFrame.frames[2].document.getElementById("ModuleErrors");' . "\n";
2902*cdf0e10cSrcweir    print HTML '    if (ModuleNameObj != null) {' . "\n";
2903*cdf0e10cSrcweir    print HTML '        var ModuleName = ModuleNameObj.getAttribute(\'name\');' . "\n";
2904*cdf0e10cSrcweir    print HTML '        var ModuleHref = top.innerFrame.frames[0].document.getElementById(ModuleName).getAttribute(\'href\');' . "\n";
2905*cdf0e10cSrcweir    print HTML '         eval(ModuleHref);' . "\n";
2906*cdf0e10cSrcweir    print HTML '    } else if (top.innerFrame.frames[2].document.getElementById("ErroneousModules") != null) {' . "\n";
2907*cdf0e10cSrcweir    print HTML '        var ModuleHref = top.innerFrame.frames[0].document.getElementById("ErroneousModules").getAttribute(\'href\');' . "\n";
2908*cdf0e10cSrcweir    print HTML '        eval(ModuleHref);' . "\n";
2909*cdf0e10cSrcweir    print HTML '        if (top.innerFrame.frames[1].document.getElementById("ModuleJobs") != null) {' . "\n";
2910*cdf0e10cSrcweir    print HTML '            var ModuleName = top.innerFrame.frames[1].document.getElementById("ModuleJobs").getAttribute(\'name\');' . "\n";
2911*cdf0e10cSrcweir    print HTML '            ModuleHref = top.innerFrame.frames[0].document.getElementById(ModuleName).getAttribute(\'href\');' . "\n";
2912*cdf0e10cSrcweir    print HTML '            var HrefString = ModuleHref.toString();' . "\n";
2913*cdf0e10cSrcweir    print HTML '            var RefEntries = HrefString.split(",");' . "\n";
2914*cdf0e10cSrcweir    print HTML '            var RefreshParams = new Array();' . "\n";
2915*cdf0e10cSrcweir    print HTML '            for (i = 0; i < RefEntries.length; i++) {' . "\n";
2916*cdf0e10cSrcweir    print HTML '                RefreshParams[i] = RefEntries[i].substring(RefEntries[i].indexOf("\'") + 1, RefEntries[i].lastIndexOf("\'"));' . "\n";
2917*cdf0e10cSrcweir    print HTML '            };' . "\n";
2918*cdf0e10cSrcweir    print HTML '            FillFrame_1(RefreshParams[0], RefreshParams[1], RefreshParams[2]);' . "\n";
2919*cdf0e10cSrcweir    print HTML '        }' . "\n";
2920*cdf0e10cSrcweir    print HTML '    };' . "\n";
2921*cdf0e10cSrcweir    print HTML '}' . "\n";
2922*cdf0e10cSrcweir    print HTML 'function loadFrame_1() {' . "\n";
2923*cdf0e10cSrcweir    print HTML '    document.write("<h3 align=center>Jobs</h3>");' . "\n";
2924*cdf0e10cSrcweir    print HTML '    document.write("Click on the project of interest");' . "\n";
2925*cdf0e10cSrcweir    print HTML '    document.close();' . "\n";
2926*cdf0e10cSrcweir    print HTML '}' . "\n";
2927*cdf0e10cSrcweir    print HTML 'function loadFrame_2() {' . "\n";
2928*cdf0e10cSrcweir    print HTML '    document.write("<tr bgcolor=lightgrey<td><h3>Errors</h3></pre></td></tr>");' . "\n";
2929*cdf0e10cSrcweir    print HTML '    document.write("Click on the project of interest");' . "\n";
2930*cdf0e10cSrcweir    print HTML '    document.close();' . "\n";
2931*cdf0e10cSrcweir    print HTML '}    function getStatusInnerHTML(Status) {        var StatusInnerHtml;' . "\n";
2932*cdf0e10cSrcweir    print HTML '    if (Status == "success") {' . "\n";
2933*cdf0e10cSrcweir    print HTML '        StatusInnerHtml = "<em style=color:green>";' . "\n";
2934*cdf0e10cSrcweir    print HTML '    } else if (Status == "building") {' . "\n";
2935*cdf0e10cSrcweir    print HTML '        StatusInnerHtml = "<em style=color:blue>";' . "\n";
2936*cdf0e10cSrcweir    print HTML '    } else if (Status == "error") {' . "\n";
2937*cdf0e10cSrcweir    print HTML '        StatusInnerHtml = "<em style=color:red>";' . "\n";
2938*cdf0e10cSrcweir    print HTML '    } else {' . "\n";
2939*cdf0e10cSrcweir    print HTML '        StatusInnerHtml = "<em style=color:gray>";' . "\n";
2940*cdf0e10cSrcweir    print HTML '    };' . "\n";
2941*cdf0e10cSrcweir    print HTML '    StatusInnerHtml += Status + "</em>";' . "\n";
2942*cdf0e10cSrcweir    print HTML '    return StatusInnerHtml;' . "\n";
2943*cdf0e10cSrcweir    print HTML '}    ' . "\n";
2944*cdf0e10cSrcweir    print HTML 'function ShowLog(LogFilePath, ModuleJob) {' . "\n";
2945*cdf0e10cSrcweir    print HTML '    top.innerFrame.frames[2].document.write("<h3 id=ModuleErrors name=\"" + null + "\">Log for " + ModuleJob + "</h3>");' . "\n";
2946*cdf0e10cSrcweir    print HTML '    top.innerFrame.frames[2].document.write("<iframe id=LogFile name=Log src="';
2947*cdf0e10cSrcweir	if (defined $html_path) {
2948*cdf0e10cSrcweir		print HTML 'file://';
2949*cdf0e10cSrcweir	}
2950*cdf0e10cSrcweir	print HTML '+ LogFilePath + " width=100%></iframe>");' . "\n";
2951*cdf0e10cSrcweir    print HTML '    top.innerFrame.frames[2].document.close();' . "\n";
2952*cdf0e10cSrcweir    print HTML '};' . "\n";
2953*cdf0e10cSrcweir    print HTML 'function FillFrame_1(Module, Message1, Message2) {' . "\n";
2954*cdf0e10cSrcweir    print HTML '    var FullUpdate = 1;' . "\n";
2955*cdf0e10cSrcweir    print HTML '    if (top.innerFrame.frames[1].document.getElementById("ModuleJobs") != null) {' . "\n";
2956*cdf0e10cSrcweir    print HTML '        var ModuleName = top.innerFrame.frames[1].document.getElementById("ModuleJobs").getAttribute(\'name\');' . "\n";
2957*cdf0e10cSrcweir    print HTML '        if (Module == ModuleName) FullUpdate = 0;' . "\n";
2958*cdf0e10cSrcweir    print HTML '    }' . "\n";
2959*cdf0e10cSrcweir    print HTML '    if (FullUpdate) {' . "\n";
2960*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("<h3 align=center>Jobs in module " + Module + ":</h3>");' . "\n";
2961*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("<table id=ModuleJobs  name=" + Module + " width=100% bgcolor=white>");' . "\n";
2962*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("    <tr>");' . "\n";
2963*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("        <td width=* align=center><strong style=color:blue>Status</strong></td>");' . "\n";
2964*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("        <td width=* align=center><strong style=color:blue>Job</strong></td>");' . "\n";
2965*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("        <td width=* align=center><strong style=color:blue>Start Time</strong></td>");' . "\n";
2966*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("        <td width=* align=center><strong style=color:blue>Finish Time</strong></td>");' . "\n";
2967*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("        <td width=* align=center><strong style=color:blue>Client</strong></td>");' . "\n" if ($server_mode);
2968*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("    </tr>");' . "\n";
2969*cdf0e10cSrcweir    print HTML '        var dir_info_strings = Message2.split("<br><br>");' . "\n";
2970*cdf0e10cSrcweir    print HTML '        for (i = 0; i < dir_info_strings.length; i++) {' . "\n";
2971*cdf0e10cSrcweir    print HTML '            var dir_info_array = dir_info_strings[i].split("<br>");' . "\n";
2972*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[1].document.write("    <tr status=" + dir_info_array[0] + ">");' . "\n";
2973*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[1].document.write("        <td align=center>");' . "\n";
2974*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[1].document.write(               getStatusInnerHTML(dir_info_array[0]) + "&nbsp");' . "\n";
2975*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[1].document.write("        </td>");' . "\n";
2976*cdf0e10cSrcweir    print HTML '            if (dir_info_array[4] == "@") {' . "\n";
2977*cdf0e10cSrcweir    print HTML '                top.innerFrame.frames[1].document.write("        <td style=white-space:nowrap>" + dir_info_array[1] + "</td>");' . "\n";
2978*cdf0e10cSrcweir    print HTML '            } else {' . "\n";
2979*cdf0e10cSrcweir    print HTML '                top.innerFrame.frames[1].document.write("        <td><a href=\"javascript:top.ShowLog(\'" + dir_info_array[4] + "\', \'" + dir_info_array[1] + "\')\"); title=\"Show Log\">" + dir_info_array[1] + "</a></td>");' . "\n";
2980*cdf0e10cSrcweir    print HTML '            };' . "\n";
2981*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[1].document.write("        <td align=center>" + dir_info_array[2] + "</td>");' . "\n";
2982*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[1].document.write("        <td align=center>" + dir_info_array[3] + "</td>");' . "\n";
2983*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[1].document.write("        <td align=center>" + dir_info_array[5] + "</td>");' . "\n" if ($server_mode);
2984*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[1].document.write("    </tr>");' . "\n";
2985*cdf0e10cSrcweir    print HTML '        };' . "\n";
2986*cdf0e10cSrcweir    print HTML '        top.innerFrame.frames[1].document.write("</table>");' . "\n";
2987*cdf0e10cSrcweir    print HTML '    } else {' . "\n";
2988*cdf0e10cSrcweir    print HTML '        var dir_info_strings = Message2.split("<br><br>");' . "\n";
2989*cdf0e10cSrcweir    print HTML '        var ModuleRows = top.innerFrame.frames[1].document.getElementById("ModuleJobs").rows;' . "\n";
2990*cdf0e10cSrcweir    print HTML '        for (i = 0; i < dir_info_strings.length; i++) {' . "\n";
2991*cdf0e10cSrcweir    print HTML '            var dir_info_array = dir_info_strings[i].split("<br>");' . "\n";
2992*cdf0e10cSrcweir    print HTML '            var OldStatus = ModuleRows[i + 1].getAttribute(\'status\');' . "\n";
2993*cdf0e10cSrcweir    print HTML '            if(dir_info_array[0] != OldStatus) {' . "\n";
2994*cdf0e10cSrcweir    print HTML '                var DirectoryInfos = ModuleRows[i + 1].cells;' . "\n";
2995*cdf0e10cSrcweir    print HTML '                DirectoryInfos[0].innerHTML = getStatusInnerHTML(dir_info_array[0]) + "&nbsp";' . "\n";
2996*cdf0e10cSrcweir    print HTML '                if (dir_info_array[4] != "@") {' . "\n";
2997*cdf0e10cSrcweir    print HTML '                    DirectoryInfos[1].innerHTML = "<a href=\"javascript:top.ShowLog(\'" + dir_info_array[4] + "\', \'" + dir_info_array[1] + "\')\"); title=\"Show Log\">" + dir_info_array[1] + "</a>";' . "\n";
2998*cdf0e10cSrcweir    print HTML '                };' . "\n";
2999*cdf0e10cSrcweir    print HTML '                DirectoryInfos[2].innerHTML = dir_info_array[2];' . "\n";
3000*cdf0e10cSrcweir    print HTML '                DirectoryInfos[3].innerHTML = dir_info_array[3];' . "\n";
3001*cdf0e10cSrcweir    print HTML '                DirectoryInfos[4].innerHTML = dir_info_array[5];' . "\n" if ($server_mode);
3002*cdf0e10cSrcweir    print HTML '            };' . "\n";
3003*cdf0e10cSrcweir    print HTML '        };' . "\n";
3004*cdf0e10cSrcweir    print HTML '    };' . "\n";
3005*cdf0e10cSrcweir    print HTML '    top.innerFrame.frames[1].document.close();' . "\n";
3006*cdf0e10cSrcweir    print HTML '};' . "\n";
3007*cdf0e10cSrcweir    print HTML 'function Error(Module, Message1, Message2) {' . "\n";
3008*cdf0e10cSrcweir    print HTML '    if (Module == \'\') {' . "\n";
3009*cdf0e10cSrcweir    print HTML '        if (Message1 != \'\') {' . "\n";
3010*cdf0e10cSrcweir    print HTML '            var erroneous_modules = Message1.split("<br>");' . "\n";
3011*cdf0e10cSrcweir    print HTML '            var ErrorNumber = erroneous_modules.length;' . "\n";
3012*cdf0e10cSrcweir
3013*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[2].document.write("<h3 id=ErroneousModules errors=" + erroneous_modules.length + ">Modules with errors:</h3>");' . "\n";
3014*cdf0e10cSrcweir    print HTML '            for (i = 0; i < ErrorNumber; i++) {' . "\n";
3015*cdf0e10cSrcweir    print HTML '                var ModuleObj = top.innerFrame.frames[0].document.getElementById(erroneous_modules[i]);' . "\n";
3016*cdf0e10cSrcweir    print HTML '                top.innerFrame.frames[2].document.write("<a href=\"");' . "\n";
3017*cdf0e10cSrcweir    print HTML '                top.innerFrame.frames[2].document.write(ModuleObj.getAttribute(\'href\'));' . "\n";
3018*cdf0e10cSrcweir    print HTML '                top.innerFrame.frames[2].document.write("\"); title=\"");' . "\n";
3019*cdf0e10cSrcweir    print HTML '                top.innerFrame.frames[2].document.write("\">" + erroneous_modules[i] + "</a>&nbsp ");' . "\n";
3020*cdf0e10cSrcweir    print HTML '            };' . "\n";
3021*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[2].document.close();' . "\n";
3022*cdf0e10cSrcweir    print HTML '        };' . "\n";
3023*cdf0e10cSrcweir    print HTML '    } else {' . "\n";
3024*cdf0e10cSrcweir    print HTML '        var ModuleNameObj = top.innerFrame.frames[2].document.getElementById("ModuleErrors");' . "\n";
3025*cdf0e10cSrcweir    print HTML '        var OldErrors = null;' . "\n";
3026*cdf0e10cSrcweir    print HTML '        var ErrorNumber = Message1.split("<br>").length;' . "\n";
3027*cdf0e10cSrcweir    print HTML '        if ((ModuleNameObj != null) && (Module == ModuleNameObj.getAttribute(\'name\')) ) {' . "\n";
3028*cdf0e10cSrcweir    print HTML '            OldErrors = ModuleNameObj.getAttribute(\'errors\');' . "\n";
3029*cdf0e10cSrcweir    print HTML '        }' . "\n";
3030*cdf0e10cSrcweir    print HTML '        if ((OldErrors == null) || (OldErrors != ErrorNumber)) {' . "\n";
3031*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[2].document.write("<h3 id=ModuleErrors errors=" + ErrorNumber + " name=\"" + Module + "\">Errors in module " + Module + ":</h3>");' . "\n";
3032*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[2].document.write(Message1);' . "\n";
3033*cdf0e10cSrcweir    print HTML '            top.innerFrame.frames[2].document.close();' . "\n";
3034*cdf0e10cSrcweir    print HTML '        }' . "\n";
3035*cdf0e10cSrcweir    print HTML '        FillFrame_1(Module, Message1, Message2);' . "\n";
3036*cdf0e10cSrcweir    print HTML '    }' . "\n";
3037*cdf0e10cSrcweir    print HTML '}' . "\n";
3038*cdf0e10cSrcweir    print HTML 'function updateInnerFrame() {' . "\n";
3039*cdf0e10cSrcweir    print HTML '     top.innerFrame.frames[0].document.location.reload();' . "\n";
3040*cdf0e10cSrcweir    print HTML '     refreshInfoFrames();' . "\n";
3041*cdf0e10cSrcweir    print HTML '};' . "\n\n";
3042*cdf0e10cSrcweir
3043*cdf0e10cSrcweir    print HTML 'function setRefreshRate() {' . "\n";
3044*cdf0e10cSrcweir    print HTML '    RefreshRate = document.Formular.rate.value;' . "\n";
3045*cdf0e10cSrcweir    print HTML '    if (!isNaN(RefreshRate * 1)) {' . "\n";
3046*cdf0e10cSrcweir    print HTML '        top.frames[0].clearInterval(IntervalID);' . "\n";
3047*cdf0e10cSrcweir    print HTML '        IntervalID = top.frames[0].setInterval("updateInnerFrame()", RefreshRate * 1000);' . "\n";
3048*cdf0e10cSrcweir    print HTML '    };' . "\n";
3049*cdf0e10cSrcweir    print HTML '};' . "\n";
3050*cdf0e10cSrcweir
3051*cdf0e10cSrcweir    print HTML 'function initFrames() {' . "\n";
3052*cdf0e10cSrcweir    print HTML '    var urlquery = location.href.split("?");' . "\n";
3053*cdf0e10cSrcweir    print HTML '    if (urlquery.length == 1) {' . "\n";
3054*cdf0e10cSrcweir    print HTML '        document.write("<html><head><TITLE id=MainTitle>' . $ENV{INPATH} .'</TITLE>");' . "\n";
3055*cdf0e10cSrcweir    print HTML '        document.write("    <frameset rows=\"12%,88%\">");' . "\n";
3056*cdf0e10cSrcweir    print HTML '        document.write("        <frame name=\"topFrame\" src=\"" + urlquery + "?initTop\"/>");' . "\n";
3057*cdf0e10cSrcweir    print HTML '        document.write("        <frame name=\"innerFrame\" src=\"" + urlquery + "?initInnerPage\"/>");' . "\n";
3058*cdf0e10cSrcweir    print HTML '        document.write("    </frameset>");' . "\n";
3059*cdf0e10cSrcweir    print HTML '        document.write("</head></html>");' . "\n";
3060*cdf0e10cSrcweir    print HTML '    } else if (urlquery[1].substring(0,7) == "initTop") {' . "\n";
3061*cdf0e10cSrcweir    print HTML '        var urlquerycontent = urlquery[1].split("=");' . "\n";
3062*cdf0e10cSrcweir    print HTML '        var UpdateRate = 10' . "\n";
3063*cdf0e10cSrcweir    print HTML '        if (urlquerycontent.length > 2) {' . "\n";
3064*cdf0e10cSrcweir    print HTML '            if (isNaN(urlquerycontent[2] * 1)) {' . "\n";
3065*cdf0e10cSrcweir    print HTML '                alert(urlquerycontent[2] + " is not a number. Ignored.");' . "\n";
3066*cdf0e10cSrcweir    print HTML '            } else {' . "\n";
3067*cdf0e10cSrcweir    print HTML '                UpdateRate = urlquerycontent[2];' . "\n";
3068*cdf0e10cSrcweir    print HTML '            };' . "\n";
3069*cdf0e10cSrcweir    print HTML '        };' . "\n";
3070*cdf0e10cSrcweir    print HTML '        document.write("<html><body>");' . "\n";
3071*cdf0e10cSrcweir    print HTML '        document.write("<h3 align=center>Build process progress status</h3>");' . "\n";
3072*cdf0e10cSrcweir    print HTML '        document.write("<div align=\"right\">");' . "\n";
3073*cdf0e10cSrcweir    print HTML '        document.write("    <table border=\"0\"> <tr>");' . "\n";
3074*cdf0e10cSrcweir    print HTML '        document.write("<td>Refresh rate(sec):</td>");' . "\n";
3075*cdf0e10cSrcweir    print HTML '        document.write("<th>");' . "\n";
3076*cdf0e10cSrcweir    print HTML '        document.write("<FORM name=\"Formular\" onsubmit=\"setRefreshRate()\">");' . "\n";
3077*cdf0e10cSrcweir    print HTML '        document.write("<input type=\"hidden\" name=\"initTop\" value=\"\"/>");' . "\n";
3078*cdf0e10cSrcweir    print HTML '        document.write("<input type=\"text\" id=\"RateValue\" name=\"rate\" autocomplete=\"off\" value=\"" + UpdateRate + "\" size=\"1\"/>");' . "\n";
3079*cdf0e10cSrcweir    print HTML '        document.write("<input type=\"submit\" value=\"OK\">");' . "\n";
3080*cdf0e10cSrcweir    print HTML '        document.write("</FORM>");' . "\n";
3081*cdf0e10cSrcweir    print HTML '        document.write("</th></tr></table>");' . "\n";
3082*cdf0e10cSrcweir    print HTML '        document.write("</div>");' . "\n";
3083*cdf0e10cSrcweir    print HTML '        document.write("    </frameset>");' . "\n";
3084*cdf0e10cSrcweir    print HTML '        document.write("</body></html>");' . "\n";
3085*cdf0e10cSrcweir    print HTML '        top.frames[0].clearInterval(IntervalID);' . "\n";
3086*cdf0e10cSrcweir    print HTML '        IntervalID = top.frames[0].setInterval("updateInnerFrame()", UpdateRate * 1000);' . "\n";
3087*cdf0e10cSrcweir    print HTML '    } else if (urlquery[1] == "initInnerPage") {' . "\n";
3088*cdf0e10cSrcweir    print HTML '        document.write("<html><head>");' . "\n";
3089*cdf0e10cSrcweir    print HTML '        document.write(\'    <frameset rows="80%,20%\">\');' . "\n";
3090*cdf0e10cSrcweir    print HTML '        document.write(\'        <frameset cols="70%,30%">\');' . "\n";
3091*cdf0e10cSrcweir    print HTML '        document.write(\'            <frame src="\');' . "\n";
3092*cdf0e10cSrcweir    print HTML '        document.write(urlquery[0]);' . "\n";
3093*cdf0e10cSrcweir    print HTML '        document.write(\'?initFrame0"/>\');' . "\n";
3094*cdf0e10cSrcweir    print HTML '        document.write(\'            <frame src="\');' . "\n";
3095*cdf0e10cSrcweir    print HTML '        document.write(urlquery[0]);' . "\n";
3096*cdf0e10cSrcweir    print HTML '        document.write(\'?initFrame1"/>\');' . "\n";
3097*cdf0e10cSrcweir    print HTML '        document.write(\'        </frameset>\');' . "\n";
3098*cdf0e10cSrcweir    print HTML '        document.write(\'            <frame src="\');' . "\n";
3099*cdf0e10cSrcweir    print HTML '        document.write(urlquery[0]);' . "\n";
3100*cdf0e10cSrcweir    print HTML '        document.write(\'?initFrame2"  name="infoframe"/>\');' . "\n";
3101*cdf0e10cSrcweir    print HTML '        document.write(\'    </frameset>\');' . "\n";
3102*cdf0e10cSrcweir    print HTML '        document.write("</head></html>");' . "\n";
3103*cdf0e10cSrcweir    print HTML '    } else {' . "\n";
3104*cdf0e10cSrcweir    print HTML '        if (urlquery[1] == "initFrame0" ) {' . "\n";
3105*cdf0e10cSrcweir    print HTML '            loadFrame_0();' . "\n";
3106*cdf0e10cSrcweir    print HTML '        } else if (urlquery[1] == "initFrame1" ) {          ' . "\n";
3107*cdf0e10cSrcweir    print HTML '            loadFrame_1();' . "\n";
3108*cdf0e10cSrcweir    print HTML '        } else if (urlquery[1] == "initFrame2" ) {' . "\n";
3109*cdf0e10cSrcweir    print HTML '            loadFrame_2();' . "\n";
3110*cdf0e10cSrcweir    print HTML '        }' . "\n";
3111*cdf0e10cSrcweir    print HTML '    };' . "\n";
3112*cdf0e10cSrcweir    print HTML '};' . "\n";
3113*cdf0e10cSrcweir    print HTML '</script><noscript>Your browser doesn\'t support JavaScript!</noscript></head></html>' . "\n";
3114*cdf0e10cSrcweir    close HTML;
3115*cdf0e10cSrcweir    rename_file($temp_html_file, $html_file);
3116*cdf0e10cSrcweir};
3117*cdf0e10cSrcweir
3118*cdf0e10cSrcweirsub get_local_time_line {
3119*cdf0e10cSrcweir    my $epoch_time = shift;
3120*cdf0e10cSrcweir    my $local_time_line;
3121*cdf0e10cSrcweir    my @time_array;
3122*cdf0e10cSrcweir    if ($epoch_time) {
3123*cdf0e10cSrcweir        @time_array = localtime($epoch_time);
3124*cdf0e10cSrcweir        $local_time_line = sprintf("%02d:%02d:%02d", $time_array[2], $time_array[1], $time_array[0]);
3125*cdf0e10cSrcweir    } else {
3126*cdf0e10cSrcweir        $local_time_line = '-';
3127*cdf0e10cSrcweir    };
3128*cdf0e10cSrcweir    return $local_time_line;
3129*cdf0e10cSrcweir};
3130*cdf0e10cSrcweir
3131*cdf0e10cSrcweirsub get_dirs_info_line {
3132*cdf0e10cSrcweir    my $job = shift;
3133*cdf0e10cSrcweir    my $dirs_info_line = $jobs_hash{$job}->{STATUS} . '<br>';
3134*cdf0e10cSrcweir    my @time_array;
3135*cdf0e10cSrcweir    my $log_path_string;
3136*cdf0e10cSrcweir    $dirs_info_line .= $jobs_hash{$job}->{SHORT_NAME} . '<br>';
3137*cdf0e10cSrcweir    $dirs_info_line .= get_local_time_line($jobs_hash{$job}->{START_TIME}) . '<br>';
3138*cdf0e10cSrcweir    $dirs_info_line .= get_local_time_line($jobs_hash{$job}->{FINISH_TIME}) . '<br>';
3139*cdf0e10cSrcweir    if ($jobs_hash{$job}->{STATUS} eq 'waiting' || (!-f $jobs_hash{$job}->{LONG_LOG_PATH})) {
3140*cdf0e10cSrcweir        $dirs_info_line .= '@';
3141*cdf0e10cSrcweir    } else {
3142*cdf0e10cSrcweir        if (defined $html_path) {
3143*cdf0e10cSrcweir            $log_path_string = $jobs_hash{$job}->{LONG_LOG_PATH};
3144*cdf0e10cSrcweir        } else {
3145*cdf0e10cSrcweir            $log_path_string = $jobs_hash{$job}->{LOG_PATH};
3146*cdf0e10cSrcweir        };
3147*cdf0e10cSrcweir        $log_path_string =~ s/\\/\//g;
3148*cdf0e10cSrcweir        $dirs_info_line .= $log_path_string;
3149*cdf0e10cSrcweir    };
3150*cdf0e10cSrcweir    $dirs_info_line .= '<br>';
3151*cdf0e10cSrcweir    $dirs_info_line .= $jobs_hash{$job}->{CLIENT} . '<br>' if ($server_mode);
3152*cdf0e10cSrcweir    return $dirs_info_line;
3153*cdf0e10cSrcweir};
3154*cdf0e10cSrcweir
3155*cdf0e10cSrcweirsub get_html_info {
3156*cdf0e10cSrcweir    my $module = shift;
3157*cdf0e10cSrcweir    my $module_info_hash = $html_info{$module};
3158*cdf0e10cSrcweir    my $dirs = $$module_info_hash{DIRS};
3159*cdf0e10cSrcweir    my $dirs_number = scalar @$dirs;
3160*cdf0e10cSrcweir    my $dirs_info_line = '\'';
3161*cdf0e10cSrcweir    if ($dirs_number) {
3162*cdf0e10cSrcweir        my %dirs_sorted_by_order = ();
3163*cdf0e10cSrcweir        foreach (@$dirs) {
3164*cdf0e10cSrcweir            $dirs_sorted_by_order{$jobs_hash{$_}->{BUILD_NUMBER}} = $_;
3165*cdf0e10cSrcweir        }
3166*cdf0e10cSrcweir        foreach (sort {$a <=> $b} keys %dirs_sorted_by_order) {
3167*cdf0e10cSrcweir            $dirs_info_line .= get_dirs_info_line($dirs_sorted_by_order{$_}) . '<br>';
3168*cdf0e10cSrcweir        }
3169*cdf0e10cSrcweir    } else {
3170*cdf0e10cSrcweir        return(undef, undef, 0, 0, 0, '-');
3171*cdf0e10cSrcweir#        $dirs_info_line .= 'No information available yet';
3172*cdf0e10cSrcweir    };
3173*cdf0e10cSrcweir    $dirs_info_line =~ s/(<br>)*$//o;
3174*cdf0e10cSrcweir    $dirs_info_line .= '\'';
3175*cdf0e10cSrcweir    $dirs = $$module_info_hash{SUCCESSFUL};
3176*cdf0e10cSrcweir    my $successful_number = scalar @$dirs;
3177*cdf0e10cSrcweir    $dirs = $$module_info_hash{ERRORFUL};
3178*cdf0e10cSrcweir    my $errorful_number = scalar @$dirs;
3179*cdf0e10cSrcweir    my $errors_info_line = '\'';
3180*cdf0e10cSrcweir    if ($errorful_number) {
3181*cdf0e10cSrcweir        $errors_info_line .= $_ . '<br>' foreach (@$dirs);
3182*cdf0e10cSrcweir    } else {
3183*cdf0e10cSrcweir        $errors_info_line .= 'No errors';
3184*cdf0e10cSrcweir    };
3185*cdf0e10cSrcweir    $errors_info_line .= '\'';
3186*cdf0e10cSrcweir#    if (defined $full_info) {
3187*cdf0e10cSrcweir    my $time_line = get_time_line($$module_info_hash{BUILD_TIME});
3188*cdf0e10cSrcweir        my ($successes_percent, $errors_percent) = get_progress_percentage($dirs_number - 1, $successful_number - 1, $errorful_number);
3189*cdf0e10cSrcweir        return($errors_info_line, $dirs_info_line, $errorful_number, $successes_percent, $errors_percent, $time_line);
3190*cdf0e10cSrcweir#    } else {
3191*cdf0e10cSrcweir#        return($errors_info_line, $dirs_info_line, $errorful_number);
3192*cdf0e10cSrcweir#    };
3193*cdf0e10cSrcweir};
3194*cdf0e10cSrcweir
3195*cdf0e10cSrcweirsub get_time_line {
3196*cdf0e10cSrcweir    use integer;
3197*cdf0e10cSrcweir    my $seconds = shift;
3198*cdf0e10cSrcweir    my $hours = $seconds/3600;
3199*cdf0e10cSrcweir    my $minits = ($seconds/60)%60;
3200*cdf0e10cSrcweir    $seconds -= ($hours*3600 + $minits*60);
3201*cdf0e10cSrcweir    return(sprintf("%02d\:%02d\:%02d" , $hours, $minits, $seconds));
3202*cdf0e10cSrcweir};
3203*cdf0e10cSrcweir
3204*cdf0e10cSrcweirsub get_progress_percentage {
3205*cdf0e10cSrcweir    use integer;
3206*cdf0e10cSrcweir    my ($dirs_number, $successful_number, $errorful_number) = @_;
3207*cdf0e10cSrcweir    return (0 ,0) if (!$dirs_number);
3208*cdf0e10cSrcweir    my $errors_percent = ($errorful_number * 100)/ $dirs_number;
3209*cdf0e10cSrcweir    my $successes_percent;
3210*cdf0e10cSrcweir    if ($dirs_number == ($successful_number + $errorful_number)) {
3211*cdf0e10cSrcweir        $successes_percent = 100 - $errors_percent;
3212*cdf0e10cSrcweir    } else {
3213*cdf0e10cSrcweir        $successes_percent = ($successful_number * 100)/ $dirs_number;
3214*cdf0e10cSrcweir    };
3215*cdf0e10cSrcweir    return ($successes_percent, $errors_percent);
3216*cdf0e10cSrcweir};
3217*cdf0e10cSrcweir
3218*cdf0e10cSrcweir#
3219*cdf0e10cSrcweir# This procedure stores the dmake result in %html_info
3220*cdf0e10cSrcweir#
3221*cdf0e10cSrcweirsub html_store_job_info {
3222*cdf0e10cSrcweir    return if (!$html);
3223*cdf0e10cSrcweir    my ($deps_hash, $build_dir, $error_code) = @_;
3224*cdf0e10cSrcweir    my $force_update = 0;
3225*cdf0e10cSrcweir    if ($build_dir =~ /(\s)/o && (defined $error_code)) {
3226*cdf0e10cSrcweir        $force_update++ if (!children_number());
3227*cdf0e10cSrcweir    }
3228*cdf0e10cSrcweir    my $module = $module_by_hash{$deps_hash};
3229*cdf0e10cSrcweir    my $module_info_hash = $html_info{$module};
3230*cdf0e10cSrcweir    my $dmake_array;
3231*cdf0e10cSrcweir    if (defined $error_code) {
3232*cdf0e10cSrcweir        $jobs_hash{$build_dir}->{FINISH_TIME} = time();
3233*cdf0e10cSrcweir        $$module_info_hash{BUILD_TIME} += $jobs_hash{$build_dir}->{FINISH_TIME} - $jobs_hash{$build_dir}->{START_TIME};
3234*cdf0e10cSrcweir        if ($error_code) {
3235*cdf0e10cSrcweir            $jobs_hash{$build_dir}->{STATUS} = 'error';
3236*cdf0e10cSrcweir            $dmake_array = $$module_info_hash{ERRORFUL};
3237*cdf0e10cSrcweir            $build_dir =~ s/\\/\//g;
3238*cdf0e10cSrcweir            $modules_with_errors{$module}++;
3239*cdf0e10cSrcweir        } else {
3240*cdf0e10cSrcweir            if ($build_dir =~ /(\s)announce/o) {
3241*cdf0e10cSrcweir                $jobs_hash{$build_dir}->{STATUS} = '-';
3242*cdf0e10cSrcweir            } else {
3243*cdf0e10cSrcweir                $jobs_hash{$build_dir}->{STATUS} = 'success';
3244*cdf0e10cSrcweir            };
3245*cdf0e10cSrcweir            $dmake_array = $$module_info_hash{SUCCESSFUL};
3246*cdf0e10cSrcweir        };
3247*cdf0e10cSrcweir        push (@$dmake_array, $build_dir);
3248*cdf0e10cSrcweir    };
3249*cdf0e10cSrcweir};
3250*cdf0e10cSrcweir
3251*cdf0e10cSrcweirsub start_server_on_port {
3252*cdf0e10cSrcweir    my $port = shift;
3253*cdf0e10cSrcweir    my $socket_obj = shift;
3254*cdf0e10cSrcweir    $client_timeout = 1 if (!$parent_process);
3255*cdf0e10cSrcweir    if ($ENV{GUI} eq 'WNT') {
3256*cdf0e10cSrcweir        $$socket_obj = new IO::Socket::INET (#LocalAddr => hostname(),
3257*cdf0e10cSrcweir                                  LocalPort => $port,
3258*cdf0e10cSrcweir                                  Proto     => 'tcp',
3259*cdf0e10cSrcweir                                  Listen    => 100); # 100 clients can be on queue, I think it is enough
3260*cdf0e10cSrcweir    } else {
3261*cdf0e10cSrcweir        $$socket_obj = new IO::Socket::INET (#LocalAddr => hostname(),
3262*cdf0e10cSrcweir                                  LocalPort => $port,
3263*cdf0e10cSrcweir                                  Proto     => 'tcp',
3264*cdf0e10cSrcweir                                  ReuseAddr     => 1,
3265*cdf0e10cSrcweir                                  Listen    => 100); # 100 clients can be on queue, I think it is enough
3266*cdf0e10cSrcweir    };
3267*cdf0e10cSrcweir    return('Cannot create socket object') if (!defined $$socket_obj);
3268*cdf0e10cSrcweir    my $timeout = $$socket_obj->timeout($client_timeout);
3269*cdf0e10cSrcweir    $$socket_obj->autoflush(1);
3270*cdf0e10cSrcweir    if ($parent_process && $debug) {
3271*cdf0e10cSrcweir        print "SERVER started on port $port\n";
3272*cdf0e10cSrcweir    } else {
3273*cdf0e10cSrcweir        print "html_port:$html_port html_socket_obj: $html_socket_obj\n";
3274*cdf0e10cSrcweir    };
3275*cdf0e10cSrcweir    return 0;
3276*cdf0e10cSrcweir};
3277*cdf0e10cSrcweir
3278*cdf0e10cSrcweirsub accept_html_connection {
3279*cdf0e10cSrcweir    my $new_socket_obj = undef;
3280*cdf0e10cSrcweir    $new_socket_obj = $html_socket_obj->accept();
3281*cdf0e10cSrcweir    return $new_socket_obj;
3282*cdf0e10cSrcweir};
3283*cdf0e10cSrcweir
3284*cdf0e10cSrcweirsub accept_connection {
3285*cdf0e10cSrcweir    my $new_socket_obj = undef;
3286*cdf0e10cSrcweir    do {
3287*cdf0e10cSrcweir        $new_socket_obj = $server_socket_obj->accept();
3288*cdf0e10cSrcweir        if (!$new_socket_obj) {
3289*cdf0e10cSrcweir            print "Timeout on incoming connection\n";
3290*cdf0e10cSrcweir            check_client_jobs();
3291*cdf0e10cSrcweir        };
3292*cdf0e10cSrcweir    } while (!$new_socket_obj);
3293*cdf0e10cSrcweir    return $new_socket_obj;
3294*cdf0e10cSrcweir};
3295*cdf0e10cSrcweir
3296*cdf0e10cSrcweirsub check_client_jobs {
3297*cdf0e10cSrcweir    foreach (keys %clients_times) {
3298*cdf0e10cSrcweir        if (time - $clients_times{$_} > $client_timeout) {
3299*cdf0e10cSrcweir            print "Client's $_ Job: \"$clients_jobs{$_}\" apparently got lost...\n";
3300*cdf0e10cSrcweir            print "Scheduling for rebuild...\n";
3301*cdf0e10cSrcweir            print "You might need to check the $_\n";
3302*cdf0e10cSrcweir            $lost_client_jobs{$clients_jobs{$_}}++;
3303*cdf0e10cSrcweir            delete $processes_hash{$_};
3304*cdf0e10cSrcweir            delete $clients_jobs{$_};
3305*cdf0e10cSrcweir            delete $clients_times{$_};
3306*cdf0e10cSrcweir#        } else {
3307*cdf0e10cSrcweir#            print time - $clients_times{$_} . "\n";
3308*cdf0e10cSrcweir        };
3309*cdf0e10cSrcweir    };
3310*cdf0e10cSrcweir};
3311*cdf0e10cSrcweir
3312*cdf0e10cSrcweirsub get_server_ports {
3313*cdf0e10cSrcweir    # use port 7890 as default
3314*cdf0e10cSrcweir    my $default_port = 7890;
3315*cdf0e10cSrcweir    if ($ports_string) {
3316*cdf0e10cSrcweir        @server_ports = split( /:/, $ports_string);
3317*cdf0e10cSrcweir    } else {
3318*cdf0e10cSrcweir        @server_ports = ($default_port .. $default_port + 4);
3319*cdf0e10cSrcweir    };
3320*cdf0e10cSrcweir};
3321*cdf0e10cSrcweir
3322*cdf0e10cSrcweirsub run_server {
3323*cdf0e10cSrcweir    my @build_queue = ();        # array, containing queue of projects
3324*cdf0e10cSrcweir                                # to build
3325*cdf0e10cSrcweir    my $error = 0;
3326*cdf0e10cSrcweir    if (scalar @server_ports) {
3327*cdf0e10cSrcweir        foreach (@server_ports) {
3328*cdf0e10cSrcweir            $error = start_server_on_port($_, \$server_socket_obj);
3329*cdf0e10cSrcweir            if ($error) {
3330*cdf0e10cSrcweir                print STDERR "port $_: $error\n";
3331*cdf0e10cSrcweir            } else {
3332*cdf0e10cSrcweir#                $SIG{KILL} = \&stop_server;
3333*cdf0e10cSrcweir#                $SIG{INT} = \&stop_server;
3334*cdf0e10cSrcweir#                $SIG{TERM} = \&stop_server;
3335*cdf0e10cSrcweir#                $SIG{QUIT} = \&stop_server;
3336*cdf0e10cSrcweir                last;
3337*cdf0e10cSrcweir            };
3338*cdf0e10cSrcweir        };
3339*cdf0e10cSrcweir        print_error('Unable to start server on port(s): ' . "@server_ports\n") if ($error);
3340*cdf0e10cSrcweir    } else {
3341*cdf0e10cSrcweir        print_error('No ports for server to start');
3342*cdf0e10cSrcweir    };
3343*cdf0e10cSrcweir
3344*cdf0e10cSrcweir    my $client_addr;
3345*cdf0e10cSrcweir    my $job_string_base = get_job_string_base();
3346*cdf0e10cSrcweir    my $new_socket_obj;
3347*cdf0e10cSrcweir     while ($new_socket_obj = accept_connection()) {
3348*cdf0e10cSrcweir        check_client_jobs();
3349*cdf0e10cSrcweir    	# find out who connected
3350*cdf0e10cSrcweir    	my $client_ipnum = $new_socket_obj->peerhost();
3351*cdf0e10cSrcweir        my $client_host = gethostbyaddr(inet_aton($client_ipnum), AF_INET);
3352*cdf0e10cSrcweir    	# print who is connected
3353*cdf0e10cSrcweir    	# send them a message, close connection
3354*cdf0e10cSrcweir        my $client_message = <$new_socket_obj>;
3355*cdf0e10cSrcweir        chomp $client_message;
3356*cdf0e10cSrcweir        my @client_data = split(/ /, $client_message);
3357*cdf0e10cSrcweir        my %client_hash = ();
3358*cdf0e10cSrcweir        foreach (@client_data) {
3359*cdf0e10cSrcweir            /(=)/;
3360*cdf0e10cSrcweir            $client_hash{$`} = $';
3361*cdf0e10cSrcweir        }
3362*cdf0e10cSrcweir        my $pid = $client_hash{pid} . '@' . $client_host;
3363*cdf0e10cSrcweir        if (defined $client_hash{platform}) {
3364*cdf0e10cSrcweir            if ($client_hash{platform} ne $ENV{OUTPATH} || (defined $client_hash{osname} && ($^O ne $client_hash{osname}))) {
3365*cdf0e10cSrcweir                print $new_socket_obj "Wrong platform";
3366*cdf0e10cSrcweir                close($new_socket_obj);
3367*cdf0e10cSrcweir                next;
3368*cdf0e10cSrcweir            };
3369*cdf0e10cSrcweir        } else {
3370*cdf0e10cSrcweir            if ($client_hash{result} eq "0") {
3371*cdf0e10cSrcweir#                print "$clients_jobs{$pid} succedded on $pid\n";
3372*cdf0e10cSrcweir            } else {
3373*cdf0e10cSrcweir                print "Error $client_hash{result}\n";
3374*cdf0e10cSrcweir                if (store_error($pid, $client_hash{result})) {
3375*cdf0e10cSrcweir                    print $new_socket_obj $job_string_base . $clients_jobs{$pid};
3376*cdf0e10cSrcweir                    close($new_socket_obj);
3377*cdf0e10cSrcweir                    $clients_times{$pid} = time;
3378*cdf0e10cSrcweir                    next;
3379*cdf0e10cSrcweir                };
3380*cdf0e10cSrcweir            };
3381*cdf0e10cSrcweir            delete $clients_times{$pid};
3382*cdf0e10cSrcweir            clear_from_child($pid);
3383*cdf0e10cSrcweir            delete $clients_jobs{$pid};
3384*cdf0e10cSrcweir            $verbose_mode && print 'Running processes: ', children_number(), "\n";
3385*cdf0e10cSrcweir            # Actually, next 3 strings are only for even distribution
3386*cdf0e10cSrcweir            # of clients if there are more than one build server running
3387*cdf0e10cSrcweir    	    print $new_socket_obj 'No job';
3388*cdf0e10cSrcweir            close($new_socket_obj);
3389*cdf0e10cSrcweir            next;
3390*cdf0e10cSrcweir        };
3391*cdf0e10cSrcweir        my $job_string;
3392*cdf0e10cSrcweir        my @lost_jobs = keys %lost_client_jobs;
3393*cdf0e10cSrcweir        if (scalar @lost_jobs) {
3394*cdf0e10cSrcweir            $job_string = $lost_jobs[0];
3395*cdf0e10cSrcweir            delete $lost_client_jobs{$lost_jobs[0]};
3396*cdf0e10cSrcweir        } else {
3397*cdf0e10cSrcweir#            $job_string = get_job_string(\@build_queue, $pid);
3398*cdf0e10cSrcweir            $job_string = get_job_string(\@build_queue);
3399*cdf0e10cSrcweir        };
3400*cdf0e10cSrcweir        if ($job_string) {
3401*cdf0e10cSrcweir            my $job_dir = $job_jobdir{$job_string};
3402*cdf0e10cSrcweir            $processes_hash{$pid} = $job_dir;
3403*cdf0e10cSrcweir            $jobs_hash{$job_dir}->{CLIENT} = $pid;
3404*cdf0e10cSrcweir            print "$pid got $job_dir\n";
3405*cdf0e10cSrcweir    	    print $new_socket_obj $job_string_base . $job_string;
3406*cdf0e10cSrcweir            $clients_jobs{$pid} = $job_string;
3407*cdf0e10cSrcweir            $clients_times{$pid} = time;
3408*cdf0e10cSrcweir            my $children_running = children_number();
3409*cdf0e10cSrcweir            $verbose_mode && print 'Running processes: ', $children_running, "\n";
3410*cdf0e10cSrcweir            $maximal_processes = $children_running if ($children_running > $maximal_processes);
3411*cdf0e10cSrcweir        } else {
3412*cdf0e10cSrcweir    	    print $new_socket_obj 'No job';
3413*cdf0e10cSrcweir        };
3414*cdf0e10cSrcweir        close($new_socket_obj);
3415*cdf0e10cSrcweir    };
3416*cdf0e10cSrcweir};
3417*cdf0e10cSrcweir
3418*cdf0e10cSrcweir#
3419*cdf0e10cSrcweir# Procedure returns the part of the job string that is similar for all clients
3420*cdf0e10cSrcweir#
3421*cdf0e10cSrcweirsub get_job_string_base {
3422*cdf0e10cSrcweir    if ($setenv_string) {
3423*cdf0e10cSrcweir        return "setenv_string=$setenv_string ";
3424*cdf0e10cSrcweir    };
3425*cdf0e10cSrcweir	my $job_string_base = "server_pid=$$ setsolar_cmd=$ENV{SETSOLAR_CMD} ";
3426*cdf0e10cSrcweir    $job_string_base .= "source_root=$ENV{SOURCE_ROOT} " if (defined $ENV{SOURCE_ROOT});
3427*cdf0e10cSrcweir    $job_string_base .= "updater=$ENV{UPDATER} " if (defined $ENV{UPDATER});
3428*cdf0e10cSrcweir    return $job_string_base;
3429*cdf0e10cSrcweir};
3430*cdf0e10cSrcweir
3431*cdf0e10cSrcweirsub get_job_string {
3432*cdf0e10cSrcweir    my $build_queue = shift;
3433*cdf0e10cSrcweir	my $job = $dmake;
3434*cdf0e10cSrcweir    my ($job_dir, $dependencies_hash);
3435*cdf0e10cSrcweir    if ($build_all_parents) {
3436*cdf0e10cSrcweir        fill_modules_queue($build_queue);
3437*cdf0e10cSrcweir        do {
3438*cdf0e10cSrcweir            ($job_dir, $dependencies_hash) = pick_jobdir($build_queue);
3439*cdf0e10cSrcweir            return '' if (!$job_dir);
3440*cdf0e10cSrcweir            $jobs_hash{$job_dir}->{START_TIME} = time();
3441*cdf0e10cSrcweir            $jobs_hash{$job_dir}->{STATUS} = 'building';
3442*cdf0e10cSrcweir            if ($job_dir =~ /(\s)$pre_job/o) {
3443*cdf0e10cSrcweir                do_custom_job($job_dir, $dependencies_hash);
3444*cdf0e10cSrcweir                $job_dir = '';
3445*cdf0e10cSrcweir            };
3446*cdf0e10cSrcweir        } while (!$job_dir);
3447*cdf0e10cSrcweir    } else {
3448*cdf0e10cSrcweir        $dependencies_hash = \%local_deps_hash;
3449*cdf0e10cSrcweir        do {
3450*cdf0e10cSrcweir            $job_dir = pick_prj_to_build(\%local_deps_hash);
3451*cdf0e10cSrcweir            if (!$job_dir && !children_number()) {
3452*cdf0e10cSrcweir                cancel_build() if (scalar keys %broken_build);
3453*cdf0e10cSrcweir                mp_success_exit();
3454*cdf0e10cSrcweir            };
3455*cdf0e10cSrcweir            return '' if (!$job_dir);
3456*cdf0e10cSrcweir            $jobs_hash{$job_dir}->{START_TIME} = time();
3457*cdf0e10cSrcweir            $jobs_hash{$job_dir}->{STATUS} = 'building';
3458*cdf0e10cSrcweir            if ($job_dir =~ /(\s)$pre_job/o) {
3459*cdf0e10cSrcweir#                if ($' eq $pre_job) {
3460*cdf0e10cSrcweir                    do_custom_job($job_dir, $dependencies_hash);
3461*cdf0e10cSrcweir                    $job_dir = '';
3462*cdf0e10cSrcweir#                }
3463*cdf0e10cSrcweir            };
3464*cdf0e10cSrcweir        } while (!$job_dir);
3465*cdf0e10cSrcweir    };
3466*cdf0e10cSrcweir    $running_children{$dependencies_hash}++;
3467*cdf0e10cSrcweir    $folders_hashes{$job_dir} = $dependencies_hash;
3468*cdf0e10cSrcweir    my $log_file = $jobs_hash{$job_dir}->{LONG_LOG_PATH};
3469*cdf0e10cSrcweir    my $full_job_dir = $job_dir;
3470*cdf0e10cSrcweir    if ($job_dir =~ /(\s)/o) {
3471*cdf0e10cSrcweir        $job = $';
3472*cdf0e10cSrcweir        $job = $deliver_command if ($job eq $post_job);
3473*cdf0e10cSrcweir        $full_job_dir = $module_paths{$`};
3474*cdf0e10cSrcweir    }
3475*cdf0e10cSrcweir    my $log_dir = File::Basename::dirname($log_file);
3476*cdf0e10cSrcweir    if (!-d $log_dir) {
3477*cdf0e10cSrcweir        chdir $full_job_dir;
3478*cdf0e10cSrcweir        getcwd();
3479*cdf0e10cSrcweir        system("$perl $mkout");
3480*cdf0e10cSrcweir    };
3481*cdf0e10cSrcweir    my $job_string = "job_dir=$full_job_dir job=$job log=$log_file";
3482*cdf0e10cSrcweir    $job_jobdir{$job_string} = $job_dir;
3483*cdf0e10cSrcweir    return $job_string;
3484*cdf0e10cSrcweir};
3485*cdf0e10cSrcweir
3486*cdf0e10cSrcweirsub pick_jobdir {
3487*cdf0e10cSrcweir    my $build_queue = shift;
3488*cdf0e10cSrcweir    my $i = 0;
3489*cdf0e10cSrcweir    foreach (@$build_queue) {
3490*cdf0e10cSrcweir        my $prj = $$build_queue[$i];
3491*cdf0e10cSrcweir        my $prj_deps_hash = $projects_deps_hash{$prj};
3492*cdf0e10cSrcweir        if (defined $modules_with_errors{$prj_deps_hash} && !$ignore) {
3493*cdf0e10cSrcweir            push (@broken_module_names, $prj);
3494*cdf0e10cSrcweir            splice (@$build_queue, $i, 1);
3495*cdf0e10cSrcweir            next;
3496*cdf0e10cSrcweir        };
3497*cdf0e10cSrcweir        $running_children{$prj_deps_hash} = 0 if (!defined $running_children{$prj_deps_hash});
3498*cdf0e10cSrcweir        my $child_nick = pick_prj_to_build($prj_deps_hash);
3499*cdf0e10cSrcweir        if ($child_nick) {
3500*cdf0e10cSrcweir            return ($child_nick, $prj_deps_hash);
3501*cdf0e10cSrcweir        }
3502*cdf0e10cSrcweir        if ((!scalar keys %$prj_deps_hash) && !$running_children{$prj_deps_hash}) {
3503*cdf0e10cSrcweir            if (!defined $modules_with_errors{$prj_deps_hash} || $ignore)
3504*cdf0e10cSrcweir            {
3505*cdf0e10cSrcweir                remove_from_dependencies($prj, \%global_deps_hash);
3506*cdf0e10cSrcweir                $build_is_finished{$prj}++;
3507*cdf0e10cSrcweir                splice (@$build_queue, $i, 1);
3508*cdf0e10cSrcweir                next;
3509*cdf0e10cSrcweir            };
3510*cdf0e10cSrcweir        };
3511*cdf0e10cSrcweir        $i++;
3512*cdf0e10cSrcweir    };
3513*cdf0e10cSrcweir};
3514*cdf0e10cSrcweir
3515*cdf0e10cSrcweirsub fill_modules_queue {
3516*cdf0e10cSrcweir    my $build_queue = shift;
3517*cdf0e10cSrcweir    my $prj;
3518*cdf0e10cSrcweir    while ($prj = pick_prj_to_build(\%global_deps_hash)) {
3519*cdf0e10cSrcweir        push @$build_queue, $prj;
3520*cdf0e10cSrcweir        $projects_deps_hash{$prj} = {};
3521*cdf0e10cSrcweir        get_module_dep_hash($prj, $projects_deps_hash{$prj});
3522*cdf0e10cSrcweir        my $info_hash = $html_info{$prj};
3523*cdf0e10cSrcweir        $$info_hash{DIRS} = check_deps_hash($projects_deps_hash{$prj}, $prj);
3524*cdf0e10cSrcweir        $module_by_hash{$projects_deps_hash{$prj}} = $prj;
3525*cdf0e10cSrcweir    };
3526*cdf0e10cSrcweir    if (!$prj && !children_number() && (!scalar @$build_queue)) {
3527*cdf0e10cSrcweir        cancel_build() if (scalar keys %broken_build);
3528*cdf0e10cSrcweir        mp_success_exit();
3529*cdf0e10cSrcweir    };
3530*cdf0e10cSrcweir};
3531*cdf0e10cSrcweir
3532*cdf0e10cSrcweirsub is_gnumake_module {
3533*cdf0e10cSrcweir    my $module = shift;
3534*cdf0e10cSrcweir    my $bridgemakefile = $source_config->get_module_path($module) . "/prj/makefile.mk";
3535*cdf0e10cSrcweir    return (-e $bridgemakefile);
3536*cdf0e10cSrcweir}
3537*cdf0e10cSrcweir
3538*cdf0e10cSrcweirsub check_partial_gnumake_build {
3539*cdf0e10cSrcweir    if(!$build_all_parents && is_gnumake_module(shift)) {
3540*cdf0e10cSrcweir        print "This module has been migrated to GNU make.\n";
3541*cdf0e10cSrcweir        print "You can only use build --all/--since here with build.pl.\n";
3542*cdf0e10cSrcweir        print "To do the equivalent of 'build && deliver' call:\n";
3543*cdf0e10cSrcweir        print "\tmake -sr\n";
3544*cdf0e10cSrcweir        print "in the module root (This will modify the solver).\n";
3545*cdf0e10cSrcweir        exit 1;
3546*cdf0e10cSrcweir    }
3547*cdf0e10cSrcweir}
3548