1# should be call by FvwmScript-ComExample as: 2# perl [-w] fvwm-script-ComExample --com-name ComExample-pid 3# where pid is the process id of FvwmScript-ComExample 4 5use strict; 6use Getopt::Long; 7 8my $comName = ""; 9my $userHome = $ENV{'HOME'} || "./."; 10my $userDir = $ENV{'FVWM_USERDIR'} || "$userHome/.fvwm"; 11my $scriptName = ($0 =~ m:([^/]+)$:, $1); 12 13GetOptions( 14 "help|h" => \&showHelp, 15 "com-name=s" => \$comName, 16) || showHelp(); 17 18showHelp() if ($comName eq ""); 19 20# the fifos for the communication with FvwmScript 21my $outFifo = ".tmp-com-out-" . $comName; 22my $inFifo = ".tmp-com-in-" . $comName; 23 24# extract the the pid of FvwmScript-ComExample 25my $comPid = $comName; 26$comPid =~ s/ComExample-//; 27showHelp() if ($comPid !~ /^\d+$/); 28 29# startup stuff: 30# nothing :o) 31 32# go to the communication loop (never return) 33comLoop(); 34 35#------------------------------------------------------------------------------- 36# usage 37sub showHelp { 38 print "\n"; 39 print "$scriptName must be run by FvwmScript-ComExample as follow:\n\n"; 40 print "\tperl $scriptName --com-name ComExample-pid\n\n"; 41 print "where pid is the process id of FvwmScript-ComExample\n"; 42 print "\n"; 43 exit 0; 44} 45 46#------------------------------------------------------------------------------- 47# the communication loop 48sub comLoop { 49 my $command = ""; 50 my $return = ""; 51 my $count=0; 52 53 chdir($userDir) || die "No FvwmConfigHome $userDir"; 54 # paranoia 55 unlink($outFifo) if -p "$outFifo"; 56 unlink($inFifo) if -p "$inFifo"; 57 58 while(1) { 59 # read the command and check every 10 sec if FvwmScript-ComExemple 60 # is still alive 61 myMakeFifo($inFifo) if ! -p "$inFifo"; 62 eval { 63 local $SIG{ALRM} = \&checkScript; 64 alarm(10); 65 # block unless FvwmScript write on $inFifo 66 open(IN,"$inFifo") || die "cannot open $inFifo"; 67 alarm(0); 68 # read the message 69 ($command)=(<IN>); 70 chomp($command); 71 close(IN); 72 }; 73 if ($@ =~ /^cannot/) { 74 print STDERR "$comName: cannot read in fifo $inFifo\n"; 75 unlink("$inFifo") if -p "$inFifo"; 76 exit(1); 77 } 78 if ($@ =~ /^NoScript/) { 79 print STDERR "$comName: No more FvwmScript-ComExample: exit!\n"; 80 unlink("$inFifo") if -p "$inFifo"; 81 exit(0); 82 } 83 if ($@ =~ /^Script/) { 84 next; 85 } 86 87 unlink($inFifo); 88 89 # build the answer 90 $return = ""; 91 if ($command eq "startup") 92 { 93 $return = "fvwm-script-ComExample.pl perl script is up"; 94 } 95 elsif ($command eq "count") 96 { 97 $count++; 98 $return = "Get $count count messages"; 99 } 100 elsif ($command eq "multilines") 101 { 102 # return an answer ready for the FvwmScript Parse function 103 my @r = (); 104 $r[0] = "line1 (" . int(rand 20) . ")"; 105 $r[1] = "Second Line (" . int(rand 20) . ")"; 106 $r[2] = "An other Line (" . int(rand 20) . ")"; 107 $return = buildAnswerForParse(@r); 108 } 109 # ...etc. 110 # -------------------------- 111 elsif ($command eq "exit") { 112 exit(0); 113 } 114 else { 115 print STDERR "$comName: unknown command $command\n"; 116 $return = "0"; 117 } 118 119 # send the answer to FvwmScript, we wait 10 sec 120 myMakeFifo($outFifo); 121 eval { 122 local $SIG{ALRM} = sub { die "Timeout" }; 123 alarm(10); 124 # this line block until FvwmScript take the answer 125 open(OUT,">$outFifo") || die "$comName: cannot write on fifo $outFifo"; 126 alarm(0); 127 print OUT $return; 128 close(OUT); 129 }; 130 if ($@ =~ /cannot/) { 131 print STDERR "$comName: cannot write on fifo $outFifo\n"; 132 unlink($outFifo); 133 exit(1); 134 } 135 if ($@ =~ /Timeout/) { 136 print STDERR "$comName: FvwmScript do not read my answer!\n"; 137 } 138 unlink($outFifo); 139 } # while 140} 141 142#----------------------------------------------------------------------------- 143# multi-lines to one line for the Parse FvwmScript function 144sub buildAnswerForParse { 145 my @r = @_; 146 my $out = ""; 147 my $l = 0; 148 149 foreach (@r) { 150 $l = length($_); 151 $out .= "0" x (4 - length($l)) . "$l" . $_; 152 } 153 return $out; 154} 155 156#----------------------------------------------------------------------------- 157# make a fifo 158sub myMakeFifo { 159 my ($fifo) = @_; 160 system("mkfifo '$fifo'"); 161} 162 163#---------------------------------------------------------------------------- 164# An alarm handler to check if FvwmScript-ComExample is still alive 165sub checkScript { 166 167 die "Script" unless ($comPid); 168 169 my $test = 0; 170 171 $test = 1 if kill 0 => $comPid; 172 173 if ($test) { die "Script"; } 174 else { 175 unlink($outFifo) if -p "$outFifo"; 176 unlink($inFifo) if -p "$inFifo"; 177 die "NoScript"; 178 } 179} 180 181#----------------------------------------------------------------------------- 182# For killing the FvwmScript-ComExample if an error happen in this script 183END { 184 if ($?) { 185 my $message = "$scriptName: internal error $?\n"; 186 $message .= "\tOS error: $!\n" if $!; 187 # actually the following is never executed on unix 188 $message .= "\tOS error 2: $^E\n" if $^E && !($! && $^E eq $!); 189 190 unlink($outFifo) if -p "$outFifo"; 191 unlink($inFifo) if -p "$inFifo"; 192 if ($comPid) { 193 kill(9, $comPid); 194 $message .= "\tkilling FvwmScript-ComExample"; 195 } 196 print STDERR "$message\n"; 197 } 198} 199