view release on metacpan or  search on metacpan

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

        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;
  unlink( $filename )
    or die "Cannot delete file '$filename' from disk: $!";
}# end delete_file()


#==============================================================================
sub open_file_for_writing
{
  my ($s, $context, $filename) = @_;
  
  # Try to open the file for writing:
  my $ofh = IO::File->new();
  $ofh->open($filename, '>' )
    or die "Cannot open file '$filename' for writing: $!";
  $ofh->binmode;
  $ofh->autoflush(1);
  
  return $ofh;
}# end open_file_for_writing()


#==============================================================================
sub open_file_for_reading
{
  my ($s, $context, $filename) = @_;
  
  # Try to open the file for reading:
  my $ifh = IO::File->new();
  $ifh->open($filename, '<' )
    or die "Cannot open file '$filename' for reading: $!";
  $ifh->binmode;
  
  return $ifh;
}# end open_file_for_reading()


#==============================================================================
sub open_file_for_appending
{
  my ($s, $context, $filename) = @_;
  
  # Try to open the file for appending:
  my $ofh = IO::File->new();
  $ofh->open($filename, '>>' )
    or die "Cannot open file '$filename' for appending: $!";
  $ofh->binmode;
  $ofh->autoflush(1);