Subject: | Bug in Tk::FBox::ResolveFile with defaultextension |
Tk::FBox::ResolveFile has a small bug which doesnot add the default
extension to the entered file name, if the total path of the file
contains a character '.' as it is treated as if the file already has an
extension.
Test program: getSaveFile.pl
For testing, cd to any sub-directory and use the following commands:
mkdir bla.bla
perl getSaveFile.pl
enter xyz in the "File Name" entry of the dialog being opened and click
on 'Save' button. It will show the filename ending with xyz, i.e.
without the expected extension .dat
Proposed patch for Tk::FBox: Tk.FBox.pm.patch
Subject: | Tk.FBox.pm.patch |
***************
*** 557,563 ****
# 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 !~ /\..+$/ && defined $defaultext) {
$path = "$path$defaultext";
}
# Cannot just test for existance here as non-existing files are
--- 557,563 ----
# 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 !~ /\..+$/ && 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 :(");