[BACK]Return to playmp3s.pl CVS log [TXT][DIR] Up to [local] / mp3 / daemon

File: [local] / mp3 / daemon / playmp3s.pl (download)

Revision 1.5, Thu Feb 8 18:13:33 2007 UTC (17 years, 3 months ago) by andrew
Branch: MAIN
Changes since 1.4: +3 -3 lines

I forgot, those are different files.

#!/usr/bin/perl
# $RedRiver: playmp3s.pl,v 1.4 2007/02/08 17:54:38 andrew Exp $
########################################################################
# PlayMP3.pl *** play's MP3s off a playlist using mp3play
#
# 04-14-00
# Written by andrew fresh <andrew@mad-techies.org>
########################################################################

use strict;
use warnings;
use diagnostics;

use vars qw/ %cfgs /;

my $config_file = shift || "/etc/playmp3s.conf";

my %cfgs = readconfig($config_file);

my $err_log = $cfgs{errors} || "/var/log/playmp3s.log";


Print_PlayLog("Beginning playtime\n\n");

my %Full_Playlist;
$Full_Playlist{last_mod} = 0;
my $playlist_last_mod = 0;

my @playlist;

for(;;) {
#   while(1) {
 	my $save_playlist;

        my ($last_mod) = (stat($cfgs{list}))[9];
	if ($playlist_last_mod != $last_mod) {
		@playlist = ();
		$playlist_last_mod = $last_mod;
	}

    	while (! @playlist) {
    		Print_PlayLog("Getting Playlist . . .\n");
#    		bail("getting playlist");
    		@playlist = get_playlist($cfgs{list});
			unless (@playlist) {
#	    		bail("getting full playlist");
				@playlist = get_full_playlist($cfgs{fulllist});
				

				Print_PlayLog("Got full playlist\n");
				$save_playlist = 0;
			} else {
				Print_PlayLog("Got normal playlist\n");
				$save_playlist = 1;
			}
			unless (@playlist) { sleep 10; }
		}
		Print_PlayLog("Got playlist\n");

		Print_PlayLog("getting song to play . . .\n");
		my $song = int rand(scalar(@playlist));
		my $filename = splice(@playlist,$song,1);
		Print_PlayLog("\tGot $song - filename is\n\t$filename\n");

		Print_PlayLog("displaying file that is playing . . . ");
		DisplayPlaying($cfgs{currenthtml},$filename);
		Print_PlayLog("done\n");

		if ($save_playlist) {
			Print_PlayLog("Saving Playlist. . .");
			save_playlist($cfgs{list},@playlist) || bail("Unable to save playlist!: $!");
			Print_PlayLog("done\n");
		} 

		Print_PlayLog("Playing: $filename . . .\n");
		
		if (defined $filename && $filename =~ /\.mp3$/i) {
			`$cfgs{mp3play} \"$cfgs{basedir}$filename\"`;
		} elsif ($filename =~ /\.ogg$/i) {
			my $play = "$cfgs{basedir}$filename";
			$play =~ s/(\(|\)|&|"|'| |-)/\\$1/g;
			print "\n\n$play\n\n";
			`$cfgs{oggplay} $play`;
		}


#	my $kid = 0;
#    while ($kid ne -1 && ContinueRun()) { 
#     while ($kid ne -1) { 
#   	print "waiting to end . . . ";
#        my $kid = waitpid(-1,&WNOHANG);
#       print "done.\n";
#    }


		if ($song) {
			Print_PlayLog("Adding Last. . .");
			delete ${ $Full_Playlist{list} }{$song};

			AddLast($filename, $cfgs{playedlist}, $cfgs{numhistory}, $cfgs{playedhtml}, $cfgs{addurl});
			Print_PlayLog("done\n");
		}
		
		Print_PlayLog("Displaying Nothing . . .");
		DisplayPlaying($cfgs{currenthtml},"Nothing");
		Print_PlayLog("done\n");

		#@playlist = ();
		
		sleep 1;
}


sub Install {
    # add your additional install messages or functions here
    print "\nThank you for installing this file\n";
}

sub Remove {
    # add your additional remove messages or functions here
    print "\nSorry you had to leave\n";
}

sub Help {
    # add your additional help messages or functions here
    print "\nYou don't really need help do you??\n";
}

#########################################################################
# GetTime
sub GetTime {
	my $hours = shift || 0;
	my ($sec,$min,$hour,$mday,$mon,$year,,,) = localtime(time - (3600 * $hours)); # 86400 seconds is one day
	
	if ($min  < 10) { $min  = "0$min"}
	if ($sec  < 10) { $sec  = "0$sec"}
	if ($hour < 10) { $hour = "0$hour"}
	if ($mday < 10) { $mday = "0$mday"}
	if ($mon  < 10) { $mon  = "0$mon"}
	
	my $time = ($year + 1900) . '-' . ++$mon . '-' . $mday  . ' ' . $hour . ':' . $min . ':' . $sec;
	return $time;
}
#########################################################################





#######################################################################
# read in the Playlist
sub get_full_playlist {
	my $FILE = shift;
	my ($last_mod) = (stat($FILE))[9];

	if ($Full_Playlist{last_mod} != $last_mod) {
		my @list;
		@list = get_playlist($FILE);

		@list = grep !m#$cfgs{skipregex}#io, @list;

		my @played_list = get_playlist($cfgs{playedlist});

		my %played;
		@played{@played_list} = ();

	
		delete $Full_Playlist{list};

		foreach my $song (@list) {	
			$Full_Playlist{list}{$song} = 1 
				unless (exists $played{$song});
		}

		$Full_Playlist{last_mod} = $last_mod;
	}

	return keys %{  $Full_Playlist{list} };
}
#######################################################################

#######################################################################
# read in the Playlist
sub get_playlist {
	my $FILE = shift;
	my @lines;
#	open PLAYlistLOG, ">c:/ps/playlistlog.txt";
	
#   print PLAYlistLOG "Getting Playlist from file: $FILE\n";	
 #  close PLAYlistLOG;
	if (-e $FILE) {
		open (FILE, $FILE) || bail ("Couldn't open $FILE: $!");
		chomp (@lines = <FILE>);
		close (FILE) || bail ("Couldn't close $FILE: $!");
	} else {
		open (FILE, ">$FILE") || return @lines;
		close (FILE) || bail ("Couldn't close $FILE: $!");
		return @lines;
	}
	return @lines;
}




#######################################################################
# writes back the new playlist
sub save_playlist {
	my $FILE = shift;
	my @lines = @_;
	open (FILE, ">$FILE") || bail ("Couldn\'t open playlist to save $FILE: $!");
	foreach (@lines) {
		print FILE "$_\n";
	}
	close (FILE) || bail ("Couldn't close $FILE: $!");
	return 1;
}




#######################################################################
# Prints a webpage with the currently playing song
sub DisplayPlaying {
	
	my $htmlfile = shift;
	my $playing  = shift;

	open BLANK, ">$htmlfile" or bail("Unable to open $htmlfile: $!");
	print BLANK "<html>\n<head>\n\t<title>' . $playing . '</title>\n";
	print BLANK "<meta HTTP-EQUIV=\"REFRESH\" CONTENT=\"5\">\n";
	print BLANK "<meta HTTP-EQUIV=\"Pragma\" CONTENT=\"no-cache\">\n";
	print BLANK "</head>\n";
	print BLANK '<body leftmargin="0"  topmargin="0" ',
	                   'marginwidth="0" marginheight="0">', "\n\n";
	print BLANK "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" width=\"100%\">\n";
	print BLANK "  <tr>\n";
	print BLANK "    <td align=\"left\"><b><i>Currently playing:</i> $playing</b></td>\n";
	print BLANK "    <td align=\"right\">Started at: " . GetTime() . "</td>\n";
	print BLANK "  </tr>\n";
	print BLANK "</table>\n";

#	print BLANK "<center><b>Currently playing: $playing</b><br>\nStarted at: " . GetTime() . "</center>";

	print BLANK "</body>\n</head>\n</html>\n";
	close BLANK || bail("Unable to close BLANK: $!");
}



#######################################################################
# Prints a webpage with the previously played song
# AddLast($filename, $cfgs{playedlist}, $cfgs{numhistory}, $cfgs{playedhtml}, $cfgs{addurl});
sub AddLast {
	my $lastsong = shift;
	my $lastlist = shift;
	my $history  = shift;
	my $htmlfile = shift;
	my $addurl   = shift;
	
	my @LIST = get_playlist($lastlist);
	unshift @LIST, $lastsong;
	splice (@LIST, $history);
	save_playlist($lastlist,@LIST);
	DisplayPrevious($htmlfile, $addurl, @LIST);
}




#######################################################################
# Prints a webpage with the previously played song
sub DisplayPrevious {
	
	my $htmlfile = shift;
	my $addurl   = shift;
	my $lastplay = shift;
	my @played   = @_;
	open BLANK, ">$htmlfile" or bail("Unable to open $htmlfile: $!");
	print BLANK "<html>\n<head>\n\t<title>' . $lastplay . '</title>\n";
	print BLANK "<meta HTTP-EQUIV=\"REFRESH\" CONTENT=\"30\">\n";
	print BLANK "<meta HTTP-EQUIV=\"Pragma\" CONTENT=\"no-cache\">\n";
	print BLANK "<body>\n\n";
	
	print BLANK "<p>[ <a href=\"bin/ShowFiles.pl\">Beginning</a> | \n";
	print BLANK "<a href=\"bin/ShowAll.pl\">All MP3's</a> |\n";
	print BLANK "<a href=\"bin/ShowPlaylist.pl\">Playlist</a> |\n";
	print BLANK "<a href=\"ShowPlaylist.pl?newlist.lst\">New Files</a> |\n";
	print BLANK "<a href=\"played.htm\">Previously played</a> ]<p>\n";





	print BLANK "<center><b>Last played: <a href=\"$addurl\?" . EncodeURL("$lastplay") . "\" target=\"bottom\">$lastplay</a></b><br>\nStarted at: " . GetTime() . "</center><p>\n";
	
	print BLANK "before that:<br>\n";
	
	print BLANK "<UL>\n";
	
	foreach my $song (@played) {
		print BLANK "\t<li>Song: <a href=\"$addurl\?" . EncodeURL("$song") . "\" target=\"bottom\">$song</a></li>\n";
	}
	
	print BLANK "</UL>\n";
	
	
	print BLANK "</body>\n</head>\n</html>\n";
	close BLANK || bail("Unable to close played.htm: $!");
}




########################################################################
# *** EncodeURL: %encodes the parameters of the URL
sub EncodeURL {
	my $strURL = shift;
	$strURL =~ s/(\W)/sprintf("%%%x", ord($1))/eg;
	return $strURL;
}



########################################################################
# read in config file.
sub readconfig {
	my $CONFIG = shift;
	my $delimter = shift || '=';
	my %configs;
		if (-e $CONFIG) {
		open (CONFIG, $CONFIG) or bail ("Couldn\'t open $CONFIG: $!");
		while (<CONFIG>) {
			chomp;	# no newline
			s/#.*//;	# no comments
			s/^\s+//;	# no leading  white space
			s/\s+$//;	# no trailing white space
			next unless length;	# anything left?
			my ($var, $value) = split(/\s*$delimter\s*/, $_, 2);
#			$var   =~ tr/A-Za-z0-9_\.\,\/\\ / /cd;	# delete all the non alphanumerics 
#			$value =~ tr/A-Za-z0-9_\/\.\,\\ / /cd;	# delete all the non alphanumerics 
			$var   =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 
			$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 
			$configs{$var}=$value;
		}
		close CONFIG or bail ("Couldn't close $CONFIG: $!");
	} else { print '<!-- No config file: ' . $CONFIG; print ' -->'; print "\n"; }
	return %configs;
}
########################################################################


#sub ForkMP3Player { # This forks the MP3 player.  
##	KillPlaying(0);
#	
#	my $player = shift;
#	my $song = shift;
#
#	$player =! s/%%f%%/\"$song\"/ig;
#
#	
#	FORK: {
#		if ($Mp3Playerpid = fork) {
#			# parent here
##			print "\nMp3Playerpid: ", $Mp3Playerpid;
#			# child process pid is available in $pid
#			print "Parent PID: $Mp3Playerpid\n";
#		} elsif (defined $Mp3Playerpid) { # $pid is zero here if defined
#			# child here
#			print "\nPlaying $song\n";
##			exec("$configs{mp3play} -b 16384 --reopen --aggressive -m \"$song\"");
#			print "\n";
##			exec("$player \"$song\"");
#			exec("$player");
#			exit(0);
#			# parent process pid is available with getppid
#		} elsif ($! =~ /No more process/) { 
#			# EAGAIN, supposedly recoverable fork error
#			sleep 5;
#			redo FORK;
#		} else {
#			# weird fork error
#			bail("\nCan't fork: $!");
#		}
#	}
#}




#######################################################################
# Bail: this subrouting dies and displays the error to the browser.
# gotten from the example in the O'Reilly 
# _Learning_Perl_on_Win32_Systems_
sub bail { 
	open ERR, '>>$err_log';
#	open ERR, ">>c:/ps/error.txt";

	my $error = "@_";
	print "Unexpected Error: $error\n";
	print ERR "Unexpected Error: $error\n";
	close ERR;
#	exit;
}

sub Print_PlayLog
{
	open PLAYLOG, ">>/tmp/playlog" or bail("Unable to open PLAYLOG");
	print GetTime(), "\t", @_;
	print PLAYLOG GetTime(), "\t", @_;
	close PLAYLOG;
}