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

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 :)

Replies are listed 'Best First'.
Re^5: Passing database ID to \&hook through $data (CGI)
by Anonymous Monk on Sep 20, 2008 at 16:09 UTC 
    #$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]
      You're supposed to fill in something like /^(\d+)/

      doh, and doh again. that one I walked right into, as I actually did know, but completely overlooked.. ;)

[reply]

In Section Seekers of Perl Wisdom