Annotation of mp3/bin/removemp3playlist.pl, Revision 1.3
1.1 andrew 1: #!/usr/bin/perl -w
1.3 ! andrew 2: # $RedRiver: removemp3playlist.pl,v 1.2 2006/08/12 00:14:53 andrew Exp $
1.1 andrew 3: ########################################################################
4: # RemoveMP3Playlist.pl *** Removed MP3's from the playlist
5: #
6: # 04-19-00
7: # Written by andrew fresh <andrew@mad-techies.org>
8: ########################################################################
9: use strict;
10: use diagnostics;
11:
12:
13: #my qw/ $removed $filename $list /;
14: ########################################################################
15: # *** Variables ***
16:
17:
18:
19: ########################################################################
20: # *** MAIN ***
21: ########################################################################
1.3 ! andrew 22: my ($prefix, $filename, $playlist) = split /\&/, $ENV{'QUERY_STRING'};
! 23: if ($filename) {
! 24: $filename =~ s/%(..)/pack("c",hex($1))/ge;
! 25: } else {
! 26: $filename ='';
! 27: }
! 28: if ($playlist) {
! 29: $playlist =~ s/%(..)/pack("c",hex($1))/ge;
! 30: } else {
! 31: $playlist ='playlist.lst';
! 32: }
! 33:
! 34: if ($prefix) {
! 35: $prefix =~ s/%(..)/pack("c",hex($1))/ge;
! 36: } else {
! 37: $prefix ='';
! 38: }
! 39:
! 40: my $list = '/var/www/mp3/playlist/' . $prefix . $playlist;
1.1 andrew 41:
42: my @playlist = get_playlist($list);
43: $filename =~ s/%(..)/pack("c",hex($1))/ge;
44: my $removed = 0;
45: my $oldfilename;
46:
47: print "Content-Type: text/html\n\n";
1.3 ! andrew 48: print "<html>\n<head>\n\t<meta HTTP-EQUIV='Pragma' CONTENT='no-cache'> <title>Removed $filename</title>\n<body>\n\n";
1.1 andrew 49:
50: # Print_Nav();
51: my $i;
52: for ($i=0;$i<=$#playlist;$i++) {
53: if ($filename eq $playlist[$i]) {
54: $oldfilename = splice(@playlist,$i,1);
55: $removed++;
56: }
57: }
58:
59: save_playlist($list,@playlist) || bail("Unable to save playlist!: $!");
60:
61: if ($removed == 1) {
62: print "Removed $removed instance of $filename";
63: } elsif ($removed > 1) {
64: print "Removed $removed instances of $filename";
65: } else {
66: print "Not Removed!<br>\n";
67: print "$filename not found"
68: }
69:
70: print "</body>\n</head>\n</html>\n";
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81: ########################################################################
82: # *** SUBS ***
83: ########################################################################
84:
85:
86:
87:
88: #######################################################################
89: # writes back the new playlist
90: sub save_playlist {
91: my $FILE = shift;
92: my @lines = @_;
93: open (FILE, ">$FILE") || bail ("Couldn\'t open $FILE: $!");
94: foreach (@lines) {
95: print FILE "$_\n";
96: }
97: close (FILE) || bail ("Couldn't close $FILE: $!");
98: return 1;
99: }
100:
101:
102:
103:
104: #######################################################################
105: # read in the Playlist
106: sub get_playlist {
107: my $FILE = shift;
108: my @lines;
109: while (@lines == 0) {
110: open (FILE, $FILE) || bail ("Couldn\'t open $FILE: $!");
111: chomp (@lines = <FILE>);
112: close (FILE) || bail ("Couldn't close $FILE: $!");
113: }
114: return @lines;
115: }
116:
117:
118:
119:
120:
121: ########################################################################
122: # Bail: this subrouting dies and displays the error to the browser.
123: # gotten from the example in the O'Reilly
124: # _Learning_Perl_on_Win32_Systems_
125: sub bail {
126: my $error = "@_";
127: print "Error! $error";
128: exit;
129: }
130: ########################################################################
131:
132:
133: sub Print_Nav
134: {
135: open FILE, 'nav.inc' or die "\n\ncouldn't open FILE nav.inc: $!";
136: while (<FILE>) {
137: print;
138: }
139: close FILE;
140: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>