HTTP-Promise

 view release on metacpan or  search on metacpan

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

## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package HTTP::Promise::Entity;
BEGIN
{
    use strict;
    use warnings;
    warnings::register_categories( 'HTTP::Promise' );
    use parent qw( Module::Generic );
    use vars qw( $VERSION $EXCEPTION_CLASS $BOUNDARY_DELIMITER $BOM2ENC $ENC2BOM $BOM_RE 
                 $BOM_MAX_LENGTH $DEFAULT_MIME_TYPE );
    use Data::UUID;
    use HTTP::Promise::Exception;
    use HTTP::Promise::Headers;
    use HTTP::Promise::Body;
    use Module::Generic::HeaderValue;
    # use Nice::Try;
    use Symbol;
    use URI::Escape::XS ();
    use constant CRLF => "\015\012";
    our $EXCEPTION_CLASS = 'HTTP::Promise::Exception';

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

    my $headers = $self->headers;
    # If parameter content_type_charset is set to false, this means it was just tried and 
    # we should not try it again.
    if( ( my $charset = $headers->content_type_charset ) && 
        ( !exists( $opts->{content_type_charset} ) || $opts->{content_type_charset} ) )
    {
        return( $charset );
    }

    $self->_load_class( 'Encode' ) || return( $self->pass_error );
    unless( defined( $BOM2ENC ) && scalar( %$BOM2ENC ) )
    {
        # Credits: Matthew Lawrence (File::BOM)
        our $BOM2ENC = +{
            map{ Encode::encode( $_, "\x{feff}" ) => $_ } qw(
                UTF-8
                UTF-16BE
                UTF-16LE
                UTF-32BE
                UTF-32LE
            )
        };

        our $ENC2BOM = +{
            reverse( %$BOM2ENC ),
            map{ $_ => Encode::encode( $_, "\x{feff}" ) } qw(
                UCS-2
                iso-10646-1
                utf8
            )
        };
        my @boms = sort{ length( $b ) <=> length( $a ) } keys( %$BOM2ENC );
        our $BOM_MAX_LENGTH = length( $boms[0] );
        {
            local $" = '|';
            our $BOM_RE = qr/@boms/;
        }
    }
    
    # time to start guessing
    # If called from decoded_content, kind of pointless to call decoded_content again
    my $cref;
    if( exists( $opts->{content} ) && length( $opts->{content} ) )
    {
        return( $self->error( "Unsupported data type (", ref( $opts->{content} ), ")." ) ) if( ref( $opts->{content} ) && !$self->_is_scalar( $opts->{content} ) );
        $cref = $self->_is_scalar( $opts->{content} ) ? $opts->{content} : \$opts->{content};

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

        my $io = $body->open( '<', { binmode => 'raw' } ) ||
            return( $self->pass_error( $body->error ) );
        my $buff;
        my $bytes = $io->read( $buff, 4096 );
        return( $self->pass_error( $io->error ) ) if( !defined( $bytes ) );
        return( '' ) if( !$bytes );
        $cref = \$buff;
    }
    
    # Is there a Byte Order Mark?
    if( $$cref =~ /^($BOM_RE)/ )
    {
        my $bom = $1;
        return( $BOM2ENC->{ $bom } );
    }

    # Unicode BOM
    return( 'UTF-8' )    if( $$cref =~ /^\xEF\xBB\xBF/ );
    return( 'UTF-32LE' ) if( $$cref =~ /^\xFF\xFE\x00\x00/ );
    return( 'UTF-32BE' ) if( $$cref =~ /^\x00\x00\xFE\xFF/ );
    return( 'UTF-16LE' ) if( $$cref =~ /^\xFF\xFE/ );
    return( 'UTF-16BE' ) if( $$cref =~ /^\xFE\xFF/ );

    if( $headers->content_is_xml )
    {
        # http://www.w3.org/TR/2006/REC-xml-20060816/#sec-guessing
        # XML entity not accompanied by external encoding information and not

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

        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;

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

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.