view release on metacpan or  search on metacpan

MP3/Playlist.pm  view on Meta::CPAN

package Apache::MP3::Playlist;
# $Id: Playlist.pm,v 1.6 2006/01/03 19:37:52 lstein Exp $
# generates playlists in cookies

use strict;
use vars qw(@ISA $VERSION);
use Apache2::Const qw(:common REDIRECT HTTP_NO_CONTENT HTTP_NOT_MODIFIED);
use File::Basename 'dirname','basename','fileparse';
use CGI qw(:standard);
use Apache::MP3::Sorted;
use CGI::Session;

@ISA = 'Apache::MP3::Sorted';
$VERSION = 1.05;

sub run {
  my $self = shift;
  my $result = $self->process_playlist;
  return $result if defined $result;
  $self->SUPER::run();
}

sub list_directory {
  my $self = shift;
  $self->r->headers_out->add(Expires => CGI::Util::expires('now'));
  $self->SUPER::list_directory(@_);
}

sub process_playlist {
  my $self = shift;
  my $r = $self->r;
  my @playlist;
  my $changed;

  my $playlist = $self->retrieve_playlist;

  if (param('Clear All')) {
    @$playlist = ();
    $changed++;
  }

  if (param('Clear Selected')) {
    my %clear = map { $_ => 1 } param('file') or return HTTP_NO_CONTENT;
    @$playlist = grep !$clear{$_},@$playlist;
    $changed++;
  }

  if (param('Add All to Playlist')) {
    my %seen;
    @$playlist = grep !$seen{$_}++,(@$playlist,@{$self->find_mp3s});
    $changed++;
  }

  if (param('Add to Playlist')) {
    my $dir = dirname($r->uri);
    my @new = param('file') or return HTTP_NO_CONTENT;
    my %seen;
    @$playlist = grep !$seen{$_}++,(@$playlist,map {"$dir/$_"} @new);
    $changed++;
  }

  if (param('Play Selected') and param('playlist')) {
    my @uris = param('file') or return HTTP_NO_CONTENT;
    return $self->send_playlist(\@uris);
  }

  if (param('Shuffle All') and param('playlist')) {
    return HTTP_NO_CONTENT unless @$playlist;
    my @list = @$playlist;
    return $self->send_playlist(\@list,'shuffle');
  }

  if (param('Play All') and param('playlist')) {
    return HTTP_NO_CONTENT unless @$playlist;
    my @list = @$playlist;
    return $self->send_playlist(\@list);
  }

  if ($changed) {
    $self->flush;
    (my $uri = $r->uri) =~ s!playlist\.m3u$!!;
    $self->path_escape(\$uri);
    my $rand = int rand(100000);
    $r->headers_out->add(Location => "$uri?$rand");
    return REDIRECT;
  }

MP3/Playlist.pm  view on Meta::CPAN

  return;
}

sub retrieve_playlist {
  my $self = shift;
  my $r    = $self->r;

  my $session = $self->session;
  $session->param(playlist=>[]) unless $session->param('playlist');

  my $playlist = $session->param('playlist');
  $r->err_headers_out->add('Set-Cookie' => CGI::Cookie->new(-name=>'apache_mp3',
							    -value=>$session->id,
							   ));
  $playlist;
}

sub session {
  my $self = shift;
  local $CGI::Session::NAME = 'apache_mp3';
  return $self->{session} ||= CGI::Session->new();
}

sub flush {
  my $self = shift;
  $self->session->flush;
}

