Annotation of mp3/bin/addmp3playlist.pl, Revision 1.3
1.1 andrew 1: #!/usr/bin/perl -w
1.3 ! andrew 2: # $RedRiver: addmp3playlist.pl,v 1.2 2006/08/12 00:14:53 andrew Exp $
1.1 andrew 3: ########################################################################
4: # addmp3playlist.pl *** Adds MP3's to the playlist
5: #
6: # 04-13-00
7: # Written by andrew fresh <andrew@mad-techies.org>
8: ########################################################################
9: use strict;
10: use diagnostics;
11:
12:
13:
14: ########################################################################
15: # *** Variables ***
16: my $DestDir = '/home/mp3/Sorted';
17:
18:
19:
20: ########################################################################
21: # *** MAIN ***
22: ########################################################################
23: if (! -d $DestDir) { mkdir $DestDir, 0777 }
24:
1.3 ! andrew 25: my ($prefix, $filename, $playlist) = split /\&/, $ENV{'QUERY_STRING'};
1.1 andrew 26:
1.3 ! andrew 27: if ($filename) {
! 28: $filename =~ s/%(..)/pack("c",hex($1))/ge;
! 29: } else {
! 30: $filename ='';
! 31: }
! 32: if ($playlist) {
! 33: $playlist =~ s/%(..)/pack("c",hex($1))/ge;
! 34: } else {
! 35: $playlist ='playlist.lst';
! 36: }
! 37:
! 38: if ($prefix) {
! 39: $prefix =~ s/%(..)/pack("c",hex($1))/ge;
! 40: } else {
! 41: $prefix ='';
! 42: }
! 43:
! 44: my $playlist = '/var/www/mp3/playlist/' . $prefix . $playlist;
1.1 andrew 45:
46: print "Content-Type: text/html\n\n";
47:
48:
49: if ($filename) {
50: print "<html>\n<head>\n\t<meta HTTP-EQUIV='Pragma' CONTENT='no-cache'>";
51:
52: if ($ENV{'QUERY_STRING'}) {
53: print "<meta HTTP-EQUIV=Refresh CONTENT=\"10; URL=/blank.htm\">";
54: }
55:
56: print "<title>Added $filename</title>\n<body>\n\n";
57:
58: print "<h3>Added $filename</h3>\n";
59: open PLAYLIST, ">>$playlist" or bail("unable to open PLAYLIST: $!");
60: print PLAYLIST "$filename\n";
61: close PLAYLIST or bail("unable to close PLAYLIST: $!");
62: } else {
63: print "<h1>You need to pass a song</h1>";
64: }
65:
66: print "</body>\n</head>\n</html>\n";
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77: ########################################################################
78: # *** SUBS ***
79: ########################################################################
80:
81:
82:
83:
84:
85:
86:
87:
88: ########################################################################
89: # Bail: this subrouting dies and displays the error to the browser.
90: # gotten from the example in the O'Reilly
91: # _Learning_Perl_on_Win32_Systems_
92: sub bail {
93: my $error = "@_";
94: print "Error! $error";
95: exit;
96: }
97: ########################################################################
98:
99:
100: sub Print_Nav
101: {
102: open FILE, 'nav.inc' or die "\n\ncouldn't open FILE nav.inc: $!";
103: while (<FILE>) {
104: print;
105: }
106: close FILE;
107: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>