Apache-MP3

 view release on metacpan or  search on metacpan

MP3.pm  view on Meta::CPAN


  local $CGI::XHTML = 0;

  # check that we aren't running under PerlSetupEnv Off
  if ($ENV{MOD_PERL} && !$ENV{SCRIPT_FILENAME}) {
     warn "CGI.pm cannot run with 'PerlSetupEnv Off', please set it to On";
  }

  # this is called to show a help screen
  return $self->help_screen if param('help_screen');

  # generate directory listing
  return $self->process_directory($r->filename)
    if -d $r->filename;  # should be $r->finfo, but STILL problems with this

  # simple download of file
  return $self->download_file($r->filename) unless param;

  # this is called to stream a file
  if(param('stream')){
    return $self->stream;
  }

  # this is called to generate a playlist on the current directory
  return $self->send_playlist($self->find_mp3s)
    if param('Play All');

  # this is called to generate a playlist on the current directory
  # and everything beneath
  return $self->send_playlist($self->find_mp3s('recursive')) 
    if param('Play All Recursive') ;

  # this is called to generate a shuffled playlist of current directory
  return $self->send_playlist($self->find_mp3s,'shuffle')
    if param('Shuffle');

  # this is called to generate a shuffled playlist of current directory
  return $self->send_playlist($self->find_mp3s,'shuffle')
    if param('Shuffle All');

  # this is called to generate a shuffled playlist of current directory
  # and everything beneath
  return $self->send_playlist($self->find_mp3s('recursive'),'shuffle')
    if param('Shuffle All Recursive');

  # this is called to generate a playlist for one file
  if (param('play')) {
    my $dot3 = '.m3u|.pls';
    my($basename,$ext) = $r->uri =~ m!([^/]+?)($dot3)?$!;
    $basename = quotemeta($basename);
    my @matches;
    if (-e $self->r->filename) {
      # If the actual .m3u file exists (it's a playlist), then we read it
      # to get the list of files to send
      @matches = $self->load_playlist($self->r->filename);
    } else {
      # find the MP3 file that corresponds to basename.m3u
      @matches = grep { m!/$basename[^/]*$! } @{$self->find_mp3s};
    }
    if($r->content_type eq 'audio/x-scpls'){
      open(FILE,$r->filename) || return 404;
      $r->send_fd(\*FILE);
      close(FILE);
    } else {
      $self->send_playlist(\@matches);
    }

    $self->send_playlist();
    return OK;
  }

  # this is called to generate a playlist for selected files
  if (param('Play Selected')) {
    return HTTP_NO_CONTENT unless my @files = param('file');
    my $uri = dirname($r->uri);
    $uri =~ s!/?search/?!/!;
    $self->send_playlist([map { "$uri/$_" } @files]);
    return OK;
  }

  if (param('Shuffle Selected')) {
    return HTTP_NO_CONTENT unless my @files = param('file');
    my $uri = dirname($r->uri);
    $uri =~ s!/?search/?!/!;
        my $list = [map {"$uri/$_"} @files];
        $self->shuffle($list);
    $self->send_playlist($list);
    return OK;
  }

  # otherwise don't know how to deal with this
  $self->r->log_reason('Invalid parameters -- possible attempt to circumvent checks.');
  return FORBIDDEN;
}

sub escape {
  my $uri = CGI::escape(shift);
  # unescape slashes so directories work right with mozilla
  $uri =~ s!\%2F!/!gi;
  return $uri;
}

# this generates the top-level directory listing
sub process_directory {
  my $self = shift;
  my $dir = shift;

  return $self->list_directory($dir);
}

# this downloads the file
sub download_file {
  my $self = shift;
  my $file = shift;
  my $type = $self->r->content_type;

  my $is_audio = $self->supported_type ($self->r->content_type);

  if ($is_audio && !$self->download_ok) {

    $self->r->log_reason('File downloading is forbidden');



( run in 2.379 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )