package M3UGenerator;

=head1 NAME

M3UGenerator - Generate M3U and PLSv2 playlists.

=head1 SYNOPSIS


=head1 ABSTRACT

=head1 SEE ALSO

=head1 AUTHOR

 Allen Day, E<lt>allenday@ucla.eduE<gt>
 Andrew Baerg, E<lt>andrew.baerg@gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2003, Allen Day, Andrew Baerg

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

use strict;
use File::Spec;
use File::Basename 'dirname','basename','fileparse';
use URI::Escape;
use IO::File;
use Audio::File;

use constant DEBUG => 0;

our $VERSION = '0.01';

our %AUDIO = (
               '.mp3' => 'audio/x-mp3',
               '.ogg' => 'audio/x-ogg',
             );
our %FORMAT_FIELDS = (
                      a => 'artist',
                      c => 'comment',
                      d => 'duration',
                      f => 'filename',
                      g => 'genre',
                      l => 'album',
                      m => 'min',
		              n => 'track',
                      q => 'samplerate',
		              r => 'bitrate',
		              s => 'sec',
		              S => 'seconds',
		              t => 'title',
		              y => 'year',
		                );


our $CRLF = "\015\012";

=head2 new

 Title   : new
 Usage   : $m3ugen = M3UGenerator->new(%arg);
 Function: create a new M3UGenerator instance
 Returns : an M3UGenerator object
 Args    : none


=cut

sub new{
  my($class,%arg) = @_;

  my $self = bless {}, $class;

  return $self;
}

=head2 add_directory

 Title   : add_directory
 Usage   : $m3ugen->add_directory('/usr/local/mp3');
 Function: add a directory of files to be added to the playlist
 Returns : true on success, false on failure
 Args    : a system path


=cut

sub add_directory{
   my ($self,$dir) = @_;
   warn "adding directory $dir" if DEBUG;
   if(!-d $dir or !-r $dir){
     return undef;
   } else {
     $self->_process_directory($dir);
     return 1;
   }
}

=head2 _process_directory

 Title   : _process_directory
 Usage   : $m3ugen->_process_directory('/usr/local/mp3');
 Function: searches a directory for files to add to the playlist
 Returns : true on success
 Args    : a system path to search for files


=cut

sub _process_directory{
   my ($self,$dir) = @_;

   if(!-r $dir){
     return undef;
   } else {
     warn "processing directory: $dir" if DEBUG;

     opendir(my $d, $dir) or die "couldn't opendir($dir): $!";
     my @dirents = grep {$_ ne '.' and $_ ne '..'} readdir($d);
     closedir($d) or die "couldn't closedir($dir): $!";

     foreach my $dirent (@dirents){
       warn "found dirent: $dirent" if DEBUG;

       next if !-r File::Spec->catfile($dir,$dirent);
       if(-d File::Spec->catfile($dir,$dirent)){
         next unless $self->recursive;
         $self->_process_directory(File::Spec->catdir($dir,$dirent));
       } else {
         $self->add_file(File::Spec->catfile($dir,$dirent));
       }
     }
   }

   return 1;
}


=head2 add_file

 Title   : add_file
 Usage   : $m3ugen->add_file('/usr/local/mp3/meow.mp3')
 Function: add a file to be added to the playlist
 Returns : true on success, false on failure
 Args    : a system path


=cut

sub add_file{
   my ($self,$file) = @_;

   my(undef,undef,$extension) = fileparse($file,keys(%AUDIO));
   warn "adding file $file" if DEBUG;
   warn $extension if DEBUG;

   if(!-f $file or !-r $file){
     warn "not a readable file: $file" if DEBUG;
     return undef;
   } elsif($AUDIO{lc($extension)}) {
     warn "adding $file" if DEBUG;
     push @{$self->{files}}, $file;
   } else {
     warn "not a usable mimetype: $file" if DEBUG;
     return undef;
   }

   return 1;
}

=head2 files

 Title   : files
 Usage   : @files = $m3ugen->files
 Function: returns a list of all files that have been added
           from calls to add_file() and add_directory()
 Returns : a list of files
 Args    : none


=cut

sub files{
  my $self = shift;

  if(defined($self->{files})){
    if($self->shuffle){
      for (my $i=0; $i<@{$self->{files}}; $i++) {
        my $rand = rand(scalar @{$self->{files}});

        #swap;
        ($self->{files}->[$i],$self->{files}->[$rand])
          =
        ($self->{files}->[$rand],$self->{files}->[$i]);
      }
    }

    return @{$self->{files}};

  } else {
    return ();
  }

}

