in reply to Re: Tk causes problems with file paths containing non-Latin-1 chars
in thread Tk causes problems with file paths containing non-Latin-1 chars
Grep says my codebase has 67 instances of -[fdew] file test operators that would need translating to "file_type" equivalents (not a 1:1 match unfortunately), and 28 of "open|close" that would need changing, not to mention instances where I pass the name of an image file to functions to create/resize displayable images. These may accept file handles instead, but viewed any which way, it's LOT of work I'd rather avoid ;-)
I must also admit I can't immediately see any way of doing this in a platform independent way that maintains a single codebase.
The code is my Tk based test case for the problem. The commented out lines in "sub test_file" run fine with Linux/OS-X but fail under win32. Each commented out line is followed by a Win32::Unicode equivalent that "fixes" the problem for win32:
The data tree looks like this (note the accented 'ô' of Zatochi):#!/bin/perl # # Tk demo replicates command line demo to read and checks files with e +xtended chars in the path # use strict; use warnings; use utf8; use Tk; use Cwd; use File::List; use File::Spec; use File::Basename; # These modules replicate those used by the TagSuite environment # but are not actuall used here. use Carp (qw/ croak /); use Encode; use POSIX; use XML::LibXML; use File::Spec; use Debug::Simple; use Tk qw/ Ev /; use Tk::PNG; use Tk::JPEG; use Tk::widgets qw/ NoteBook BrowseEntry Dialog DialogBox FBox Pane/; use Tk::ProgressBar; use Tk::Splashscreen; use GD::Image; use Image::Resize; use Image::ExifTool qw/ :Public /; use MIME::Base64; use DBM::Deep; use LWP::Simple; use HTML::TokeParser; use File::Copy; use File::Path; use Math::BigInt; my $path; my $win; my $t1; MAIN: { init_gui(); $path = File::Spec->catfile(getcwd(), 'data'); load(); MainLoop; } sub init_gui { Tk::CmdLine::SetArguments(qw(-geometry +410+300)); $win = MainWindow->new(-title=>'Tk wrapper', ); $win->protocol('WM_DELETE_WINDOW', sub { exit; }); $win->resizable(0, 0); my $f1 = $win->Frame(); my $f2 = $win->Frame(); $t1 = $f1->Scrolled('Text', -scrollbars=>'oe', -wrap=>'word', -heigh +t=>'26', -width=>100, ); $t1->pack(-anchor=>'e', -fill=>'both'); my $b1 = $f2->Button(-text=>'Browse...', -width=>10, -command=>\&sel +ect); $b1->pack(-anchor=>'e', -fill=>'both'); $f1->grid(-row=>0, -column=>0, -padx=>8, -pady=>4, -sticky=>'n', ); $f2->grid(-row=>1, -column=>0, -padx=>8, -pady=>4, -sticky=>'n', ); return; } sub load { my $lister = File::List->new($path); my @files = @{ $lister->find('') }; foreach my $file (@files) { test_file($file); } return; } sub test_file { my $file = shift; my $txt = ''; use Win32::Unicode::File; my $dh = Win32::Unicode::File->new; my $dir = dirname($file); #if (! -d $dir) { if (! file_type d => $dir) { $t1->insert('end', "ERROR: Base Dir '$dir' does not exist!\n"); return; } #$txt = (-w $dir) ? "Dir '$dir' is Writable by you\n" : "ERROR: dir +'$dir' NOT writable by you\n"; $txt = (! file_type r=>$dir) ? "Dir '$dir' is Writable by you\n" : " +ERROR: dir '$dir' NOT writable by you\n"; $t1->insert('end', $txt); #if (! -f $file) { if (file_type e=>$file) { $t1->insert('end', "ERROR: File '$file' does not exist!\n"); return; } #if (open my $in, '<', $file) { if ($dh->open('<', $file)) { #close $in; $dh->close; $txt = "File '$file' opened Ok\n"; } else { $txt = "ERROR: Unable to open '$file'\n"; } $t1->insert('end', $txt); return; } sub select { my $filename = $win->getOpenFile( -defaultextension => '', -initialdir => $path, -title => 'Select file', ); if ($filename) { test_file($filename); } return; }
data | +- Pan's Labyrinth (2006) | | | +- mymovies.xml | | | +- BDMV | | | +- index.TAG | +- Zatôichi 01 - The Tale of Zatoichi (1962) | +- mymovies.xml | +- VIDEO_TS | +- VIDEO_TS.TAG
|
|---|