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