请问是thread本身问题还是代码问题

slayer_axe

1. #!usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. use Tk;
   
5. use utf8;
   
6. use Encode;
   
7. use 5.010;
   
8. use File::Find;
   
9. use File::Copy;
   
10. use threads;
    
11. use threads::shared;
    
12. 
    
13. my @syncs = ();#[ [from,to],[frome,to] ]
    
14. if(open FH,"syncs"){
    
15.         while(<FH>){
    
16.         chomp;
    
17.         my @temp = split "\t",$_;
    
18.                 push @syncs,[$temp[0],$temp[1]];
    
19.         }
    
20.         close FH;
    
21. }
    
22. 
    
23. my $frequency = 30;
    
24. my $distime = 0;
    
25. my $sig        :shared = 0;
    
26. 
    
27. my $mw = MainWindow->new;
    
28. $mw->geometry('400x400+100+100');
    
29. my $f1 = $mw->Frame->pack(-side => 'top',-fill => 'x',-expand => 0,-padx => 5,-pady => 10);
    
30. my $f2 = $mw->Frame->pack(-side => 'top',-fill => 'both',-expand => 0,-padx =>5,-pady => 10);
    
31. 
    
32. my $fromtoframe = $f1->Frame->pack(-side => 'top', -fill => 'x', -expand => 1,-padx => 5, -pady => 2);
    
33. $fromtoframe->Label(-text => 'from',)->pack(-side => 'left',-fill => 'x',-expand => 1,-padx => 5);
    
34. $fromtoframe->Label(-text => 'to',)->pack(-side => 'left',-fill => 'x',-expand => 1,-padx => 5);
    
35. 
    
36. foreach(@syncs){
    
37.         &addpoint($_);
    
38. }
    
39. 
    
40. my $pane = $f2->Frame(-width => 75)->pack(-side => 'left',-fill => 'y',-padx => 5,-pady => 5);
    
41. $pane->Button(-width => 10,-text => '增加同步点',-command => sub{push (@syncs,[]);&addpoint($syncs[-1])})->pack(-side => 'top');
    
42. $pane->Button(-width => 10,-text => '减少同步点',-command => \&delpoint)->pack(-side => 'top');
    
43. my $button_frequency = $pane->Button(-width => 10,-text => '检测频率(min)',-command => \&set_frequency)->pack(-side => 'top');
    
44. my $label_frequency = $pane->Label(-textvariable => \$frequency,-relief => 'solid')->pack(-side => 'top',-fill => 'x');
    
45. my $button_distime = $pane->Button(-width => 10,-text => '更新频率(天)',-command => \&set_distime)->pack(-side => 'top');
    
46. my $label_distime = $pane->Label(-textvariable => \$distime,-relief => 'solid')->pack(-side => 'top',-fill => 'x');
    
47. $pane->Button(-width => 10,-text => '开始同步',-command => sub{threads->create(\&syncnow);})->pack(-side => 'top');
    
48. my $stopbutton;
    
49. $stopbutton = $pane->Button(-width => 10,-text => '停止同步',-command => sub{$stopbutton->Tk::bind("<Button-1>",\&givesig)})->pack(-side => 'top');
    
50. $pane->Button(-width => 10,-text => '退出程序',-command => sub {exit})->pack(-side => 'top');
    
51. 
    
52. my $textpane = $f2->Scrolled('Text',-background => 'grey',-state => 'disable')->pack(-fill => 'both',-pady => 5,-padx => 5);
    
53. MainLoop;
    
54. 
    
55. 
    
56. sub addpoint{
    
57. 
    
58.         my $ref = shift;
    
59.         my ($fromref,$toref) = (\$ref->[0],\$ref->[1]);
    
60.         my $frame = $f1->Frame->pack(-side => 'top', -fill => 'x', -expand => 1,-padx => 5, -pady => 2);
    
61.         $frame->Button(-textvariable => $fromref,-command => sub {$fromref = $mw->chooseDirectory;})->pack(-side => 'left',-fill => 'x',-expand => 1,-padx => 5);
    
62.         $frame->Button(-textvariable => $toref,-command => sub {$toref = $mw->chooseDirectory;})->pack(-side => 'left',-fill => 'x',-expand => 1,-padx => 5);
    
63. 
    
64. }
    
65. sub delpoint{
    
66.         my @f = $f1->packSlaves;
    
67.         pop @syncs;
    
68.         $f[-1]->packForget;
    
69. }
    
70. 
    
