fork02.pl to HTML.

index -|- end

Generated: Sun Apr 15 11:46:17 2012 from fork02.pl 2011/09/26 4.7 KB.

#!/usr/bin/perl
# NAME: fork02.pl
# AIM: Some experiments with fork()
# 24/09/2011 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use IO::Socket;
### use Proc::ProcessTable;

my $perl_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n";
require 'lib_fgio.pl' or die "Unable to load 'lib_fgio.pl'! Chech paths in \@INC...\n";

my $delay = 200;
# defaults
my $HOST = "192.168.1.105"; # Dell02 machine
#my $HOST = "localhost";
my $PORT = 5555;
my $TIMEOUT = 2;  # second to wait for a connect.

my $wait_exit = 1;
my $exit_child = 0;
our ($child_pid);
my @warnings = ();

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        ### prt( "\nNo warnings issued.\n\n" );
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    fgfs_disconnect();
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    show_warnings($val);
    #close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}


#sub prt($) {
#    print shift;
#}
sub prtt($) {
    my $txt = shift;
    prt(lu_get_hhmmss_UTC(time()).": $txt");
}

#sub sleep_ms($) {
#    my $usecs = shift; # = $INTERVAL
#    if ($usecs > 0) {
#        my $secs = $usecs / 1000;
#        select(undef,undef,undef,$secs);
#       #usleep($usecs);    # sampling interval
#    }
#}
sub exit_child_flag() {
    return 1 if ($exit_child);
    return 1 if (-f "TEMP_EXIT_FILE");
    return 0;
}

sub get_fgfs_values()
{
    prtt("Get 'sim' information...\n");
    show_sim_info(fgfs_get_sim_info());
    prtt("Get Fuel - comsumables...\n");
    show_consumables(fgfs_get_consumables());
    #prtt("Getting current environment...\n");
    #show_environ(fgfs_get_environ());
    prtt("Getting current COMS...\n");
    show_comms(fgfs_get_comms());
    prtt("Getting current autopilot settings...\n");
    show_autopilot_settings(fgfs_get_aps());
}

sub run_child($) {
    my ($ret) = @_;
    ###print "CREATED CHILD $$\n";
    $child_pid = $$;
    prt("IM THE CHILD $child_pid, will cycle, sleeping for $delay msecs\n");
    get_fgfs_values();
    my $tm = time();
    my ($nt,$cycles);
    #sleep 5;
    $cycles = 0;
    while (${$ret}) {
        $cycles++;
        sleep_ms($delay);
        $nt = time();
        if ($nt != $tm) {
            $tm = $nt;
            prt("IM THE CHILD $cycles ${$ret}\n");
        }
        #last if (${$ret} > 0);
        last if (exit_child_flag());
    }
    prt("IM THE CHILD $cycles ${$ret} EXIT [$child_pid] ($exit_child)\n");
    exit(0);
}


sub open_fgfs() {
    fgfs_connect($HOST, $PORT, $TIMEOUT) ||
        pgm_exit(1,"ERROR: can't open socket! Is FG running, with TELNET enabled?\n");

    #ReadMode('cbreak'); # not sure this is required, or what it does exactly

   fgfs_send("data");  # switch exchange to data mode
    
}

my $signal=15;
### my $parent=shift; # Parent PID from args
### my $proc_table=Proc::ProcessTable->new();
### foreach my $proc (@{$proc_table->table()}) {
###  kill($signal, $proc->pid) if ($proc->ppid == $parent);
###}

sub run_process() {
    my $ppid;
    my $pid = fork();
    if (not defined $pid) {
        prt("resources not avilable.\n");
    } elsif ($pid == 0) {
        run_child(\$wait_exit);
    } else {
        $ppid = $pid;
        $ppid *= -1 if ($ppid < 0);
        prt("IM THE PARENT - will wait 2 secs...\n");
        sleep 2;
        $wait_exit = 0;
        $exit_child = 1;
        # NONE OF THIS WORKS ?????????????????
#        if (defined $pid) {
#            #$pid *= -1 if ($pid < 0);
#            prt("PARENT - set exit time... killing child... $pid\n");
#            #kill($signal,$pid);
#            unless (kill 0 => $pid) {
#                prt("something wicked happened to $pid");
#            }
#            kill(-2,$pid);
#            kill(-2,$ppid) if ($pid != $ppid);
#            #kill($signal,-1);
#        } else {
            write2file("\n","TEMP_EXIT_FILE");
            prt("PARENT - set exit time... sleep 1... waiting for child...\n");
            #sleep 1;
            waitpid($pid,0);
            unlink "TEMP_EXIT_FILE";
#        }
        my $cp = 'undefined';
        $cp = $child_pid if (defined $child_pid);
        prt("Parent exiting... child pid [$cp] $pid $wait_exit $exit_child\n");
    }
}

open_fgfs();
run_process();
prt( "End of program...\n");
pgm_exit(0,"");

# eof - fork02.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional