file upload script

Discussion in 'Perl Misc' started by boris bass, Sep 4, 2003.

  1. boris bass

    boris bass Guest

    the following script

    --------------------------

    #!/usr/local/bin/perl

    ######use lib $0 =~ m#(.+)[/\\]#;
    use CGI qw:)standard);
    ######use CGI::Carp qw/fatalsToBrowser/;

    print header();
    print start_html("File Upload Example");
    print strong("Version "),$CGI::VERSION,p;

    print h1("File Upload Example"),
    '',
    strong(""),
    p,
    '',cite(''),'';

    @types = ('count lines','count words','count characters');

    # Start a multipart form.
    print start_multipart_form(),
    "Enter the file to process:",
    filefield('filename','',45),
    br,
    checkbox_group('count',\@types,\@types),
    p,
    reset,submit('submit','Process File'),
    endform;

    # Process the form if there is a file name entered
    if ($file = param('filename'))
    {
    $filename = "Cabbage.gif";
    $UPLOAD_PATH = "";
    $UPLOAD_FILE = $UPLOAD_PATH.$filename;

    print "FILE NAME: $UPLOAD_PATH$filename<br>";
    open (OUTFILE,">$UPLOAD_FILE") or die "Could not open $UPLOAD_FILE
    - $!\n";
    binmode(OUTFILE);

    while(read($file,$buffer,1024))
    {
    print OUTFILE $buffer;
    }
    print "Finished - Filname: $filename, Buffer: $buffer<BR><BR>";
    close OUTFILE;

    }

    print end_html;

    ---------------------------------

    is not working for me; the form is printed ok, but param() does not
    return a filename.

    what could possibly be wrong?

    if somebody could post a script that works for them, it would be
    greatly appreciated
     
    boris bass, Sep 4, 2003
    #1
    1. Advertising

  2. boris bass

    Bigus Guest

    "boris bass" <> wrote in message
    news:...
    > the following script
    >
    > --------------------------
    >
    > #!/usr/local/bin/perl
    >
    > ######use lib $0 =~ m#(.+)[/\\]#;
    > use CGI qw:)standard);


    [..]

    > # Process the form if there is a file name entered
    > if ($file = param('filename'))


    I always thought that you had to use CGI standard to get submitted form
    values like this:

    use CGI qw:)standard);
    $query = new CGI;
    if($file = $query->param("filename"));

    Bigus
     
    Bigus, Sep 4, 2003
    #2
    1. Advertising

  3. boris bass

    JR Guest

    (boris bass) wrote in message news:<>...
    > the following script
    >
    > --------------------------
    >
    > #!/usr/local/bin/perl
    >
    > ######use lib $0 =~ m#(.+)[/\\]#;
    > use CGI qw:)standard);
    > ######use CGI::Carp qw/fatalsToBrowser/;
    >
    > print header();
    > print start_html("File Upload Example");
    > print strong("Version "),$CGI::VERSION,p;
    >
    > print h1("File Upload Example"),
    > '',
    > strong(""),
    > p,
    > '',cite(''),'';
    >
    > @types = ('count lines','count words','count characters');
    >
    > # Start a multipart form.
    > print start_multipart_form(),
    > "Enter the file to process:",
    > filefield('filename','',45),
    > br,
    > checkbox_group('count',\@types,\@types),
    > p,
    > reset,submit('submit','Process File'),
    > endform;
    >
    > # Process the form if there is a file name entered
    > if ($file = param('filename'))
    > {
    > $filename = "Cabbage.gif";
    > $UPLOAD_PATH = "";
    > $UPLOAD_FILE = $UPLOAD_PATH.$filename;
    >
    > print "FILE NAME: $UPLOAD_PATH$filename<br>";
    > open (OUTFILE,">$UPLOAD_FILE") or die "Could not open $UPLOAD_FILE
    > - $!\n";
    > binmode(OUTFILE);
    >
    > while(read($file,$buffer,1024))
    > {
    > print OUTFILE $buffer;
    > }
    > print "Finished - Filname: $filename, Buffer: $buffer<BR><BR>";
    > close OUTFILE;
    >
    > }
    >
    > print end_html;
    >
    > ---------------------------------
    >
    > is not working for me; the form is printed ok, but param() does not
    > return a filename.
    >
    > what could possibly be wrong?
    >
    > if somebody could post a script that works for them, it would be
    > greatly appreciated


    ### I found this upload script on the web several years ago. I don't
    know
    ### if it's the best solution, but I do know that it's worked for over
    ### 500 file uploads, without a single error. Good luck.

    #!/usr/bin/perl

    $thisurl = $ENV{'SERVER_URL'}.$ENV{'SCRIPT_NAME'};
    $upload_dir = 'yourdir'; # location for uploaded files

    main();

    sub main {
    read_net_input();
    if( $GLOBAL{'UPLOAD'} ) { handle_upload(); }
    elsif( !$ENV{'PATH_INFO'} || $ENV{'PATH_INFO'} eq '/' ) {
    show_dir_content(); }
    else { start_download( $ENV{'PATH_INFO'} ); }
    }

    sub print_header {
    print "Content-Type: text/html\n\n";
    }

    sub urldecode {
    local($in) = @_;
    local($i, @input_list);
    @input_list = split(/&/,$in);
    foreach $i (@input_list) {
    $i =~ s/\+/ /g; # Convert plus's to spaces
    # Convert %XX from hex numbers to alphanumeric
    $i =~ s/%(..)/pack("c",hex($1))/ge;
    # Split into key and value.
    $loc = index($i,"=");
    $key = substr($i,0,$loc);
    $val = substr($i,$loc+1);
    $GLOBAL{$key} = $val;
    }
    }

    sub read_net_input {
    local ($i, $loc, $key, $val, $input);
    local($f,$header, $header_body, $len, $buf);
    if ($ENV{'REQUEST_METHOD'} eq "GET")
    { $input = $ENV{'QUERY_STRING'}; }
    elsif ($ENV{'REQUEST_METHOD'} eq "POST")
    {
    $len = 0;
    $input = '';
    while( $len != $ENV{'CONTENT_LENGTH'} ) {
    $buf = '';
    $len += sysread(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
    $input .= $buf;
    }
    }
    if( $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/
    ) {
    $boundary = '--'.$1; # please refer to RFC1867
    @list = split(/$boundary/, $input);
    $header_body = $list[1];
    $header_body =~ /\r\n\r\n|\n\n/; # separate header and body
    $header = $`; # front part
    $body = $'; # rear part
    $body =~ s/\r\n$//; # the last \r\n was put in by Netscape
    $GLOBAL{'FILE_CONTENT'} = $body;
    $header =~ /filename=\"(.+)\"/;
    $GLOBAL{'FILE_NAME'} = $1;
    $GLOBAL{'FILE_NAME'} =~ s/\"//g; # remove "s
    $GLOBAL{'FILE_NAME'} =~ s/\s//g; # make sure no space(include
    \n, \r..) in the file name
    for( $i=2; $list[$i]; $i++) {
    $list[$i] =~ s/^.+name=$//;
    $list[$i] =~ /\"(\w+)\"/;
    $GLOBAL{$1} = $';
    }
    return 1;
    }

    urldecode($input);
    1;
    }

    sub read_file {
    local($fname) = @_;
    local($content);
    open(FILE, "<$fname") || return '';
    while(<FILE>)
    {
    $content .= $_;
    }
    close(FILE);
    $content;
    }

    sub read_dir {
    local($target_dir) = @_ ;
    local($filename, $dir_content);
    return 0 if( !$target_dir );
    opendir(DIR, $target_dir) || return 0;
    $target_dir =~ s/^\.\///; # remove ./
    $target_dir =~ /(.+)\/(.+)\/$/; # find out upper level
    $GLOBAL{'UP_LEVEL'} = $1; # save upper level as a global
    if( $target_dir ) {
    $dir_content = "..back\n\n\n";
    }
    while($filename = readdir(DIR)) {
    if( $filename =~ /^\.|^\#|~$/ ) { next; } # skip hidden files
    $dir_content .= "$target_dir$filename\n";
    }
    closedir(DIR);
    $dir_content;
    }

    sub format_html_output {
    local($content) = @_;
    local(@filelist, $formated_content, $up_level);
    return 0 if (!$content);
    @filelist = split(/\n/, $content);
    $foo = 0;
    $formated_content = "<CENTER><TABLE cellspacing=5 cellpadding=5
    border=1>\n";
    foreach $f (@filelist) {
    if( $f eq '..back' ) {
    $up_level = $GLOBAL{'UP_LEVEL'};
    $formated_content = "<a
    href=".$thisurl.'/'.$up_level.">$f</a><br>\n<P><CENTER><TABLE
    cellspacing=5 cellpadding=5 border=1>\n";
    next;
    }
    if( !$f ) {
    next;
    }
    if( -d $f ) {
    $f = "$f/";
    }
    $foo++;
    if ($foo eq 5) {
    $formated_content .= '<TD><a
    href='.$thisurl.'/'.$f.">$f</a><TR>\n";
    $foo = 0;
    }
    else {
    $formated_content .= '<TD><a
    href='.$thisurl.'/'.$f.">$f</a>\n";
    }
    }
    $formated_content .= "</TABLE></CENTER>\n";
    $formated_content;
    }

    sub show_dir_content {
    local($dir) = @_;
    local($files, $f_files);
    $dir = './' if (!$dir); # default to cgi dir
    $files = read_dir($dir);
    $f_files = format_html_output($files);
    print_header();
    print "
    <HTML>
    <HEAD>
    <TITLE>File UpLoad/DownLoad</TITLE>
    </HEAD>
    <BODY BGCOLOR=\#FFFFFF >
    <CENTER>
    <H2>File Upload Screen</H2>
    <FORM METHOD=\"POST\" ENCTYPE=multipart/form-data >
    <TABLE>
    <TR>
    <TD WIDTH=80%>File Name: <INPUT TYPE=\"file\"
    NAME=\"file\" SIZE=50 >
    </TD>
    </TR>
    </TABLE>
    <TABLE>
    <TR>
    <TD WIDTH=20%><INPUT TYPE=submit NAME=UPLOAD
    VALUE=Upload >
    </TD>
    <TR>
    </TABLE>
    <INPUT TYPE=HIDDEN NAME=CURRENT_DIR VALUE=\"$dir\">
    </FORM>
    <font size=-1>Default Directory: $upload_dir</font></center>
    <HR>
    <I>
    <P>\&nbsp\;</P>
    </I>
    </FONT>
    </BODY>
    </HTML>
    ";
    exit;
    }

    sub show_file_not_found {
    print_header();
    print "<TITLE>Not Found</TITLE><H1>Not Found</H1> The requested
    object does not exist on this server. The link you followed is either
    outdated, inaccurate, or the server has been instructed not to let you
    have it. Connection closed by foreign host.\n"
    ;
    exit;
    }

    sub show_upload_failed {
    local($reason) = @_;
    print_header();
    print "<TITLE>Upload Failed</TITLE><H1>Upload Failed</H1> The
    requested object was not uploaded to the server. <br> Reason :
    $reason. The server may have decided not let you write to the
    directory specified. Please contact the web master for this prob
    lem. Connection closed by foreign host.\n";
    exit;
    }

    sub show_upload_success {
    local($uploaded_file) = @_;
    local(@status_list) ;
    $file_stats = `ls -la $uploaded_file`;
    @status_list = split(/\s+/, $file_stats); # bug fix in v00.01
    print_header();
    print "
    <HTML>
    <HEAD>
    <TITLE>File UpLoaded</TITLE>
    </HEAD>
    <BODY BGCOLOR=\#FFFFFF >
    <H2><center>File Transfer Successful</center></H2>
    <table align = center width = 35% cell padding = 10 border = 6>
    <tr>
    <td>
    <blockquote>
    <br />
    Remote File Name : <FONT COLOR=\#FF0000>
    $GLOBAL{'FILE_NAME'} </FONT>
    File Name : $filename
    Location : $upload_dir
    File Size : $status_list[4]
    <br />
    Local Time: $status_list[5] $status_list[6]
    $status_list[7]
    <br />
    <a href=\"$ENV{'SCRIPT_NAME'}\"> Back </a>
    </blockquote>
    </td>
    </tr>
    </table>
    <br />
    <center>
    <form action = 'myform.pl' method = 'get'>
    <input type = 'hidden' name = '$filename'>
    <input type = 'Submit' value = 'Preprocess this
    file...'>
    </form>
    </center>
    </BODY>
    </HTML>
    ";
    exit;
    }

    sub handle_upload {
    if( !$GLOBAL{'FILE_NAME'} ) { show_file_not_found(); }
    $filename = $GLOBAL{'FILE_NAME'};
    $filename =~ s/.+\\([^\\]+)$|.+\/([^\/]+)$/\1/;
    if( $GLOBAL{'UPLOAD_DIR'} =~ /CURRENT/ ) { # change upload dir
    to current
    $GLOBAL{'CURRENT_DIR'} =~ s/\s//g;
    $upload_dir = $GLOBAL{'CURRENT_DIR'};
    }
    $write_file = $upload_dir.$filename;
    open(ULFD,">$write_file") || show_upload_failed("$write_file
    $!");
    print ULFD $GLOBAL{'FILE_CONTENT'};
    close(ULFD);
    show_upload_success($write_file);
    1;
    }
     
    JR, Sep 4, 2003
    #3
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. =?Utf-8?B?U2FyYXY=?=

    Upload a file without file Upload control - ASP.Net

    =?Utf-8?B?U2FyYXY=?=, Aug 2, 2005, in forum: ASP .Net
    Replies:
    3
    Views:
    2,457
    Bruce Barker
    Aug 3, 2005
  2. Jorch
    Replies:
    2
    Views:
    1,260
    Jorch
    May 18, 2004
  3. Heather Fraser
    Replies:
    0
    Views:
    638
    Heather Fraser
    Jul 5, 2004
  4. Replies:
    1
    Views:
    941
    Gabriel Genellina
    Nov 25, 2006
  5. Prakash
    Replies:
    3
    Views:
    465
    Ray at
    Nov 12, 2003
Loading...

Share This Page