#!/usr/bin/perl -w
# CGI slide-show control for dealing with Rendez-vous server.
# (c)2011 Felix Hauri - http://realtime.f-hauri.ch - realtime@f-hauri.ch
# GNU Lesser General Public License
# All this work is published under terms of LGPL V3 http://www.gnu.org/licenses/lgpl.html
# This tool open existing UNIX Socket for sending control commands from
# standard html POST to streamed server push control flow.

my $delay=30;
use strict;
use CGI qw(:standard form delete_all);
use IO::Socket;

my $reffile='../public_html/slideshow/soziNph-anim.svg';
my @titles;
open my $fh,"<".$reffile;
my ($szIsFrame,$szTitle,$szSeqNum);
while (<$fh>) {
    $szTitle=$1 if /:title="(.*)"/;
    $szIsFrame=1 if /<\S+:frame/;
    $szSeqNum=$1-1 if /:sequence="(\d+)"/;
    ($titles[$szSeqNum],$szIsFrame)=($szTitle) if $szIsFrame && /:.*\/>/;
};
close $fh;

$|=1;
my $q=new CGI;

print header(-charset=>'utf-8').start_html(-title=>'Server Command',-style=>{-src=>'/slideshow/serveurs.css'});
if (defined param("rdzvs") &&  param("rdzvs") =~ /^([a-z0-9]+)$/) {
	my $rdzvs=$1;
	my $sockname="/tmp/cgi-rendezvous-serveur-".$1;
	if (defined param('Show') && param('Show') =~ /^(\d+|Next|Prev)$/) {
		my $cmde=$1;
		my $sk=IO::Socket::UNIX->new($sockname) or die;
# printf STDERR "Send %s to %s\n",$cmde,$rdzvs;
		print $sk $cmde;
		close $sk;
	};
	delete_all();
	print $q->start_ul;
	map {
	    my ($image,$cmde)=split(":");
	    print li(form({-method=>"POST",-action=>script_name},
                submit($image).
		hidden(-name=>'Show',-value=>$cmde).
		hidden('rdzvs',$rdzvs)));
	} qw |❱:Next ❰:Prev|;
	map {
	    my $number = my $string = 1.0*$_;
	    $string=$titles[$number];
	    print li(form({-method=>"POST",-action=>script_name},
		submit($string),hidden(-name=>'Show',-value=>$number).hidden('rdzvs',$rdzvs)));
	} (0..$#titles);
	print $q->end_ul;
} else {
	if (defined param('browse')) {
	   my %rdzvs;
	    open my $lsofhndl,"lsof|";
	    while (<$lsofhndl>) {
		chomp;
		$rdzvs{$1} = 1 if
		    m|^nph-foll.*/tmp/cgi-rendezvous-serveur-([a-z0-9]+)$|;
	    };
	    close $lsofhndl;
            my @rdzvs=map {
		form({-method=>"POST"},submit($_),hidden('rdzvs',$_))
	    } keys %rdzvs;
	    print ul(li(join(" &nbsp; ",@rdzvs))) if @rdzvs;
	};
	print ul(li(form({-method=>"POST"},textfield('rdzvs').submit())));
};
print end_html;