71. sub set_frequency{
    
72.         my $top;
    
73.         unless(Exists $top){       
    
74.                  $top= $mw->Toplevel;
    
75.                 $top->Entry(-textvariable => \$frequency)->pack(-side => 'left',-padx => 2);
    
76.                 $top->Button(-text => '设置',-command => sub {$top->withdraw;})->pack(-side => 'left',-padx => 2);
    
77.         }else{$top->deiconify;$top->raise;}
    
78. }
    
79. 
    
80. sub set_distime{
    
81.         my $top;
    
82.         unless(Exists $top){       
    
83.                  $top= $mw->Toplevel;
    
84.                 $top->Entry(-textvariable => \$distime)->pack(-side => 'left',-padx => 2);
    
85.                 $top->Button(-text => '设置',-command => sub {$top->withdraw;})->pack(-side => 'left',-padx => 2);
    
86.         }else{$top->deiconify;$top->raise;}
    
87. }
    
88. 
    
89. sub isay{
    
90.         $textpane->configure(-state => 'normal');
    
91.         foreach (@_){
    
92.                 $textpane->insert('end',$_);
    
93.         }
    
94.         $textpane->insert('end',"\n");
    
95.         $textpane->configure(-state => 'disabled');
    
96. }
    
97. 
    
98. 
    
99. sub givesig{
    
100.        
     
101.         $sig = 1;
     
102.         say 'sig is ',$sig;
     
103. 
     
104. }
     
105. 
     
106. sub syncnow{
     
107.         $sig = 0;
     
108.         until($sig){
     
109.                 &sync();
     
110.                 for(0..$frequency*60){
     
111.                         return if $sig;
     
112.                         sleep 1;
     
113.                 }
     
114.         }
     
115. }
     
116. 
     
117. 
     
118. 
     
119. sub sync{
     
120.         #savesyncs;
     
121.         if(open (FH,'>syncs')){
     
122.                 print FH $_->[0],"\t",$_->[1],"\n" foreach(@syncs);
     
123.                 close FH;
     
124.         }
     
125. 
     
126.         foreach (@syncs){
     
127.                 unless (-d $_->[0]){
     
128.                         isay ($_->[0],"不是目录或者不存在");
     
129.                         next;
     
130.                 }
     
131. 
     
132.                 unless (-d $_->[1]){
     
133.                         mkdir $_->[1],0755;
     
134.                         next;
     
135.                 }
     
136.         #        isay (" 复制 ",$_->[0]," 到 ",$_->[1]);
     
137. 
     
138.                 ##fileupdata
     
139.                 my ($from,$to) = ($_->[0],$_->[1]);
     
140.                 finddepth(\&wanted,$from);
     
141.                 sub wanted{
     
142.                         my $currentdir = $File::Find::dir;
     
143.                         my $currentname = $File::Find::name;
     
144.                         my $newdir = $currentdir;
     
145.                         my $newname = $currentname;
     
146.                         $newdir =~ s/$from/$to/i;
     
147.                         $newname =~ s/$from/$to/i;
     
148.                         mkdir $newdir,0755 unless -d $newdir;
     
149.                         unless(-r $currentname){        #文件无法读取
     
150.                                 isay "无法读取$currentname";
     
151.                                 return 1;
     
152.                         }
     
153. 
     
154.                         unless(-e $newname){        #新文件不存在
     
155.                                 say "copy($currentname,$newname)";
     
156.                                 return 1;
     
157.                         }               
     
158.        
     
159.                         my @currentstat = stat($currentname);
     
160.                         my @newstat = stat($newname);
     
161.                         my $currentmtime = $currentstat[9];
     
162.                         my $newmtime = $newstat[9];
     
163.                         my $nowtime = time;
     
164.                         return 1 if ($currentmtime == $newmtime);#文件已是最新版
     
165.                         my $thisdistime = ($currentmtime - $nowtime)/86400;
     
166.                         say "copy($currentname,$newname)" if ($thisdistime > $distime);
     
167.                         return 1;
     
168.                 }
     
169. 
     
170.         }       
     
171. 
     
172. }
     
173. 
     
174. 
     

复制代码

以上是我写的一个文件夹更新备份的脚本，以上的isay 会导致内存不能写的异常，系统是windows xp，这是什么问题呢？如果不采用线程的话是不会报错的，但是一旦开始同步文件就会导致程序没反应，所以用了线程，线程共享数据只有一个 $sig，提供线程终止信号。
isay函数为：

1. sub isay{
   
2.         $textpane->configure(-state => 'normal');
   
3.         foreach (@_){
   
4.                 $textpane->insert('end',$_);
   
5.         }
   
6.         $textpane->insert('end',"\n");
   
7.         $textpane->configure(-state => 'disabled');
   
8. }

复制代码

slayer_axe

是不是$textpane无法在线程中识别操作的原因?这个问题能解决吗？试了下 :shared是不行的