view release on metacpan or  search on metacpan

lib/IOMux/Handler.pm  view on Meta::CPAN

# Copyrights 2011-2020 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution IOMux.  Meta-POD processed with OODoc
# into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package IOMux::Handler;
use vars '$VERSION';
$VERSION = '1.01';


use warnings;
use strict;

use Log::Report  'iomux';

use Scalar::Util     'weaken';
use Time::HiRes      'time';
use Socket;
use Fcntl;

my $start_time = time;


sub new(@)  {my $class = shift; (bless {}, $class)->init( {@_} ) }

sub init($)
{   my ($self, $args) = @_;
    return $self if $self->{IH_name}; # already initialized

    my $name = $self->{IH_name} = $args->{name} || "$self";
    if(my $fh = $self->{IH_fh} = $args->{fh})
    {   $self->{IH_fileno}   = $fh->fileno;
        $self->{IH_uses_ssl} = UNIVERSAL::isa($fh, 'IO::Socket::SSL');
    }
    $self;
}


sub open() {panic}

#-------------------------

sub name()   {shift->{IH_name}}
sub mux()    {shift->{IH_mux}}


sub fileno() {shift->{IH_fileno}}
sub fh()     {shift->{IH_fh}}
sub usesSSL(){shift->{IH_uses_ssl}}

#-----------------------

sub timeout(;$)
{   my $self  = shift;
    @_ or return $self->{IH_timeout};

    my $old   = $self->{IH_timeout};
    my $after = shift;
    my $when  = !$after      ? undef
      : $after > $start_time ? $after
      :                        ($after + time);

    $self->{IH_mux}->changeTimeout($self->{IH_fileno}, $old, $when);
    $self->{IH_timeout} = $when;
}


sub close(;$)
{   my ($self, $cb) = @_;
    if(my $fh = delete $self->{IH_fh})
    {   if(my $mux = $self->{IH_mux})
        {   $mux->remove($self->{IH_fileno});
        }
        $fh->close;
    }
    local $!;
    $cb->($self) if $cb;
}  

#-------------------------

sub muxInit($;$)
{   my ($self, $mux, $handler) = @_;

    $self->{IH_mux} = $mux;
    weaken($self->{IH_mux});

    my $fileno = $self->{IH_fileno};
    $mux->handler($fileno, $handler || $self);

    if(my $timeout = $self->{IH_timeout})
    {   $mux->changeTimeout($fileno, undef, $timeout);
    }

    trace "mux add #$fileno, $self->{IH_name}";
}


sub muxRemove()
{   my $self = shift;
    delete $self->{IH_mux};
#use Carp 'cluck';
#cluck "REMOVE";
    trace "mux remove #$self->{IH_fileno}, $self->{IH_name}";
}


sub muxTimeout()