sub directory_bottom {
  my $self = shift;
  if ($self->playlist) {
    my $r = $self->r;
    my $uri = $r->uri;  # for self referencing
    $self->path_escape(\$uri);

    my $descriptions = $self->lookup_descriptions($self->playlist);
    my @ok = grep { $descriptions->{$_} } $self->playlist;

    print
      a({-name=>'playlist'}),
      table({-width=>'100%',-border=>1},
	    Tr({-class=>'playlist'},
	       td({-class=>'playlist'},
		  h3($self->x('Current Playlist')),
		  start_form(-action=>"${uri}playlist.m3u",-method=>'GET'),
		  checkbox_group(-class=>'playlist',
				 -name      => 'file',
				 -linebreak => 1,
				 -value     => \@ok,
				 -labels    => $descriptions),
		  submit(-name=>'Clear All',-value=>$self->x('Clear All')),
		  submit(-class=>'playlist',-name=>'Clear Selected',-value=>$self->x('Clear Selected')),
		  submit(-class=>'playlist',-name=>'Play Selected',-value=>$self->x('Play Selected')),
		  submit(-class=>'playlist',-name=>'Shuffle All',-value=>$self->x('Shuffle All')),
		  submit(-class=>'playlist',-name=>'Play All',-value=>$self->x('Play All')),
		  hidden(-name=>'playlist',-value=>1,-override=>1),
		  end_form(),
		  ))
	   );
  }
  $self->SUPER::directory_bottom(@_);
}

sub control_buttons {
  my $self = shift;
  return (
	  $self->{possibly_truncated}
	  ? ()
	  : (submit({-class=>'playlist',
		     -name=>'Add to Playlist',
		     -value=>$self->x('Add to Playlist')}),
	     submit({-class=>'playlist',
		     -name=>'Add All to Playlist',
		     -value=>$self->x('Add All to Playlist')
		    })
	    ),
	  submit(-name=>'Play Selected',
		 -value=>$self->x('Play Selected')
		),
	  submit(-name=>'Shuffle All',
		 -value=>$self->x('Shuffle All')
		),
	  submit(-name=>'Play All',
		-value=>$self->x('Play All'))
	 );
}

sub lookup_descriptions {
  my $self = shift;
  my $r = $self->r;
  my %d;
  for my $song (@_) {
    next unless my $sub  = $r->lookup_uri($song);
    next unless my $file = $sub->filename;
    next unless -r $file;
    next unless my $info = $self->fetch_info($file,$sub->content_type);
    $d{$song} = " $info->{description}";
  }
  return \%d;
}

sub directory_top {
  my $self = shift;
  $self->SUPER::directory_top(@_);
  my @p = $self->playlist;
  print div({-align=>'CENTER'},
	    a({-href=>'#playlist',-class=>'playlist'},$self->x('Playlist contains [quant,_1,song,songs].', scalar(@p))),br,
	    $self->{possibly_truncated} ? font({-color=>'red'},
					       strong($self->x('Your playlist is now full. No more songs can be added.'))) : '') 
    if @p;
}

sub playlist {
  my $self = shift;
  my @p = $self->{playlist} ? @{$self->{playlist}} : ();
  $self->{playlist} = shift if @_;
  return unless @p;
  return wantarray ? @p : \@p;
}

1;

=head1 NAME

Apache::MP3::Playlist - Manage directories of MP3 files with sorting and persistent playlists

=head1 SYNOPSIS

 # httpd.conf or srm.conf
 AddType audio/mpeg    mp3 MP3

 # httpd.conf or access.conf
 <Location /songs>
   SetHandler perl-script
   PerlHandler Apache::MP3::Playlist
   PerlSetVar  SortField     Title
   PerlSetVar  Fields        Title,Artist,Album,Duration
 </Location>

=head1 DESCRIPTION

Apache::MP3::Playlist subclasses Apache::MP3::Sorted to allow the user
to build playlists across directories.  Playlists are stored in
cookies and are persistent for the life of the browser.  See
L<Apache::MP3> and L<Apache::MP3::Sorted> for details on installing
and using.

=head1 CUSTOMIZATION

The "playlist" class in the F<apache_mp3.css> cascading stylesheet
defines the color of the playlist area and associated buttons.

=head1 METHODS

Apache::MP3::Playlist overrides the following methods:

 run(), directory_bottom(), control_buttons() and directory_top().

It adds several new methods:

=over 4

=item $result = $mp3->process_playlist