Re: perl doesn't release thread memory

[email protected]
Newsgroups perl.ithreads
Message-ID <[email protected]>
this sample seems to work : how did you highlight the infinite memory trouble
of your simple script ?


	  use Net::FTP;use Net::SFTP;
	  use File::Basename;
 	   use threads;
           use Thread::Semaphore;
           use Carp;

           my $semaphore = new Thread::Semaphore;
           my $GlobalVariable : shared = 0;

           $thr1 = new threads (\&sample_sub, 'ftp', 'mymachine1', 'auserx',
'apwdx', 'test.tar.Z');
           $thr2 = new threads (\&sample_sub, 'sftp', 'my2machine', 'auserx',
'apwdx', 'adummyfile.tar');
           $thr3 = new threads (\&sample_sub,
'ftp','mylastmachine','auserx','apwdx','/database/auserhome/gcc-3.2.2.tar.gz');

           sub sample_sub {
               my ($protocole, $ser, $user, $password, $filetoget) =  @_;
               $_ = $protocole;
               SWITCH : {
               /^ftp$/ && do {
               		my $ftp= Net::FTP->new($ser,Debug=>0) or die "cannot connect to
$ser: $@";
	               $ftp->login($user,$password) or die "cannot login",
$ftp->message;
               		$ftp->cwd(dirname ($filetoget)) or die "cannot change working
directory", $ftp->message;
               		$ftp->get(basename ($filetoget)) ;
               		$ftp->quit();
               		last SWITCH;
               		};
               /^sftp$/ && do {
                	my %args=(user=>$user,password=>$password);
               		my $sftp= Net::SFTP->new($ser,%args);
			$sftp->quit();
               		last SWITCH;
               		};
               croak "Mc Donald protocol unknown $_";
               }

               my $TryCount = 10;
               my $LocalCopy;
               sleep 1;
               while ($TryCount--) {
                   $semaphore->down;
                   $LocalCopy = $GlobalVariable;
                   print "$TryCount tries left for sub $protocole, $ser, $user,
(\$GlobalVariable is $GlobalVariable)\n";
                   sleep 2;
                   $LocalCopy++;
                   $GlobalVariable = $LocalCopy;
                   $semaphore->up;
               }
           }

           $thr1->join;
           $thr2->join;
           $thr3->join;
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.