Professional Web Applications Themes

File upload script - PERL Beginners

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)) { ...

  1. #1

    Default file upload script

    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 Guest

  2. #2

    Default Re: file upload script


    "boris bass" <bbasshotmail.com> wrote in message
    news:65fcb898.0309032337.27d3a45fposting.google.c om...
    > 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 Guest

  3. #3

    Default Re: file upload script

    [email]bbasshotmail.com[/email] (boris bass) wrote in message news:<65fcb898.0309032337.27d3a45fposting.google. com>...
    > 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 Guest

  4. #4

    Default File upload script

    Can someone point the way to some file upload script for webserver on
    unix/linux?

    thanks


    -----------------------------------------
    eMail solutions by
    [url]http://www.swanmail.com[/url]
    perl@swanmail.com Guest

  5. #5

    Default Re: File upload script

    --As off Sunday, November 16, 2003 5:17 PM -0800, [email]perlswanmail.com[/email]
    is alleged to have said:
    > Can someone point the way to some file upload script for webserver
    > on unix/linux?
    --As for the rest, it is mine.

    Single file, batch, automated, manual, FTP, RCP, email, SCP, CVS,
    SFTP, remote, local, web-based, commandline, GUI, from Windows, from
    Mac, from UNIX?

    Please, what is the problem you are trying to solve, and what have
    you tried? Google only turns up around 167,000 hits for a search
    relating to this. A little smaller problem-space would be useful...

    Daniel T. Staal

    ---------------------------------------------------------------
    This email copyright the author. Unless otherwise noted, you
    are expressly allowed to retransmit, quote, or otherwise use
    the contents for non-commercial purposes. This copyright will
    expire 5 years after the author's death, or in 30 years,
    whichever is longer, unless such a period is in excess of
    local copyright law.
    ---------------------------------------------------------------
    Daniel Staal Guest

  6. #6

    Default Re: File upload script

    I'm trying to allow users to upload their own webpages. I have both binary
    and text format. Although, its probably ok to upload the webpages in
    binary mode and it would bother the webserver.

    In any case, I'm wondering if use CGI is the package to use and if there
    is a cpan module that someone can recommend?

    thanks
    > --As off Sunday, November 16, 2003 5:17 PM -0800, [email]perlswanmail.com[/email]
    > is alleged to have said:
    >
    >> Can someone point the way to some file upload script for webserver
    >> on unix/linux?
    >
    > --As for the rest, it is mine.
    >
    > Single file, batch, automated, manual, FTP, RCP, email, SCP, CVS,
    > SFTP, remote, local, web-based, commandline, GUI, from Windows, from
    > Mac, from UNIX?
    >
    > Please, what is the problem you are trying to solve, and what have
    > you tried? Google only turns up around 167,000 hits for a search
    > relating to this. A little smaller problem-space would be useful...
    >
    > Daniel T. Staal
    >
    > ---------------------------------------------------------------
    > This email copyright the author. Unless otherwise noted, you
    > are expressly allowed to retransmit, quote, or otherwise use
    > the contents for non-commercial purposes. This copyright will
    > expire 5 years after the author's death, or in 30 years,
    > whichever is longer, unless such a period is in excess of
    > local copyright law.
    > ---------------------------------------------------------------
    >
    > --
    > To unsubscribe, e-mail: [email]beginners-unsubscribeperl.org[/email]
    > For additional commands, e-mail: [email]beginners-helpperl.org[/email]
    >
    >


    -----------------------------------------
    eMail solutions by
    [url]http://www.swanmail.com[/url]
    perl@swanmail.com Guest

  7. #7

    Default Re: File upload script

    On Mon, 17 Nov 2003 01:08:46 -0800, perl wrote:
    > In any case, I'm wondering if use CGI is the package to use [...]
    Why don't you bother finding out? 'perldoc CGI'. Search for 'upload'.


    --
    Tore Aursand <toreaursand.no>

    Tore Aursand Guest

  8. #8

    Default [ADMIN] Re: File upload script

    It was Monday, November 17, 2003 when Tore Aursand took the soap box, saying:
    : On Mon, 17 Nov 2003 01:08:46 -0800, perl wrote:
    : > In any case, I'm wondering if use CGI is the package to use [...]
    :
    : Why don't you bother finding out? 'perldoc CGI'. Search for 'upload'.

    This isn't a proper response. Please try to be more helpful. We're
    here to be extra helpful. He's trying to find out, and it's possible
    he just doesn't know where to look.

    In this case, he's way off. He's talking about FTP, and most likely
    wants to look at Net::FTP.

    [url]http://search.cpan.org/perldoc?Net::FTP[/url]

    Casey West

    --
    f u cn rd ths, u cn gt a gd jb n cmptr prgmmng.

    Casey West Guest

  9. #9

    Default RE: File upload script

    > I'm trying to allow users to upload their own webpages. I
    > have both binary and text format. Although, its probably ok
    > to upload the webpages in binary mode and it would bother the
    > webserver.
    >
    If it's browser based uploads CGI can help you.
    Otherwise you may be interested in Net::FTP.

    So it depends on your needs, sorry to be so vague!

    HTH
    DMuey
    > In any case, I'm wondering if use CGI is the package to use
    > and if there is a cpan module that someone can recommend?
    >
    > thanks
    >
    Dan Muey Guest

  10. #10

    Default Re: [ADMIN] Re: File upload script


    "Casey West" <caseygeeknest.com> wrote in message
    news:20031117194512.GH35368geeknest.com...
    <snip />
    >
    > Casey West
    >
    > --
    > f u cn rd ths, u cn gt a gd jb n cmptr prgmmng.
    >
    Where? =0)

    Todd W.


    Todd W. Guest

Similar Threads

  1. Replies: 8
    Last Post: April 6th, 10:48 AM
  2. Replies: 2
    Last Post: July 29th, 11:41 AM
  3. Upload Friendly (Multiple File Upload Applet)
    By ochiana in forum Coldfusion Server Administration
    Replies: 1
    Last Post: February 22nd, 02:16 AM
  4. anyone got an easy file upload script?
    By WBS in forum PHP Development
    Replies: 0
    Last Post: February 29th, 11:42 AM
  5. Adding encryption subroutine to file upload script
    By Jay Vance in forum PERL Modules
    Replies: 0
    Last Post: July 19th, 07:08 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139