Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

A Journey in Uploading

by barrycarlyon (Beadle)
on Jul 05, 2006 at 11:52 UTC ( [id://559313]=perlquestion: print w/replies, xml ) Need Help??

barrycarlyon has asked for the wisdom of the Perl Monks concerning the following question:

Fellow Monks

After asking a few question in the CB, about Uploading Files, I believe that the Correct snytax to use is

Anything in [] is pseudo code

$filename = [inputted field with Local Address, eg c:/file.jpg];
$file = [split of the filename removing everything before the last /]

open(OUTFILE,">>[destination].$file");
while ($bytesread=read($filename,$buffer,1024) ) {
  print OUTFILE $buffer;
}

$fh = upload('[name of field]');
while(<$fh>) {
  print;
}

[download]

Dont know why there is a print; but thats what the cpan doc says

My Question is this,
1. What do both Prints do
2. Does anyone have any suggestions to improve this code, and would it work

Update: The Long and short of it is, I want to upload any kind of file to a destiantion folder, similar in fashion to Photobucket, where you upload images to their site and link to them on things like forums

Solution

Here follows a copy of the working code

use CGI;
use CGI::Upload;

sub process {
  my $self = shift;
  my $q = $self->query;
  my $script = $q->script_name;

  my $filename = $q->param('uploaded_file');
  my $totalbytes;
  my ($bytesread, $buffer);
  my $numbytes = 1024;
  my $destination = "/home/[PATH REMOVED]/htdocs/uploads/";

#check rm

  print "Filename ($filename) good\n";
#sall good patch together
  my $output_file = $destination . $filename;

  print "Uploading $filename to $destination";
#upload time
  open (OUTFILE, ">", "$output_file")
    or die "Couldn't open $output_file for writing: $!";
  while ($bytesread = read($filename, $buffer, $numbytes)) {
    $totalbytes += $bytesread;
    print OUTFILE $buffer;
  }
  close OUTFILE;

#output
  print "sall good";

return;

}

[download]

Obviously the check rm is misising, all it will do is do the taint checks as described by Corion, ie check for actaully existance of the input, and check there are no illegal characters

Update

Minor glitch the code creates a file, but wont upload the contcnts of it, ie it creeats a file size of 0 bytes

Update

using

sub process {
  my $self = shift;
  my $html_template = $self->param('html_template');
  my $q = $self->query;
  my $script = $q->script_name;

  my $filename = $q->param('uploaded_file');
  my $from = $q->param('uploaded_file');
  my $diff_name = $q->param('diff_name');
  my $totalbytes;
  my ($bytesread, $buffer);
  my $num_bytes = 1024;
  my $destination = "/home/[PATH REMOVED]/htdocs/uploads/";

  binmode $filename; #just to be sure?

#check rm
  my ($results, $err_page) = $self->check_rm('input',
                                   {
                                     required => [qw/uploaded_file/],
                                     filters => ['trim'],
                                     msgs => {
                                               missing    => 'Please S
+upply a File Name',
                                             }
                                   });

  return $err_page if $err_page;

#sall good patch together
#  if ($diff_name)
#  {
#  $filename = $diff_name;
#  }
  my $output_file = $destination . $filename;
#upload time
  open (OUTFILE, ">", "$output_file") or die "Couldn't open $output_fi
+le for writing: $!";
  while ($bytesread = read($filename, $buffer, $num_bytes)) {
    $totalbytes += $bytesread;
    print OUTFILE $buffer;
  }
  die "Read Failure" unless defined($bytesread);
  unless (defined($totalbytes)) {
    print "<p>Error: Could not read file $filename, ";
    print "or was of zero length";
  } else {
    print "<p>Done ok, $totalbytes</p>";
  }
  close OUTFILE;
# or die "Couln't Close file $!";

#output
  my $output;

  $html_template->process('upload/form', {wrapper => $self->wrapper(),
                    status => "sall_good",
                    file => $filename,
                    dest => $destination,
                    from => $from,
                    }, \$output)
           || die $html_template->error;
  return $output;

}

[download]

Im getting the Read Failure error!

Specifically:

Getting a didnot return true value, and a read() on unopened filehandle then a Read Failure, it does gnerate the and empty file with the correct filename

Any Suggestions

Update

Im getting a Read Failure: Bad file descriptor

Suggestions?

The process doing the uploading is called lemons

#  open (OUTFILE, ">", "$output_file") or die "Couldn't open $output_f
+ile for writing: $!";
  open my $outfile, ">", $output_file or die "Couldn't open $output_fi
+le for writing: $!";
#  binmode $filename; #just to be sure?

  while ($bytesread = read($filename, $buffer, $num_bytes)) {
    $totalbytes += $bytesread;
    print OUTFILE $buffer;
  }
##  die 
print "Read Failure: $!" unless defined($bytesread);

[download]

num_bytes is 1024

filename is obtained from the form using a param

my $filename = $self->query->param('uploaded_file');

Barry Carlyon barry@barrycarlyon.co.uk

Replies are listed 'Best First'.
Re: After Revieing the Cpan On CGI, wrt Uploading things
by Corion (Patriarch) on Jul 05, 2006 at 12:02 UTC

    You pasted together some snippets of the CGI documentation, but all of those snippets are supposed to be used separately, not together. Personally, I would use the upload() variant:

        my $original_name = param('uploaded_file');
    my $fh = upload('uploaded_file');
    binmode $fh; # just to be sure

    # "Untaint" the original name:
    $original_name =~ s/[^\w.]/_/g;

    my $outname = File::Spec->catfile( $private_dir, $original_name );
    open my $outfile, '>', $outname
        or die "Couldn't create $outname: $!";

    local $/ = \4096; # blocksize
    while (<$fh>) {
          print $outfile $_;
    };

    warn "Uploaded a file into $outname";

    [download]

    Update: Corrected local $/ = \4096, as spotted by cdarke

[reply]
[d/l]
[select]
      I think the 'local' line should be:
      local $/ = \4096; # blocksize
      That is we want a reference to 4096 to set the block size.
[reply]

      Here is the Working code

      package LSRfm::Application::Upload;

use strict;
use warnings;
use base qw(LSRfm::Base);

use Apache::Reload;
use CGI;
use CGI::Upload;
#use CGI::Simple;

sub setup {
  my $self = shift;
  $self->start_mode('input');
  $self->run_modes([qw/input process/]);}

sub input {
  my $self = shift;
  my $errs = shift;
  my $html_template = $self->param('html_template');

  my $output;

  $html_template->process('upload/form', {wrapper => $self->wrapper(),
                    errors => $errs}, \$output)
           || die $html_template->error;
  return $output;
}

sub process {
  my $self = shift;
  my $html_template = $self->param('html_template');
  my $q = $self->query;
  my $script = $q->script_name;

  my $filename = $q->param('uploaded_file');
  my $from;
  my $fh = $q->upload('uploaded_file');
  my $diff_name = $q->param('diff_name');
  my $totalbytes;
  my ($bytesread, $buffer);
  my $num_bytes = 1024;
  my $destination = "/home/lsrfm/webs/www.lsrfm.com/htdocs/uploads/";

#check rm
  my ($results, $err_page) = $self->check_rm('input',
                                   {
                                     required => [qw/uploaded_file/],
                                     filters => ['trim'],
                                     msgs => {
                                               missing    => 'Please S
+upply a File Name',
                                             }
                                   });

  return $err_page if $err_page;

#sall good patch together
#  if ($diff_name)
#  {
#  $filename = $diff_name;
#  }
  my $output_file = $destination . $fh;
#upload time

  open (OUTFILE, ">", "$output_file") or die "Couldn't open $output_fi
+le for writing: $!";

  while ($bytesread = read($filename, $buffer, $num_bytes)) {
    $totalbytes += $bytesread;
    print OUTFILE $buffer;
  }
  die "$output_file Read Failure: $!" unless defined($bytesread);
  unless (defined($totalbytes)) {
    print "<p>Error: Could not read file $filename, ";
    print "or was of zero length";
  } else {
    print "<p>Done ok, $totalbytes</p>";
  }
  close OUTFILE or die "Couln't Close file $!";

#output
  my $output;

  $html_template->process('upload/form', {wrapper => $self->wrapper(),
                    status => "sall_good",
                    file => $filename,
                    dest => $destination,
                    from => $from,
                    }, \$output)
           || die $html_template->error;
  return $output;

}

1;

      [download]

      Dont forget to set the enctype of your form to enctype of "multipart/form-data"

      Barry Carlyon barry@barrycarlyon.co.uk
[reply]
[d/l]

        And here is a working version which allows you to change the filename

        package LSRfm::Application::Upload;

use strict;
use warnings;
use base qw(LSRfm::Base);

use Apache::Reload;
use CGI;
use CGI::Upload;
#use CGI::Simple;

sub setup {
  my $self = shift;
  $self->start_mode('input');
  $self->run_modes([qw/input process/]);}

sub input {
  my $self = shift;
  my $errs = shift;
  my $html_template = $self->param('html_template');

  my $output;

  $html_template->process('upload/form', {wrapper => $self->wrapper(),
                    errors => $errs}, \$output)
           || die $html_template->error;
  return $output;
}

sub process {
  my $self = shift;
  my $html_template = $self->param('html_template');
  my $q = $self->query;
  my $script = $q->script_name;

  my $filename = $q->param('uploaded_file');
  my $upload_file = $q->param('uploaded_file');
  my $diff_name = $q->param('diff_name');
  my $totalbytes;
  my ($bytesread, $buffer);
  my $num_bytes = 1024;
  my $destination = "/home/lsrfm/webs/www.lsrfm.com/htdocs/uploads/";

#check rm
  my ($results, $err_page) = $self->check_rm('input',
                                   {
                                     required => [qw/uploaded_file/],
                                     filters => ['trim'],
                                     msgs => {
                                               missing    => 'Please S
+upply a File Name',
                                             }
                                   });

  return $err_page if $err_page;

#sall good patch together
  if ($diff_name)
  {
  $filename = $diff_name;
  }
  my $output_file = $destination . $filename;
#upload time

  open (OUTFILE, ">", "$output_file") or die "Couldn't open $output_fi
+le for writing: $!";

  while ($bytesread = read($upload_file, $buffer, $num_bytes)) {
    $totalbytes += $bytesread;
    print OUTFILE $buffer;
  }
  die "$output_file Read Failure: $!" unless defined($bytesread);
  unless (defined($totalbytes)) {
    print "<p>Error: Could not read file $filename, ";
    print "or was of zero length";
  } else {
    print "<p>Done ok, $totalbytes</p>";
  }
  close OUTFILE or die "Couln't Close file $!";

#output
  my $output;

  $html_template->process('upload/form', {wrapper => $self->wrapper(),
                    status => "sall_good",
                    file => $filename,
                    dest => $destination,
                    from => $filename,
                    }, \$output)
           || die $html_template->error;
  return $output;

}

1;

        [download]

        Dont forget to set the enctype of your form to enctype of "multipart/form-data"

        Barry Carlyon barry@barrycarlyon.co.uk
[reply]
[d/l]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://559313]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others perusing the Monastery: (3)
As of 2024-04-25 06:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found