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/SessionData.pm

    r1098 r3531  
    33# Copyright (C) 2000 Lincoln D. Stein 
    44# Slightly modified by Paul Kulchenko to work on multiple platforms 
     5# Formatting changed to match the layout layed out in Perl Best Practices 
     6# (by Damian Conway) by Martin Kutter in 2008 
    57# 
    68# ====================================================================== 
    … …  
    1214use IO::SessionSet; 
    1315use vars '$VERSION'; 
    14 $VERSION = 1.01; 
     16$VERSION = 1.02; 
    1517 
    1618use constant BUFSIZE => 3000; 
    1719 
    1820BEGIN { 
    19   my @names = qw(EWOULDBLOCK EAGAIN EINPROGRESS); 
    20   my %WOULDBLOCK =  
    21     (eval {require Errno} ? map {Errno->can($_)->() => 1} grep {Errno->can($_)} @names : ()), 
    22     (eval {require POSIX} ? map {POSIX->can($_)->() => 1} grep {POSIX->can($_)} @names : ()); 
    23  
    24   sub WOULDBLOCK { $WOULDBLOCK{$_[0]+0} } 
     21    my @names = qw(EWOULDBLOCK EAGAIN EINPROGRESS); 
     22    my %WOULDBLOCK = 
     23        (eval {require Errno} 
     24            ? map { 
     25                Errno->can($_) 
     26                    ? (Errno->can($_)->() => 1) 
     27                    : (), 
     28                } @names 
     29            : () 
     30        ), 
     31        (eval {require POSIX} 
     32            ? map { 
     33                eval { POSIX->can($_)->() } 
     34                    ? (POSIX->can($_)->() => 1) 
     35                    : () 
     36                } @names 
     37            : () 
     38        ); 
     39 
     40    sub WOULDBLOCK { $WOULDBLOCK{$_[0]+0} } 
    2541} 
    2642 
    … …  
    2945# IO::SessionSet, not directly. 
    3046sub new { 
    31   my $pack = shift; 
    32   my ($sset,$handle,$writeonly) = @_; 
    33   # make the handle nonblocking 
    34   $handle->blocking(0); 
    35   my $self = bless { 
    36                 outbuffer   => '', 
    37                 sset        => $sset, 
    38                 handle      => $handle, 
    39                 write_limit => BUFSIZE, 
    40                 writeonly   => $writeonly, 
    41                 choker      => undef, 
    42                 choked      => 0, 
    43                },$pack; 
    44   $self->readable(1) unless $writeonly; 
    45   return $self; 
     47    my $pack = shift; 
     48    my ($sset,$handle,$writeonly) = @_; 
     49    # make the handle nonblocking (but check for 'blocking' method first) 
     50    # thanks to Jos Clijmans <jos.clijmans@recyfin.be> 
     51    $handle->blocking(0) if $handle->can('blocking'); 
     52    my $self = bless { 
     53        outbuffer   => '', 
     54        sset        => $sset, 
     55        handle      => $handle, 
     56        write_limit => BUFSIZE, 
     57        writeonly   => $writeonly, 
     58        choker      => undef, 
     59        choked      => 0, 
     60    },$pack; 
     61    $self->readable(1) unless $writeonly; 
     62    return $self; 
    4663} 
    4764 
    4865# Object method: handle() 
    4966# Return the IO::Handle object corresponding to this IO::SessionData 
    50 sub handle   { return shift->{handle}   } 
     67sub handle { 
     68    return shift->{handle}; 
     69} 
    5170 
    5271# Object method: sessions() 
    5372# Return the IO::SessionSet controlling this object. 
    54 sub sessions { return shift->{sset} } 
     73sub sessions { 
     74    return shift->{sset}; 
     75} 
    5576 
    5677# Object method: pending() 
    5778# returns number of bytes pending in the out buffer 
    58 sub pending { return length shift->{outbuffer} } 
     79sub pending { 
     80    return length shift->{outbuffer}; 
     81} 
    5982 
    6083# Object method: write_limit([$bufsize]) 
    6184# Get or set the limit on the size of the write buffer. 
    6285# Write buffer will grow to this size plus whatever extra you write to it. 
    63 sub write_limit {  
    64   my $self = shift; 
    65   return defined $_[0] ? $self->{write_limit} = $_[0]  
    66                        : $self->{write_limit}; 
     86sub write_limit { 
     87    my $self = shift; 
     88    return defined $_[0] 
     89        ? $self->{write_limit} = $_[0] 
     90        : $self->{write_limit}; 
    6791} 
    6892 
    … …  
    7094# than the set limit. 
    7195sub set_choke { 
    72   my $self = shift; 
    73   return defined $_[0] ? $self->{choker} = $_[0]  
    74                        : $self->{choker}; 
     96    my $self = shift; 
     97    return defined $_[0] 
     98        ? $self->{choker} = $_[0] 
     99        : $self->{choker}; 
    75100} 
    76101 
    … …  
    80105# written. On other errors, returns undef. 
    81106sub write { 
    82   my $self = shift; 
    83   return unless my $handle = $self->handle; # no handle 
    84   return unless defined $self->{outbuffer}; # no buffer for queued data 
    85  
    86   $self->{outbuffer} .= $_[0] if defined $_[0]; 
    87  
    88   my $rc; 
    89   if ($self->pending) { # data in the out buffer to write 
    90     local $SIG{PIPE}='IGNORE'; 
    91     $rc = syswrite($handle,$self->{outbuffer}); 
    92  
    93     # able to write, so truncate out buffer apropriately 
    94     if ($rc) { 
    95       substr($self->{outbuffer},0,$rc) = ''; 
    96     } elsif (WOULDBLOCK($!)) {  # this is OK 
    97       $rc = '0E0'; 
    98     } else { # some sort of write error, such as a PIPE error 
    99       return $self->bail_out($!); 
    100     } 
    101   } else { 
    102     $rc = '0E0';   # nothing to do, but no error either 
    103   } 
    104    
    105   $self->adjust_state; 
    106  
    107   # Result code is the number of bytes successfully transmitted 
    108   return $rc; 
     107    my $self = shift; 
     108    return unless my $handle = $self->handle; # no handle 
     109    return unless defined $self->{outbuffer}; # no buffer for queued data 
     110 
     111    $self->{outbuffer} .= $_[0] if defined $_[0]; 
     112 
     113    my $rc; 
     114    if ($self->pending) { # data in the out buffer to write 
     115        local $SIG{PIPE}='IGNORE'; 
     116        # added length() to make it work on Mac. Thanks to Robin Fuller <rfuller@broadjump.com> 
     117        $rc = syswrite($handle,$self->{outbuffer},length($self->{outbuffer})); 
     118 
     119        # able to write, so truncate out buffer apropriately 
     120        if ($rc) { 
     121            substr($self->{outbuffer},0,$rc) = ''; 
     122        } 
     123        elsif (WOULDBLOCK($!)) {  # this is OK 
     124            $rc = '0E0'; 
     125        } 
     126        else { # some sort of write error, such as a PIPE error 
     127            return $self->bail_out($!); 
     128        } 
     129    } 
     130    else { 
     131        $rc = '0E0';   # nothing to do, but no error either 
     132    } 
     133 
     134    $self->adjust_state; 
     135 
     136    # Result code is the number of bytes successfully transmitted 
     137    return $rc; 
    109138} 
    110139 
    … …  
    113142# 0EO ("0 but true") if the read would block, and undef on EOF and other failures. 
    114143sub read { 
    115   my $self = shift; 
    116   return unless my $handle = $self->handle; 
    117   my $rc = sysread($handle,$_[0],$_[1],$_[2]||0); 
    118   return $rc if defined $rc; 
    119   return '0E0' if WOULDBLOCK($!); 
    120   return; 
     144    my $self = shift; 
     145    return unless my $handle = $self->handle; 
     146    my $rc = sysread($handle,$_[0],$_[1],$_[2]||0); 
     147    return $rc if defined $rc; 
     148    return '0E0' if WOULDBLOCK($!); 
     149    return; 
    121150} 
    122151 
    … …  
    124153# Close the session and remove it from the monitored list. 
    125154sub close { 
    126   my $self = shift; 
    127   unless ($self->pending) { 
    128     $self->sessions->delete($self); 
    129     close($self->handle); 
    130   } else { 
    131     $self->readable(0); 
    132     $self->{closing}++;  # delayed close 
     155    my $self = shift; 
     156    unless ($self->pending) { 
     157        $self->sessions->delete($self); 
     158        CORE::close($self->handle); 
     159    } 
     160    else { 
     161        $self->readable(0); 
     162        $self->{closing}++;  # delayed close 
    133163    } 
    134164} 
    … …  
    138168# status of the handle on the IO::SessionSet's IO::Select sets 
    139169sub adjust_state { 
    140   my $self = shift; 
    141  
    142   # make writable if there's anything in the out buffer 
    143   $self->writable($self->pending > 0); 
    144  
    145   # make readable if there's no write limit, or the amount in the out 
    146   # buffer is less than the write limit. 
    147   $self->choke($self->write_limit <= $self->pending) if $self->write_limit; 
    148  
    149   # Try to close down the session if it is flagged 
    150   # as in the closing state. 
    151   $self->close if $self->{closing}; 
     170    my $self = shift; 
     171 
     172    # make writable if there's anything in the out buffer 
     173    $self->writable($self->pending > 0); 
     174 
     175    # make readable if there's no write limit, or the amount in the out 
     176    # buffer is less than the write limit. 
     177    $self->choke($self->write_limit <= $self->pending) if $self->write_limit; 
     178 
     179    # Try to close down the session if it is flagged 
     180    # as in the closing state. 
     181    $self->close if $self->{closing}; 
    152182} 
    153183 
    … …  
    156186# reading until the situation is cleared. 
    157187sub choke { 
    158   my $self = shift; 
    159   my $do_choke = shift; 
    160   return if $self->{choked} == $do_choke;  # no change in state 
    161   if (ref $self->set_choke eq 'CODE') { 
    162     $self->set_choke->($self,$do_choke); 
    163   } else { 
    164     $self->readable(!$do_choke); 
    165   } 
    166   $self->{choked} = $do_choke; 
     188    my $self = shift; 
     189    my $do_choke = shift; 
     190    return if $self->{choked} == $do_choke;  # no change in state 
     191    if (ref $self->set_choke eq 'CODE') { 
     192        $self->set_choke->($self,$do_choke); 
     193    } 
     194    else { 
     195        $self->readable(!$do_choke); 
     196    } 
     197    $self->{choked} = $do_choke; 
    167198} 
    168199 
    … …  
    170201# Flag the associated IO::SessionSet that we want to do reading on the handle. 
    171202sub readable { 
    172   my $self = shift; 
    173   my $is_active = shift; 
    174   return if $self->{writeonly}; 
    175   $self->sessions->activate($self,'read',$is_active); 
     203    my $self = shift; 
     204    my $is_active = shift; 
     205    return if $self->{writeonly}; 
     206    $self->sessions->activate($self,'read',$is_active); 
    176207} 
    177208 
    … …  
    179210# Flag the associated IO::SessionSet that we want to do writing on the handle. 
    180211sub writable { 
    181   my $self = shift; 
    182   my $is_active = shift; 
    183   $self->sessions->activate($self,'write',$is_active); 
     212    my $self = shift; 
     213    my $is_active = shift; 
     214    $self->sessions->activate($self,'write',$is_active); 
    184215} 
    185216 
    … …  
    189220# the handle. 
    190221sub bail_out { 
    191   my $self = shift; 
    192   my $errcode = shift;           # save errorno 
    193   delete $self->{outbuffer};     # drop buffered data 
    194   $self->close; 
    195   $! = $errcode;                 # restore errno 
    196   return; 
     222    my $self = shift; 
     223    my $errcode = shift;           # save errorno 
     224    delete $self->{outbuffer};     # drop buffered data 
     225    $self->close; 
     226    $! = $errcode;                 # restore errno 
     227    return; 
    197228} 
    198229