?
Solved

File upload with Perl/CGI

Posted on 2003-03-30
5
Medium Priority
?
585 Views
Last Modified: 2013-12-25
I need to upload a file as part of a process of creating a new record in a database. I have a record ID that is stored in the param 'ID'. I extract this and the file name using the following code:

    $ID = $cgiobject->param('ID');
    $filex = $cgiobject->param('filex');
    $filex =~ /.*\\(.*)$/;
    $filename = $1;

    binmode(STDIN);       #### ORIGINAL UPLOAD SCRIPT STARTS HERE
    @inx = <STDIN>;

    foreach (@inx){       # Added so I can see the contents of @inx
        print "$_<br>";   # but turns out to be empty
    }

    splice(@inx,0,4);
    splice(@inx,$#inx,1);
    $in = join("",@inx);
    $in = substr($in,0,length($in) - 2);;

    print "$in";

Earlier on in my script I have:

    use CGI;
    $cgiobject = new CGI;

which allows me to extract the 2 params just fine, but now I'm having trouble obtaining the actual file data. The code from binmode(STDIN) was copied from a file upload script that used to work previously, but seems to return no file data now. Is this because my binmode(STDIN) and $cgiobject calls conflict with each other? Any ideas on how I can get my uploading to work? Thanks in advance!
0
Comment
Question by:tiduck
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
5 Comments
 
LVL 51

Accepted Solution

by:
ahoffmann earned 200 total points
ID: 8237086
while (<STDIN>) {print "$_<br>";}
# or better
while ($bytesread=read( $filename,$buf,8192 )) {$inx.=$buf;}
0
 

Assisted Solution

by:amitabhrai
amitabhrai earned 200 total points
ID: 8255749
you can also try this..

my $input_file = $cgi->param('filex');
$input_file=~m/^.*(\\|\/)(.*)/; # strip the remote path and keep the filename
my $file_name = $2;  # gives only the filename without the directory
 while(<$input_file>) {
    print  $_;
}
0
 

Assisted Solution

by:notsew
notsew earned 200 total points
ID: 8304219
I'm not sure if this will help, but I've modified this script for many utilitie on my site.  All you need is a form pointing to it with <input type=file name=File1> format.   You can set it for multiple uploads as well.  You will need to change a few of the variables becuase this is pulling data from my main config area.

Best of luck!

#!/usr/bin/perl
require "../../config.pl";

# Needs to be the DIR.. i.e. - /home/webapp/www/
$Data = $uploaddir;

# If you want to allow other image file types, enter them here
@jpg_extensions = ('gif', 'jpg', 'jpeg', 'GIF', 'JPG', 'JPEG', 'png', 'PNG');

@bad_extensions = ('vbs', 'exe', 'bat', 'com', 'VBS', 'EXE', 'BAT', 'COM');

##########################################################
#      Set the maximum size of each file that is permitted.
##########################################################
if (@jpg_extensions) {
$max_size = $maxuploadsize;
}
else {
$max_size = $maxuploadsize;
}


#############################################################################  
#      DO NOT EDIT ANYTHING BELOW THIS LINE UNLESS YOU KNOW WHAT YOU ARE DOING
#############################################################################

      $max_num_files = "1";
   
    $auto_rename = 1;
    #   This variable tells the program whether or not to over-write or reject like
    #   named files. Therefore, if you upload a file with a name that already exists
    #   on the server, set this value for the appropriate following results:
    #           0 => Overwrite the existing file
    #           1 => Leave existing file in place, serialize the name of the new
    #                new file (i.e. some_book.doc, some_book1.doc, some_book2.doc, etc)
    #           2 => Reject the new file. Leaves the original file in place and rejects
    #                the new file so that it is not saved.

    use CGI;
    $max_num_files ||= 1;
    $upload_dir ||= $ENV{'DOCUMENT_ROOT'};
          undef @bad_extensions if @jpg_extensions;

    for(my $a = 1; $a <= $max_num_files; $a++) {
      my $req = new CGI;
      if($req->param("FILE$a")) {
          my $file = $req->param("FILE$a");
          my $filename = $file;
          $filename =~ s/^.*(\\|\/)//;
            #For IE
          $filename =~ s/ +/\_/g;
            #For Opera
            $filename =~ s/\"//g;
          my $proceed_type = 0;

            $filetoremember = $filename;

##################################################
# Starting to check files
##################################################

          if(@jpg_extensions) {
            foreach(@jpg_extensions) {
                my $ext = $_;
                $ext =~ s/\.//g;
                if($filename =~ /\.$ext$/) {
                  $proceed_type = 1;
                  last;
                }
            }
            unless($proceed_type) {
                push(@was_not_good_type, $filename);
            }
          }

          

#######################################
# If it's a BAD extension.. like exe...
#######################################

          elsif(@bad_extensions) {
            $proceed_type = 1;
            foreach(@bad_extensions) {
                my $ext = $_;
                $ext =~ s/\.//g;
                if($filename =~ /\.$ext$/) {
                  $proceed_type = 0;
                  last;
                }
            }
            unless($proceed_type) {
                push(@was_a_bad_type, $filename);
            }
          }

####################
# the Catch all....
####################

      else {
            $proceed_type = 1;
          }


###################

             if(($auto_rename == 2) && (-e "$Data/$filename")) {
                $proceed_type = 0;
                push(@rejected, $filename);
            }
          if($proceed_type) {
                if((-e "$Data/$filename") && ($auto_rename == 1)) {
                    my $pick_new_name = 1;
                    my $fore_num = 1;
                    $filename =~ /^(.+)\.([^\.]+)$/;
                    my $front = $1;
                    my $ext = $2;
                    while($pick_new_name) {
                        my $test_name = $front . $fore_num . '.' . $ext;
                        unless(-e "$Data/$test_name") {
                            $pick_new_name = 0;
                            $filename = $test_name;
                        }
                        $fore_num++;
                    }
                }
                elsif((-e "$Data/$filename") && ($auto_rename == 2)) {
                    next;
                }
            if(open(OUTFILE, ">$Data/$filename")) {
                  $filetoremember = $filename;
                while (my $bytesread = read($file, my $buffer, 1024)) {
                  print OUTFILE $buffer;
                    }
                close (OUTFILE);
                  if($max_size) {
                    if((-s "$Data/$filename") > ($max_size * 1024)) {
                        push(@was_too_big, $filename);
                        unlink("$Data/$filename");
                    } else {
                        push(@file_did_save, $filename);
                        }
                  } else {
                    push(@file_did_save, $filename);
                    }
            } else {
                push(@did_not_save, $filename);
            }
          }
      }

    if(@file_did_save) {
            chomp(@file_did_save);
            print "Location: $pageurl/$cgi?action=uploadsuccess&yourfile=$filetoremember\n\n";
            exit;
    } else {
      print "Location: $pageurl/$cgi?action=uploadfail&yourfile=$filetoremember\n\n";
      exit;}
}

1;
0

Featured Post

New benefit for Premium Members - Upgrade now!

Ready to get started with anonymous questions today? It's easy! Learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It is a general practice to get rid of old user profiles on a computer  in a LAN environment. As I have been working with a company in a LAN environment where users move from one place to some other place at times. This will make many user profil…
Batch, VBS, and scripts in general are incredibly useful for repetitive tasks.  Some tasks can take a while to complete and it can be annoying to check back only to discover that your script finished 5 minutes ago.  Some scripts may complete nearly …
Learn the basics of while and for loops in Python.  while loops are used for testing while, or until, a condition is met: The structure of a while loop is as follows:     while <condition>:         do something         repeate: The break statement m…
This tutorial will teach you the core code needed to finalize the addition of a watermark to your image. The viewer will use a small PHP class to learn and create a watermark.
Suggested Courses

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question