john.tm has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks. I have a perl tk widget that i am trying to get to copy a file to a previous version. But for some reason it does all i want except copy the file. the directory and file both exist. I can do an open both files successfuly! 

error message
Tk::Error: Unable to open file: No such file or directory at C:\Users\
+aaaa.pl line 63.
 main::resthand at C:\Users\aaaa.pl line 63
 Tk callback for .labframe.border.frame1.button
 Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 251
 Tk::Button::butUp at C:/Perl/site/lib/Tk/Button.pm line 175
 <ButtonRelease-1>
 (command bound to event)

[download]
perl script 

#!/usr/bin/perl
use strict;
use warnings;
use File::Path qw( mkpath);
use File::Copy qw(copy);
use File::Copy qw(move);
use Tk;
use Tk::BrowseEntry;
use Tk::LabFrame;
use Tk::LabEntry;
use Tk::Widget;
    my $test_bak = "G:\\temp\\Hand";
    my @restore_files;
    opendir (DIR, $test_bak) or warn $!;
        while (my $restore_bak = readdir(DIR)) {
        push  (@restore_files, "$restore_bak\n");
    }
    closedir(DIR);

    my $restore_date = '';

    my  $mw = MainWindow->new(-title      => " test ", 
        -background =>'LightBlue2',-foreground=>'DarkBlue');
    $mw->geometry("450x240");
                                
#---------------------------------------------------------------------
+---------------------------------------
#      create frames labels and buttons
#
#---------------------------------------------------------------------
+---------------------------------------    
    my $frame = $mw->LabFrame(-font => 'Times 08',-background =>'Light
+Blue2',
                    -labelside => "acrosstop",-foreground =>'Slategray
+')
                    ->pack(-side => 'top');    

    my $rest_sel = $frame ->BrowseEntry(-label => 'Select restore date
+ :        ', -foreground=>'DarkBlue',
                    -background =>'LightBlue2', -textvariable=> \$rest
+ore_date)
                    ->grid(-sticky => 'w', -column => 2, -row => 1 );
            $rest_sel -> insert('end', @restore_files);    
    my $restspace = $frame->Label(-text => '        ',-background =>'L
+ightBlue2')
                    ->grid(-sticky => 'e', -column => 4, -row => 1 );
        
    my $restore_but = $frame -> Button(-text => " Restore ", -command 
+=>[\&resthand], -foreground=>'DarkBlue',
                    -relief => 'raised', -background =>'LightBlue2', -
+activebackground =>'DodgerBlue1'
                    )->grid(-sticky => 'e', -column => 5, -row => 1 );
+    

    my $textframe = $mw->Scrolled("Text", -scrollbars => 'e', -foregro
+und=>'Green',-background => "Black",
                    -height => 12) ->pack(-side => 'bottom', -fill => 
+'both');                                    
                    
    tie *STDOUT, 'Tk::Text', $textframe;
    
    MainLoop;
    
sub resthand {
    $|++;
         $textframe->delete("1.0", 'end');

    printf "  Restoring   version $restore_date \n";
    my $restore_to = "G:/temp/Hand/Hand.pl";
    my $replace = "G:/temp/Hand/";
    my $rest_string = join( "", "$replace", "$restore_date" );
    print "$rest_string  \n"; # check filehandles
    print "$restore_to  \n";
                    copy ($rest_string, $restore_to) or die "Unable to
+ open file: $!";
           $textframe->see('end');
}

[download]

Replies are listed 'Best First'.
Re: perl tk widget will not copy files
by poj (Abbot) on Aug 11, 2015 at 11:40 UTC 
    while (my $restore_bak = readdir(DIR)) {
  # push  (@restore_files, "$restore_bak\n");
  push @restore_files, $restore_bak;
}

    [download]
    poj
[reply]
[d/l]
Re: perl tk widget will not copy files
by Anonymous Monk on Aug 11, 2015 at 04:12 UTC

    Please print file names in the error message. They are probably not what you think they are. Also, check for \r or \n at end of filesnames.

[reply]
Re: perl tk widget will not copy files
by Anonymous Monk on Aug 11, 2015 at 06:32 UTC

    There are no tk widgets involved in copying files

    Also, your "or die" message says open when you're trying to copy a file .... if you use Path::Tiny you don't have to remember an "or die" with appropriate message and filename

[reply]
Re: perl tk widget will not copy files
by anonymized user 468275 (Curate) on Aug 11, 2015 at 09:35 UTC
    The first place I expect your code to fail is here: my $test_bak = "G:\\temp\\Hand"; Perl partially adheres to the syntax for unix file-systems, even on non-unix operating systems. So in this case I would expect the following to work instead: my $test_bak = "G:/temp/Hand";

    Update: or rather the above assignment is the cause of this line to fail:  opendir (DIR, $test_bak) or warn $!

    One world, one people

[reply]
[d/l]
[select]

      Why do you think that one would fail where the other would work?

      The Windows API takes both, slashes and backslashes as directory entry delimiters. Perl does not care either way. I just wonder why Windows should prefer one or the other when in my experience they are interchangeable.

[reply]
        I am not sure of the design cause of this behaviour, although I have long been aware of it, but using ActiveState Perl v5.20.2, Perl could not find my home directory using backslashes or single backslashes, but changing to single forward slashes did make the opendir work on my laptop.

        Update: come to think of it, there are some advantages to Perl's uniform interface to file-systems. For example many algorithms that combine glob or opendir with recursive traversal will be portable between *nix and windows as a result.

        One world, one people

[reply]

Back to Seekers of Perl Wisdom