1package Apache::MP3::Playlist; 2# $Id: Playlist.pm,v 1.6 2006/01/03 19:37:52 lstein Exp $ 3# generates playlists in cookies 4 5use strict; 6use vars qw(@ISA $VERSION); 7use Apache2::Const qw(:common REDIRECT HTTP_NO_CONTENT HTTP_NOT_MODIFIED); 8use File::Basename 'dirname','basename','fileparse'; 9use CGI qw(:standard); 10use Apache::MP3::Sorted; 11use CGI::Session; 12 13@ISA = 'Apache::MP3::Sorted'; 14$VERSION = 1.05; 15 16sub run { 17 my $self = shift; 18 my $result = $self->process_playlist; 19 return $result if defined $result; 20 $self->SUPER::run(); 21} 22 23sub list_directory { 24 my $self = shift; 25 $self->r->headers_out->add(Expires => CGI::Util::expires('now')); 26 $self->SUPER::list_directory(@_); 27} 28 29sub process_playlist { 30 my $self = shift; 31 my $r = $self->r; 32 my @playlist; 33 my $changed; 34 35 my $playlist = $self->retrieve_playlist; 36 37 if (param('Clear All')) { 38 @$playlist = (); 39 $changed++; 40 } 41 42 if (param('Clear Selected')) { 43 my %clear = map { $_ => 1 } param('file') or return HTTP_NO_CONTENT; 44 @$playlist = grep !$clear{$_},@$playlist; 45 $changed++; 46 } 47 48 if (param('Add All to Playlist')) { 49 my %seen; 50 @$playlist = grep !$seen{$_}++,(@$playlist,@{$self->find_mp3s}); 51 $changed++; 52 } 53 54 if (param('Add to Playlist')) { 55 my $dir = dirname($r->uri); 56 my @new = param('file') or return HTTP_NO_CONTENT; 57 my %seen; 58 @$playlist = grep !$seen{$_}++,(@$playlist,map {"$dir/$_"} @new); 59 $changed++; 60 } 61 62 if (param('Play Selected') and param('playlist')) { 63 my @uris = param('file') or return HTTP_NO_CONTENT; 64 return $self->send_playlist(\@uris); 65 } 66 67 if (param('Shuffle All') and param('playlist')) { 68 return HTTP_NO_CONTENT unless @$playlist; 69 my @list = @$playlist; 70 return $self->send_playlist(\@list,'shuffle'); 71 } 72 73 if (param('Play All') and param('playlist')) { 74 return HTTP_NO_CONTENT unless @$playlist; 75 my @list = @$playlist; 76 return $self->send_playlist(\@list); 77 } 78 79 if ($changed) { 80 $self->flush; 81 (my $uri = $r->uri) =~ s!playlist\.m3u$!!; 82 $self->path_escape(\$uri); 83 my $rand = int rand(100000); 84 $r->headers_out->add(Location => "$uri?$rand"); 85 return REDIRECT; 86 } 87 88 $self->playlist($playlist); 89 return; 90} 91 92sub retrieve_playlist { 93 my $self = shift; 94 my $r = $self->r; 95 96 my $session = $self->session; 97 $session->param(playlist=>[]) unless $session->param('playlist'); 98 99 my $playlist = $session->param('playlist'); 100 $r->err_headers_out->add('Set-Cookie' => CGI::Cookie->new(-name=>'apache_mp3', 101 -value=>$session->id, 102 )); 103 $playlist; 104} 105 106sub session { 107 my $self = shift; 108 local $CGI::Session::NAME = 'apache_mp3'; 109 return $self->{session} ||= CGI::Session->new(); 110} 111 112sub flush { 113 my $self = shift; 114 $self->session->flush; 115} 116 117sub directory_bottom { 118 my $self = shift; 119 if ($self->playlist) { 120 my $r = $self->r; 121 my $uri = $r->uri; # for self referencing 122 $self->path_escape(\$uri); 123 124 my $descriptions = $self->lookup_descriptions($self->playlist); 125 my @ok = grep { $descriptions->{$_} } $self->playlist; 126 127 print 128 a({-name=>'playlist'}), 129 table({-width=>'100%',-border=>1}, 130 Tr({-class=>'playlist'}, 131 td({-class=>'playlist'}, 132 h3($self->x('Current Playlist')), 133 start_form(-action=>"${uri}playlist.m3u",-method=>'GET'), 134 checkbox_group(-class=>'playlist', 135 -name => 'file', 136 -linebreak => 1, 137 -value => \@ok, 138 -labels => $descriptions), 139 submit(-name=>'Clear All',-value=>$self->x('Clear All')), 140 submit(-class=>'playlist',-name=>'Clear Selected',-value=>$self->x('Clear Selected')), 141 submit(-class=>'playlist',-name=>'Play Selected',-value=>$self->x('Play Selected')), 142 submit(-class=>'playlist',-name=>'Shuffle All',-value=>$self->x('Shuffle All')), 143 submit(-class=>'playlist',-name=>'Play All',-value=>$self->x('Play All')), 144 hidden(-name=>'playlist',-value=>1,-override=>1), 145 end_form(), 146 )) 147 ); 148 } 149 $self->SUPER::directory_bottom(@_); 150} 151 152sub control_buttons { 153 my $self = shift; 154 return ( 155 $self->{possibly_truncated} 156 ? () 157 : (submit({-class=>'playlist', 158 -name=>'Add to Playlist', 159 -value=>$self->x('Add to Playlist')}), 160 submit({-class=>'playlist', 161 -name=>'Add All to Playlist', 162 -value=>$self->x('Add All to Playlist') 163 }) 164 ), 165 submit(-name=>'Play Selected', 166 -value=>$self->x('Play Selected') 167 ), 168 submit(-name=>'Shuffle All', 169 -value=>$self->x('Shuffle All') 170 ), 171 submit(-name=>'Play All', 172 -value=>$self->x('Play All')) 173 ); 174} 175 176sub lookup_descriptions { 177 my $self = shift; 178 my $r = $self->r; 179 my %d; 180 for my $song (@_) { 181 next unless my $sub = $r->lookup_uri($song); 182 next unless my $file = $sub->filename; 183 next unless -r $file; 184 next unless my $info = $self->fetch_info($file,$sub->content_type); 185 $d{$song} = " $info->{description}"; 186 } 187 return \%d; 188} 189 190sub directory_top { 191 my $self = shift; 192 $self->SUPER::directory_top(@_); 193 my @p = $self->playlist; 194 print div({-align=>'CENTER'}, 195 a({-href=>'#playlist',-class=>'playlist'},$self->x('Playlist contains [quant,_1,song,songs].', scalar(@p))),br, 196 $self->{possibly_truncated} ? font({-color=>'red'}, 197 strong($self->x('Your playlist is now full. No more songs can be added.'))) : '') 198 if @p; 199} 200 201sub playlist { 202 my $self = shift; 203 my @p = $self->{playlist} ? @{$self->{playlist}} : (); 204 $self->{playlist} = shift if @_; 205 return unless @p; 206 return wantarray ? @p : \@p; 207} 208 2091; 210 211=head1 NAME 212 213Apache::MP3::Playlist - Manage directories of MP3 files with sorting and persistent playlists 214 215=head1 SYNOPSIS 216 217 # httpd.conf or srm.conf 218 AddType audio/mpeg mp3 MP3 219 220 # httpd.conf or access.conf 221 <Location /songs> 222 SetHandler perl-script 223 PerlHandler Apache::MP3::Playlist 224 PerlSetVar SortField Title 225 PerlSetVar Fields Title,Artist,Album,Duration 226 </Location> 227 228=head1 DESCRIPTION 229 230Apache::MP3::Playlist subclasses Apache::MP3::Sorted to allow the user 231to build playlists across directories. Playlists are stored in 232cookies and are persistent for the life of the browser. See 233L<Apache::MP3> and L<Apache::MP3::Sorted> for details on installing 234and using. 235 236=head1 CUSTOMIZATION 237 238The "playlist" class in the F<apache_mp3.css> cascading stylesheet 239defines the color of the playlist area and associated buttons. 240 241=head1 METHODS 242 243Apache::MP3::Playlist overrides the following methods: 244 245 run(), directory_bottom(), control_buttons() and directory_top(). 246 247It adds several new methods: 248 249=over 4 250 251=item $result = $mp3->process_playlist 252 253Process buttons that affect the playlist. 254 255=item $hashref = $mp3->lookup_descriptions(@uris) 256 257Look up the description fields for the MP3 files indicated by the list 258of URIs (not paths) and return a hashref. 259 260=item @list = $mp3->playlist([@list]) 261 262Get or set the current stored playlist. In a list context returns the 263list of URIs of stored MP3 files. In a scalar context returns an 264array reference. Pass a list of URIs to set the playlist. 265 266=head1 Linking to this module 267 268The following new linking conventions apply: 269 270=item Add MP3 files to the user's playlist 271 272Append "/playlist.m3u?Add+to+Playlist;file=file1;file=file2..." to the 273name of the directory that contains the files: 274 275 <a 276 href="/Songs/Madonna/playlist.m3u?Add+to+Playlist=1;file=like_a_virgin.mp3;file=evita.mp3"> 277 Two favorites</a> 278 279=item Add all MP3 files in a directory to the user's playlist: 280 281Append "/playlist.m3u?Add+All+to+Playlist" to the name of the 282directory that contains the files: 283 284 <a 285 href="/Songs/Madonna/playlist.m3u?Add+All+to+Playlist=1"> 286 Madonna'a a Momma</a> 287 288=item Delete some MP3 files from the user's playlist: 289 290Append 291"/playlist.m3u?Clear+Selected=1;playlist=1;file=file1;file=file2..." 292to the name of the current directory. 293 294NOTE: the file names must be absolute URLs, not relative URLs. This 295is because the playlist spans directories. By the same token, the 296current directory does not have to contain the removed song(s). 297Example: 298 299 <a 300 href="/Songs/Springsteen/playlist.m3u?Clear+Selected=1; 301 playlist=1;file=/Songs/Madonna/like_a_virgin.mp3"> 302 No longer a virgin, alas</a> 303 304=item Clear user's playlist: 305 306Append "/playlist.m3u?Clear+All=1;playlist=1" to the name of the 307current directory. 308 309Example: 310 311 <a href="/Songs/Springsteen/playlist.m3u?Clear+All=1;playlist=1"> 312 A virgin playlist</a> 313 314=item Stream the playlist 315 316Append "/playlist.m3u?Play+All=1;playlist=1" to the name of the 317current directory. 318 319Example: 320 321 <a href="/Songs/Madonna/playlist.m3u?Play+All=1;playlist=1"> 322 Stream me!</a> 323 324=item Stream the playlist in random order 325 326As above, but use "Shuffle+All" rather than "Play+All". 327 328=item Stream part of the playlist 329 330Append 331"/playlist.m3u?Play+Selected=1;playlist=1;file=file1;file=file2..." 332to the name of the current directory. 333 334NOTE: the files must be full URLs. It is not strictly necessary for 335them to be on the current playlist, so this allows you to stream 336playlists of arbitrary sets of MP3 files. 337 338Example: 339 340 <a 341 href="/Songs/playlist.m3u?Play+Selected=1; 342 playlist=1;file=/Songs/Madonna/like_a_virgin.mp3; 343 file=/Songs/Madonna/working_girl.mp3; 344 file=/Songs/Beatles/let_it_be.mp3"> 345 Madonna and John, together again for the first time</a> 346 347=back 348 349=head1 BUGS 350 351This module uses client-side cookies to mantain the playlist. This 352limits the number of songs that can be placed in the playlist to about 35350 songs. 354 355=head1 ACKNOWLEDGEMENTS 356 357Chris Nandor came up with the idea for the persistent playlist and 358implemented it using server-side DBM files. I reimplemented it using 359client-side cookies, which simplifies maintenance and security, but 360limits playlists in size. 361 362=head1 AUTHOR 363 364Copyright 2000, Lincoln Stein <lstein@cshl.org>. 365 366This module is distributed under the same terms as Perl itself. Feel 367free to use, modify and redistribute it as long as you retain the 368correct attribution. 369 370=head1 SEE ALSO 371 372L<Apache::MP3::Sorted>, L<Apache::MP3>, L<MP3::Info>, L<Apache> 373 374=cut 375