HTTP-Tiny

 view release on metacpan or  search on metacpan

lib/HTTP/Tiny.pm  view on Meta::CPAN

858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
    else {
        $request->{headers}{'content-type'} ||= "application/octet-stream";
        $request->{headers}{'transfer-encoding'} = 'chunked'
          unless exists $request->{headers}{'content-length'}
          || $request->{headers}{'transfer-encoding'};
        $request->{cb} = $args->{content};
    }
}
elsif ( length $args->{content} ) {
    my $content = $args->{content};
    if ( $] ge '5.008' ) {
        utf8::downgrade($content, 1)
            or die(qq/Wide character in request message body\n/);
    }
    $request->{headers}{'content-type'} ||= "application/octet-stream";
    $request->{headers}{'content-length'} = length $content
      unless $request->{headers}{'content-length'}
          || $request->{headers}{'transfer-encoding'};
    $request->{cb} = sub { substr $content, 0, length $content, '' };
}
$request->{trailer_cb} = $args->{trailer_callback}

lib/HTTP/Tiny.pm  view on Meta::CPAN

1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
# URI escaping adapted from URI::Escape
# c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
# perl 5.6 ready UTF-8 encoding adapted from JSON::PP
my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
$escapes{' '}="+";
my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
 
sub _uri_escape {
    my ($self, $str) = @_;
    return "" if !defined $str;
    if ( $] ge '5.008' ) {
        utf8::encode($str);
    }
    else {
        $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
            if ( length $str == do { use bytes; length $str } );
        $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
    }
    $str =~ s/($unsafe_char)/$escapes{$1}/g;
    return $str;
}

lib/HTTP/Tiny.pm  view on Meta::CPAN

1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
    @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
    my ($self) = @_;
    CORE::close($self->{fh})
      or die(qq/Could not close socket: '$!'\n/);
}
 
sub write {
    @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
    my ($self, $buf) = @_;
 
    if ( $] ge '5.008' ) {
        utf8::downgrade($buf, 1)
            or die(qq/Wide character in write()\n/);
    }
 
    my $len = length $buf;
    my $off = 0;
 
    local $SIG{PIPE} = 'IGNORE';
 
    while () {

lib/HTTP/Tiny.pm  view on Meta::CPAN

1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
@_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
my ($self, $request) = @_;
 
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
while () {
    my $data = $request->{cb}->();
 
    defined $data && length $data
      or last;
 
    if ( $] ge '5.008' ) {
        utf8::downgrade($data, 1)
            or die(qq/Wide character in write_content()\n/);
    }
 
    $len += $self->write($data);
}
 
$len == $content_length
  or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);

lib/HTTP/Tiny.pm  view on Meta::CPAN

1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
@_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
my ($self, $request) = @_;
 
my $len = 0;
while () {
    my $data = $request->{cb}->();
 
    defined $data && length $data
      or last;
 
    if ( $] ge '5.008' ) {
        utf8::downgrade($data, 1)
            or die(qq/Wide character in write_chunked_body()\n/);
    }
 
    $len += length $data;
 
    my $chunk  = sprintf '%X', length $data;
       $chunk .= "\x0D\x0A";
       $chunk .= $data;
       $chunk .= "\x0D\x0A";