[BACK]Return to removemp3playlist.pl CVS log [TXT][DIR] Up to [local] / mp3 / bin

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>