Wiggins d'Anconia wrote:
This is the simple part, and probably looks a little like.
open file...
read in file...
print file back to browser...
close file
There are simpler ways to do this, but what I have come to use looks like:
my $READHANDLE;
unless (open $READHANDLE, $file) {
# error handling...
}
binmode $READHANDLE;
$| = 1;
while ( my $length = sysread $READHANDLE, my $buffer, $block_size ) {
next unless defined $length;
my $offset = 0;
while ( $length ) {
my $written = syswrite STDOUT, $buffer, $length, $offset;
$length -= $written;
$offset += $written;
}
}
close $READHANDLE;
print "\n";
You will want to remove this as it will be an addition to the actual
data which can break some formats.
exit;
============================================================================
Does this hit the mark?
http://danconia.org
-----------------------------------------------------------
Hello Wiggins
I'm very grateful for your help - I finally have a working version of a
CGI script which will allow me to selecte files simply by clicking on a
'download' icon which is what I was after for some special purpose web
pages for site maintenance.
Below is the final script I came up with which performs the actual file
download.....
========================================================================
#!/usr/local/bin/perl -w
# -----------------------------------------------------------------
# filedownload.cgi - Downloads a file
#
# Designed to be executed by clicking on a webpage link or an icon
#
# <a href="...filedownload.cgi?filepath=<filepath>arbitrary text</a>
#
# 2005/09/19 - Original coding
#
# Note: This script based primarily on suggestions given by
# Wiggins d'Anconia at [EMAIL PROTECTED]
#
# Notes: http://support.microsoft.com/kb/q182315/ says not to use
# quote marks for filename in Content-Disposition statement
# -----------------------------------------------------------------
use strict;
use diagnostics;
my($basedir) = "<base directory>";
my($baseurl) = "http://spacecovers.com";;
my($filepath) = $ENV{QUERY_STRING};
$filepath = '' if(!$filepath);
# add basedir to filepath if it has none
if($filepath !~ m!^$basedir!i) {
print "basedir not found<br>";
$filepath = "$basedir/$filepath";
}
# convert double /'s to single /.
$filepath =~ s!//!/!i;
# Get just the filename from the path
my($filename) = $filepath;
$filename =~ s!^(.+/)(.+)$!$2!i;
# Read file in binary mode
my($buffer) = &read_file_binary($filepath);
# Set headers
print "Content-Type: application/octet-stream;\n";
print "Content-Disposition: attachment; filename=$filename\n";
print "\n";
# download the file's contents
print $buffer;
exit;
# ----------------------------------------------------------------
# Read the file in binary mode
# $buffer = &read_file_binary($filename);
# ----------------------------------------------------------------
sub read_file_binary {
my($filename) = @_;
my($var) = '';
# Open the file in binary mode
if(!open(FILE,$filename)) {
print "Content-type: text/html\n\n";
print "Can't open file [$filename]<br>";
exit;
}
binmode(FILE);
# Read in the file
while (<FILE>) {
$var .= $_;
}
# close the file and return its contents
close(FILE);
return $var;
}
========================================================================
Please excuse the code. It most likely could be optimized and provide more
error checking but its the best I know how to do at present. However, I'm
always open to suggestions on better ways to do things.
I've tested the script using Mozilla 5.0, Firefox 1.0, IE 6.0, and even
the ancient Netscape 4.7 (horrors!). The test program I used is at....
http://spacecovers.com/cgi-bin/test/test_filedownload.htm
and it tests various sizes of files and the following file types (.htm,
.txt, and .cgi).
In those browsers tested, the results were similar. All came up with a
'File Download' dialogue box (although different flavors). I think I
need to do some further testing on different file types (e.g., .exe,
.zip, .jpg, etc...) But that will have to wait till a bit later.
I want to thank everyone who responded to my posting. I think this is a
great group. Many seasoned programmers willing to help those of us with
less experience.
Thank you.....
Tony Frasketi
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
