#!/usr/bin/perl -w

package MusicServer;

use strict;
use IO::Socket;
use Carp;

my $PROTOCOL = '5.1';

################################################################################
# Library routines
################################################################################

sub new {
	my $pkg = shift;
	my $connection = bless {
		server	=>	'localhost',
		port	=>	'5096',
		username	=>	'',
		password	=>	'',
	}, $pkg;
	return $connection;
}

sub server {
	my $self = shift;
	@_ ? $self->{server} = shift
	   : $self->{server};
}

sub port {
	my $self = shift;
	@_ ? $self->{port} = shift
	   : $self->{port};
}

sub username {
	my $self = shift;
	@_ ? $self->{username} = shift
	   : $self->{username};
}

sub password {
	my $self = shift;
	@_ ? $self->{password} = shift
	   : $self->{password};
}

sub connect {
	my $self = shift;
	$self->{socket} = new IO::Socket::INET(
		PeerAddr => $self->{server},
		PeerPort => $self->{port},
		Proto	=> 'tcp') or return 0;
	$self->printSocket("HELO v$PROTOCOL\r\n");
	while ($_ = $self->readSocket) {
		if (/^HELO v/) {
			return 1;
		} elsif (/^NOVER$/) {
			carp "The server does not accept protocol $PROTOCOL.";
			return 0;
		}
	}
}

sub printSocket {
	my $self = shift;
	my @data = @_;
	my $socket = $self->{socket};
	for (@data) {
		print $socket "$_" or carp "Could not write to socket.";
	}
}

sub readSocket {
	my $self = shift;
	my $socket = $self->{socket};
	if ($_ = $socket->getline) {
		s/\r\n$//;
		return $_;
	} else {
		carp "Could not read from socket.";
		return 0;
	}
}

# Connection

#sub helo {
#	my $self = shift;
#	$self->printSocket("HELO v$PROTOCOL\r\n");
#	$self->readSocket;
#}

