#!/usr/bin/perl -w
use strict;
use IO::Socket;
use Net::hostent;                 # for OO version of gethostbyaddr

my $version = "0.02";
my $configfile = ".mpservrc";

my $conf = read_conf();
unless (defined $$conf{port}[0]) {
  $$conf{port}[0] = 1010;     # port to connect to
}

my $server = IO::Socket::INET->new( Proto     => 'tcp',
				    LocalPort => $$conf{port}[0],
				    Listen    => SOMAXCONN,
				    Reuse     => 1);
die "can't setup server" unless $server;

print "\n=[ $0 v$version ]=\n";
print "[Server $0 started on port ", $$conf{port}[0], "]\n";
print "[Creating MP3 DataBase]\n";
my $db = refresh(@{$$conf{hostsrc}});

my @queue      = ();
my $playing    = 0;
sub REAPER {
  my $waitedpid = wait;
  # loathe sysV: it makes us not only reinstate
  # the handler, but place it after the wait
  print "Hi, you've reached the reaper!\n";
  $playing = 0;
  shift @queue;
  $SIG{USR2} = \&REAPER;
  q_song($db, \@queue);
}
$SIG{USR2} = \&REAPER;

print "[Accepting Clients]\n";

my @motd = (
	    "Server version $version\n",
	    "-----------------------\n",
	    "This 'interface' is not really intended for humans\n",
	    "but instead for a well-designed client. I have given\n",
	    "some primitive help for the commands.\n"
	   );

my ($client, $hostinfo);
while ($client = $server->accept()) {
  $client->autoflush(1);
  #  print $client "Welcome to $0; type help for command list.\n";
  $hostinfo = gethostbyaddr($client->peeraddr);
  my $clienthost = $hostinfo->name || $client->peerhost;
  printf "[Connect from %s]\n", $clienthost;
  #  print $client "mp3serv> ";
  while (<$client>) {
    print;
    next unless /\S/;
    if    (/^(quit|exit)/i)    { last;                                     }
    elsif (/^(date|time)/i)    { printf $client "%s\n", scalar localtime;  }
    elsif (/^refresh/i)        { $db = refresh(@{$$conf{hostsrc}});        }
    elsif (/^(list|l\W)/i)     { echodb($client, $db);                     }
    elsif (/^(play|p\W)( ([ \S]+))?/i)  { q_song($db, \@queue, $3);        }
    elsif (/^(what|w\W)/i)     { print $client "Currently playing: $queue[0]\n";       }
    elsif (/^q\W/) { 
      for (my $i = 0; $i <= $#queue; $i++) {
	print $client "[$i] $queue[$i]\n";
      }
    }
    elsif (/^qrm ([ \S]+)?/i)   { q_remove(\@queue, $1);  }
    elsif (/^qup ([ \S]+)?/i)   { q_promote(\@queue, $1); }
    elsif (/^qdown ([ \S]+)?/i) { q_demote(\@queue, $1);  }
    elsif (/^motd/i)            { print $client @motd;    }
    elsif (/^(help|h\W)/i) { 
      if    (/ (list|l\W)/i) { 
	print $client "usage: list\n";
	print $client " desc: Available songs.\n";
      }
      elsif (/ qrm/i) {
	print $client "usage: qrm position\n";
	print $client " desc: remove item from queue at position\n";
      }
      elsif (/ qup/i) {
	print $client "usage: qup position\n";
	print $client " desc: promote item at position\n";
      } 
      elsif (/ qdown/i) {
	print $client "usage: qdown position\n";
	print $client " desc: demote item at position\n";
      }
      elsif (/ motd/i) {
	print $client "usage: motd\n";
	print $client " desc: Message of the day.\n";
      }
      elsif (/ (play|p\W)/i) { 
	print $client "usage: play [song]\n";
	print $client " song: entry appearing in 'list'\n";
	print $client " desc: Send song to the play queue; Whip server to sing.\n";
      }
      elsif (/ q\W/i) {
	print $client "usage: q\n";
	print $client " desc: What's in the queue (includes playing song).\n";
      }
      elsif (/ (quit|exit)/i) { 
	print $client "usage: quit | exit\n";
	print $client " desc: End session; Close connection.\n"; 
      }
      elsif (/ refresh/i) {
	print $client "usage: refresh\n";
	print $client " desc: Update list of songs available on source servers.\n";
      }
      elsif (/ (what|w)\W/i) {
	print $client "usage: what\n";
	print $client " desc: What is playing now?\n";
      }
      else {
	print $client "usage: help command\n";
	print $client " desc: Gives a short tidbit on what the command does.\n";
	print $client " cmds: exit list play qrm quit refresh what help\n";
      }
    }
    else { print $client "Commands: list motd play qrm refresh what help\n"; }
  } continue {
    #  print $client "mp3serv> ";
  }
  close $client;
  print "[$clienthost has left]\n";
}


