| Subject: | Tk::FBox::Show calls ResolveFile with not enough parameters |
This is with reference to Bug Id: 55146
In the subroutine Tk::FBox::Show ResolveFile is called with 2 parameters:
ResolveFile($initialdir, 'junk')
but the subroutine expects 3 parameters:
sub ResolveFile {
my($context, $text, $defaultext) = @_;
which means that in the subroutine $text gets set equal to 'junk'
instead of the value of $initialdir.
To test use getSaveFile.pl from Bug Id: 55146
Test program: getSaveFile.pl
For testing, cd to any sub-directory and use the following commands:
mkdir -p bla.bla/junk
perl getSaveFile.pl
When the dialog opens the initial directory is ./bla.bla/junk instead of
./bla.bla as set by the program (-initialdir => './bla.bla').
The attached patch includes the patch from Bug Id: 55146
Version information:
[james.r@jrushworth FBox]$ perl -MTk -le 'print $Tk::VERSION'
804.029
[james.r@jrushworth FBox]$ perl -v
This is perl, v5.8.8 built for i686-linux
[james.r@jrushworth FBox]$ uname -a
Linux jrushworth 2.6.35-gentoo-r4 #1 SMP PREEMPT Fri Aug 27 09:22:15 MDT
2010 i686 Intel(R) Pentium(R) D CPU 3.40GHz GenuineIntel GNU/Linux
| Subject: | FBox.pm.patch |
diff -c orig/FBox.pm patched/FBox.pm
*** orig/FBox.pm Thu Nov 4 08:18:36 2010
--- patched/FBox.pm Thu Nov 4 10:02:37 2010
***************
*** 255,261 ****
{
my $initialdir = $w->cget(-initialdir);
if (defined $initialdir) {
! my ($flag, $path, $file) = ResolveFile($initialdir, 'junk');
if ($flag eq 'OK' or $flag eq 'FILE') {
$w->{'selectPath'} = $path;
} else {
--- 255,261 ----
{
my $initialdir = $w->cget(-initialdir);
if (defined $initialdir) {
! my ($flag, $path, $file) = ResolveFile('', $initialdir, '');
if ($flag eq 'OK' or $flag eq 'FILE') {
$w->{'selectPath'} = $path;
} else {
***************
*** 559,565 ****
# If the file has no extension, append the default. Be careful not
# to do this for directories, otherwise typing a dirname in the box
# will give back "dirname.extension" instead of trying to change dir.
! if (!-d $path && $path !~ /\..+$/s && defined $defaultext) {
$path = "$path$defaultext";
}
# Cannot just test for existance here as non-existing files are
--- 559,565 ----
# If the file has no extension, append the default. Be careful not
# to do this for directories, otherwise typing a dirname in the box
# will give back "dirname.extension" instead of trying to change dir.
! if (!-d $path && $text !~ /\..+$/s && defined $defaultext) {
$path = "$path$defaultext";
}
# Cannot just test for existance here as non-existing files are
| Subject: | getSaveFile.pl |
use strict;
use Tk;
my $main = new MainWindow();
$DB::single++;
my $fileName = $main->getSaveFile (
-initialdir => './bla.bla',
-filetypes => [ [ 'Data files', '.dat' ] ],
-title => 'Save File As ...',
-defaultextension => '.dat'
);
$main->messageBox(-message => "fileName is $fileName :(");