view release on metacpan or  search on metacpan

script/platform-info  view on Meta::CPAN

#            |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
#        )$/x )  ? $is_valid_utf8 : '';
#    }
#
#
#    sub decode_error {
#        my $error  = shift;
#        my $no_rep = shift;
#        my $str    = defined $text ? substr($text, $at) : '';
#        my $mess   = '';
#        my $type   = 'U*';
#
#        if ( OLD_PERL ) {
#            my $type   =  $] <  5.006           ? 'C*'
#                        : utf8::is_utf8( $str ) ? 'U*' 
#                        : 'C*'
#                        ;
#        }
#
#        for my $c ( unpack( $type, $str ) ) { 
#            $mess .=  $c == 0x07 ? '\a'
#                    : $c == 0x09 ? '\t'
#                    : $c == 0x0a ? '\n'
#                    : $c == 0x0d ? '\r'
#                    : $c == 0x0c ? '\f'
#                    : $c <  0x20 ? sprintf('\x{%x}', $c)
#                    : $c == 0x5c ? '\\\\'
#                    : $c <  0x80 ? chr($c)
#                    : sprintf('\x{%x}', $c)
#                    ;
#            if ( length $mess >= 20 ) {
#                $mess .= '...';
#                last;
#            }
#        }
#
#        unless ( length $mess ) {
#            $mess = '(end of string)';
#        }
#
#        Carp::croak (
#            $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
#        );
#
#    }
#
#
#    sub _json_object_hook {
#        my $o    = $_[0];
#        my @ks = keys %{$o};
#
#        if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
#            my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
#            if (@val == 0) {
#                return $o;
#            }
#            elsif (@val == 1) {
#                return $val[0];
#            }
#            else {
#                Carp::croak("filter_json_single_key_object callbacks must not return more than one scalar");
#            }
#        }
#
#        my @val = $cb_object->($o) if ($cb_object);
#        if (@val == 0) {
#            return $o;
#        }
#        elsif (@val == 1) {
#            return $val[0];
#        }
#        else {
#            Carp::croak("filter_json_object callbacks must not return more than one scalar");
#        }
#    }
#
#
#    sub PP_decode_box {
#        {
#            text    => $text,
#            at      => $at,
#            ch      => $ch,
#            len     => $len,
#            depth   => $depth,
#            encoding      => $encoding,
#            is_valid_utf8 => $is_valid_utf8,
#        };
#    }
#
#} 
#
#
#sub _decode_surrogates { 
#    my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
#    my $un  = pack('U*', $uni);
#    utf8::encode( $un );
#    return $un;
#}
#
#
#sub _decode_unicode {
#    my $un = pack('U', hex shift);
#    utf8::encode( $un );
#    return $un;
#}
#
#
#BEGIN {
#
#    unless ( defined &utf8::is_utf8 ) {
#       require Encode;
#       *utf8::is_utf8 = *Encode::is_utf8;
#    }
#
#    if ( !OLD_PERL ) {
#        *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
#        *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
#        *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
#        *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
#
#        if ($] < 5.008003) { 
#            package JSON::PP;
#            require subs;
#            subs->import('join');
#            eval q|
#                sub join {
#                    return '' if (@_ < 2);
#                    my $j   = shift;
#                    my $str = shift;
#                    for (@_) { $str .= $j . $_; }
#                    return $str;
#                }
#            |;