Merged and added import scripts

git-svn-id: https://vdr-muggle.svn.sourceforge.net/svnroot/vdr-muggle/trunk/muggle-plugin@99 e10066b5-e1e2-0310-b819-94efdf66514b

1 files changed, 349 insertions, 0 deletions

diff --git a/scripts/gdio.pm b/scripts/gdio.pm
new file mode 100755
index 0000000..0fd6e2f
--- /dev/null
+++ b/scripts/gdio.pm
@@ -0,0 +1,349 @@
+##################################################
+#
+# GiantDisc mp3 Jukebox
+# 
+# © 2000, Rolf Brugger
+#
+##################################################
+
+package gdio;
+
+#use lib '/home/music/bin';
+
+use IO::Socket;
+use strict;
+
+# GiantDisc IO routines
+
+### Constants & global variables
+my $no_mode = 0;
+my $rs232_mode = 1;
+my $tcpip_srv_mode = 2;
+my $tcpip_cli_mode = 3;
+
+my $commMode = $no_mode;
+
+
+### Serial communication parameters:
+my $serdev;
+my $serbaud;
+
+### TCP/IP communication parameters
+my $gdsocket;
+my $connection;
+
+undef $connection;
+
+#################################################################
+### initialization routines:
+
+sub serio_init{
+  ### Init serial port
+  my $logtarget;
+  ($logtarget, $serdev, $serbaud) = @_;
+  
+  print("### Init serial port $serdev at $serbaud bps\n");
+  
+  # Config serial port: 
+  #	- disable echo 
+  #	- enable hardware flow control
+  system("stty $serbaud -echo crtscts <$serdev");
+  open (SERIN, "<$serdev");
+  open (SEROUT, ">$serdev");
+
+  ### Alternative?
+  #sysopen (SERIN, $serdev, O_RDRW | O_NODELAY | O_NOCTTY)
+  #or die "Can't open $serdev: $!";
+  #my $ofh = select(SEROUT); $| = 1; 
+  #select($ofh);
+
+  $commMode = $rs232_mode;
+}
+
+
+
+sub tcpip_srv_init{
+  my ($logtarget, $tcpiphost, $tcpipport) = @_;
+
+  print "Open socket on $tcpiphost at port $tcpipport as server\n";
+  $gdsocket = new IO::Socket::INET( LocalHost => $tcpiphost,
+                                 LocalPort => $tcpipport,
+                                 Proto     => 'tcp',
+                                 Listen    => 1,
+                                 Reuse     => 1);
+
+  die "could not open socket: $!\n" unless $gdsocket;
+
+  $commMode = $tcpip_srv_mode;
+}
+
+sub tcpip_cli_init{
+  my ($logtarget, $tcpiphost, $tcpipport) = @_;
+
+  print "Open socket on $tcpiphost at port $tcpipport as client\n";
+  $gdsocket = new IO::Socket::INET( PeerAddr => $tcpiphost,
+                                 PeerPort => $tcpipport,
+                                 Proto    => 'tcp');
+
+  die "could not open socket: $!\n" unless $gdsocket;
+
+  $commMode = $tcpip_cli_mode;
+}
+
+#################################################################
+
+sub serio_getline { # returns one line
+  my $line = <SERIN>;
+  return $line;
+}
+
+sub putline_nack { # sends one line, without waiting for acknowledge (currently not used)
+  my ($line)=@_;
+  print (SEROUT "$line\n");
+}
+
+sub serio_putline
+### The soutine returns true, if the client does not want to receive
+### more lines (acknowledged with a 'stop' command).
+###
+### If the routines has to wait too long for an acknowledge (>20sec), the
+### transmission is aborted. Such situations could be caused by crashed
+### clients or broken transmission lines.
+{
+  my ($line)=@_;
+  my $ackstring;
+  print (SEROUT "$line\n");
+  ### wait for acknowledge (max 20 sec)
+  eval{
+    local $SIG{ALRM} = sub { die "ACK timeout" };	# set Alarm event handler
+    alarm 20;						# 20 sec timeout
+    
+    $ackstring=gdio::getline();
+    chop($ackstring);
+    
+    alarm 0;						# deactivate Alarm
+  };
+  if ($@ and $@ =~ /ACK timeout/ ) { 
+    print ("\nACKNOWLEDGE TIMEOUT\n\n");
+    $ackstring = "s"; #abort current transmission
+  };
+
+  if($ackstring eq "s"){
+    print ("\nACK-stop received\n");
+    return 1;	# stop transmission
+  }
+  else{
+    return 0;
+  }
+}
+
+#################################################################
+#
+# If we experienced and error reading for the socket, then
+# $connection would be set to "0" and so we need to wait for the 
+# palm client to reconnect.
+#
+# Thanks to Viktor for the tcpip code snippets
+
+sub tcpip_srv_check_connection{
+    my $timeout;
+    print "connection open? ... ";
+    if ( ! defined $connection ) {
+    	print "no\n";
+	print "Server accepting socket ... \n";
+	$connection = $gdsocket->accept();
+	$timeout = $connection->timeout();
+	#print "Server Connection time out is [$timeout] \n";
+	$timeout = $connection->timeout(60);
+	#print "Server Connection time out set to [$timeout] \n";
+    }
+    else{
+    	print "yes\n";
+    }
+
+    return $connection;
+}
+
+#
+# If we have an error reading the input assume client has
+# disconnected. We close the socket and return a "NULL" command
+#
+sub tcpip_srv_getline{
+  print "server listening ...\n";
+  my $line;
+  if ( $line = <$connection> ) {
+    #print "line recieved: [$line] \n";
+    return $line;
+  }
+  else {
+    print "Client disconnected ...\n";
+    close ($connection) ;
+    undef $connection;
+    return "NULL\n";
+  }
+}
+
+sub tcpip_cli_getline{
+  print "listening ...\n";
+  my $line;
+  if ( $line = <$gdsocket> ) {
+    #print "line recieved: [$line] \n";
+    return $line;
+  }
+}
+
+
+sub tcpip_srv_getline_SINGLECHAR{  ### just for tests ...
+  print "server listening ...\n";
+  my $line="";
+  my $cbuf;
+  while ( read $connection, $cbuf, 1 ) {
+    print "char recieved: [$cbuf] \n";
+    $line .= $cbuf;
+    last if ($cbuf eq "\n");
+  }
+  print "line recieved: [$line] \n";
+  return $line;
+}
+
+
+sub tcpip_srv_putline{
+# There is currently a problem with this routine.
+# The Palm client should be able to interrupt the transmission, if too many
+# lines are sent to it. When the client shuts down the socket, the server does
+# not directly recognize this. The 'if (print $connection $line."\n" )' is never
+# false, unless the Palm is turned off.
+# This has probably to do with the fact, that there is already sent data in a
+# buffer?
+#
+# The current workaround is, that the Palm receives the supernumerous lines, but
+# doesn't store them. Not very efficient ...  :-(
+
+  my ($line)=@_;
+  #print "Sending to socket: \"$line\"\n";
+#if (defined($connection->connected())){
+#print "WE ARE CONNECTED\n";}
+#else{
+#print "WE ARE _NOT_ CONNECTED\n";}
+
+  if (print $connection $line."\n" ) {
+    return 0; #don't stop
+  }
+  else{
+    print "Client disconnected ...\n";
+    close ($connection) ;
+    undef $connection;
+    return 1; #stop transmission
+  }
+}
+
+
+sub tcpip_cli_putline_NOACK{
+  my ($line)=@_;
+  #print "Sending to socket: \"$line\"\n";
+
+  if (print $gdsocket $line."\n" ) {
+    return 0; #don't stop
+  }
+  return 0;
+}
+sub tcpip_cli_putline
+{
+  my ($line)=@_;
+  my $ackstring;
+  print $gdsocket $line."\n";
+  ### wait for acknowledge (max 20 sec)
+  eval{
+    local $SIG{ALRM} = sub { die "ACK timeout" };	# set Alarm event handler
+    alarm 20;						# 20 sec timeout
+    
+    $ackstring=<$gdsocket>;
+    chop($ackstring);
+    
+    alarm 0;						# deactivate Alarm
+  };
+  if ($@ and $@ =~ /ACK timeout/ ) { 
+    print ("\nACKNOWLEDGE TIMEOUT\n\n");
+    $ackstring = "s"; #abort current transmission
+  };
+
+  if($ackstring eq "s"){
+    print ("\nACK-stop received\n");
+    return 1;	# stop transmission
+  }
+  else{
+    return 0;
+  }
+}
+
+
+
+#sub close_connection
+#{
+#  print "Closing Connection - $connection  \n";
+#  close($connection)
+#}
+
+#################################################################
+### public routines:
+
+sub check_connection
+{
+  if    ($commMode == $rs232_mode){
+    return 1;
+  }
+  elsif ($commMode == $tcpip_srv_mode){
+    return tcpip_srv_check_connection();
+  }
+  elsif ($commMode == $tcpip_cli_mode){
+    return 1;
+  }
+  else{
+    print "Error: unknown communication mode\n";
+    exit;
+  }
+}
+
+sub putline
+{
+  if    ($commMode == $rs232_mode){
+    return serio_putline(@_);
+  }
+  elsif ($commMode == $tcpip_srv_mode){
+    return tcpip_srv_putline(@_);
+  }
+  elsif ($commMode == $tcpip_cli_mode){
+    return tcpip_cli_putline(@_);
+  }
+  else{
+    print "Error: unknown communication mode\n";
+    exit;
+  }
+}
+
+sub getline
+{
+  if    ($commMode == $rs232_mode){
+    return serio_getline();
+  }
+  elsif ($commMode == $tcpip_srv_mode){
+    return tcpip_srv_getline();
+  }
+  elsif ($commMode == $tcpip_cli_mode){
+    return tcpip_cli_getline();
+  }
+  else{
+    print "Error: unknown communication mode\n";
+    exit;
+  }
+}
+
+
+#################################################################
+
+END{
+  print ("io modul finished\n");
+}
+
+#
+1;