Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
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 surveying the Monastery: (8)
As of 2014-08-28 00:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (254 votes), past polls