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