[Libreoffice-commits] .: bootstrap.1 set_soenv.in solenv/bin

Norbert Thiebaud nthiebaud at kemper.freedesktop.org
Wed Aug 10 18:48:18 PDT 2011


 bootstrap.1                |    2 
 set_soenv.in               |    4 
 solenv/bin/build.pl        |  290 -----------------------------
 solenv/bin/build_client.pl |  436 ---------------------------------------------
 4 files changed, 6 insertions(+), 726 deletions(-)

New commits:
commit da1681af3a32ba7d0d6406dcc4ddfc1c5e56d914
Author: Jordan Ayers <jordan.ayers at gmail.com>
Date:   Wed Aug 10 08:17:55 2011 -0500

    Remove --server mode and supporting code from build.pl.

diff --git a/bootstrap.1 b/bootstrap.1
index 069b995..19a9d1e 100755
--- a/bootstrap.1
+++ b/bootstrap.1
@@ -11,7 +11,6 @@ fi
 unalias mkout
 unalias deliver
 unalias build
-unalias build_client
 unalias zipdep
 
 # executables are *.exe for WNT. This variable is necessary since Cygwin 1.5.x
@@ -71,7 +70,6 @@ fi
 #make sure build.pl is executable 
 
 chmod +x "$SRC_ROOT/solenv/bin/build.pl"
-chmod +x "$SRC_ROOT/solenv/bin/build_client.pl"
 chmod +x "$SRC_ROOT/solenv/bin/zipdep.pl"
 chmod +x "$SRC_ROOT/solenv/bin/gccinstlib.pl"
 
diff --git a/set_soenv.in b/set_soenv.in
index e12f64a..1227ef4 100755
--- a/set_soenv.in
+++ b/set_soenv.in
@@ -89,7 +89,7 @@ my ( $oldPATH, $SRC_ROOT, $SO_HOME, $JAVA_HOME, $JDK, $JAVAFLAGS, $OOO_SHELL,
 # IId. Declaring the aliases.
 #-------------------------------------------
 #
-my ( $dmake, $build, $build_client, $mkout, $deliver, $zipdep );
+my ( $dmake, $build, $mkout, $deliver, $zipdep );
 #
 
 #-------------------------------------------------------------
@@ -1455,7 +1455,6 @@ else
 	$mkout           = '"perl $SOLARENV/bin/mkout.pl"';
 	$deliver         = '"perl $SOLARENV/bin/deliver.pl"';
 	$build           = '"perl $SOLARENV/bin/build.pl"';
-	$build_client    = '"perl $SOLARENV/bin/build_client.pl"';
 	$zipdep          = '"perl $SOLARENV/bin/zipdep.pl"';
 
 #
@@ -2107,7 +2106,6 @@ ToFile( "Don't set aliases when bootstrapping", $empty, "c" );
 ToFile( "alias mkout",       $mkout,             "a" );
 ToFile( "alias deliver",     $deliver,           "a" );
 ToFile( "alias build",       $build,             "a" );
-ToFile( "alias build_client",$build_client,      "a" );
 ToFile( "alias zipdep",      $zipdep,            "a" );
 
 # on Solaris, MacOSX and FreeBSD, set GNUCOPY and GNUPATCH
diff --git a/solenv/bin/build.pl b/solenv/bin/build.pl
index 9c6bc3c..9c710fe 100755
--- a/solenv/bin/build.pl
+++ b/solenv/bin/build.pl
@@ -158,20 +158,12 @@
     my $stop_build_on_error = 0; # for multiprocessing mode: do not build further module if there is an error
     my $interactive = 0; # for interactive mode... (for testing purpose enabled by default)
     my $parent_process = 1;
-    my $server_mode = 0;
-    my $setenv_string = ''; # string for configuration of the client environment
-    my $ports_string = ''; # string with possible ports for server
     my @server_ports = ();
     my $html_port = 0;
-    my $server_socket_obj = undef; # socket object for server
     my $html_socket_obj = undef; # socket object for server
-    my %clients_jobs = ();
-    my %clients_times = ();
     my $client_timeout = 0; # time for client to build (in sec)...
                             # The longest time period after that
                             # the server considered as an error/client crash
-    my %lost_client_jobs = (); # hash containing lost jobs
-    my %job_jobdir = (); # hash containing job-dir pairs
     my $reschedule_queue = 0;
     my %module_build_queue = ();
     my %reversed_dependencies = ();
@@ -654,9 +646,6 @@ sub build_all {
             build_multiprocessing();
             return;
         };
-        if ($server_mode) {
-            run_server();
-        };
         while ($prj = pick_prj_to_build(\%global_deps_hash)) {
             if (!defined $dead_parents{$prj}) {
                 if (scalar keys %broken_build) {
@@ -685,11 +674,7 @@ sub build_all {
         my $info_hash = $html_info{$initial_module};
         $$info_hash{DIRS} = check_deps_hash(\%local_deps_hash, $initial_module);
         $module_by_hash{\%local_deps_hash} = $initial_module;
-        if ($server_mode) {
-            run_server();
-        } else {
-            build_dependent(\%local_deps_hash);
-        };
+        build_dependent(\%local_deps_hash);
     };
 };
 
@@ -1242,7 +1227,7 @@ sub find_indep_prj {
     $all_dependent = 1;
     handle_dead_children(0) if ($processes_to_run);
     my $children = children_number();
-    return '' if (!$server_mode && $children && ($children >= $processes_to_run));
+    return '' if ($children && ($children >= $processes_to_run));
     $dependencies = shift;
     if (scalar keys %$dependencies) {
         foreach my $job (keys %$dependencies) {
@@ -1361,14 +1346,12 @@ sub print_error {
 
 sub usage {
     print STDERR "\nbuild\n";
-    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] [--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] [--exclude_branch_from prj_name1[:prj_name2] [prj_name3 [...]]] [--interactive] [--verbose]\n";
+    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] [--deliver|-d [--dlv_switch deliver_switch]]] [-P processes] [--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] [--exclude_branch_from prj_name1[:prj_name2] [prj_name3 [...]]] [--interactive] [--verbose]\n";
     print STDERR "Example1:    build --from sfx2\n";
     print STDERR "                     - build all projects dependent from sfx2, starting with sfx2, finishing with the current module\n";
     print STDERR "Example2:    build --all:sfx2\n";
     print STDERR "                     - the same as --all, but skip all projects that have been already built when using \"--all\" switch before sfx2\n";
-    print STDERR "Example3:    build --all --server\n";
-    print STDERR "                     - build all projects in server mode, use first available port from default range 7890-7894 (running clients required!!)\n";
-    print STDERR "Example4(for unixes):\n";
+    print STDERR "Example3(for unixes):\n";
     print STDERR "             build --all --pre_job=echo\\ Starting\\ job\\ in\\ \\\$PWD --job=some_script.sh --post_job=echo\\ Job\\ in\\ \\\$PWD\\ is\\ made\n";
     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";
     print STDERR "\nSwitches:\n";
@@ -1384,11 +1367,6 @@ sub usage {
     print STDERR "        --file       - generate command file file_name\n";
     print STDERR "        --deliver    - only deliver, no build (usable for \'-all\' and \'-from\' keys)\n";
     print STDERR "        -P           - start multiprocessing build, with number of processes passed\n";
-    print STDERR "        --server     - start build in server mode (clients required)\n";
-    print STDERR "          --setenvstring  - string for configuration of the client environment\n";
-    print STDERR "          --port          - set server port, default is 7890. You may pass several ports, the server will be started on the first available\n";
-    print STDERR "                            otherwise the server will be started on first available port from the default range 7890-7894\n";
-    print STDERR "          --client_timeout  - time frame after which the client/job is considered to be lost. Default is 120 min\n";
     print STDERR "        --dlv_switch - use deliver with the switch specified\n";
     print STDERR "        --help       - print help info\n";
     print STDERR "        --ignore     - force tool to ignore errors\n";
@@ -1453,10 +1431,6 @@ sub get_options {
         $arg =~ /^--dontgraboutput$/        and $dont_grab_output = 1      and next;
         $arg =~ /^--html_path$/ and $html_path = shift @ARGV  and next;
         $arg =~ /^-i$/        and $ignore = 1                            and next;
-        $arg =~ /^--server$/        and $server_mode = 1                      and next;
-        $arg =~ /^--client_timeout$/ and $client_timeout = (shift @ARGV)*60  and next;
-        $arg =~ /^--setenvstring$/            and $setenv_string =  shift @ARGV         and next;
-        $arg =~ /^--port$/            and $ports_string =  shift @ARGV         and next;
         $arg =~ /^--version$/   and do_exit(0);
         $arg =~ /^-V$/          and do_exit(0);
         $arg =~ /^-m$/            and get_modes()         and next;
@@ -1496,20 +1470,9 @@ sub get_options {
         if (!$enable_multiprocessing) {
             print_error("Cannot load Win32::Process module for multiprocessing build");
         };
-        if ($server_mode) {
-            print_error("Switches -P and --server collision");
-        };
     } elsif ($stop_build_on_error) {
         print_error("Switch --stoponerror is only for multiprocessing builds");
     };
-    if ($server_mode) {
-        $html++;
-        $client_timeout = 60 * 60 * 2 if (!$client_timeout);
-    } else {
-        print_error("--ports switch is for server mode only!!") if ($ports_string);
-        print_error("--setenvstring switch is for server mode only!!") if ($setenv_string);
-        print_error("--client_timeout switch is for server mode only!!") if ($client_timeout);
-    };
 
     if ($only_platform) {
         $only_common = 'common';
@@ -2785,7 +2748,6 @@ sub generate_html_file {
     print HTML '        top.innerFrame.frames[1].document.write("        <td width=* align=center><strong style=color:blue>Job</strong></td>");' . "\n";
     print HTML '        top.innerFrame.frames[1].document.write("        <td width=* align=center><strong style=color:blue>Start Time</strong></td>");' . "\n";
     print HTML '        top.innerFrame.frames[1].document.write("        <td width=* align=center><strong style=color:blue>Finish Time</strong></td>");' . "\n";
-    print HTML '        top.innerFrame.frames[1].document.write("        <td width=* align=center><strong style=color:blue>Client</strong></td>");' . "\n" if ($server_mode);
     print HTML '        top.innerFrame.frames[1].document.write("    </tr>");' . "\n";
     print HTML '        var dir_info_strings = Message2.split("<br><br>");' . "\n";
     print HTML '        for (i = 0; i < dir_info_strings.length; i++) {' . "\n";
@@ -2801,7 +2763,6 @@ sub generate_html_file {
     print HTML '            };' . "\n";
     print HTML '            top.innerFrame.frames[1].document.write("        <td align=center>" + dir_info_array[2] + "</td>");' . "\n";
     print HTML '            top.innerFrame.frames[1].document.write("        <td align=center>" + dir_info_array[3] + "</td>");' . "\n";
-    print HTML '            top.innerFrame.frames[1].document.write("        <td align=center>" + dir_info_array[5] + "</td>");' . "\n" if ($server_mode);
     print HTML '            top.innerFrame.frames[1].document.write("    </tr>");' . "\n";
     print HTML '        };' . "\n";
     print HTML '        top.innerFrame.frames[1].document.write("</table>");' . "\n";
@@ -2819,7 +2780,6 @@ sub generate_html_file {
     print HTML '                };' . "\n";
     print HTML '                DirectoryInfos[2].innerHTML = dir_info_array[2];' . "\n";
     print HTML '                DirectoryInfos[3].innerHTML = dir_info_array[3];' . "\n";
-    print HTML '                DirectoryInfos[4].innerHTML = dir_info_array[5];' . "\n" if ($server_mode);
     print HTML '            };' . "\n";
     print HTML '        };' . "\n";
     print HTML '    };' . "\n";
@@ -2969,7 +2929,6 @@ sub get_dirs_info_line {
         $dirs_info_line .= $log_path_string;
     };
     $dirs_info_line .= '<br>';
-    $dirs_info_line .= $jobs_hash{$job}->{CLIENT} . '<br>' if ($server_mode);
     return $dirs_info_line;
 };
 
@@ -3097,249 +3056,10 @@ sub accept_html_connection {
     return $new_socket_obj;
 };
 
-sub accept_connection {
-    my $new_socket_obj = undef;
-    do {
-        $new_socket_obj = $server_socket_obj->accept();
-        if (!$new_socket_obj) {
-            print "Timeout on incoming connection\n";
-            check_client_jobs();
-        };
-    } while (!$new_socket_obj);
-    return $new_socket_obj;
-};
-
-sub check_client_jobs {
-    foreach (keys %clients_times) {
-        if (time - $clients_times{$_} > $client_timeout) {
-            print "Client's $_ Job: \"$clients_jobs{$_}\" apparently got lost...\n";
-            print "Scheduling for rebuild...\n";
-            print "You might need to check the $_\n";
-            $lost_client_jobs{$clients_jobs{$_}}++;
-            delete $processes_hash{$_};
-            delete $clients_jobs{$_};
-            delete $clients_times{$_};
-        };
-    };
-};
-
 sub get_server_ports {
     # use port 7890 as default
     my $default_port = 7890;
-    if ($ports_string) {
-        @server_ports = split( /:/, $ports_string);
-    } else {
-        @server_ports = ($default_port .. $default_port + 4);
-    };
-};
-
-sub run_server {
-    my @build_queue = ();        # array, containing queue of projects
-                                # to build
-    my $error = 0;
-    if (scalar @server_ports) {
-        foreach (@server_ports) {
-            $error = start_server_on_port($_, \$server_socket_obj);
-            if ($error) {
-                print STDERR "port $_: $error\n";
-            } else {
-                last;
-            };
-        };
-        print_error('Unable to start server on port(s): ' . "@server_ports\n") if ($error);
-    } else {
-        print_error('No ports for server to start');
-    };
-
-    my $client_addr;
-    my $job_string_base = get_job_string_base();
-    my $new_socket_obj;
-     while ($new_socket_obj = accept_connection()) {
-        check_client_jobs();
-        # find out who connected
-        my $client_ipnum = $new_socket_obj->peerhost();
-        my $client_host = gethostbyaddr(inet_aton($client_ipnum), AF_INET);
-        # print who is connected
-        # send them a message, close connection
-        my $client_message = <$new_socket_obj>;
-        chomp $client_message;
-        my @client_data = split(/ /, $client_message);
-        my %client_hash = ();
-        foreach (@client_data) {
-            /(=)/;
-            $client_hash{$`} = $'; #'
-        }
-        my $pid = $client_hash{pid} . '@' . $client_host;
-        if (defined $client_hash{platform}) {
-            if ($client_hash{platform} ne $ENV{OUTPATH} || (defined $client_hash{osname} && ($^O ne $client_hash{osname}))) {
-                print $new_socket_obj "Wrong platform";
-                close($new_socket_obj);
-                next;
-            };
-        } else {
-            if ($client_hash{result} eq "0") {
-            } else {
-                print "Error $client_hash{result}\n";
-                if (store_error($pid, $client_hash{result})) {
-                    print $new_socket_obj $job_string_base . $clients_jobs{$pid};
-                    close($new_socket_obj);
-                    $clients_times{$pid} = time;
-                    next;
-                };
-            };
-            delete $clients_times{$pid};
-            clear_from_child($pid);
-            delete $clients_jobs{$pid};
-            $verbose_mode && print 'Running processes: ', children_number(), "\n";
-            # Actually, next 3 strings are only for even distribution
-            # of clients if there are more than one build server running
-            print $new_socket_obj 'No job';
-            close($new_socket_obj);
-            next;
-        };
-        my $job_string;
-        my @lost_jobs = keys %lost_client_jobs;
-        if (scalar @lost_jobs) {
-            $job_string = $lost_jobs[0];
-            delete $lost_client_jobs{$lost_jobs[0]};
-        } else {
-            $job_string = get_job_string(\@build_queue);
-        };
-        if ($job_string) {
-            my $job_dir = $job_jobdir{$job_string};
-            $processes_hash{$pid} = $job_dir;
-            $jobs_hash{$job_dir}->{CLIENT} = $pid;
-            print "$pid got $job_dir\n";
-            print $new_socket_obj $job_string_base . $job_string;
-            $clients_jobs{$pid} = $job_string;
-            $clients_times{$pid} = time;
-            my $children_running = children_number();
-            $verbose_mode && print 'Running processes: ', $children_running, "\n";
-            $maximal_processes = $children_running if ($children_running > $maximal_processes);
-        } else {
-            print $new_socket_obj 'No job';
-        };
-        close($new_socket_obj);
-    };
-};
-
-#
-# Procedure returns the part of the job string that is similar for all clients
-#
-sub get_job_string_base {
-    if ($setenv_string) {
-        return "setenv_string=$setenv_string ";
-    };
-    my $job_string_base = "server_pid=$$ setsolar_cmd=$ENV{SETSOLAR_CMD} ";
-    $job_string_base .= "source_root=$ENV{SOURCE_ROOT} " if (defined $ENV{SOURCE_ROOT});
-    $job_string_base .= "updater=$ENV{UPDATER} " if (defined $ENV{UPDATER});
-    return $job_string_base;
-};
-
-sub get_job_string {
-    my $build_queue = shift;
-    my $job = $dmake;
-    my ($job_dir, $dependencies_hash);
-    if ($build_all_parents) {
-        fill_modules_queue($build_queue);
-        do {
-            ($job_dir, $dependencies_hash) = pick_jobdir($build_queue);
-            return '' if (!$job_dir);
-            $jobs_hash{$job_dir}->{START_TIME} = time();
-            $jobs_hash{$job_dir}->{STATUS} = 'building';
-            if ($job_dir =~ /(\s)$pre_job/o) {
-                do_custom_job($job_dir, $dependencies_hash);
-                $job_dir = '';
-            };
-        } while (!$job_dir);
-    } else {
-        $dependencies_hash = \%local_deps_hash;
-        do {
-            $job_dir = pick_prj_to_build(\%local_deps_hash);
-            if (!$job_dir && !children_number()) {
-                cancel_build() if (scalar keys %broken_build);
-                mp_success_exit();
-            };
-            return '' if (!$job_dir);
-            $jobs_hash{$job_dir}->{START_TIME} = time();
-            $jobs_hash{$job_dir}->{STATUS} = 'building';
-            if ($job_dir =~ /(\s)$pre_job/o) {
-                do_custom_job($job_dir, $dependencies_hash);
-                $job_dir = '';
-            };
-        } while (!$job_dir);
-    };
-    $running_children{$dependencies_hash}++;
-    $folders_hashes{$job_dir} = $dependencies_hash;
-    my $log_file = $jobs_hash{$job_dir}->{LONG_LOG_PATH};
-    my $full_job_dir = $job_dir;
-    if ($job_dir =~ /(\s)/o) {
-        $job = $'; #'
-        print $echo . "determine if we need to deliver $job_dir\n";
-        if ($job eq $post_job) {
-            if( $is_gbuild{$job_dir} ) {
-                print "Skip deliver for gmake-built module $job_dir\n";
-                return'';
-            };
-            $job = $deliver_command
-        };
-        $full_job_dir = $module_paths{$`};
-    }
-    my $log_dir = File::Basename::dirname($log_file);
-    if (!-d $log_dir) {
-        chdir $full_job_dir;
-        getcwd();
-        system("$perl $mkout");
-    };
-    my $job_string = "job_dir=$full_job_dir job=$job log=$log_file";
-    $job_jobdir{$job_string} = $job_dir;
-    return $job_string;
-};
-
-sub pick_jobdir {
-    my $build_queue = shift;
-    my $i = 0;
-    foreach (@$build_queue) {
-        my $prj = $$build_queue[$i];
-        my $prj_deps_hash = $projects_deps_hash{$prj};
-        if (defined $modules_with_errors{$prj_deps_hash} && !$ignore) {
-            push (@broken_modules_names, $prj);
-            splice (@$build_queue, $i, 1);
-            next;
-        };
-        $running_children{$prj_deps_hash} = 0 if (!defined $running_children{$prj_deps_hash});
-        my $child_nick = pick_prj_to_build($prj_deps_hash);
-        if ($child_nick) {
-            return ($child_nick, $prj_deps_hash);
-        }
-        if ((!scalar keys %$prj_deps_hash) && !$running_children{$prj_deps_hash}) {
-            if (!defined $modules_with_errors{$prj_deps_hash} || $ignore)
-            {
-                remove_from_dependencies($prj, \%global_deps_hash);
-                $build_is_finished{$prj}++;
-                splice (@$build_queue, $i, 1);
-                next;
-            };
-        };
-        $i++;
-    };
-};
-
-sub fill_modules_queue {
-    my $build_queue = shift;
-    my $prj;
-    while ($prj = pick_prj_to_build(\%global_deps_hash)) {
-        push @$build_queue, $prj;
-        $projects_deps_hash{$prj} = {};
-        get_module_dep_hash($prj, $projects_deps_hash{$prj});
-        my $info_hash = $html_info{$prj};
-        $$info_hash{DIRS} = check_deps_hash($projects_deps_hash{$prj}, $prj);
-        $module_by_hash{$projects_deps_hash{$prj}} = $prj;
-    };
-    if (!$prj && !children_number() && (!scalar @$build_queue)) {
-        cancel_build() if (scalar keys %broken_build);
-        mp_success_exit();
-    };
+    @server_ports = ($default_port .. $default_port + 4);
 };
 
 sub is_gnumake_module {
diff --git a/solenv/bin/build_client.pl b/solenv/bin/build_client.pl
deleted file mode 100755
index 5119f60..0000000
--- a/solenv/bin/build_client.pl
+++ /dev/null
@@ -1,436 +0,0 @@
-:
-eval 'exec perl -S $0 ${1+"$@"}'
-    if 0;
-#*************************************************************************
-#
-# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
-#
-# Copyright 2000, 2010 Oracle and/or its affiliates.
-#
-# OpenOffice.org - a multi-platform office productivity suite
-#
-# This file is part of OpenOffice.org.
-#
-# OpenOffice.org is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License version 3
-# only, as published by the Free Software Foundation.
-#
-# OpenOffice.org is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU Lesser General Public License version 3 for more details
-# (a copy is included in the LICENSE file that accompanied this code).
-#
-# You should have received a copy of the GNU Lesser General Public License
-# version 3 along with OpenOffice.org.  If not, see
-# <http://www.openoffice.org/license.html>
-# for a copy of the LGPLv3 License.
-#
-#*************************************************************************
-#
-# build_client - client for the build tool in server mode
-#
-
-use strict;
-use Socket;
-use Sys::Hostname;
-use File::Temp qw(tmpnam);
-use POSIX;
-use Cwd qw (cwd);
-
-$SIG{KILL} = \&handle_temp_files;
-$SIG{INT} = \&handle_temp_files;
-
-### main ###
-my $enable_multiprocessing = 1;
-my $server_list_file;
-my $server_list_time_stamp = 0;
-my %ENV_BACKUP;
-$ENV_BACKUP{$_} = $ENV{$_} foreach (keys %ENV);
-
-if ($^O eq 'MSWin32') {
-    eval { require Win32::Process; import Win32::Process; };
-    $enable_multiprocessing = 0 if ($@);
-} else {
-    use Cwd 'chdir';
-};
-my $processes_to_run = 1;
-
-my %hosts_ports = ();
-my $default_port = 7890;
-my @ARGV_COPY = @ARGV; # @ARGV BACKUP
-print "arguments: @ARGV\n";
-get_options();
-
-my $proto = getprotobyname('tcp');
-my $paddr;
-my $host = hostname();
-my $current_server = '';
-my $got_job = 0;
-my %job_temp_files = ();
-my %environments = (); # hash containing all environments
-my $env_alias;
-my %platform_rejects = (); # hash containing paddr of server, that replied "Wrong platform"
-
-my $child = 0;
-if ($processes_to_run > 1) {
-    my $started_processes = 1;
-    if ($^O eq 'MSWin32') {
-        my $process_obj = undef;
-        my $child_args = "perl $0";
-        foreach (@ARGV_COPY) {
-            /^-P(\d+)$/        and next;
-            /^-P$/     and shift @ARGV_COPY  and next;
-            $child_args .= " $_";
-        };
-        do {
-            my $rc = Win32::Process::Create($process_obj, $^X,
-                                            $child_args,
-                                                0, 0, #NORMAL_PRIORITY_CLASS,
-                                            ".");
-            print_error("Cannot start child process") if (!$rc);
-            $started_processes++;
-        } while ($started_processes < $processes_to_run);
-    } else {
-        my $pid;
-        do {
-            if ($pid = fork) { # parent
-                $started_processes++;
-                print $started_processes . "\n";
-            } elsif (defined $pid) { # child
-                $child++;
-            };
-        } while (($started_processes < $processes_to_run) && !$child);
-    };
-};
-
-run_client();
-### end of main procedure ###
-
-#########################
-#                       #
-#      Procedures       #
-#                       #
-#########################
-sub handle_temp_files {
-    print STDERR "Got signal - clearing up...\n";
-    foreach (keys %job_temp_files) {
-        if ($job_temp_files{$_}) {
-            rename($_, $job_temp_files{$_}) or system("mv", $_, $job_temp_files{$_});
-            print STDERR "Could not rename $_ to $job_temp_files{$_}\n" if (-e $_);
-        } else {
-            unlink $_ or system("rm -rf $_");
-            print STDERR "Could not remove $_\n" if (-e $_);
-        };
-    };
-    exit($?);
-};
-
-sub run_client {
-# initialize host and port
-    if (!scalar keys %hosts_ports) {
-        $hosts_ports{localhost} = $default_port;
-    }
-
-    print "Started client with PID $$, hostname $host\n";
-
-    my $message = '';
-    my $current_port = '';
-    my %active_servers = ();
-
-    do {
-        $got_job = 0;
-        foreach $current_server (keys %hosts_ports) {
-            foreach $current_port (keys %{$hosts_ports{$current_server}}) {
-
-                #before each "inactive" server/port connect - connect to each "active" server/port
-                next if (defined ${$active_servers{$current_server}}{$current_port});
-                # "active" cycle
-                foreach my $active_server (keys %active_servers) {
-                    foreach my $active_port (keys %{$active_servers{$active_server}}) {
-                        my $iaddr = inet_aton($active_server);
-                        $paddr = sockaddr_in($active_port, $iaddr);
-                        do {
-                            my $server_is_active = 0;
-                            $message = request_job($message, $active_server, $active_port);
-                            $server_is_active++ if ($message);
-                            if (!$server_is_active) {
-                                delete ${$active_servers{$active_server}}{$active_port};
-                                # throw away obsolete environments
-                                foreach (keys %environments) {
-                                    /^\d+@/;
-                                    if ($' eq "$active_server:$active_port") {
-                                        delete $environments{$_};
-                                    };
-                                };
-                            };
-                            $message = '' if ($message eq 'No job');
-                        } while ($message);
-                    };
-                };
-
-                # "inactive" cycle
-                my $iaddr = inet_aton($current_server);
-                $paddr = sockaddr_in($current_port, $iaddr);
-                do {
-                    $message = request_job($message, $current_server, $current_port);
-                    if ($message) {
-                        if (!defined $active_servers{$current_server}) {
-                            my %ports;
-                            $active_servers{$current_server} = \%ports;
-                        };
-                        ${$active_servers{$current_server}}{$current_port}++;
-                    };
-                    $message = '' if ($message eq 'No job');
-                } while ($message);
-            };
-        };
-        sleep 5 if (!$got_job);
-        read_server_list();
-    } while(1);
-};
-
-sub usage {
-    my $error = shift;
-    print STDERR "\nbuild_client\n";
-    print STDERR "Syntax:    build_client [-PN] host1[:port1:...:portN] [host2[:port1:...:portN] ... hostN[:port1:...:portN]]|\@server_list_file\n";
-    print STDERR "        -P           - start multiprocessing build, with number of processes passed\n";
-    print STDERR "Example1:   build_client myserver1 myserver2:7891:7892\n";
-    print STDERR "            the client will be asking for jobs on myserver1's default ports (7890-7894)\n";
-    print STDERR "            and on myserver2's ports 7891 and 7892\n";
-    print STDERR "Example2:   build_client -P2 myserver1:7990 myserver2\n";
-    print STDERR "            start 2 clients which will be asking for jobs myserver1's port 7990\n";
-    print STDERR "            and myserver2's default ports (7890-7894)\n";
-    exit ($error);
-};
-
-sub get_options {
-    my $arg;
-    usage(1) if (!scalar @ARGV);
-    while ($arg = shift @ARGV) {
-        usage(0) if /^--help$/;
-        usage(0) if /^-h$/;
-        $arg =~ /^-P(\d+)$/        and $processes_to_run = $1 and next;
-        $arg =~ /^-P$/            and $processes_to_run = shift @ARGV     and next;
-        $arg =~ /^@(\S+)$/            and $server_list_file = $1    and next;
-        store_server($arg);
-    };
-    if (($processes_to_run > 1) && (!$enable_multiprocessing)) {
-        print_error("Cannot load Win32::Process module for multiple client start");
-    };
-    if ($server_list_file) {
-        print_error("$server_list_file is not a regular file!!") if (!-f $server_list_file);
-        read_server_list();
-    }
-    print_error("No server info") if (!scalar %hosts_ports);
-};
-
-sub store_server {
-    my $server_string = shift;
-    my @server_params = ();
-    @server_params = split (/:/, $server_string);
-    my $host = shift @server_params;
-    my @names = gethostbyname($host);
-    my $host_full_name = $names[0];
-    my %ports = ();
-    if (defined $hosts_ports{$host_full_name}) {
-        %ports = %{$hosts_ports{$host_full_name}};
-    };
-    # To do: implement keys in form server:port -> priority
-    if (defined $hosts_ports{$host_full_name}) {
-        if (!$server_list_time_stamp) {
-            print "The $host with ip address " . inet_ntoa(inet_aton($host)) . " is at least two times in the server list\n";
-        };
-    } else {
-        print "Added server $host as $host_full_name\n";
-    };
-    if (scalar @server_params) {
-         $ports{$_}++ foreach (@server_params);
-    } else {
-         $ports{$_}++ foreach ($default_port .. $default_port + 4);
-    };
-    $hosts_ports{$host_full_name} = \%ports;
-};
-
-sub read_server_list {
-    open(SERVER_LIST, "<$server_list_file") or return;
-    my $current_time_stamp = (stat($server_list_file))[9];
-    return if ($server_list_time_stamp >= $current_time_stamp);
-    my @server_array = ();
-    foreach my $file_string(<SERVER_LIST>) {
-        while ($file_string =~ /(\S+)/) {
-            $file_string = $';
-            store_server($1);
-        };
-    };
-    close SERVER_LIST;
-    $server_list_time_stamp = $current_time_stamp;
-};
-
-sub request_job {
-    my ($message, $current_server, $current_port) = @_;
-    $message = "platform=$ENV_BACKUP{OUTPATH} pid=$$ osname=$^O" if (!$message);
-    # create the socket, connect to the port
-    socket(SOCKET, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
-    connect(SOCKET, $paddr) or return '';
-    my $error_code = 1;
-    $message .= "\n";
-    syswrite SOCKET, $message, length $message;
-    while (my $line = <SOCKET>) {
-        chomp $line;
-        if ($line eq 'No job') {
-            close SOCKET or die "close: $!";
-            return $line;
-        };
-        if ($line eq "Wrong platform") {
-            if (!defined $platform_rejects{$paddr}) {
-                $platform_rejects{$paddr}++;
-                print STDERR $line . "\n";
-            }
-            close SOCKET or die "close: $!";
-            delete $hosts_ports{$current_server};
-            return '';
-        } elsif (defined $platform_rejects{$paddr}) {
-            delete $platform_rejects{$paddr};
-        };
-        $got_job++;
-        $error_code = do_job($line . " server=$current_server port=$current_port");
-    }
-    close SOCKET or die "close: $!";
-    return("result=$error_code pid=$$");
-}
-
-sub do_job {
-    my @job_parameters = split(/ /, shift);
-    my %job_hash = ();
-    my $last_param;
-    my $error_code;
-    print "Client $$@" . "$host\n";
-    foreach (@job_parameters) {
-        if (/(=)/) {
-            $job_hash{$`} = $';
-            $last_param = $`;
-        } else {
-           $job_hash{$last_param} .= " $_";
-        };
-    };
-    $env_alias = $job_hash{server_pid} . '@' . $job_hash{server} . ':' . $job_hash{port};
-    my $result = "1"; # default value
-    my $cmd_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
-    my $tmp_log_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
-    $job_temp_files{$tmp_log_file} = $job_hash{log};
-    my $setenv_string = '';
-    if (defined $job_hash{setenv_string}) {
-        # use configuration string from server
-        $setenv_string .= $job_hash{setenv_string};
-        print "Environment: $setenv_string\n";
-
-        my $directory = $job_hash{job_dir};
-        open (COMMAND_FILE, ">$cmd_file");
-        print COMMAND_FILE "$setenv_string\n";
-        if (!defined $job_hash{job_dir}) {
-            close COMMAND_FILE;
-            print "No job_dir, cmd file: $cmd_file\n";
-            foreach (keys %job_hash) {
-                print "key: $_ $job_hash{$_}\n";
-            };
-            exit (1);
-        };
-
-        print COMMAND_FILE "pushd $job_hash{job_dir} && ";
-        print COMMAND_FILE $job_hash{job} ." >& $tmp_log_file\n";
-        print COMMAND_FILE "exit \$?\n";
-        close COMMAND_FILE;
-        $job_temp_files{$cmd_file} = 0;
-        $job_temp_files{$tmp_log_file} = $job_hash{log};
-        $error_code = system($ENV{SHELL}, $cmd_file);
-        unlink $cmd_file or system("rm -rf $cmd_file");
-        delete $job_temp_files{$cmd_file};
-    } else {
-        # generate setsolar string
-        if (!defined $environments{$env_alias}) {
-            $error_code = get_setsolar_environment(\%job_hash);
-            return($error_code) if ($error_code);
-        };
-        my $solar_vars = $environments{$env_alias};
-
-        delete $ENV{$_} foreach (keys %ENV);
-        $ENV{$_} = $$solar_vars{$_} foreach (keys %$solar_vars);
-        print 'Workspace: ';
-        print $ENV{SOLARSRC};
-
-        print "\nplatform: $ENV{INPATH} $^O";
-        print "\ndir: $job_hash{job_dir}\n";
-        print "job: $job_hash{job}\n";
-        chdir $job_hash{job_dir};
-        getcwd();
-        my $job_string = $job_hash{job} . ' > ' . $tmp_log_file . ' 2>&1';
-        $error_code = system($job_string);
-    };
-    rename($tmp_log_file, $job_hash{log}) or system("mv", $tmp_log_file, $job_hash{log});
-    delete $job_temp_files{$tmp_log_file};
-
-    if ($error_code) {
-        print "Error code = $error_code\n\n";
-    } else {
-        print "Success!!\n\n";
-    };
-    return $error_code;
-};
-
-sub get_setsolar_environment {
-    my $job_hash = shift;
-    my $server_pid = $$job_hash{server_pid};
-    my $setsolar_string = $$job_hash{setsolar_cmd};
-    # Prepare the string for the client
-    $setsolar_string =~ s/\s-file\s\S+//g;
-    my $error_code = 0;
-    my $cmd_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
-    my $tmp_log_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
-    if (defined $$job_hash{updater}) {
-        $ENV{UPDATER} = $$job_hash{updater};
-    } else {
-        undef $ENV{UPDATER} if (defined $ENV{UPDATER});
-    };
-    if (defined $$job_hash{source_root}) {
-        $ENV{SOURCE_ROOT} = $$job_hash{source_root};
-    } else {
-        undef $ENV{SOURCE_ROOT} if (defined $ENV{SOURCE_ROOT});
-    };
-    $error_code = system("$setsolar_string -file $cmd_file");
-    store_env_hash($cmd_file);
-    return $error_code;
-};
-
-sub print_error {
-    my $message = shift;
-    print STDERR "\nERROR: $message\n";
-    exit(1);
-};
-sub store_env_hash {
-    my $ss_setenv_file = shift;
-    my %solar_vars = ();
-    my $cmd_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
-    my $env_vars_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
-    print "$cmd_file $env_vars_file\n";
-    #get all env variables in $env_vars_file
-    open (COMMAND_FILE, ">$cmd_file");
-    print COMMAND_FILE "source $ss_setenv_file\n";
-    print COMMAND_FILE "env > $env_vars_file\n";
-    close COMMAND_FILE;
-    system($ENV{SHELL}, $cmd_file);
-    print_error($?) if ($?);
-    unlink $cmd_file or system("rm -rf $cmd_file");
-    unlink $ss_setenv_file or system("rm -rf $ss_setenv_file");
-
-    open SOLARTABLE, "<$env_vars_file" or die "can´t open solarfile $env_vars_file";
-    while(<SOLARTABLE>) {
-        chomp;
-        s/\r\n//o;
-        /(=)/;
-        $solar_vars{$`} = $';
-    };
-    close SOLARTABLE;
-    unlink $env_vars_file or system("rm -rf $env_vars_file");
-    $environments{$env_alias} = \%solar_vars;
-};


More information about the Libreoffice-commits mailing list