in reply to Re: Passing database ID to \&hook through $data (CGI)
in thread Passing database ID to \&hook through $data (CGI)

What you're trying to do is not what this was intended for, but you may be able to work around with QUERY_STRING

Then I do wonder what it was intended for then, if not for tracking the state of uploads.

I made up a small example, using bits of your code:

The upload-form: (form.html)

<!-- using GET will make the QUERY_STRING as mentioned in the previous
+ post, but.. that's not how it's supposed to be? -->
<form action="minitest.cgi" enctype="multipart/form-data" method="GET"
+>
 <input type="file" name="file">
 <input type="submit" value="send">
 <input type="hidden" name="pregeneratedID" value="123456">
</form>

[download]

the upload-script: (minitest.cgi)

#!/usr/bin/perl -w

use strict;
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser);

my $query = CGI->new($ENV{QUERY_STRING});

# I will initially save my file with this name and copy it to the corr
+ect name later (ID+original suffix)
# ID has to be passed to 'hook', to keep track of the upload-status in
+ a DB (I will just use a plain file here for testing)
# as only $filename (the originale name on the client-disk is passed t
+o the hook, there is no relation between the
# sanitized filename I will use when saving the uploaded file, and the
+ filename used in the hook, thus practically rendering
# the hook useless
my $data = $query->param('pregeneratedID');
if (!$data) { print $query->header(); print "no data?"; exit; }
$data = $1 if $data =~ //;# untaint generatedID - for some reason this
+ sets the contents of $data to .. nothing
if (!$data) { print $query->header(); print "no data?"; exit; }

$query = CGI->new(\&hook, $data);

my $fh = $query->upload('file');
# I want to save the file with the same filename as the ID (so it's ea
+sier to keep track of during download)
# for testing purposes, I will not handle renaming and moving the file
+ in this example
my $name = $data;

open ( UPLOADFILE, ">uploads/$name" ) or die ("$!");
binmode UPLOADFILE;
while ( <$fh> )
{
 print UPLOADFILE;
}
close UPLOADFILE;

print $query->header();
print "look in uploads/test.log and see if $data was passed to the hoo
+k<br>\n";
print "If the file is not there, it means hook was never called, provi
+ng the manual right (blasted!))<br>\n";
print "filetype: ".$query->uploadInfo($fh)->{'Content-Type'}; # this b
+arfs, as nothing survives the sanitizing..

####

sub hook {
 my ($filename,$buffer,$bytes_received,$data) = @_;
 open (LOG, ">>uploads/test.log");
 print LOG $filename." ".$bytes_received. " - ".$data."\n";
 close (LOG);
}

[download]

This leaves me with an empty file in uploads/ named '123456' and no log-file, meaning the hook wasn't called.

I can only conclude, that the hook-feature makes it possible to either keep track of a specific upload by using un-sanitized filenames, giving me the option of actually using the progress-information logged by the hook, or using fully sanitized filenames in the hook as well, (by generating the ID within the upload-script, before declaring the cgi-obj), but then not having any posibilities of keeping track of the upload while it is in progress.. unless CGI.pm is modified so it will pass more information from the upload-handler. As I see it, the $data-option is nearly useless

Of course, if there is any other way of doing this in a nice way, don't keep it back :)

Replies are listed 'Best First'.
Re^3: Passing database ID to \&hook through $data (CGI)
by Anonymous Monk on Sep 20, 2008 at 11:30 UTC
    Then I do wonder what it was intended for then, if not for tracking the state of uploads.
    Nowhere is it suggested you can get your chicken before upload hook. It says The $data field is optional; it lets you pass configuration information (e.g. a database handle) to your hook callback.

    <!-- using GET will make the QUERY_STRING as mentioned in the previous post, but.. that's not how it's supposed to be? --> Who suggested you use get? I said as long as action is /foo/bar.cgi?chicken=ididid Example 

    #!/usr/bin/perl  -- 

use strict;
use warnings;

