请perl高手帮我看看，为什么偶滴代码中 Semaphore 没有起作用呢？

kelvenchi

1. #! /usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. use threads;
   
5. use threads::shared;
   
6. use Socket;
   
7. use Thread::Semaphore;
   
8. use Thread::Queue;
   
9. 
   
10. if (my $pid = fork) {
    
11.     exit;
    
12. } elsif ($pid = fork) {
    
13.     setpgrp;
    
14.     exit;
    
15. } else {
    
16. 
    
17.     my $fd    = Thread::Queue->new();
    
18.     my $rabbish = Thread::Queue->new();
    
19.     my $sem = shared_clone(Thread::Semaphore->new(5));
    
20.     my $lis = threads->create(\&boss);
    
21.     my $jt = threads->create(\&joinThread);
    
22. 
    
23.     sub worker {
    
24.         my $fino = $fd->dequeue;
    
25.         while (1) {
    
26.         my @in;
    
27.         open my $fhh, "<tserver.pl" or die "$!";
    
28.         @in = <$fhh>;
    
29.         close $fhh or die "$!";
    
30.         open my $fh, ">&=$fino" or die "$!";
    
31.         while (@in) {
    
32.             my $single = shift @in;
    
33.             print $fh "$single";
    
34.         }
    
35.         print $fh "this message is from the server $ and the tid is " . threads->self->tid . "\n";
    
36.         close $fh or die "$!";
    
37.         }
    
38.     }
    
39. 
    
40.     sub joinThread {
    
41.         while (my $j = $rabbish->dequeue()) {
    
42.             $j->detach;
    
43.             $sem->up;
    
44.         }
    
45.     }
    
46. 
    
47.     sub boss {
    
48.         socket Server, AF_INET, SOCK_STREAM, getprotobyname 'tcp';
    
49.         setsockopt Server, SOL_SOCKET, SO_REUSEADDR, 1;
    
50.         my $paddr = sockaddr_in 9001, INADDR_ANY;
    
51.         bind Server, $paddr;
    
52.         listen Server, SOMAXCONN;
    
53.         while (accept my $Client , Server) {
    
54.             my $t;
    
55.             $t = threads->create(\&worker) if $sem->down_nb();
    
56.             $rabbish->enqueue($t) if $t;
    
57.             $fd->enqueue(fileno $Client)if $t;
    
58.             undef $t;
    
59.             close $Client;
    
60.         }
    
61.     }
    
62.     $lis->join;
    
63.     $jt->join;
    
64. }
    

复制代码