#!/usr/bin/perl

# request.pl
# - song request CGI to be used with icedj.pl
#
# Copyright (c) 1999 Arne Claassen <icedj@remixradio.com>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#

use strict;
use Time::Local;

print "Content-type: text/html\n\n";
$, = "\n";


# ____ Define Globals _________________________________________________________
use vars qw($FAILLOG $REQUESTLOG $AVAILABLE $USED $LOCKFILE $LOCKED);
use vars qw(%CONF @SONGINFO);

# _____ Get the CGI Input _____________________________________________________
my($buffer, $pair, @pairs, $name, $value, %in, @query_vals, $couple);
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
	($name, $value) = split(/=/, $pair);
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ s/\t/ /g;
	$in{$name} = $value;
	}

if ($ENV{'QUERY_STRING'}) {
	@query_vals = split(/&/, $ENV{'QUERY_STRING'});
	foreach $couple (@query_vals) {
		($name, $value) = split(/=/, $couple);
		$in{$name} = $value;
		}
	}

# ____ Get Config _____________________________________________________________
my($DOCROOT) = $ENV{'DOCUMENT_ROOT'};

$CONF{'datadir'} = "$DOCROOT/data/";
$FAILLOG = "$CONF{'datadir'}requesterr.log";

my ($CONF) = $CONF{'datadir'}.$in{'conf'};
if($in{'conf'} eq "") {
	ScriptError("NO CONFIG","Request are temporarily offline");
	}