use CGI();

$|=1;
$ENV{QUERY_STRING}="";

{

    my $q = CGI->new("".$ENV{QUERY_STRING});
    $q->param(qw' chicken ididid ');

    print join "\n",
    $q->start_html,
    $q->start_form(
        -method=>'POST',
        -action=>  $q->self_url,
        -enctype=> &CGI::MULTIPART
    ),
    $q->filefield('file'),
    $q->hidden(pregeneratedID => 123456 ),
    $q->end_form,
    $q->end_html;
}

__END__
<!DOCTYPE html
    PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-U
+S">
<head>
<title>Untitled Document</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1
+" />
</head>
<body>

<form method="post" action="http://localhost?chicken=ididid" enctype="
+multipart/form-data">

<input type="file" name="file"  />
<input type="hidden" name="pregeneratedID" value="123456"  />
</form>

</body>
</html>

    [download]
[reply]
[d/l]
[select]

      Dear Anonymous Monk,

      I was blind, but now I see. Of course it wasn't stated anywhere that should use GET, I guess I was just sleepy when I read your previous post.

      I did some more testing with your suggestion and lo and behold, it works like a charrm, so now I provide a fully working example*:

      (*Even though there are a few bits and pieces that should be checked up on (keeping things sane), I should remember to give credit to Justin Simoni, who posted the original script, on which this is based years and years ago)

      #!/usr/bin/perl -w

# Where is the upload file going?
my $Upload_Dir = 'uploads'; 

$| = 1; 

use strict; 
use CGI::Carp qw(fatalsToBrowser); 
use CGI qw/:standard/; 
use CGI::Ajax;
use File::Basename; 
my $safe_filename_characters = "a-zA-Z0-9_.-";

# get the ID from the action-url

# this will be used to grab the id from the action-part of the url thi
+s script is called with (thanks to Anonymous Monk)
my $q = CGI->new($ENV{QUERY_STRING});

# I will initially save my file with ID+original suffix
# ID has to be passed to 'hook', to keep track of the upload-status in
+ a DB (I will just use a plain file here for testing)
my $data = $q->param('id');
#$data = $1 if $data =~ //;# untaint id - for some reason this sets th
+e contents of $data to .. nothing?

# create new object    
$q   = CGI->new(\&hook, $data);
my $pjx = new CGI::Ajax('check_status' => \&check_status);

my $init_rand_string = 0; 

if(!$q->param('process')){ 
    $init_rand_string = generate_rand_string(); 
}

my $d = <<EOF
 
