Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re^2: Entry widget not accepting /

by ghosh123 (Monk)
on Oct 05, 2012 at 12:22 UTC ( #997462=note: print w/ replies, xml ) Need Help??


in reply to Re: Entry widget not accepting /
in thread Entry widget not accepting /

Hi Zentara,
I could find the problem. The problem is use of File::Spec->canonpath, File::Spec->catdir etc.

I am attaching my code here, you can just copy/paste them to run.

The script : anykey.pl

#!/opt/perl_5.8.8/bin use Tk; use strict; use warnings; use Anykey; my $value; my $mw = MainWindow->new(); $mw->geometry("700x200"); my $frame= $mw->Frame()->grid(-row => 5, -columnspan => 2, -rowspan = +> 2)->pack(-side => 'top', -anchor => 'nw'); my $Entry = $frame->Entry(-width => 80) ->pack(-side => 'left'); my $obj = Anykey->new(widget=>$Entry); $frame->Button(-text => "Browse...",-bg => 'snow3',-command => [\&setd +ir,$obj])->grid()->pack(-side => 'left'); sub setdir { my $obj = shift; $obj->setDir(); } MainLoop;

The module : Anykey.pm

package Anykey; use File::Spec; sub new { my ($class,%args) = @_; my $self = { widget => $args{widget}, value=>$args{value}, }; bless $self,$class; my $value = '/home/ghoshabh'; $self->{textvariable} = \$value; $self->{widget}->configure(-textvariable => $self->{textvariable}) +; $self->{widget}->bind('<Any-KeyPress>', sub { $self->onChange() } +); return $self; } sub onChange { my $self = shift; print "onChange is being called: ", ${$self->{textvariable}}, "\n" +; print "Widget onChange : ",$self->{widget}, "\n"; unless($self->{isChanged}) { print "unless isChaned ", $self->{value}, "|",${$self->{textvariab +le}}, "\n"; $self->{isChanged} = 1 if $self->{value} ne ${$self->{textvari +able}}; } $self->setValue(${$self->{textvariable}}); } sub setValue { my ($self,$value) = @_; $value = buildPath($value); $self->_setValue($value); } sub _setValue { my ($self,$value) = @_; ${$self->{textvariable}} = $value; $self->{value} = $value; $self->{widget}->xview('end'); } sub setDir { my $self = shift; my $mw = shift; print "Inside setDir 1 : pkg $self || $self->{textvariable} ||shif +ted $mw ## \n"; my $dir = $self->{widget}->chooseDirectory(-initialdir => $self->{ +value}); print "Inside setDir 2 : pkg $self || $self->{textvariable} ## \n" + ; if(defined $dir) { ${$self->{textvariable}} = $dir; $self->onChange() } } sub buildPath { my $path = shift; $path = File::Spec->canonpath($path); print "buildPath : After canonpath: $path :\n" ; if ( substr( $path, 0, 2 ) eq ".." ) { $path = getcwd . "/" . $path; print "buildPath : After substr and concat: $path :\n"; } # remove the .. my @dirs = File::Spec->splitdir($path); print "buildPath dirs: @dirs ||| \n" ; for ( my $i = @dirs - 1 ; $i > 0 ; $i-- ) { my $skip = 0; while ( $dirs[$i] eq ".." ) { $dirs[$i] = ""; $i--; $skip++; } for ( ; $skip > 0 ; $skip-- ) { if ( substr( $dirs[$i], 0, 1 ) ne '$' ) { $dirs[$i] = ""; } $i-- if $skip > 1; } } $path = File::Spec->catdir(@dirs); print "buildPath : After spec:catdir : $path :\n" ; $path =~ s/\\/\//g; $retPath =~ s/\\/\//g; print "buildPath : After final substn : $path || $retPath \n"; return $path ; } 1;

I just pasted the portion of code from my work. The main problem is from buildPath(), I have to return a path in a way so that the '/' is not deleted and displayed in the gui.
Also just a mere concatenation like $value .= "/"; will not serve my purpose.

Thanks. Please help


Comment on Re^2: Entry widget not accepting /
Select or Download Code
Re^3: Entry widget not accepting /
by zentara (Archbishop) on Oct 05, 2012 at 13:56 UTC
    I get your code to run, and observe the error of / not being accepted. Your code is a bit complicated, and I will look at it, but just as a first comment I noticed one oddity. If you enter a \ instead of a /, a / will be inserted properly. ?? This link perl-getcwd-ending-forward-slashes may yield a clue.

    I'm wondering why you even use File::Spec's catdir? The docs say

    catdir
    Concatenate two or more directory names to form a complete path ending with a directory. But remove the trailing slash from the resulting string, because it doesn't look good, isn't necessary and confuses OS/2. Of course, if this is the root directory, don't cut off the trailing slash :-)

    When I comment out all the File::Spec canonpath and catdir lines from your script, it adds a / just fine.


    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
Re^3: Entry widget not accepting /
by kcott (Abbot) on Oct 06, 2012 at 01:51 UTC

    G'day ghosh123,

    The Entry widget is accepting a forward slash (/)!

    I added an additional print statement to sub buildPath {...}:

    sub buildPath { my $path = shift; print "buildPath : BEFORE canonpath: $path :\n" ; $path = File::Spec->canonpath($path); print "buildPath : After canonpath: $path :\n" ; ...

    The output before and after canonpath() is:

    ... buildPath : BEFORE canonpath: /home/ghoshabh/ : buildPath : After canonpath: /home/ghoshabh : ...

    Here's a workaround which I've successfully tested:

    sub buildPath { my $path = shift; my $trailing = $path =~ /\/$/ ? '/' : ''; ... return $path . $trailing; }

    -- Ken

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://997462]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (5)
As of 2015-07-03 22:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (57 votes), past polls