Upload File (Loading of a file on the server means Perl)

Code of the program:

*!/usr/bin/perl * use-T for CGI-scripts

  $SIG {ALRM} = sub {die " $0 timed out "}; * these 2 lines do not work under

  alarm 900; * Windows, but they are unessential

  use strict; * rescues from silly mistakes

  use Fcntl; * O_EXCL, O_CREAT and O_WRONLY

  use CGI qw (:standard); * read " perldoc CGI "

  use CGI:: Carp qw (fatalsToBrowser); * a conclusion of mistakes to browser-T

  $CGI:: POST_MAX = 131072; * the maximal input = 128 KB

  my $foto = param ('foto'); * a name of a file and odnovrem. handle

  my $DIR =/home/alex/pics ' * do not forget " chmod 777 pics "

  my $JS = " // JavaScript-function for pred-

                                                 // varitel`noj checks of the form

  function check (form)

  {

      if (form.elements ['foto'] .value.length <4) // foto should be filled

      {

          alert (' A gde zhe foto? '); // to show JavaScript-okoshko

          form.elements ['foto'] .select (); // to allocate the text into a field foto

          form.elements ['foto'] .focus (); // and to jump there the cursor

          return false; // false will forbid browser-T

} // to send the data to the server

      return true; // all OK - can be sent

} ";

  print header (-type => ' text/html; charset=koi8-r '),

        start_html (-title => ' MISS IHTERHET ', * to print heading and $JS

-script => $JS);

  * regex below checks, whether is .gif or .jp (e) g in the end puts a name

  * A file in $1

  if ($foto! ~ / ([w-] +. (?: gif | jpe? g)) $/ix) *F«½eh¬« the name, a way is thrown out

  {

      print h1 (' Send us a photo! '), *start_form will not work

            start_multipart_form (-onsubmit => ' return check (this) '),

            filefield (-name => 'foto'),

            submit (-value => ' Go baby go! '), * to print the form with the button

            end_form; * to print

}

  * This script prevents to enter to nobody dust (for example xxxx.gif) into a field foto,

  * That will lead to to creation of empty files; if it disturbs you, establish

  * New version CGI.pm also read

  * http: // stein.cshl.org/WWW/software/CGI / * upload

  elsif (not sysopen FILE, " $DIR / $ 1 ", O_EXCL | O_CREAT | O_WRONLY, 0444)

  {

      print h1 (" He I can create $DIR / $ 1: $! "); * the mistake or such file already is

}

  * Files spoil at a parcel{sending}? See below!

  else * that's all right - the file is created

  {

      binmode FILE; * to switch on binmode for Windows

      print FILE while (<$foto>); * and to copy the data in a file

      close FILE;

      print h1 (' Intimate to you thanks! '); * to bring up as dogs Pavlova

}

  print end_html; * to print

If zakachka some files occurs to glitches - probably, the file will be recoded hurriedly by Russian apache.

Variants of the decision:

1.zapretite all code conversions for a script which assorts FileUpload, for example in such a way: CharsetDisable On also do{make} code conversion.

2. Use CharsetRecodeMultipartForms directive which has appeared in PL23, but thus you all the same should recode manually text parts of searches. For this purpose it is possible to use Russian Apache API, accessible in other modules or Russian Apache Perl API, accessible of mod_perl.