view release on metacpan or  search on metacpan

lib/Web/ComposableRequest/Base.pm  view on Meta::CPAN

   my $body    = HTTP::Body->new($self->content_type, $len);

   $body->cleanup(TRUE);
   $body->tmpdir($self->_config->tempdir);

   return $body unless $len;

   try   { $self->_decode_body($body, $content) }
   catch {
      # uncoverable subroutine
      # uncoverable statement
      $self->_log->({ level => 'error', message => $_ });
   };

   return $body;
};

my $_build__content = sub {
   my $self    = shift;
   my $cl      = $self->content_length  or return NUL;
   my $fh      = $self->_env->{ 'psgi.input' } or return NUL;
   my $content = NUL;

   try {
      $fh->can( 'seek' ) and $fh->seek( 0, 0 );
      $fh->read( $content, $cl, 0 );
      $fh->can( 'seek' ) and $fh->seek( 0, 0 );
   }
   catch {
      # uncoverable subroutine
      # uncoverable statement
      $self->_log->( { level => 'error', message => $_ } );
   };

   return $content;
};

my $_build_tunnel_method = sub {
   return $_[ 0 ]->body_params->(  '_method', { optional => TRUE } )
       || $_[ 0 ]->query_params->( '_method', { optional => TRUE } )
       || 'not_found';
};

# Public attributes
has 'address'        => is => 'lazy', isa => SimpleStr,
   builder           => sub { $_[ 0 ]->_env->{ 'REMOTE_ADDR' } // NUL };

has 'base'           => is => 'lazy', isa => Object,
   builder           => sub { new_uri $_[ 0 ]->scheme, $_[ 0 ]->_base },
   init_arg          => undef;

has 'body'           => is => 'lazy', isa => Object, builder => $_build_body;

has 'content_length' => is => 'lazy', isa => PositiveInt,
   builder           => sub { $_[ 0 ]->_env->{ 'CONTENT_LENGTH' } // 0 };

has 'content_type'   => is => 'lazy', isa => SimpleStr,
   builder           => sub { $_[ 0 ]->_env->{ 'CONTENT_TYPE' } // NUL };

has 'host'           => is => 'lazy', isa => NonEmptySimpleStr,
   builder           => sub { (split m{ : }mx, $_[ 0 ]->hostport)[ 0 ] };

has 'hostport'       => is => 'lazy', isa => NonEmptySimpleStr,
   builder           => sub { $_[ 0 ]->_env->{ 'HTTP_HOST' } // 'localhost' };

has 'method'         => is => 'lazy', isa => SimpleStr,
   builder           => sub { lc( $_[ 0 ]->_env->{ 'REQUEST_METHOD' } // NUL )};

has 'path'           => is => 'lazy', isa => SimpleStr, builder => sub {
   my $v             =  $_[ 0 ]->_env->{ 'PATH_INFO' } // '/';
      $v             =~ s{ \A / }{}mx; $v =~ s{ \? .* \z }{}mx; $v };

has 'port'           => is => 'lazy', isa => NonZeroPositiveInt,
   builder           => sub { $_[ 0 ]->_env->{ 'SERVER_PORT' } // 80 };

has 'protocol'       => is => 'lazy', isa => NonEmptySimpleStr,
   builder           => sub { $_[ 0 ]->_env->{ 'SERVER_PROTOCOL' } };

has 'query'          => is => 'lazy', isa => Str, builder => sub {
   my $v             =  $_[ 0 ]->_env->{ 'QUERY_STRING' }; $v ? "?${v}" : NUL };

has 'referer'        => is => 'lazy', isa => Str,
   builder           => sub { $_[ 0 ]->_env->{ 'HTTP_REFERER' } // NUL };

has 'remote_host'    => is => 'lazy', isa => SimpleStr,
   builder           => sub { $_[ 0 ]->_env->{ 'REMOTE_HOST' } // NUL };

has 'scheme'         => is => 'lazy', isa => NonEmptySimpleStr,
   builder           => sub { $_[ 0 ]->_env->{ 'psgi.url_scheme' } // 'http' };

has 'script'         => is => 'lazy', isa => SimpleStr, builder => sub {
   my $v             =  $_[ 0 ]->_env->{ 'SCRIPT_NAME' } // '/';
      $v             =~ s{ / \z }{}gmx; $v };

has 'tunnel_method'  => is => 'lazy', isa => NonEmptySimpleStr,
   builder           => $_build_tunnel_method;

has 'upload'         => is => 'lazy', isa => Object | Undef,
   predicate         => TRUE;

has 'uri'            => is => 'lazy', isa => Object, builder => sub {
   new_uri $_[ 0 ]->scheme, $_[ 0 ]->_base.$_[ 0 ]->path.$_[ 0 ]->query };

# Private attributes
has '_args'    => is => 'ro',   isa => ArrayRef,
   builder     => sub { [] }, init_arg => 'args';

has '_base'    => is => 'lazy', isa => NonEmptySimpleStr, builder => sub {
   $_[ 0 ]->scheme.'://'.$_[ 0 ]->hostport.$_[ 0 ]->script.'/' };

has '_config'  => is => 'ro',   isa => Object,
   required    => TRUE, init_arg => 'config';

has '_content' => is => 'lazy', isa => Str,
   builder     => $_build__content;

has '_env'     => is => 'ro',   isa => HashRef,
   init_arg    => 'env', required => TRUE;

has '_log'     => is => 'lazy', isa => CodeRef,
   builder     => sub { $_[ 0 ]->_env->{ 'psgix.logger' } // sub {} },