Thanks fo Jay.I'm now reading the docs about perl's threads.
I have been watching that program,and find it run well at the current 
time.But,it's not the normal pressure for it.Because these days are our New 
Year,all people are going home for their vacations.When the vacation is end,the 
pressure of socket requests should be much heavy than now.
Certainly,it's a single process program now.I'll put the primary code here,and 
any criticism or suggestion is welcome.

----
my %records;    # here is the var that I want to get it be shared by all child

while(1)
{
    next unless my $connection = $listen_socket->accept;
    my $line = <$connection>;
    $connection->close;

    {
        local $/=CRLF;
        chomp $line;
    }

    #1_mengde77_01_100gv3eb:2048000:get
    next unless $line =~ /^(.*):(\d+):(get|put)$/;

    my ($mid,$size,$type) = split(/:/,$line);
    my $timestamp = time();
    $records{$mid}->{$timestamp} += $size;

    write_log("current socket 
info:",$timestamp,$mid,$records{$mid}->{$timestamp},
               scalar keys %{$records{$mid}}) if $logLevel == 0;

    my $sum;
    for my $time (keys %{$records{$mid}})
    {
        if ($time < $timestamp - 3600)
        {
            write_log("prepare to delete old timestamp:",$mid,$time)
                if $logLevel == 0 or $logLevel == 1;

            delete $records{$mid}->{$time};

            if ($logLevel == 0 or $logLevel == 1)
            {
                unless ($records{$mid}->{$time}){
                    write_log("delete old timestamp success:",$mid,$time);
                }else{
                    write_log("can't delete old timestamp:",$mid,$time);
                }
            }
        }else{
            $sum += $records{$mid}->{$time};
        }
    }

    if ($sum > LIMIT)
    {
        insertDB($mid,$sum);

        write_log("insert to db:",$mid,$sum) 
            if $logLevel == 0 or $logLevel == 1 or $logLevel == 2;

        write_log("prepare to clean item:",$mid)
            if $logLevel == 0 or $logLevel == 1;

        delete $records{$mid};

        if ($logLevel == 0 or $logLevel == 1)
        {
            unless ($records{$mid})
            {
                write_log("clean item success:",$mid);
            }else{
                write_log("can't clean item:",$mid);
            }
        }
    }
}

----

-----Original Message-----
>From: Jay Savage <[EMAIL PROTECTED]>
>Sent: Feb 2, 2006 8:15 AM
>To: Jeff Pang <[EMAIL PROTECTED]>, beginners perl <beginners@perl.org>
>Subject: Re: how to share variable across multi-processes
>
>On 2/1/06, Jeff Pang <[EMAIL PROTECTED]> wrote:
>> hello,
>> You have misunderstood my meanings.
>> I fork the child process in socket server's parent process,and the socket 
>> server accept the requests from socket clients,which are distributed in 
>> about 200 different hosts.
>> I don't do the IPC communication of child-to-parent socket.:-)
>>
>
>Jeff,
>
>You can also use sockets locally to communicate between parent and
>child. The process connectiong to the socket doesn't have to be on a
>remote host. Search the docs for the differnce between "unix" sockets
>and TCP/UDP sockets; see also "named pipes".
>
>You'll also want to be careful with all this forking. Accepting
>multiple connections from hundreds of hosts can fill up the process
>table and eat up file descriptors pretty quickly, especially if you're
>creating zombies and not reaping them, not mention memory: each forked
>child gets it's own complete copy of the Perl interpreter, plus
>whatever modules the parent has loaded. Forking is expensive; this may
>be a good time to read up oin threads.
>
>-- jay
>--------------------------------------------------
>This email and attachment(s): [  ] blogable; [ x ] ask first; [  ]
>private and confidential
>
>daggerquill [at] gmail [dot] com
>http://www.tuaw.com  http://www.dpguru.com  http://www.engatiki.org
>
>values of ? will give rise to dom!


--
Jeff Pang
NetEase AntiSpam Team
http://corp.netease.com

-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>


Reply via email to