package Mud::IOManager;
use strict;
use Mud::CoreTools;
use vars qw(%SelectMasks %Notifiers);

use Mud::Platform;
use Mud::Obj::Event;
use Mud::Scheduler;

use constant IO_DEBUG => 0;
use constant IO_CANT_HAPPEN => 0;

%SelectMasks = (read => '', write => '', exception => '') unless %SelectMasks;
%Notifiers   = (read => {}, write => {}, exception => {}) unless %Notifiers;

=head1 Description

Mud::IOManager provides a Perlish interface and central management point
for 4-arg select() or equivalent.

It is designed to be more efficient and specialized than IO::Select for
the application.

=head1 Methods

=over 4

=item CM add(FH, TYPE, EVENT)

Adds FH (which must be open) to the set of file descriptors being
monitored. TYPE is one of 'read', 'write', or 'exception'. EVENT
must be an object suitable for passing to Mud::Scheduler->add.

EVENT will be added to the scheduler when the socket is ready for
E<lt>TYPEE<gt>ing.

=cut

sub add {
  my ($class, $fh, $type, $event) = @_;

  defined($fh                 ) or confess "undef passed to ".__PACKAGE__."->add";
  defined(my $fn = fileno($fh)) or confess "bad filehandle passed to ".__PACKAGE__."->add";
  vec($SelectMasks{$type}, $fn, 1) = 1;
  $Notifiers{$type}{$fn} = $event;
  1;
}

=item CM remove(FH, TYPE)

Removes FH (which must be open) from the set of file descriptors
being monitored. TYPE is the same as for add().

=cut

sub remove {
  my ($class, $fh, $type) = @_;

  defined(my $fn = fileno($fh)) or cluck("bad filehandle passed to ".__PACKAGE__."->remove"), return;
  for ($type ? $type : keys(%SelectMasks)) {
    vec($SelectMasks{$_}, $fn, 1) = 0;
    delete $Notifiers{$_}{$fn};
  }
  1;
}

=item CM block_for(TIMEOUT)

Waits for IO for TIMEOUT. If TIMEOUT is undef, waits forever.

=cut

sub block_for {
  my ($class, $timeout) = @_;

  print "IO: blocking for ".(defined $timeout ? $timeout : 'undef')."\n" if IO_DEBUG;

  my %bits;
  
  return 0 unless Mud::Platform::p_select(
    $bits{read}      = $SelectMasks{read},
    $bits{write}     = $SelectMasks{write},
    $bits{exception} = $SelectMasks{exception},
    $timeout
  );

  print "IO: select succeded: read:".unpack('b*', $bits{read})
                          ." write:".unpack('b*', $bits{write})
                          ." exception:".unpack('b*', $bits{exception})
                          ."\n"                                 if IO_DEBUG;
  
  foreach my $type (keys %SelectMasks) {
    foreach my $fileno (keys %{ $Notifiers{$type} }) {
      if (vec($bits{$type}, $fileno, 1)) {
        vec($bits{$type}, $fileno, 1) = 0 if IO_CANT_HAPPEN;
        print "IO: got $type on $fileno\n" if IO_DEBUG;
        
        $Notifiers{$type}{$fileno}->schedule
          if $Notifiers{$type}{$fileno}; # test if there's still a notifier, in case a previous one called remove()
      }
    } 
    if (IO_CANT_HAPPEN and $bits{$type} !~ /^\x00*$/) {
      warn "select() returned unknown filenos for $type";
    }
  }
  1;
}

=back

=cut

1;
__END__
