Test-ModuleVersion

 view release on metacpan or  search on metacpan

lib/Test/ModuleVersion.pm  view on Meta::CPAN

389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
if (defined $args->{content}) {
    $request->{headers}{'content-type'} ||= "application/octet-stream";
    if (ref $args->{content} eq 'CODE') {
        $request->{headers}{'transfer-encoding'} = 'chunked'
          unless $request->{headers}{'content-length'}
              || $request->{headers}{'transfer-encoding'};
        $request->{cb} = $args->{content};
    }
    else {
        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-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}
        if ref $args->{trailer_callback} eq 'CODE';

lib/Test/ModuleVersion.pm  view on Meta::CPAN

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
 
# 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 Test::ModuleVersion::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) = @_;
    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}/ge;
    return $str;
}

lib/Test/ModuleVersion.pm  view on Meta::CPAN

601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
    @_ == 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/Test/ModuleVersion.pm  view on Meta::CPAN

826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
@_ == 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 missmatch (got: $len expected: $content_length)\n/);

lib/Test/ModuleVersion.pm  view on Meta::CPAN

873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
@_ == 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";