open(CONF, $CONF) || ScriptError("OPEN ERR: CONFIG","Request are temporarily offline");
while (<CONF>) {
	chomp;
	if(/^#/) { next; } #comment, ignore line
	/(\S+)\s+(.*)$/;
	$CONF{$1} = $2;
	}
close(CONF);

# ____ Set up Constants _______________________________________________________
$AVAILABLE = "$CONF{'datadir'}avail-$CONF{'logname'}";
$USED = "$CONF{'datadir'}used-$CONF{'logname'}";
$LOCKFILE = "$CONF{'datadir'}icedj-$CONF{'logname'}.LCK";
$REQUESTLOG = "$CONF{'datadir'}request-$CONF{'logname'}.log";
$FAILLOG = "$CONF{'datadir'}failedrequest-$CONF{'logname'}.log";
@SONGINFO = ('request','path','artist','title');
push(@SONGINFO, split(/\s+/,$CONF{'songinfo'}));

# ____ Check for a show conflict ______________________________________________
if(-e "$CONF{'datadir'}$CONF{'logname'}.show") {
	open(SHOW, "$CONF{'datadir'}$CONF{'logname'}.show");
	my($showname) = <SHOW>;
	chomp $showname;
	close(SHOW);
	ScriptError('show conflict',"We are currently broadcasting the show, $showname. Please try your request again after the show has concluded.");
	}

checkRequest(%in);

makeRequest(%in);

exit;

# ____ checkRequest ___________________________________________________________
sub checkRequest {
	my(@in) = @_;
	my($M,$D,$Y,$h,$m,$s,$uniqueID,$requests,$temp,$found);
	if($in{'uniqueID'} eq "") { ScriptError("no track ID","No track ID was provided"); }
	open(LOG, "$REQUESTLOG");
	my(@block) = split(/\s+/, $CONF{'blockip'});
	foreach(@block) {
		s/\./\\./g;
		s/\*/\\w+/g;
		if( $ENV{'REMOTE_ADDR'}=~ /^$_$/) {
			ScriptError("BLOCKED","You have been blocked from making requests. If you feel that this was done in error please contact $CONF{'email'}.");
			}
		}
	open(PL, $CONF{'datadir'}.$CONF{'playlist'});
	my(@temp) = <PL>;
	close(PL);
	foreach $temp (@temp) {
		my(@songinfo) = split('\t',$temp);
		chomp @songinfo;
		my($curID) = lc(($songinfo[0]));
		$curID =~ s/\W//g;
		if($curID eq $in{'uniqueID'}) { $found = 1; }
		}
	unless($found) { ScriptError("INVALID TRACK","The requested track does not exist"); }
	
	my(@special) = split(/\s+/, $CONF{'specialip'});
	foreach(@special) {
		s/\./\\./g;
		s/\*/\\w+/g;
		return if( $ENV{'REMOTE_ADDR'}=~ /^$_$/);
		}

	while(<LOG>) {
		if(($M,$D,$Y,$h,$m,$s,$uniqueID) = m#<(\d+)/(\d+)/(\d+)\@(\d+):(\d+):(\d+)>\t$ENV{'REMOTE_ADDR'}\t(.*)$#) {
			if(time - (timelocal($s,$m,$h, $D,($M-1),$Y))<86400) {
				#it happened in the last 24 hours, so we care
				if($uniqueID eq $in{'uniqueID'}) {
					ScriptError("duplicate request attempt","You can request the same track only once in a 24 hour period");
					}
				$requests++;
				if($requests>int($CONF{'maxrequests'})) {
					ScriptError("bulk request attempt","You can only make $CONF{'maxrequests'} different requests in a 24 hour period");
					}
				}
			}
		}
	close(LOG);
	}

# ____ makeRequest ____________________________________________________________
sub makeRequest {
	my(@in) = @_;
	my($songinfo, $i, $msg, $dummy, $artist, $song, $path, $unique, $request);
	my($songinfo, $key, $tempblock);
	my(%song, @songinfo, @tail);
	my($orderindex) = 0;
	my($found) = 0;
	my($enqueued) = 0;
	my($before) = 0;
	my($count) = 0;
	lockfiles();
	open(AVAIL, "$AVAILABLE") || ScriptError("OPEN ERR: $AVAILABLE","Request are temporarily offline");
	open(AVAILTMP, ">$AVAILABLE.tmp") || ScriptError("WRITE ERR: $AVAILABLE.tmp","Request are temporarily offline");
	open(USED, "$USED") || ScriptError("OPEN ERR: $USED","Request are temporarily offline");
	open(USEDTMP, ">$USED.tmp") || ScriptError("WRITE ERR: $USED.tmp","Request are temporarily offline");
	my(@available) = <AVAIL>;
	my(@used) = <USED>;
	chomp(@available);
	chomp(@used);
	$msg = "what's wrong here?";
	#check USED to see if it was recently played
	for($i=0;$i<=$#used;$i++) {
		($request,$path) = (split('\t',$used[$i]));
		$unique = lc($path);
		$unique =~ s/\W//g;
		if($unique eq $in{'uniqueID'}) {
			$found = 1;
			$msg = "it was in used";
			($songinfo) = splice(@used,$i,1);
			#make sure that we don't play it again to soon
			$orderindex = $CONF{'replaymin'} - ($#used-$i);
			last;
			}
		}
	#it wasn't in USED, check available
	if(!$found) {
		for($i=0;$i<=$#available;$i++) {
			($request,$path) = (split('\t',$available[$i]));
			$unique = lc($path);
			$unique =~ s/\W//g;
			if($unique eq $in{'uniqueID'}) {
				$msg = "it was in available";
				if($request == 1) {
					$msg =  "$song has already been requested and is in the queue\n";
					$enqueued = 1;
					$before = $#available - $i;
					}
				else {
					($songinfo) = splice(@available,$i,1);
					}
				$found = 1;
				last;
				}
			}
		}
	if(!$found) {
		$msg = "The request song does not appear to be on the playlist\n";
		}
	elsif(!$enqueued) {
		#mark as request
		$songinfo =~ s/^0\t/1\t/;
		@songinfo = split('\t',$songinfo);
		for($i=0;$i<=$#SONGINFO;$i++) {
			$song{$SONGINFO[$i]} = $songinfo[$i];
			}
		if($orderindex>0) { 
			if($orderindex >= $#available) { 
				#available is too small, pull some from used
				unshift(@available, reverse(splice(@used, 0, $CONF{'replaymin'})));
				}
			@tail = splice(@available, ($#available-$orderindex+1),$orderindex);
			}
		while($#available>=0) {
			#available is getting too small, pull some from used
			if($#available <= 1) { 
				unshift(@available, reverse(splice(@used, 0, int($CONF{'replaymin'}/2))));
				}
			if($available[$#available] =~ /^1\t/) {
				unshift(@tail, pop(@available));
				}
			else {
				push(@available, $songinfo, @tail);
				$before = @tail;
				last;
				}
			}
		}
	print AVAILTMP @available;
	print AVAILTMP "\n";
	print USEDTMP @used;
	print USEDTMP "\n";
	close(AVAIL); 
	close(AVAILTMP);
	close(USED); 
	close(USEDTMP);
	unlink($AVAILABLE);
	unlink($USED);
	rename("$AVAILABLE.tmp",$AVAILABLE);
	rename("$USED.tmp",$USED);
	open(LOG, ">>$REQUESTLOG");
	my(@time) = localtime(time);
	my($i,$j);
	for($i=0;$i<=$#time;$i++)
		{
		if (length($time[$i])<2) {
			$time[$i] = "0$time[$i]";
			}
		}
	my($s,$m,$h,$D,$M,$Y) = @time;
	$M++;
	print LOG "<$M/$D/$Y\@$h:$m:$s>\t$ENV{'REMOTE_ADDR'}\t$in{'uniqueID'}\n";
	close(LOG);
	unlockfiles();


	open(TEMPLATE, "$CONF{'webroot'}$CONF{'requestpage'}.tmpl")|| ScriptError("OPEN ERR: $CONF{'webroot'}$CONF{'requestpage'}.tmpl","Request are temporarily offline");
	my(@template) = <TEMPLATE>;
	close(TEMPLATE);
	my($template) = join('',@template);
	my($header,$dummy,$block,$dummy,$footer) = $template =~ m#((\n|.)*)<!BLOCK>((\n|.)*)</!BLOCK>((\n|.)*)#;
	$song{'msg'} = $msg;
	foreach $key (keys %song) { 
		$header =~ s/<!$key>/$song{$key}/gi;		
		$footer =~ s/<!$key>/$song{$key}/gi;
		}
	my($oddblock,$evenblock);
	$oddblock = $evenblock = $block;
	$oddblock =~ s#<!EVEN>(\n|.)*?</!EVEN>##gi;
	$oddblock =~ s#<!ODD>((\n|.)*?)</!ODD>#$1#gi;
	$evenblock =~ s#<!ODD>(\n|.)*?</!ODD>##gi;
	$evenblock =~ s#<!EVEN>((\n|.)*?)</!EVEN>#$1#gi;
	
	print "$header\n";
	$i = 0;
	foreach (reverse(@available)) {
		last if ($count>$before);
		@songinfo = split('\t',$_);
		my(%song);
		for($j=0;$j<=$#SONGINFO;$j++) {
			$song{$SONGINFO[$j]} = $songinfo[$j];
			}
		$song{'request'} = ($song{'request'})?"Yes":"No";
		$i++;
		if($i % 2) { $tempblock = $oddblock; }
		else { $tempblock = $evenblock; }
		foreach $key (keys %song) {
			if($key =~ /^l_/) {
				$tempblock =~ s/<!$key>/<A HREF="$song{$key}">/gi
					unless($song{$key} eq "");
				}
			else {
				$tempblock =~ s/<!$key>/$song{$key}/gi;
				}
			}
		print "$tempblock\n";
		$count++;
		}
	print "$footer\n";
	}
	
# ____ lockfiles ___________________________________________________________________
# locks the data files used for the playlist
# using the lockfile utility provided with procmail for file locking. If you do
# not wish to use it, or have some other file mechanism replace the lockfile
# calls here
sub lockfiles {
#uncomment the below line if you use lockfile() for locking
#	system("/opt/bin/lockfile -2 -r 20 -s 3 -l 30 $LOCKFILE") && dieLog('locking is screwed!');
	}

# ____ unlockfiles _________________________________________________________________
# unlocks the data files used for the playlist
# using the lockfile utility provided with procmail for file locking. If you do
# not wish to use it, or have some other file mechanism replace the lockfile
# calls here
sub unlockfiles {
#uncomment the below lines if you use lockfile() for locking
#	chmod(0666,$LOCKFILE);
#	unlink($LOCKFILE);
	#also want to reset the permissions on our files...
	chmod(0666,$AVAILABLE);
	chmod(0666,$USED);
	}

# ____ ScriptError ____________________________________________________________
# if something goes wrong this returns an error page instead
sub ScriptError {
	my($err,$msg) = @_;
	unlockfiles() if($LOCKED);
	open(ERR,">>$FAILLOG");
	my(@time) = localtime(time);
	my($i);
	for($i=0;$i<=$#time;$i++)
		{
		if (length($time[$i])<2) {
			$time[$i] = "0$time[$i]";
			}
		}
	my($s,$m,$h,$D,$M,$Y) = @time;
#	my($s,$m,$h,$D,$M,$Y) = localtime(time);
	$M++;
	print ERR "<$M/$D/$Y\@$h:$m:$s>\t$ENV{'REMOTE_ADDR'}\t$in{'uniqueID'}\t$err\n";
	close(ERR);
	open(TEMPLATE, "$CONF{'webroot'}$CONF{'requestpage'}.err");
	my(@template) = <TEMPLATE>;
	close(TEMPLATE);
	my($template) = join('',@template);
	$template =~ s/<!errmsg>/$msg/gi;
	print $template;
	exit;
	}
