view release on metacpan or  search on metacpan

lib/Conduit/Client.pm  view on Meta::CPAN

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2026 -- leonerd@leonerd.org.uk

use v5.36;

use feature 'try';
use Future::AsyncAwait;
use Object::Pad 0.807 ':experimental(inherit_field)';

class Conduit::Client 0.03
   :strict(params);

no if $^V lt v5.40, warnings => "experimental::try", "experimental::builtin";

field $socket :param;

use Future::Buffer;
use Future::IO;
use HTTP::Request;
use HTTP::Response;

use Conduit::Metrics;

field $readbuf;
ADJUST {
   $readbuf = Future::Buffer->new(
      fill => sub () { Future::IO->sysread( $socket, 8192 ); },
   );
}

field $server :param :inheritable;
ADJUST { builtin::weaken( $server ); }

async method read_request ()
{
   defined( my $header = await $readbuf->read_until( qr/\x0D\x0A\x0D\x0A/ ) )
      or return undef;

   my $req = HTTP::Request->parse( $header );

   my $content_length = $req->content_length // 0;

   if( $content_length ) {
      my $body = await $readbuf->read_exactly( $content_length );

      $req->add_content( $body );
   }

   Conduit::Metrics->received_request( $req );
   return $req;
}

field $bytes_written :inheritable;

async method write ( $str )
{
   await Future::IO->write_exactly( $socket, $str );
   $bytes_written += length $str;
}

class Conduit::Client::_ForHTTP
   :strict(params);
inherit Conduit::Client qw( $server $bytes_written );

no if $^V lt v5.40, warnings => "experimental::try", "experimental::builtin";

field $responder :param;

async method run ()
{
   while( defined( my $req = await $self->read_request ) ) {
      my $resp;
      try {
         $resp = await $responder->( $req );
      }
      catch( $e ) {
         chomp $e;
         $resp = HTTP::Response->new( 500, undef,
            [ "Content-Type" => "text/plain" ],
            $e,
         );
      }
      $resp->request( $req );

      $resp->protocol or $resp->protocol( $req->protocol );
      $resp->content_length or $resp->content_length( length $resp->content );

      $bytes_written = 0;

      $server->on_response_header( $req, $resp )
         if $server->can( "on_response_header" );