view release on metacpan or  search on metacpan

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

  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);
  
  return $ofh;
}# end open_file_for_appending()


#==============================================================================
sub compose_download_file_path
{
  my ($s, $context) = @_;
  
  # Compose the local filename:
  my $file = $context->request->Form->{file};
  my $filename = $context->config->web->media_manager_upload_root . '/' . $file;
  
  return $filename;
}# end compose_file_path()


#==============================================================================
sub compose_download_file_name
{
  my ($s, $context) = @_;
  
  # Compose the local filename:
  my $file = $context->request->Form->{file};
  
  return $file;
}# end compose_file_name()


#==============================================================================
sub compose_upload_file_name
{
  my ($s, $context, $Upload) = @_;
  
#  my $filename = $Upload;
  my ($filename) = $Upload->{upload}->{upload_filename} =~ m/.*[\\\/]([^\/\\]+)$/;
  if( ! $filename )
  {
    $filename = $Upload->{upload}->{upload_filename};
  }# end if()
  
  return $filename;
}# end compose_upload_file_name()


#==============================================================================
sub compose_upload_file_path
{
  my ($s, $context, $Upload, $filename) = @_;
  
  unless( defined($filename) && length($filename) )
  {
    die "\$filename not provided";
  }# end unless()
  
  return $context->config->web->media_manager_upload_root . "/$filename";
}# end compose_upload_file_path()