File: [local] / mp3 / daemon / playmp3s.pl (download)
Revision 1.8, Tue Jun 14 15:53:27 2011 UTC (13 years, 1 month ago) by andrew
Branch: MAIN
Changes since 1.7: +291 -283 lines
perltidy
|
#!/usr/bin/perl
# $RedRiver: playmp3s.pl,v 1.7 2010/10/28 19:21:29 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";
my $Num_History = 0;
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");
Print_PlayLog("Adding Last. . .");
AddLast(
$filename, $cfgs{playedlist}, $Num_History,
$cfgs{playedhtml}, $cfgs{addurl}
);
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");
my $player;
my $play = "$cfgs{basedir}$filename";
if ( defined $filename && $filename =~ /\.mp3$/i ) {
$player = $cfgs{mp3play};
}
elsif ( $filename =~ /\.ogg$/i ) {
$player = $cfgs{oggplay};
#$play =~ s/(\(|\)|&|"|'| |-)/\\$1/g;
}
if ( not $player =~ s/\{\}/"$play"/g ) {
$player .= ' "' . $play . '"';
}
Print_PlayLog("$player\n");
`$player`;
# my $kid = 0;
# while ($kid ne -1 && ContinueRun()) {
# while ($kid ne -1) {
# print "waiting to end . . . ";
# my $kid = waitpid(-1,&WNOHANG);
# print "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};
my $list_size = 0;
foreach my $song (@list) {
$list_size++;
$Full_Playlist{list}{$song} = 1
unless ( exists $played{$song} );
}
my $history = int $list_size * 0.1;
if ($history) {
Print_PlayLog("New history is $history\n");
$Num_History = $history;
}
$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}, $Num_History, $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);
DisplayPrevious( $htmlfile, $addurl, @LIST ) if $htmlfile;
unshift @LIST, $lastsong;
splice( @LIST, $history ) if $history;
save_playlist( $lastlist, @LIST );
# Remove song from full list so we don't play it again.
delete $Full_Playlist{list}{$lastsong};
}
#######################################################################
# 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;
}