modules/FvwmScript/Scripts/fvwm-script-ComExample.pl

   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
   5 use strict;
   6 use Getopt::Long;
   7
   8 my $comName = "";
   9 my $userHome = $ENV{'HOME'} || "./.";
  10 my $userDir = $ENV{'FVWM_USERDIR'} || "$userHome/.fvwm";
  11 my $scriptName = ($0 =~ m:([^/]+)$:, $1);
  12
  13 GetOptions(
  14    "help|h"      => \&showHelp,
  15    "com-name=s"  => \$comName,
  16 ) || showHelp();
  17
  18 showHelp() if ($comName eq "");
  19
  20 # the fifos for the communication with FvwmScript
  21 my $outFifo = ".tmp-com-out-" . $comName;
  22 my $inFifo = ".tmp-com-in-"  . $comName;
  23
  24 # extract the the pid of FvwmScript-ComExample
  25 my $comPid = $comName;
  26 $comPid =~ s/ComExample-//;
  27 showHelp() if ($comPid !~ /^\d+$/);
  28
  29 # startup stuff:
  30 # nothing :o)
  31
  32 # go to the communication loop (never return)
  33 comLoop();
  34
  35 #-------------------------------------------------------------------------------
  36 # usage
  37 sub 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
  48 sub 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
 144 sub 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
 158 sub myMakeFifo {
 159         my ($fifo) = @_;
 160         system("mkfifo '$fifo'");
 161 }
 162
 163 #----------------------------------------------------------------------------
 164 # An alarm handler to check if FvwmScript-ComExample is still alive
 165 sub 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
 183 END {
 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 }