sub refresh {
  my @hosts = @_;
  my ($host, $LIST, $url, $file, %db);
  foreach $host (@hosts) {
    $LIST = GetIndex($host, '/mp3/index');
    while (<$LIST>) {
      next unless(/^http/);  # weed out any non-URL entries
      chomp;
      ($url, $file) = split /\t/;
      $file =~ s/_/ /g;
      $db{$file}{'url'} = $url;
    }
  }
  return \%db;
}


sub q_promote {
  my ($q, $num) = @_;

  if($num < 1 || $num > $#$q) {
    print "can't promote $num\n";
  } elsif ($num == 1) {
    splice @$q, 2, 0, $$q[0];	# preempt playing song and requeue after song 1
    system 'killall mpg123';
  } else {
    my $temp = $$q[$num-1];
    $$q[$num-1] = $$q[$num];
    $$q[$num] = $temp;
  }

}

sub q_demote {
  my ($q, $num) = @_;

  if($num < 0 || $num >= $#$q) {
    print "can't demote $num\n";
  } elsif ($num == 0) {
    print "preempt";
    splice @$q, 2, 0, $$q[0];	# preempt playing song and requeue after song 1
    system 'killall mpg123';
  } else {
    my $temp = $$q[$num+1];
    $$q[$num+1] = $$q[$num];
    $$q[$num] = $temp;
  }
}

sub q_remove {
  my ($q, $num) = @_;
  if($num > $#$q) {
    print "can't remove $num from queue of length $#$q\n";
  } elsif ($num == 0) {
    system 'killall mpg123';	# untested
  } else {
    splice @$q, $num, 1;
  }
}

sub q_song {
  my ($db, $q, $song) = @_;
  print "Welcome to q_song!!\n";
  push @$q, $song if (defined $song);
  print "q_song: playing = $playing\n";
  print "q_song: song = ", defined($song) ? "$song\n" : "(undef)\n";
  print "q_song: currently ", scalar @$q, " songs in the queue\n";
  if (defined $$q[0] && $playing == 0) {    
    my $wget   = "wget " . quotemeta($$db{$$q[0]}{'url'}) . " -nv -O -";
    my $mpg123 = "mpg123 -b 4096 -q -";
    my $kill   = "kill -USR2 $$";
    my $wait_for_audio = 'perl -e \'while(not open(F,">/dev/dsp")) {print "waiting for /dev/dsp\n";sleep 2;}\'';
    my $cmd    = "( $wait_for_audio ; $wget | $mpg123 ; $kill ) &";
    print "$cmd\n";
    system $cmd;
    $playing++;
  }
}


sub echodb {
  my ($fh, $db) = @_;
  foreach my $elem (sort keys %$db) {
    print $fh "$elem\n";
  }
}


sub GetIndex {
  my ($host, $document) = @_;
  my $remote = IO::Socket::INET->new(Proto     => "tcp",
				     PeerAddr  => $host,
				     PeerPort  => "http(80)");
  unless ($remote) { die "cannot connect to http daemon on $host" }
  $remote->autoflush(1);
  print $remote "GET $document HTTP/1.0\n\n";
  return $remote;
}


sub read_conf {
  my (@line,%conf);
  open(CONFIG,"$ENV{HOME}/$configfile") 
    or die("\nCouldn't open configuration file \"$ENV{HOME}/$configfile\"!\n");
  while (<CONFIG>) {
    next if /^\#/;
    next if /^\s+$/;
    chomp;
    @line = split /=/;
    push @{$conf{$line[0]}}, $line[1];
  }
  return(\%conf);
}