Apache::MP3::Sorted - Generate sorted streamable directories of MP3 files

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

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

 sort_mp3s()  mp3_table_header()   mp3_list_bottom()

package Apache::MP3::Sorted;
# $Id: Sorted.pm,v 1.4 2006/01/03 19:37:52 lstein Exp $
# example of how to subclass Apache::MP3 in order to provide
# control over the sorting of the rows of the MP3 table

use strict;
use Apache::MP3;
use CGI qw/:standard *TR param/;

use vars qw(@ISA $VERSION);
@ISA = 'Apache::MP3';

$VERSION = 2.02;

use constant DEBUG => 0;

# to choose the right type of sort for each of the mp3 fields
my %sort_modes = (
		  # config        field       sort type
		  title       => [qw(title        alpha)],
		  artist      => [qw(artist       alpha)],
		  duration    => [qw(seconds      numeric)],
		  seconds     => [qw(seconds      numeric)],
		  genre       => [qw(genre        alpha)],
		  album       => [qw(album        alpha)],
		  comment     => [qw(comment      alpha)],
		  description => [qw(description  alpha)],
		  bitrate     => [qw(bitrate      numeric)],
		  filename    => [qw(filename     alpha)],
		  kbps        => [qw(kbps         numeric)],
		  samplerate  => [qw(samplerate   numeric)],
		  track       => [qw(track        numeric)],
		  year        => [qw(year         numeric)],
		 );

sub sort_fields {
  my $self       = shift;
  my $field_spec = lc param('sort') if param('sort');
  # If there is not SortFields var, look for SortField, which is the var used
  # by the one sort field Apache::MP3::Sorted. This should retain a good amount
  # of backward compatibility
  $field_spec  ||= lc($self->r->dir_config('SortFields')
                      || $self->r->dir_config('SortField'));
  return split /[^\w+-]+/, $field_spec;
}

# sort MP3s
sub sort_mp3s {
  my $self   = shift;
  my $files  = shift;
  my @sort_info = (); # holds info about how to sort each field

  # Verify the sorting fields and build up our @sort_info data structure that
  # keep track of how everything should work.
  foreach ($self->sort_fields) {
    my ($reverse_sort, $field) = /^([+-]?)(.*)/;
    $reverse_sort = ($reverse_sort eq '-');
    if (exists($sort_modes{$field})) {
      # each @sort_info entry is [sort_order, sort_field, sort_type]
      push(@sort_info, [$reverse_sort, $sort_modes{$field}[0], $sort_modes{$field}[1]]);
    } else {
      $self->r->warn("Ignoring unsupported sort field $_ in sort_mp3s().");
    }
  }

  if (!@sort_info) {
    # no known sort types given
    $self->r->warn("No recognized sort fields passed to sort_mp3s()") if DEBUG;
    return $self->SUPER::sort_mp3s($files);
  }

  # Create an anonymous subroutine so we have closure of @sort_info and $files
  my $by_fields_sorter =
    sub {
      my $val = 0;
      foreach (@sort_info) {
        my ($reverse_sort, $field, $sort_type) = @$_;
        my ($x, $y) = ($files->{$a}{$field}, $files->{$b}{$field});
        ($x, $y) = ($y, $x) if $reverse_sort; # swap args for reverse sort
        if ($sort_type eq 'alpha') {
          $val = $x cmp $y;
        } elsif ($sort_type eq 'numeric') {
          $val = $x <=> $y;
        }
        last if $val;
      }
      return $val; # Found no compare difference between elements
    };

  return sort $by_fields_sorter keys %$files;
}

sub format_table_fields {
  my $self = shift;
  my $sort = param('sort') || '';
  my @fields;

  foreach ($self->fields) {
    $_ ||= '';
    my $sort = $sort eq lc($_)  ? lc("-$_") : lc($_);
    push @fields,a({-href=>"?sort=$sort"},
      $self->x(ucfirst($_))
    );
  }
  @fields;
}

# Add hidden field for sorting
sub mp3_list_bottom {
  my $self = shift;
  print hidden('sort');
  $self->SUPER::mp3_list_bottom(@_);
}


1;