=head2 clear_files

 Title   : clear_files
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub clear_files{
   my ($self) = @_;
   $self->{files} = undef;
   return 1;
}

=head2 m3u

 Title   : m3u
 Usage   : $m3u_text = $m3ugen->m3u
 Function: generates an Extended M3U string from the
           contents of the list returned by files().
           files not recognized by MP3::Info are
           silently ignored
 Returns : a Extended M3U string
 Args    : none


=cut

sub m3u{
   my $self = shift;

   my $output = undef;


   # The extended format is:
   #	#EXTM3U
   #	#EXTINF:seconds,title - artist (album)
   #	URL
   # but apparently you can override with this
   #	#EXTART:Britney Spears
   #	#EXTALB:Oops!.. I Did It Again
   #	#EXTTIT:Something or other
   # and there doesn't seem to be a way to escape the -, so that's safer
   # in theory, but if you send both it seems to ignore all but the EXTINF
   # and there's no way to send seconds without it anyway, so we'll just do
   # that.
   #
   # .... except that the second format breaks older versions of winamp
   # so we'll use EXTINF only!

   $output .= "#EXTM3U$CRLF" if $self->files;
   foreach my $file ($self->files){
     my $info = $self->_get_info($file);

     next unless defined($info);
     $file = $self->_mangle_path($file);

     my $time   = -1; # $info->secs   || -1;
     my $artist = $info->tag->artist || 'Unknown Artist';
     my $album  = $info->tag->album  || 'Unknown Album';
     my $title  = $info->tag->title  || 'Unknown Title';

     $output .= sprintf("#EXTINF:%d,%s - %s (%s)",$time,$title,$artist,$album) . $CRLF;
     $output .= $file . $CRLF;
   }

   return $output;
}

=head2 pls

 Title   : pls
 Usage   : $pls_text = $m3ugen->pls
 Function: generates a PLSv2 string from the
           contents of the list returned by files().
           files not recognized by MP3::Info are
           silently ignored.
 Returns : a PLSv2 string
 Args    : none


=cut

sub pls{
   my $self = shift;

   my $output = undef;

   $output .= "[playlist]$CRLF" if $self->files;
   my $c = 0;
   foreach my $file ($self->files){
     my $info = $self->_get_info($file);

     next unless defined($info);

     $c++;

     $file = $self->_mangle_path($file);

     my $time   = -1; # $info->secs   || -1;
     my $artist = $info->tag->artist || 'Unknown Artist';
     my $album  = $info->tag->album  || 'Unknown Album';
     my $title  = $info->tag->title  || 'Unknown Title';

     $output .= uri_escape(sprintf("File%d=%s${CRLF}Title%d=%s - %s (%s)${CRLF}Length%d=%d$CRLF",$c,$file,$c,$title,$artist,$album,$c,$time));
   }

   $output .= "NumberOfEntries=$c$CRLF" if $self->files;
   $output .= "Version=2$CRLF"          if $self->files;

   return $output;
}


=head2 _open_file

 Title   : _open_file
 Usage   : $fh = $m3ugen->open_file('/usr/local/mp3/meow.mp3');
 Function:
 Example :
 Returns :
 Args    :


=cut

sub _open_file{
  my ($self,$file) = @_;

  return undef unless $file;
  return IO::File->new($file,O_RDONLY);
}

=head2 _mangle_path

 Title   : _mangle_path
 Usage   : $path = $m3ugen->_mangle_path('/usr/local/mp3/meow.mp3');
 Function: applies alias substitutions and prefixes to a system path.
           this is intended to be used to create resolvable URLs.
 Returns : a string
 Args    : a system path


=cut

sub _mangle_path{
   my ($self,$path) = @_;

   my $qpath = quotemeta($path);

   foreach my $alias ($self->alias){
     warn "replacing $alias..." if DEBUG;
     my $search = $alias;

     my $qalias = quotemeta($alias);

     next unless $path =~ /^$qalias/;

     my $replace = $self->alias($alias);
     $path =~ s/^$qalias/$replace/;
     last;
   }
   $path = join '', ($self->prefix ||'', $path ||'', $self->postfix ||'');
   return $path;
}

