File: [local] / mp3 / daemon / playmp3s.pl (download)
Revision 1.1.1.1 (vendor branch), Thu Mar 2 23:20:48 2006 UTC (18 years, 4 months ago) by andrew
Branch: REDRIVER
Changes since 1.1: +0 -0 lines
our MP3 player
|
#!/usr/bin/perl
########################################################################
# 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 /;
#use strict qw/ $cfgs{list} @playlist $cfgs{mp3play} $filename $cfgs{basedir} $cfgs{htmldir} /;
#use diagnostics;
my $config_file = shift || "/etc/playmp3s.conf";
my $err_log = $cfgs{errors} || "/var/log/playmp3s.log";
my %cfgs = readconfig($config_file);
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{htmldir},$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{htmldir}, $cfgs{addurl});
Print_PlayLog("done\n");
}
Print_PlayLog("Displaying Nothing . . .");
DisplayPlaying($cfgs{htmldir},"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 $htmldir = shift;
my $playing = shift;
open BLANK, ">$htmldir/current.htm" or bail("Unable to open current.htm: $!");
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{htmldir}, $cfgs{addurl});
sub AddLast {
my $lastsong = shift;
my $lastlist = shift;
my $history = shift;
my $htmldir = shift;
my $addurl = shift;
my @LIST = get_playlist($lastlist);
unshift @LIST, $lastsong;
splice (@LIST, $history);
save_playlist($lastlist,@LIST);
DisplayPrevious($htmldir, $addurl, @LIST);
}
#######################################################################
# Prints a webpage with the previously played song
sub DisplayPrevious {
my $htmldir = shift;
my $addurl = shift;
my $lastplay = shift;
my @played = @_;
open BLANK, ">$htmldir/played.htm" or bail("Unable to open $htmldir/played.htm: $!");
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;
}