Re: Entry widget not accepting /

[zentara]

Can you make a minimal test script which demonstrates your / insertion problem? Does it work without the bind to 'Any-Key-Press'. ?

[ghosh123]

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

[zentara]

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.

[kcott]

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;
}