view release on metacpan or  search on metacpan

lib/Apache/TieBucketBrigade.pm  view on Meta::CPAN

package Apache::TieBucketBrigade;

use 5.008001;

use strict;
use warnings;

use Apache::Connection ();
use APR::Bucket ();
use APR::Brigade ();
use APR::Util ();
use APR::Const -compile => qw(SUCCESS EOF);
use Apache::Const -compile => qw(OK MODE_GETLINE);
use APR::Const -compile => qw(NONBLOCK_READ POLLIN TIMEUP);
use APR::Socket ();
use IO::WrapTie;
use Apache::Filter;
use IO::File;

use base qw(IO::WrapTie::Slave Class::Data::Inheritable);
#our @ISA = qw

our $VERSION = '0.05';

__PACKAGE__->mk_classdata('handles');
__PACKAGE__->{handles} = {};

use ex::override
    GLOBAL_select =>
    sub {
        if (@_ == 1) {
            #ignore selecting filehandle
            my $sh = shift;
            unless (ref($sh)) {
                my $caller = caller();
                $sh = \*{$caller .'::'. $sh};
            }
            return CORE::select();
        }
        elsif (@_ == 4) {
            my @bits = @_;
            foreach my $fn (keys %{__PACKAGE__->{handles}} ) {
                #check each phony fileno in our array to see if it matches
                my $rin = vec($bits[0],$fn,1) if $bits[0];
                my $win = vec($bits[1],$fn,1) if $bits[1];
                my $ein = vec($bits[2],$fn,1) if $bits[2];
                if ($rin or $win or $ein) {
                    my $fh = __PACKAGE__->{handles}->{$fn}->{apache};
                    my $conn = $fh->connection;
                    my $pool = $conn->pool;
                    my $sock = $conn->client_socket;

                    my $timeout = $bits[3];
                    $timeout = -1 unless defined $timeout;
                    $timeout = $timeout * 1_000_000 if $timeout > 0;

                    # XXX: APR::Socket->poll() really should return
                    # the number of sockets successfully polled along with
                    # the time left. We have to fake it here.
                    my $rc = $sock->poll($pool, $timeout, APR::POLLIN);
                    if($rc == APR::SUCCESS) {
                        return wantarray ? (1, $bits[3]) : 1;
                    }
                    elsif($rc == APR::TIMEUP) {
                        return wantarray ? (0, 0) : 0;
                    }
                    else {
                        die "Failed to poll socket: " .
                            APR::Error::strerror($rc);
                    }
                }
            }

            #if we haven't returned by now then it's just a normal
            #select on some other fileno, use CORE::select
            return
                CORE::select($_[0],$_[1],$_[2],$_[3]);
        }
        else {
            #some idiot doesn't know how to use select
            die "WTF ?";
        }
};


sub TIEHANDLE {
    my $invocant = shift;
    my $connection = shift;
    my $class = ref($invocant) || $invocant;
    my $self = {                            
        @_,
    };
    bless $self, $class;
    $self->{bbin} = APR::Brigade->new($connection->pool,
                                      $connection->bucket_alloc);