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