Show
Ignore:
Timestamp:
03/12/09 09:11:52 (9 months ago)
Author:
fumiakiy
Message:

Merged sockfish to trunk. "svn merge -r3114:3527 http://code.sixapart.com/svn/movabletype/branches/sockfish/ ."

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • trunk/extlib/IO/SessionSet.pm

    r1098 r3531  
    22# 
    33# Copyright (C) 2000 Lincoln D. Stein 
     4# Formatting changed to match the layout layed out in Perl Best Practices 
     5# (by Damian Conway) by Martin Kutter in 2008 
    46# 
    57# ====================================================================== 
    … …  
    2123# accept new IO::SessionData objects automatically. 
    2224sub new { 
    23   my $pack = shift; 
    24   my $listen = shift; 
    25   my $self = bless {  
    26                     sessions     => {}, 
    27                     readers      => IO::Select->new(), 
    28                     writers      => IO::Select->new(), 
    29                    },$pack; 
    30   # if initialized with an IO::Handle object (or subclass) 
    31   # then we treat it as a listening socket. 
    32   if ( defined($listen) and $listen->can('accept') ) {  
    33     $self->{listen_socket} = $listen; 
    34     $self->{readers}->add($listen); 
    35   } 
    36   return $self; 
     25    my $pack = shift; 
     26    my $listen = shift; 
     27    my $self = bless {  
     28        sessions     => {}, 
     29        readers      => IO::Select->new(), 
     30        writers      => IO::Select->new(), 
     31        }, $pack; 
     32    # if initialized with an IO::Handle object (or subclass) 
     33    # then we treat it as a listening socket. 
     34    if ( defined($listen) and $listen->can('accept') ) {  
     35        $self->{listen_socket} = $listen; 
     36        $self->{readers}->add($listen); 
     37    } 
     38    return $self; 
    3739} 
    3840 
    3941# Object method: sessions() 
    4042# Return list of all the sessions currently in the set. 
    41 sub sessions { return values %{shift->{sessions}} }; 
     43sub sessions { 
     44    return values %{shift->{sessions}} 
     45}; 
    4246 
    4347# Object method: add() 
    … …  
    4549# create a IO::SessionData wrapper around the handle. 
    4650sub add { 
    47   my $self = shift; 
    48   my ($handle,$writeonly) = @_; 
    49   warn "Adding a new session for $handle.\n" if $DEBUG; 
    50   return $self->{sessions}{$handle} = $self->SessionDataClass->new($self,$handle,$writeonly); 
     51    my $self = shift; 
     52    my ($handle,$writeonly) = @_; 
     53    warn "Adding a new session for $handle.\n" if $DEBUG; 
     54    return $self->{sessions}{$handle} =  
     55        $self->SessionDataClass->new($self,$handle,$writeonly); 
    5156} 
    5257 
    … …  
    5560# a corresponding IO::SessionData wrapper. 
    5661sub delete { 
    57   my $self = shift; 
    58   my $thing = shift; 
    59   my $handle = $self->to_handle($thing); 
    60   my $sess = $self->to_session($thing); 
    61   warn "Deleting session $sess handle $handle.\n" if $DEBUG; 
    62   delete $self->{sessions}{$handle}; 
    63   $self->{readers}->remove($handle); 
    64   $self->{writers}->remove($handle); 
     62    my $self = shift; 
     63    my $thing = shift; 
     64    my $handle = $self->to_handle($thing); 
     65    my $sess = $self->to_session($thing); 
     66    warn "Deleting session $sess handle $handle.\n" if $DEBUG; 
     67    delete $self->{sessions}{$handle}; 
     68    $self->{readers}->remove($handle); 
     69    $self->{writers}->remove($handle); 
    6570} 
    6671 
    … …  
    6873# Return a handle, given either a handle or a IO::SessionData object. 
    6974sub to_handle { 
    70   my $self = shift; 
    71   my $thing = shift; 
    72   return $thing->handle if $thing->isa('IO::SessionData'); 
    73   return $thing if defined (fileno $thing); 
    74   return;  # undefined value 
     75    my $self = shift; 
     76    my $thing = shift; 
     77    return $thing->handle if $thing->isa('IO::SessionData'); 
     78    return $thing if defined (fileno $thing); 
     79    return;  # undefined value 
    7580} 
    7681 
    … …  
    7883# Return a IO::SessionData object, given either a handle or the object itself. 
    7984sub to_session { 
    80   my $self = shift; 
    81   my $thing = shift; 
    82   return $thing if $thing->isa('IO::SessionData'); 
    83   return $self->{sessions}{$thing} if defined (fileno $thing); 
    84   return;  # undefined value 
     85    my $self = shift; 
     86    my $thing = shift; 
     87    return $thing if $thing->isa('IO::SessionData'); 
     88    return $self->{sessions}{$thing} if defined (fileno $thing); 
     89    return;  # undefined value 
    8590} 
    8691 
    … …  
    9196# May use either a session object or a handle as first argument. 
    9297sub activate { 
    93   my $self = shift; 
    94   my ($thing,$rw,$act) = @_; 
    95   croak 'Usage $obj->activate($session,"read"|"write" [,$activate])' 
    96     unless @_ >= 2; 
    97   my $handle = $self->to_handle($thing); 
    98   my $select = lc($rw) eq 'read' ? 'readers' : 'writers'; 
    99   my $prior = defined $self->{$select}->exists($handle); 
    100   if (defined $act && $act != $prior) { 
    101     $self->{$select}->add($handle)        if $act; 
    102     $self->{$select}->remove($handle) unless $act; 
    103     warn $act ? 'Activating' : 'Inactivating', 
    104            " handle $handle for ", 
     98    my $self = shift; 
     99    my ($thing,$rw,$act) = @_; 
     100    croak 'Usage $obj->activate($session,"read"|"write" [,$activate])' 
     101        unless @_ >= 2; 
     102    my $handle = $self->to_handle($thing); 
     103    my $select = lc($rw) eq 'read' ? 'readers' : 'writers'; 
     104    my $prior = defined $self->{$select}->exists($handle); 
     105    if (defined $act && $act != $prior) { 
     106        $self->{$select}->add($handle)        if $act; 
     107        $self->{$select}->remove($handle) unless $act; 
     108        warn $act ? 'Activating' : 'Inactivating', 
     109            " handle $handle for ", 
    105110            $rw eq 'read' ? 'reading':'writing',".\n" if $DEBUG; 
    106   } 
    107   return $prior; 
     111    } 
     112    return $prior; 
    108113} 
    109114 
    110115# Object method: wait() 
    111 # Wait for I/O.  Handles writes automatically.  Returns a list of IO::SessionData 
    112 # objects ready for reading.   
    113 # If there is a listen socket, then will automatically do an accept() and return 
    114 # a new IO::SessionData object for that. 
     116# Wait for I/O.  Handles writes automatically.  Returns a list of  
     117# IO::SessionData objects ready for reading.   
     118# If there is a listen socket, then will automatically do an accept() 
     119# and return a new IO::SessionData object for that. 
    115120sub wait { 
    116   my $self = shift; 
    117   my $timeout = shift; 
     121    my $self = shift; 
     122    my $timeout = shift; 
    118123 
    119   # Call select() to get the list of sessions that are ready for reading/writing. 
    120   croak "IO::Select->select() returned error: $!" 
    121     unless my ($read,$write) =  
    122       IO::Select->select($self->{readers},$self->{writers},undef,$timeout); 
     124    # Call select() to get the list of sessions that are ready for  
     125    # reading/writing. 
     126    warn "IO::Select->select() returned error: $!" 
     127        unless my ($read,$write) =  
     128            IO::Select->select($self->{readers},$self->{writers},undef,$timeout); 
    123129 
    124   # handle queued writes automatically 
    125   foreach (@$write) { 
    126     my $session = $self->to_session($_); 
    127     warn "Writing pending data (",$session->pending+0," bytes) for $_.\n" if $DEBUG; 
    128     my $rc = $session->write; 
    129   } 
     130    # handle queued writes automatically 
     131    foreach (@$write) { 
     132        my $session = $self->to_session($_); 
     133        warn "Writing pending data (",$session->pending+0," bytes) for $_.\n"  
     134            if $DEBUG; 
     135        my $rc = $session->write; 
     136    } 
    130137 
    131   # Return list of sessions that are ready for reading. 
    132   # If one of the ready handles is the listen socket, then 
    133   # create a new session. 
    134   # Otherwise return the ready handles as a list of IO::SessionData objects. 
    135   my @sessions; 
    136   foreach (@$read) { 
    137     if ($_ eq $self->{listen_socket}) { 
    138       my $newhandle = $_->accept; 
    139       warn "Accepting a new handle $newhandle.\n" if $DEBUG; 
    140       my $newsess = $self->add($newhandle) if $newhandle; 
    141       push @sessions,$newsess; 
    142     } else { 
    143       push @sessions,$self->to_session($_); 
     138    # Return list of sessions that are ready for reading. 
     139    # If one of the ready handles is the listen socket, then 
     140    # create a new session. 
     141    # Otherwise return the ready handles as a list of IO::SessionData objects. 
     142    my @sessions; 
     143    foreach (@$read) { 
     144        if ($_ eq $self->{listen_socket}) { 
     145            my $newhandle = $_->accept; 
     146            warn "Accepting a new handle $newhandle.\n" if $DEBUG; 
     147            my $newsess = $self->add($newhandle) if $newhandle; 
     148            push @sessions,$newsess; 
     149        } 
     150        else { 
     151            push @sessions,$self->to_session($_); 
     152        } 
    144153    } 
    145   } 
    146   return @sessions; 
     154    return @sessions; 
    147155} 
    148156