File: [local] / mp3 / bin / removemp3playlist.pl (download)
Revision 1.3, Thu Feb 8 20:04:03 2007 UTC (17 years, 7 months ago) by andrew
Branch: MAIN
CVS Tags: HEAD Changes since 1.2: +21 -4 lines
First shot at making multiple jukeboxes from the same files.
|
#!/usr/bin/perl -w
# $RedRiver: removemp3playlist.pl,v 1.2 2006/08/12 00:14:53 andrew Exp $
########################################################################
# RemoveMP3Playlist.pl *** Removed MP3's from the playlist
#
# 04-19-00
# Written by andrew fresh <andrew@mad-techies.org>
########################################################################
use strict;
use diagnostics;
#my qw/ $removed $filename $list /;
########################################################################
# *** Variables ***
########################################################################
# *** MAIN ***
########################################################################
my ($prefix, $filename, $playlist) = split /\&/, $ENV{'QUERY_STRING'};
if ($filename) {
$filename =~ s/%(..)/pack("c",hex($1))/ge;
} else {
$filename ='';
}
if ($playlist) {
$playlist =~ s/%(..)/pack("c",hex($1))/ge;
} else {
$playlist ='playlist.lst';
}
if ($prefix) {
$prefix =~ s/%(..)/pack("c",hex($1))/ge;
} else {
$prefix ='';
}
my $list = '/var/www/mp3/playlist/' . $prefix . $playlist;
my @playlist = get_playlist($list);
$filename =~ s/%(..)/pack("c",hex($1))/ge;
my $removed = 0;
my $oldfilename;
print "Content-Type: text/html\n\n";
print "<html>\n<head>\n\t<meta HTTP-EQUIV='Pragma' CONTENT='no-cache'> <title>Removed $filename</title>\n<body>\n\n";
# Print_Nav();
my $i;
for ($i=0;$i<=$#playlist;$i++) {
if ($filename eq $playlist[$i]) {
$oldfilename = splice(@playlist,$i,1);
$removed++;
}
}
save_playlist($list,@playlist) || bail("Unable to save playlist!: $!");
if ($removed == 1) {
print "Removed $removed instance of $filename";
} elsif ($removed > 1) {
print "Removed $removed instances of $filename";
} else {
print "Not Removed!<br>\n";
print "$filename not found"
}
print "</body>\n</head>\n</html>\n";
########################################################################
# *** SUBS ***
########################################################################
#######################################################################
# writes back the new playlist
sub save_playlist {
my $FILE = shift;
my @lines = @_;
open (FILE, ">$FILE") || bail ("Couldn\'t open $FILE: $!");
foreach (@lines) {
print FILE "$_\n";
}
close (FILE) || bail ("Couldn't close $FILE: $!");
return 1;
}
#######################################################################
# read in the Playlist
sub get_playlist {
my $FILE = shift;
my @lines;
while (@lines == 0) {
open (FILE, $FILE) || bail ("Couldn\'t open $FILE: $!");
chomp (@lines = <FILE>);
close (FILE) || bail ("Couldn't close $FILE: $!");
}
return @lines;
}
########################################################################
# 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 {
my $error = "@_";
print "Error! $error";
exit;
}
########################################################################
sub Print_Nav
{
open FILE, 'nav.inc' or die "\n\ncouldn't open FILE nav.inc: $!";
while (<FILE>) {
print;
}
close FILE;
}