sub iam {
	my $self = shift;
	$self->printSocket("IAM::$self->{username}::$self->{password}\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^WHOAREYOU$/) {
		carp "The IAM command was formed incorrectly.";
		return 0;
	} elsif (/^BADUSER$/) {
		carp "Username/password wrong.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub quit {
	my $self = shift;
	$self->printSocket("QUIT\r\n");
	return 1;
}

################################################################################
# Player Controls
################################################################################

sub play {
	my $self = shift;
	$self->printSocket("PLAY\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^ALREADYPLAYING$/) {
		carp "The server was already playing a track.";
		return 0;
	} elsif (/^NOMORETRACKS$/) {
		carp "The server was at the end of the playlist.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub stop {
	my $self = shift;
	$self->printSocket("STOP\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTYOURS$/) {
		carp "The current track is not yours.";
		return 0;
	} elsif (/^NOTPLAYING$/) {
		carp "The server is not playing anything.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub next {
	my $self = shift;
	$self->printSocket("NEXT\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTYOURS$/) {
		carp "The current track is not yours.";
		return 0;
	} elsif (/^NOMORETRACKS$/) {
		carp "The server is at the end of the playlist.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub back {
	my $self = shift;
	$self->printSocket("BACK\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTYOURS$/) {
		carp "The current track is not yours.";
		return 0;
	} elsif (/^NOMORETRACKS$/) {
		carp "The server is at the start of the playlist.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub goto {
	my $self = shift;
	my $track = shift;
	$self->printSocket("GOTO::$track\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTYOURS$/) {
		carp "The current track is not yours.";
		return 0;
	} elsif (/^NOTFOUND$/) {
		carp "Track $track was not found in the queue or history";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub listhead {
	my $self = shift;
	$self->printSocket("LISTHEAD\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTYOURS$/) {
		carp "The current track is not yours.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

################################################################################
# Queue Manipulation
################################################################################

sub enqueue {
	my $self = shift;
	my $file = shift;
	$self->printSocket("ENQUEUE::$file\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTFOUND$/) {
		carp "File $file was not found.";
		return 0;
	} elsif (/^HITLIMIT$/) {
		carp "The user has reached their track capacity.";
		return 0;
	} elsif (/^ALREADYQUEUED$/) {
		carp "The track is already in the playlist.";
		return 0;
	} elsif (/^TOOLONG$/) {
		carp "The track is too long.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub clear {
	my $self = shift;
	$self->printSocket("CLEAR\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub remove {
	my $self = shift;
	my $trackid = shift;
	$self->printSocket("REMOVE::$trackid\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTYOURS$/) {
		carp "Track $trackid is not yours.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub rmregex {
	my $self = shift;
	my $regex = shift;
	$self->printSocket("RMREGEX::$regex\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub addsignpost {
	my $self = shift;
	my ($type,$repeats,$arguments) = @_;
	$self->printSocket("ADDSIGNPOST::$type::$repeats");
	$self->printSocket("::$arguments") if $arguments;
	$self->printSocket("\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^BADCMD$/) {
		carp "No signpost support.";
		return 0;
	} elsif (/^NOTFOUND$/) {
		carp "Bad type: $type";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub swap {
	my $self = shift;
	my ($trackid1,$trackid2) = @_;
	$self->printSocket("SWAP::$trackid1::$trackid2\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTFOUND$/) {
		carp "At least one of $trackid1 and $trackid2 was not found.";
		return 0;
	} elsif (/^NOTYOURS$/) {
		carp "Permission denied on at least one of $trackid1 and $trackid2.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

################################################################################
# Information
################################################################################

sub queue {
	my $self = shift;
	$self->printSocket("QUEUE\r\n");
	my @queue;
	while ($_ = $self->readSocket) {
		last if /^ENDQUEUE/;
		if (/^(CURRENT)?TRACK::(.*?)::SIGNPOST: (.*?)::(.*?)::(.*)$/) {
			push @queue, {
				'current'	=>	($1 ? 1 : 0),
				'owner'		=>	$2,
				'type'		=>	$3,
				'trackid'	=>	$4,
				'repeats'	=>	$5,
			};
		} elsif (/^(CURRENT)?TRACK::(.*?)::(.*?)::(.*?)::(.*?)::(.*?)$/) {
			push @queue, {
				'current'	=>	($1 ? 1 : 0),
				'owner'		=>	$2,
				'title'		=>	$3,
				'trackid'	=>	$4,
				'time'		=>	$5,
				'seconds'	=>	$6,
			};
		} else {
			carp "Bad response from server.";
			return 0;
		}
	}
	return @queue;
}

sub currenttrack {
	my $self = shift;
	$self->printSocket("CURRENTTRACK\r\n");
	$_ = $self->readSocket;
	if (/^CURRENTTRACK::(.*?)::(.*?)::(.*?)::(.*?)::(.*)$/) {
		return {
			'owner' => $1,
			'title' => $2,
			'trackid' => $3,
			'time' => $4,
			'seconds' => $5,
		};
	} elsif (/^NOTFOUND$/) {
		carp "No current track was found.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub time {
	my $self = shift;
	$self->printSocket("TIME\r\n");
	$_ = $self->readSocket;
	if (/^TIME::(.*)$/) {
		return $1;
	} elsif (/^NOTPLAYING$/) {
		carp "The server was not playing.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub getpath {
	my $self = shift;
	my ($type,$track) = @_;
	$self->printSocket("GET${type}PATH::$track\r\n");
	$_ = $self->readSocket;
	if (/^PATH::(.*)$/) {
		return $1;
	} elsif (/^NOTFOUND$/) {
		carp "Trackid $track was not found.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub uptime {
	my $self = shift;
	$self->printSocket("UPTIME\r\n");
	$_ = $self->readSocket;
	if (/^(.*?)::(.*?)::(.*?)::(.*?)::(.*?)$/) {
		return {
			'days'		=> $1,
			'hours'		=> $2,
			'minutes'	=> $3,
			'seconds'	=> $4,
			'tracks'	=> $5,
		};
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

################################################################################
# VFS
################################################################################

sub vfs_ls {
	my $self = shift;
	my $path = shift;
	$self->printSocket("VFS-LS");
	$self->printSocket("::$path") if $path;
	$self->printSocket("\r\n");
	my @listing;
        while ($_ = $self->readSocket) {
		if (/^FILE::(.*)$/) {
			push @listing, $1;
		} elsif (/^DIR::(.*)$/) {
			push @listing, $1;
		} elsif (/^ENDLS$/) {
    			return @listing;
		} elsif (/^NOTFOUND$/) {
			carp "The CWD is not valid or could not be read.";
			return 0;
		} else {
			carp "Bad response from server.";
			return 0;
		}
        }
}

sub vfs_cd {
	my $self = shift;
	my $dir = shift;
	$self->printSocket("VFS-CD::$dir\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTDIR$/) {
		carp "$dir is not a directory.";
		return 0;
	} elsif (/^NOTFOUND$/) {
		carp "$dir was not found.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub vfs_cwd {
	my $self = shift;
	$self->printSocket("VFS-CWD\r\n");
	$_ = $self->readSocket;
	if (/^CWD::(.*)$/) {
		return $1;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub vfs_enqueue {
	my $self = shift;
	my $file = shift;
	$self->printSocket("VFS-ENQUEUE::$file\r\n");
	$_ = $self->readSocket;
	if (/^OK$/) {
		return 1;
	} elsif (/^NOTFOUND$/) {
		carp "The file $file was not found.";
		return 0;
	} elsif (/^HITLIMIT$/) {
		carp "The user has already reached their track capacity.";
		return 0;
	} elsif (/^ALREADYQUEUED$/) {
		carp "The track is already in the playlist.";
		return 0;
	} elsif (/^TOOLONG$/) {
		carp "The track is too long.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

sub vfs_getpath {
	my $self = shift;
	my ($type,$vfspath) = @_;
	$self->printSocket("VFS-GET${type}PATH::$vfspath\r\n");
	$_ = $self->readSocket;
	if (/^PATH::(.*)$/) {
		return $1;
	} elsif (/^NOTFOUND$/) {
		carp "The track $vfspath was not found.";
		return 0;
	} else {
		carp "Bad response from server.";
		return 0;
	}
}

################################################################################
# Admin
################################################################################
#sub shutdown {
#	my $self = shift;
#	$self->printSocket("SHUTDOWN\r\n");
#	$_ = $self->readSocket;
#	if (/^BYE$/) {
#		return 1;
#	} else {
#		carp "Bad response from server.";
#		return 0;
#	}
#}

#sub user_add {
#	my $self = shift;
#	my ($userid,$password,$track_limit) = @_;
#	$self->printSocket("USER_ADD::$userid::$password::$track_limit\r\n");
#	$_ = $self->readSocket;
#	if (/^OK$/) {
#		return 1;
#	} else {
#		carp "Bad response from server.";
#		return 0;
#	}
#}

#sub user_kill {
#	my $self = shift;
#	my $userid = shift;
#	$self->printSocket("USER-KILL::$userid\r\n");
#	$_ = $self->readSocket;
#	if (/^OK$/) {
#		return 1;
#	} elsif (/^BADUSER$/) {
#		carp "User $userid does not exist.";
#		return 0;
#	} else {
#		carp "Bad response from server.";
#		return 0;
#	}
#}

#sub user_pass {
#	my $self = shift;
#	my ($userid,$password) = @_;
#	$self->printSocket("USER-PASS::$userid::$password\r\n");
#	$_ = $self->readSocket;
#	if (/^OK$/) {
#		return 1;
#	} elsif (/^BADUSER$/) {
#		carp "The user specified does not exist.";
#		return 0;
#	} else {
#		carp "Bad response from server.";
#		return 0;
#	}
#}

#sub user_limit {
#	my $self = shift;
#	my ($userid,$newlimit) = @_;
#	$self->printSocket("USER-LIMIT::$userid::$newlimit\r\n");
#	$_ = $self->readSocket;
#	if (/^OK$/) {
#		return 1;
#	} elsif (/^BADUSER$/) {
#		carp "User $userid does not exist.";
#		return 0;
#	} else {
#		carp "Bad response from server.";
#		return 0;
#	}
#}

#sub user_list {
#	my $self = shift;
#	$self->printSocket("USER-LIST\r\n");
#	my @userlist;
#	while ($_ = $self->readSocket) {
#		if (/^USER::(.*?)::(.*?)$/) {
#			push @userlist, [$1,$2];
#		} elsif (/^ENDULIST$/) {
#			return @userlist;
#		} else {
#			carp "Bad response from server.";
#			return 0;
#		}
#	}
#}

#sub get {
#	my $self = shift;
#	my $option = shift;
#	$self->printSocket("GET::$option\r\n");
#	my @optionlist;
#	while ($_ = $self->readSocket) {
#		if (/^OPTION::(.*?)$/) {
#			push @optionlist, [];
#		}	
#	}
#}

#sub set {
#	my $self = shift;
#	my ($option,$value) = @_;
#	$self->printSocket("SET::$option=$value\r\n");
#	$self->readSocket;
#}

#sub playlist_save {
#	my $self = shift;
#	my $filename = shift;
#	$self->printSocket("PLAYLIST-SAVE::$filename\r\n");
#	$self->readSocket;
#}

#sub playlist_load {
#	my $self = shift;
#	my $filename = shift;
#	$self->printSocket("PLAYLIST-LOAD::$filename\r\n");
#	$self->readSocket;
#}

1;