xine-cddb-server.pl.txt

`#!/usr/bin/perl --  
  
# xine-cddb-server  
# by Ulf Harnhammar in 2005  
# I hereby place this program in the public domain.  
  
use strict;  
use IO::Socket;  
  
$main::port = 8880;  
$main::timeout = 5;  
  
  
# *** SUBROUTINES ***  
  
  
sub mysend($$)  
{  
my $file = shift;  
my $str = shift;  
  
print $file "$str\n";  
print "SENT: $str\n";  
} # sub mysend  
  
  
sub myreceive($)  
{  
my $file = shift;  
my $inp;  
  
eval  
{  
local $SIG{ALRM} = sub { die "alarm\n" };  
alarm $main::timeout;  
$inp = <$file>;  
alarm 0;  
};  
  
if ($@ eq "alarm\n") { $inp = ''; print "TIMED OUT\n"; }  
$inp =~ tr/\015\012\000//d;  
print "RECEIVED: $inp\n";  
$inp;  
} # sub myreceive  
  
  
# *** MAIN PROGRAM ***  
  
  
{  
my $server = IO::Socket::INET->new( Proto => 'tcp',  
LocalPort => $main::port,  
Listen => SOMAXCONN,  
Reuse => 1);  
die "can't set up server!\n" unless $server;  
  
  
while (my $client = $server->accept())  
{  
$client->autoflush(1);  
print 'connection from '.$client->peerhost."\n";  
  
  
mysend($client, '201 metaur CDDBP server v1.5PL2 ready at '.  
scalar localtime);  
  
while (my $str = myreceive($client))  
{  
if ($str =~ m/^cddb hello ([^ ]+) ([^ ]+) (.+)$/i)  
{  
mysend($client, "200 Hello and welcome $1\@$2 running $3.");  
next;  
}  
  
if ($str =~ m/^proto (\d+)$/i)  
{  
mysend($client, "201 OK, CDDB protocol level now: $1");  
next;  
}  
  
if ($str =~ m/^cddb query ([0-9a-f]+)/i)  
{  
mysend($client, "200 rock $1 Exploiters / Formatted and Stringed");  
next;  
}  
  
if ($str =~ m/^cddb read ([a-z]+) ([0-9a-f]+)/i)  
{  
my $docum = <<HERE;  
210 $1 $2 CD database entry follows (until terminating \`.')  
# %n%n%n%n  
DISCID=$2  
DTITLE=Exploiters / Formatted and Stringed  
DYEAR=2005  
DGENRE=Rock  
TTITLE0=Format  
TTITLE1=String  
TTITLE2=Bug  
EXTD= YEAR: 2005  
EXTT0=  
EXTT1=  
EXTT2=  
PLAYORDER=  
.  
HERE  
  
$docum =~ s|\s+$||s;  
mysend($client, $docum);  
next;  
}  
  
if ($str =~ m/^quit$/i)  
{  
mysend($client, '230 metaur Closing connection. Goodbye.');  
last;  
}  
  
mysend($client, '500 Unrecognized command.');  
} # while str=myreceive(client)  
  
close $client;  
print "closed\n\n\n";  
} # while client=server->accept()  
}  
`