view release on metacpan or  search on metacpan

lib/HTTP/Promise/Message.pm  view on Meta::CPAN

sub decoded_content
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    $opts->{charset_strict} //= 0;
    my $old_fatal = $self->fatal;
    $self->fatal( $opts->{raise_error} ? 1 : 0 );
    my $body = $self->decode_content( ( scalar( keys( %$opts ) ) ? $opts : () ) );
    return( $self->pass_error ) if( !defined( $body ) );
    # There is no entity or no body
    if( !$body )
    {
        return( $self->new_scalar );
    }
    $self->fatal( $old_fatal );
    my $dummy = '';
    return( $opts->{ref} ? \$dummy : $dummy ) if( $body->is_empty );
    unless( $opts->{binmode} )
    {
        # Need to explicitly provide the body to get the encoding from, otherwise, io_encoding()
        # would get the default one, which might not yet be replaced with its decoded version.
        my $enc = $self->entity->io_encoding( body => $body, charset_strict => $opts->{charset_strict} );
        $opts->{binmode} = $enc if( $enc );
    }
    
    # Because of an edge case where open with :binmode(utf-8) layer does not decode properly \x{FF}
    # but Encode::decode( 'utf-8', $buff ) does, and since the body is loaded into a string
    # anyway, we first read the data as raw and then decode it with Encode
    my $binmode;
    if( exists( $opts->{binmode} ) && 
        length( $opts->{binmode} ) && 
        lc( substr( $opts->{binmode}, 0, 3 ) ) eq 'utf' )
    {
        $binmode = delete( $opts->{binmode} );
        $opts->{binmode} = 'raw';
    }
    my $content = $body->as_string( ( scalar( keys( %$opts ) ) ? $opts : () ) );
    if( !defined( $content ) )
    {
        return( $self->pass_error( $body->error ) );
    }
    if( defined( $binmode ) )
    {
        $self->_load_class( 'Encode' ) || return( $self->pass_error );
        # try-catch
        local $@;
        eval
        {
            $$content = Encode::decode( $binmode, $$content, ( Encode::FB_DEFAULT | Encode::LEAVE_SRC ) );
        };
        if( $@ )
        {
            return( $self->error( "Error decoding body content with character encoding '$binmode': $@" ) );
        }
    }
    
    # $content is a scalar object that stringifies
    if( $self->headers->content_is_xml )
    {
        # Get rid of the XML encoding declaration if present (\x{FEFF})
        $$content =~ s/^\N{BOM}//;
        if( $$content =~ m/^(?<decl>[[:blank:]\h\v]*<\?xml(.*?)\?>)/is )
        {
            substr( $$content, 0, length( $+{decl} ) ) =~ s{
                [[:blank:]\h\v]+
                encoding[[:blank:]\h\v]*=[[:blank:]\h\v]*
                (?<quote>["'])
                (?<encoding>(?>\\\g{quote}|(?!\g{quote}).)*+)
                \g{quote}
            }
            {}xmis;
        }
    }
    return( $content );
}

sub decoded_content_utf8
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    $opts->{binmode} = 'utf-8';
    my $data = $self->decoded_content( $opts );
    if( !defined( $data ) && $self->error )
    {
        return( $self->pass_error );
    }

    if( $self->headers->content_is_xml )
    {
        # Get rid of the XML encoding declaration if present
        $$data =~ s/^\x{FEFF}//;
        
        if( $$data =~ /^(\s*<\?xml[^\x00]*?\?>)/ )
        {
            substr( $$data, 0, length($1)) =~ s/\sencoding\s*=\s*(["']).*?\1//;
        }
    }
    return( $data );
}

sub decoded_json
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    $opts->{binmode} = 'utf-8';
    my $data = $self->decoded_content_utf8( $opts );
    return( $self->pass_error ) if( !defined( $data ) && $self->error );
    return if( !defined( $data ) );
    if( $self->headers->content_is_json )
    {
        local $@;
        # try-catch
        my $ref = $self->new_json_safe->relaxed->decode( $$data );
        if( !defined( $ref ) && $self->error )
        {
            my $err = $self->error->message;
            return( $self->error( "Error decoding JSON payload: $err\nPayload was: $$data" ) );
        }
        return( $ref );
    }
    return( $$data );

lib/HTTP/Promise/Message.pm  view on Meta::CPAN

    my $m = HTTP::Promise::Message->new([
        'Content-Type' => 'text/plain; charset=utf-8',
        ],
        "\x{E3}\x{81}\x{8A}\x{E6}\x{97}\x{A9}\x{E3}\x{81}\x{86}\x{EF}\x{BC}\x{81}\x{A}",
    );
    my $content = $m->content;

C<$content> would contain undecoded utf-8 bytes, i.e. not in perl's internal representation. Indeed, charset is never decoded. If you want the charset decoded content, use L</decoded_content>, which will guess the content charset to decode it into pe...

    my $decoded_content = $m->decoded_content( binmode => 'utf-8' );

or

    my $decoded_content = $m->decoded_content_utf8;

See L</decoded_content> for more information.

=head2 content_charset

This is a convenient method that calls L<HTTP::Promise::Entity/content_charset> and returns the result.

This method attempts at guessing the content charset of the entity body.

It returns a string representing the content charset, possibly empty if nothing was found, or upon error, sets an L<error|Module::Generic/error> and returns C<undef>.

=head2 content_ref

This sets or gets the content as a scalar reference.

In assignment mode, this takes a scalar reference and pass it to L</content> and returns the L<body object|HTTP::Promise::Body>

Otherwise, this returns the content as L<scalar object|Module::Generic::Scalar>.

If an error occurs, this sets an L<error|Module::Generic/error> and returns C<undef>.

=head2 decodable

This gets an L<array object|Module::Generic::Array> of all supported and installed decodings on the system, by calling L<HTTP::Promise::Stream/decodable>

=head2 decode

This decodes the HTTP message body and return true.

If there is no C<Content-Encoding> set, or the entity body is empty, or the entity body already has been decoded, this does nothing obviously. Otherwise, this calls L<HTTP::Promise::Entity/decode_body> passing it the encodings as an array reference.

If an error occurs, this sets an L<error|Module::Generic/error> and returns C<undef>.

=head2 decode_content

This is similar to </decode>, except that it takes an hash or hash reference of options passed to L<HTTP::Promise::Entity/decode_body>, notably C<replace>, which if true will replace the body by its decoded version and if false will return a new body...

This returns the entity body object upon success, or upon error, sets an L<error|Module::Generic/error> and returns C<undef>.

=head2 decoded_content

This takes an hash or hash reference of options and returns the decoded representation of the body, including charset.

This calls L</decode_content>, passing it the options provided, to decompress the entity body if necessary. Then, unless the C<binmode> option was provided, this calls L<HTTP::Promise::Entity/io_encoding> to guess the charset encoding, and set the C<...

If the entity body is an xml file, any C<BOM> (Byte Order Mark) will be removed.

This returns the content as a L<scalar object|Module::Generic::Scalar>, or upon error, sets an L<error|Module::Generic/error> and returns C<undef>.

Supported options are:

=over 4

=item * C<binmode>

The L<PerlIO> encoding to apply to decode the data.

If not provided, this will be guessed by calling L<HTTP::Promise::Entity/io_encoding>

=item * C<charset_strict>

If true, this will returns an error if there is some issues with the content charset. By default, this is false, making it lenient, especially with malformed utf-8.

=item * C<raise_error>

When set to true, this will cause this method to die upon error. Default is false.

=back

=head2 decoded_content_utf8

This calls L</decoded_content>, but this sets the C<binmode> option to C<utf-8>.

It returns whatever L</decode_content> returns.

=head2 decoded_json

If the content type of the response is C<application/json>, this will call L</decoded_content_utf8> and decode the JSON payload and return the hash reference. If an error occurred, it will set L<an error|Module::Generic/error> and return C<undef> in ...

=head2 dump

This takes an hash or hash reference of options and either print the resulting dump on the C<STDOUT> in void content, or returns a string representation of the HTTP message, or upon error, sets an L<error|Module::Generic/error> and returns C<undef>.

Supported options are:

=over 4

=item * C<maxlength>

The maximum amount of body data in bytes to display.

=item * C<no_content>

The string to use when there is no entity body data.

=item * C<prefix>

A string to be added at the beginning of each line of the data returned.

=item * C<preheader>

An arbitrary string to add before the HTTP headers, typically the HTTP C<start line>

=back

    # Returns a string