view release on metacpan or  search on metacpan

lib/Apache2/ASP/MediaManager.pm  view on Meta::CPAN

package Apache2::ASP::MediaManager;

use strict;
use base 'Apache2::ASP::UploadHandler';
use MIME::Types;
use IO::File;

my $mimetypes = MIME::Types->new();


#==============================================================================
sub run
{
  my ($s, $context) = @_;
  
  shift(@_);
	
	my $mode = $context->request->Form->{mode};
	
	return unless ( ! $mode ) || ( $mode !~ m/^(create|edit)$/ );
	
  my $filename = $s->compose_download_file_path( $context );
  my $file = $s->compose_download_file_name( $context );
  
  # Find its MIME type and set our 'ContentType' value:
  my $ext;
  unless( $mode )
  {
    # Find its MIME type and set our 'ContentType' value:
    ($ext) = $file =~ m/.*?\.([^\.]+)$/;
    my $type = $ext ? $mimetypes->mimeTypeOf( $ext ) || 'application/octet-stream' : 'application/octet-stream';
    $context->response->ContentType( $type );
  }# end unless()
  
  # Call our extension hooks:
  if( $mode )
  {
    if( $mode eq 'delete' )
    {
      $s->before_delete( $context, $filename )
        or return;
      $s->delete_file( $context, $filename );
      return $s->after_delete( $context, $filename );
    }
    elsif( defined(my $handler = $s->modes( $mode )) )
    {
      return $handler->( $s, $context );
    }# end if()
  }# end if()
  
  # Get the readable filehandle:
  unless( -f $filename )
  {
    $context->response->Status( 404 );
    return;
  }# end unless()
  
  # Call our before- hook:
  $s->before_download( $context, $filename )
    or return;
  
  # Wait until "before_download" has cleared before we open a filehandle:
  my $ifh = $s->open_file_for_reading( $context, $filename );
  
  # Send any HTTP headers:
  $s->send_http_headers($context, $filename, $file, $ext);
  
  # Print the file out:
  if( (stat($ifh))[7] < 1024 ** 2 )
  {
    # File is < 1M, so just slurp and print:
    local $/;
    $context->response->Write( scalar(<$ifh>) );
  }
  else
  {
    while( my $line = <$ifh> )
    {
      $context->response->Write( $line );
    }# end while()
  }# end while()
  $context->response->Flush;
  
  # Done!
  $ifh->close;
  
  # Call our after- hook:
  $s->after_download( $context, $filename );
}# end run()


#==============================================================================
sub send_http_headers
{
  my ($s, $context, $filename, $file, $ext) = @_;
  
  # Send the 'content-length' header:
  $context->r->err_headers_out->{'Content-Length'} = (stat($filename))[7];
  
  # PDF files should force the "Save file as..." dialog:
  my $disposition = (lc($ext) eq 'pdf') ? 'attachment' : 'inline';
  $file =~ s/\s/_/g;
  
  $context->r->err_headers_out->{'content-disposition'} = "$disposition;filename=" . $file . ';yay=yay';
}# end send_http_headers()


#==============================================================================
sub delete_file
{
  my ($s, $context, $filename) = @_;
  
  die "'$filename' is a directory, not a file" if -d $filename;
  return unless -f $filename;