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