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