=head2 _get_info

 Title   : _get_info
 Usage   : $mp3_info = $m3ugen->_get_info($file)
 Function: constucts and returns an MP3::Info object.  the intended
           use here is to access MP3 metadata (from ID3 tags,
           filesize, etc).
 Returns : a new MP3::Info object on success, false on failure
 Args    : a system path to a file


=cut

sub _get_info{
   my ($self,$file) = @_;

   return undef unless $file;
   return Audio::File->new( $file );
}


=head2 alias

 Title   : alias
 Usage   : #returns 1
           $m3ugen->alias('/home/allenday/mp3' => '/mp3');

           #returns '/mp3'
           $m3ugen->alias('/home/allenday/mp3');

           #returns 1
           $m3ugen->alias('/usr/local/share/mp3' => '/share/mp3'); #returns 1

           #returns qw(/mp3 /share/mp3)
           $m3ugen->alias();
 Function: this method provides similar behavior to Apache's Alias directive.
           it allows mapping of system paths to virtual paths for usage by,
           for instance, a webserver.  the mapping is simple: when examining
           a file, M3UGenerator tries to match the beginning of the file's
           full path to a sorted list of aliases.  the first alias to match
           is accepted.  this may cause unexpected behavior in the event that
           a file's path matches multiple alias entries.  patches welcome.
 Returns : see Usage
 Args    : see Usage


=cut

sub alias{
   my ($self,$search,$replace) = @_;

   if(defined($search) and defined($replace)){
     $self->{alias}{$search} = $replace;
   } elsif(defined($search)) {
     return $self->{alias}{$search};
   } else {
     return sort keys %{$self->{alias}};
   }
}

=head2 prefix

 Title   : prefix
 Usage   : $m3ugen->prefix('http://');
 Function: prefix all entries in the playlist with this value.
           this string is *not* uri or system path escaped.
 Returns : value of prefix (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub prefix{
    my $self = shift;

    return $self->{'prefix'} = shift if @_;
    return $self->{'prefix'};
}

=head2 postfix

 Title   : postfix
 Usage   : $obj->postfix($newval)
 Function: postfix all entries in the playlist with this value.
           this string is *not* uri or system path escaped.
           uri escaped.
 Returns : value of postfix (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub postfix{
    my $self = shift;

    return $self->{'postfix'} = shift if @_;
    return $self->{'postfix'};
}

=head2 recursive

 Title   : recursive
 Usage   : $obj->recursive($newval)
 Function: flag determining whether a directory is recursively
           searched for files when passed to ::add_directory().
           default is false (no recursion).
 Example : 
 Returns : value of recursive (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub recursive{
    my $self = shift;

    return $self->{'recursive'} = shift if @_;
    return $self->{'recursive'};
}

=head2 shuffle

 Title   : shuffle
 Usage   : $obj->shuffle($newval)
 Function: 
 Example : 
 Returns : value of shuffle (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub shuffle{
    my $self = shift;

    return $self->{'shuffle'} = shift if @_;
    return $self->{'shuffle'};
}

=head2 description

 Title   : description
 Usage   : $description = $m3ugen->description('/usr/local/mp3/meow.mp3');
 Function: returns a description string of an MP3.  this is extracted
           from the ID3 tags by MP3::Info.  the description format can
           be customized, see the description_format() method.
 Returns : a description string
 Args    : a valid system path


=cut

sub description{
  my $self = shift;
  my $file = shift;
  my $data = Audio::File->new( $file );
  my $description;
  my $format = $self->description_format;
  if ($format) {
    ($description = $format) =~ s{%([atfglncrdmsqS%])}
      {$1 eq '%' ? '%'
	 : $data->tag->{$FORMAT_FIELDS{$1}}
       }gxe;
  } else {
    $description = $data->tag->{title} || basename($file, qw(.mp3 .MP3 .mp2 .MP2 .ogg .OGG) );
    $description .= " - $data->tag->{artist}" if $data->tag->{artist};
    $description .= " ($data->tag->{album})"  if $data->tag->{album};
  }
  return $description;
}

=head2 description_format

 Title   : description_format
 Usage   : $m3ugen->description_format($format_string)
 Function: 
 Returns : value of description_format (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub description_format{
    my $self = shift;

    return $self->{'description_format'} = shift if @_;
    return $self->{'description_format'};
}
1;
