mediaserv:playlists

#!/usr/bin/perl require "environment.pl"; require "config.pl"; $|=1; $path = 'playlists' . $path unless $path =~ m|^/media|; if($path ne 'playlists' && -d $docroot.$path) { print STDERR "first if\n"; if($ENV{QUERY_STRING} eq 'Stream') { if($metafile eq 'm3u') { print "Content-type: audio/x-mpegurl\r\n\r\n"; @files = `find '$docroot$path' -follow -type f | sort`; foreach (@files) { chomp; next if /\.$metafile_re$/; my $filepath = $_; $filepath =~ s|$docroot||; $filepath =~ s|//|/|g; print "http://$ENV{SERVER_NAME}", &tourl($filepath), "\r\n" if -f $_; } } elsif($metafile eq 'ram' || $metafiles eq 'rmm') { print "Content-type: audio/x-pn-realaudio\r\n\r\n"; @files = `find '$docroot$path' -follow -type f | sort`; foreach (@files) { chomp; next if /\.$metafile_re$/; my $filepath = $_; $filepath =~ s|$docroot||; $filepath =~ s|//|/|g; print "rtsp://$ENV{SERVER_NAME}", &tourl($filepath), "\r\n" if -f $_; } } exit(0); } } elsif($path =~ /\.m3u$/) { print STDERR "second if\n"; print "Content-type: audio/x-mpegurl\r\n\r\n"; if($path =~ m/\.n\.m3u/) { # negative playlist open(PL,'<'.$docroot.$path); $path =~ s|/[^/]+\.m3u$||; $path = '/media/audio' if $path =~ m|^playlists|; my %filtered = (); my %filtered_directories = (); while() { chomp; s/[\r\n]//g; $_ = "media/" . $_; $filtered{$_}++; $filtered_directories{$_}++ if -d $docroot.$_; } my $directory_filter = '^(' . join('|', sort keys %filtered_directories) . ')' if %filtered_directories; my @files = `find '${docroot}media' -follow -type f | sort`; foreach (@files) { chomp; next unless /\.$mediafile_re$/; #next if /\.$metafile_re$/; my $filepath = $_; $filepath =~ s|$docroot||; $filepath =~ s|//|/|g; next if $filtered{$filepath}; next if $directory_filter && ($filepath =~ m|$directory_filter|); print "http://$ENV{SERVER_NAME}/", &tourl($filepath), "\r\n" if -f $_; } } else { print STDERR "blah\n"; open(PL,'<'.$docroot.$path); print STDERR '<'.$docroot.$path,"\n"; $path =~ s|/[^/]+\.m3u$||; $path = '/media' if $path =~ m|^playlists|; while() { chomp; s/[\r\n]//g; #print STDERR "\$_: '$_'\n"; $filepath = $docroot.$path.'/'.$_; $filepath =~ s| / | - |g; #print STDERR "\$filepath: '$filepath'\n"; print STDERR "can't find '$filepath'\n" unless -f $filepath; print "http://$ENV{SERVER_NAME}", &tourl($path.'/'.$_), "\r\n" if -f $filepath; } } } elsif($path ne 'playlists') { print STDERR "third if\n"; if($metafile eq 'm3u') { my $realpath = "http://$ENV{SERVER_NAME}" . &tourl($path); print "Content-type: audio/x-mpegurl\r\n\r\n"; print "$realpath\r\n"; } elsif(($metafile eq 'ram') || ($metafile eq 'rmm') || ($metafile eq 'smil')) { my $realpath = "rtsp://$ENV{SERVER_NAME}" . &tourl($path); print "Content-type: audio/x-pn-realaudio\r\n\r\n"; print "$realpath\r\n"; } else { my $realpath = "http://$ENV{SERVER_NAME}" . &tourl($path); print "Status: 302 Found\r\nLocation: $realpath\r\n\r\n"; } } else { print STDERR "fourth if\n"; print "Content-type: text/html\r\n\r\n"; print "\r\n"; print " \r\n"; print " mediaserv:playlists\n"; print " "; print " \n"; print " \n"; print " \n"; print " \n"; if($path =~ m/[A-Z]/) { print " \n"; print " \n"; print " \n"; } print "

\n"; print " \n"; my @lists = (); $username ||= 'martian'; $path = 'playlists/'.$username; opendir(D,$docroot.$path); while($_=readdir(D)) { next if /^\./; if(/\.$metafile_re$/) { push @lists, $username.'/'.$_; } } closedir(D); $path = 'playlists/system'; opendir(D,$docroot.$path); while($_=readdir(D)) { next if /^\./; if(/\.$metafile_re$/) { push @lists, 'system/'.$_; } } closedir(D); @lists = (@lists, &shared_playlists() ); if(@lists) { my $i=0; my $colbreak = (@lists > 5) ? ((@lists+2)/3) : 0; print " \n"; } print "

\n"; print " $\"\"$ $dir/
\n"; print "

\n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print "

$indent

\n"; foreach $_ (sort @lists) { my $url = &tourl("$script/$_"); print " $\"\"$ $_"; print "
\n"; $i++; if($colbreak && $i%$colbreak==0 && $i<@lists) { print "

\n" } } print "

\n"; print "

\n"; print " \n"; print " [ Browse ]\n"; print " [ Diskbuilder ]\n" if $username eq 'martian'; print " [ Options ]\n" unless $username eq 'guest'; print " [ Help ]\n"; print " [ About ]\n"; print " [ Suggestions ]\n"; print " \n"; print "

\n"; print " Search Amazon: \n"; print "

\n"; print " \n"; print "\n"; } sub tourl { my($path) = @_; $path =~ s!([ \@\%\&\=\\\?\#])!sprintf("%%%2.2x", ord($1))!eg; return $path; }