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