solenv/bin/build.pl

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