my $filename = $upload->file_name( 'fichier' );
my $type = $upload->file_type( 'fichier' );
my $file_handle = $upload->file_handle( 'fichier' );
In the above three lines, you are calling methods that all have the following general form:
sub file_XXXX {
my $self = shift;
my ($param) = @_;
my $cgi = $self->{'_CGI'};
return undef unless defined $cgi->param($param);
$self->{'_PARAMS'}->{$param} = $self->_handle_file( $cgi, $param)
unless exists $self->{'_PARAMS'}->{$param};
return $self->{'_PARAMS'}->{$param}->{'file_XXXX'};
}
In the above example, replace the XXXX with whatever the second part of the method name is and you have the correct method. The author of the module you are using is calling a private method, &CGI::Upload::_handle_file, which creates a hash reference, $object, and returns it and it gets assigned to $param. The relevant code is this:
my $object = {
'file_handle' => $fh,
'file_name' => $file[0] . $file[2],
'file_type' => substr(lc $file[2], 1),
'mime_type' => $magic->checktype_filehandle($fh)
};
$fh->seek(0, 0);
$fh->binmode if $CGI::needs_binmode;
return $object;
Now, that looks all fine and dandy. The author is creating a hash reference and later accessing one of the members of the hash. However, a little while earlier in the same method, we see the following little tidbit:
sub _handle_file {
# ... more code
fileparse_set_fstype(
do {
my $browser = HTTP::BrowserDetect->new;
return 'MSWin32' if $browser->windows;
return 'MacOS' if $browser->mac;
$^O;
}
);
# ... more code
}
The problem lies in that do block. If $browser->windows evaluates as true, then 'MSWin32' will be returned from this subroutine, rather than returned as the argument to &fileparse_set_fstype, which is what the author was intending. What this means is that 'MSWin32' gets returned instead of a hash reference. I'll shoot an email to the author. In the meantime, try hacking the module with the following (untested) code:
my $browser = HTTP::BrowserDetect->new;
fileparse_set_fstype(
$browser->windows
? 'MSWin32'
: $browser->mac
? 'MacOS'
: $^0
);
And here's a little 'proof of concept' program demonstrating the bug:
#!/usr/bin/perl -w
use strict;
sub test {
my $arg = shift;
my $x = foo (
do {
# In theory, this will pass 7 to foo() if $arg is 3
# In reality, it will return from test()
return 7 if $arg == 3;
}
);
$x = 5;
return $x;
}
print test( 3 ),$/;
print test( 5 ),$/;
sub foo {};
Cheers,
Ovid
Join the Perlmonks Setiathome Group or just click on the the link and check out our stats. |