print qq!  # code  !;
[download]

print q!   # code !;
[download]

Now there are really ugly ways that you might be able to get beyond that, such as using exec(), or system() and somehow ensuring you pass them all of what had been in STDIN, but I don't recommend them.

File upload in Perl should be fairly OS-agnostic. There are lots of good nodes around the monastery that will answer your question, but here's one that I've written.

If that doesn't work for you, let us know what the problems you have with it are. Alternately, of course, you can just write your upload script straight in PHP. mmm.... mixing PHP and CGI... it does tend to lead to maintainence headaches.

Hope it helps.

jarich

Oh for chrissake. With a newish version of CGI.pm (version 2.47+, you do:

$fh = $query->upload('FILE');
     while (<$fh>) 
{
           $filecontents .= $_;
     }
[download]

my $file = $query->param('FILE');

my ($bytesread,$buffer,$filecontents);
while ($bytesread = read($file,$buffer,1024))
   { 
      $filecontents .= $buffer;
   }
undef $bytesread; undef $buffer;
[download]

-- Regards,
Helgi Briem
helgi AT decode DOT is

Note - The below needs CRLF support to make it pretty much bug free.

#!/usr/bin/perl
use strict;

BEGIN {
    unshift @INC, $1 if $0 =~ m!(.*)[/\\]!;
}

eval {
    my $in = process_buffer();

    print "Content-Type: text/html\n\n";
    print q~<form method="post" action="" enctype="multipart/form-data
+"><input type="file" name="file"><br><input type="submit" value="Uplo
+ad"></form>~;

    if ($in->{file}) {
        (my $fn = $in->{file}) =~ s!^.*(\\|\/)!!; # get actual filenam
+e
        open FH, ">$fn";
        binmode FH;
        print FH $::multipart_data{$in->{file}};
        close FH;
        print "<p>File $in->{file} Uploaded!";
    }
};
print "content-type: text/html\n\n$@" if $@;


# process_buffer: Read the form data.
sub process_buffer {
    binmode STDIN;
    binmode STDOUT;
    binmode STDERR;
    my $buffer;
    if ($ENV{'REQUEST_METHOD'} =~ /^(GET|HEAD)$/) {
        $buffer = $ENV{'QUERY_STRING'};
    }
    elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
        if ((my $received = read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'
+})) != $ENV{'CONTENT_LENGTH'}) {
            die "Short read: wanted $ENV{'CONTENT_LENGTH'}, but unfort
+unately got $received";
        }
        if ($ENV{'CONTENT_TYPE'} =~ m|^multipart/form-data|) { # Begin
+ multipart
            my ($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\
+";,]+)\"?/;
            die "Couldn't find boundary. This is usually caused by a b
+ug server-side." unless $boundary;
            $boundary = "--$boundary";
            my @buffer = ();
            for my $i (grep /^\s*Content-Disposition:/i, split /$bound
+ary/, $buffer) {
                my @data = split("\r\n\r\n", substr($i, 0, length($i) 
+- 2));
                my $headers = shift @data;
                my %header;
                while ($headers =~ /([-\w!\#$%&\'*+.^_\`|{}~]+):"?(.+)
+"?/xmgo) {
                    my ($name, $value) = ($1, $2);
                    $name =~ s/\b(\w)/\u$1/g;
                    $header{$name} = $value;
                }
                my ($key) = $header{'Content-Disposition'} =~ / name="
+?([^\";]*)"?/;
                my $value = join "\r\n\r\n", @data;
                # POSSIBLE BUG ALERT: Netscape does not escape quotati
+on marks in file names?
                my ($filename) = $header{'Content-Disposition'} =~ / f
+ilename="?([^\"]*)"?/;
                #$filename =~ s!\\!/!g;
                $filename =~ s~[^\w\d \-_:/\\\.]~~g;
                if ($filename) {
                    $::multipart_data{$filename} = $value;
                    push @buffer, "$key=$filename";
                }
                else {
                    push @buffer, "$key=$value";
                }
            }
            $buffer = join ';', @buffer;
        } # End multipart
    }
    else {
          die "Unknown request method used: $ENV{'REQUEST_METHOD'}";
    }
    return format_buffer($buffer);
}

# format_buffer: Converts a standard buffer into a hash.
#                Syntax: format_buffer('key=value&key2=value2');
sub format_buffer {
    my $buffer = shift;
    my $temp;
    for my $pair ( split /[&;]/, $buffer ) {
        my ($name, $value) = split /=/, $pair;
        $name =~ tr/+/ /;
        $name =~ s/%([a-fA-F0-9]{2})/pack("c", hex($1))/eg;
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9]{2})/pack("c", hex($1))/eg;
        if (exists $temp->{$name}) {
            if (ref $temp->{$name}) {
                push @{ $temp->{$name} }, $value;
            }
            else {
                $temp->{$name} = [$temp->{$name}, $value];
            }
        }
        else {
            $temp->{$name} = $value;
        }
    }
    return $temp;
}
[download]

UPDATE: You can get the above code in .txt format here!