<html>
    <head>
        <script type="text/javascript"> 
            function run () {
                setInterval("check_status(['check_upload__1', 'rand_st
+ring'], ['statusbar']);",'1000')
            }
        </script> 
    </head>
    <body>
            <div id="statusbar" style="float: left; padding: 8px"></di
+v>
        <div style="float: left"><form name="default_form" enctype="mu
+ltipart/form-data" method="post" action="?id=$init_rand_string">
            <input type="file" name="uploadedfile" />
            <input type="hidden" name="yes_upload" value="1" />
            <input type="hidden" name="process" value="1" />
            <input type="hidden" name="rand_string" id="rand_string" v
+alue="$init_rand_string" />
            <input type="submit" value="upload." onClick="javascript: 
+run();" /></form></div>
    </body>
</html>

EOF
; 
my $outfile;
my $outfile2;
if ($q->param('uploadedfile')) { 
    $outfile = $q->param('uploadedfile'); 
    my ($name, $path, $extension) = fileparse($outfile, qr/\.[^.]*/);
    $outfile2 = $q->param('rand_string') . $extension;
} else { $outfile = $outfile2 = "na"; }

my $p = <<EOF

<html>
    <head>
    </head>
    <body>
        <h1>
            Done!: 
        </h1>
        <hr /> 
        <p> 
         "$outfile" saved as "$outfile2"
        </p><div><a href="ajaxup.cgi">back</a>
    </body>
</html>

EOF
; 

main(); 

sub main { 

    if($q->param('process')){ 
        if($q->param('yes_upload')) { 
            upload_that_file($q); 
        }   
        print $q->header(); 
        print $p; 
        dump_meta_file();   
    }
    else {         
        print $pjx->build_html( $q, $d);
    }
}


sub upload_that_file { 

    my $q = shift; 
    
    my $fh       = $q->upload('uploadedfile');
    my $filename = $q->param('uploadedfile');


    if ($filename =~ m/c:/i) {  
        fileparse_set_fstype('MSWin32');
    }
    my ($name, $path, $extension) = fileparse($filename, qr/\.[^.]*/);
   $filename = $q->param('rand_string') . $extension;
   $filename =~ tr/ /_/;
   $filename =~ s/[^$safe_filename_characters]//g;

    return '' if ! $filename; 
    
    my $outfile = $Upload_Dir . '/' . $filename;
    open (OUTFILE, '>' . $outfile) or die("can't write to " . $outfile
+ . ": $!");        
    
    my $bytes_read = 0;
    while (my $bytesread = read($fh, my $buffer, 1024)) { 
        print OUTFILE $buffer; 
        $bytes_read += $bytesread;
    } 
    close (OUTFILE);
}


sub check_status { 
   
   # here we use the passed $data to look up the status of that partic
+ular upload
   my $filename = $q->param('rand_string');
   # shoul be detainted, but we're just testing, right?
   return '' 
    if ! -f  $Upload_Dir . '/' . $filename . '-meta.txt'; 
        
    open my $META, '<', $Upload_Dir . '/' . $filename  . '-meta.txt' o
+r die $!;
    my $s = do { local $/; <$META> };
    close ($META); 
    
   my $small = 100 - ($s * 1); 
   my $big = $s * 1; 
   
    my   $r .= '<div style="width:' . $big . 'px; height: 10pt; backgr
+ound-color: #cccccc; float:left; border: solid #cccccc 1px; font-size
+: 8pt; color: black; padding-left: 2px">'.$s.'%</div>'; 
         $r .= '<div style="width:' . $small . 'px; height:10pt; backg
+round-color: white; float:left; border: solid #cccccc 1px; font-size:
+ 8pt;margin-left: 0px;"></div>';
    return $r; 
    
}


sub dump_meta_file { 
   my $filename = $q->param('rand_string');

    unlink($Upload_Dir . '/' . $filename . '-meta.txt') or warn "delet
+ing meta file didn't work..."; 
}


# will be replaced with my own sub that interacts with a DB
sub generate_rand_string { 

    my $chars = shift || 'aAeEiIoOuUyYabcdefghijkmnopqrstuvwxyzABCDEFG
+HJKMNPQRSTUVWXYZ23456789';
    my $num   = shift || 1024;
    
    require Digest::MD5;
    
    my @chars = split '', $chars;
    my $ran;
    for(1..$num){
        $ran .= $chars[rand @chars];
    }
    return Digest::MD5::md5_hex($ran); 
 }

sub hook {
   # here we use the passed $data to provide a proper ID for the curre
+nt file being uploaded
    my ($filename, $buffer, $bytes_read, $data) = @_;

    $bytes_read ||= 0; 

    open(COUNTER, ">" . $Upload_Dir . '/' . $data . '-meta.txt'); 
    my $per = 0; 
    if($ENV{CONTENT_LENGTH} >  0){ # This *should* stop us from dividi
+ng by 0, right?
        $per = int(($bytes_read * 100) / $ENV{CONTENT_LENGTH});
    }
    print COUNTER $per;
    close(COUNTER); 
}

      [download]

      Thank you to those who gave this some thought :)

[reply]
[d/l]
        #$data = $1 if $data =~ //;# untaint id - for some reason this sets th
+e contents of $data to .. nothing?

        [download]
        You're supposed to fill in something like /^(\d+)/ :)
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom