view release on metacpan or  search on metacpan

script/platform-info  view on Meta::CPAN

#        return number() if($ch =~ /[0-9]/ or $ch eq '-');
#        return word();
#    }
#
#    sub string {
#        my $utf16;
#        my $is_utf8;
#
#        ($is_valid_utf8, $utf8_len) = ('', 0);
#
#        my $s = ''; 
#
#        if($ch eq '"' or ($singlequote and $ch eq "'")){
#            my $boundChar = $ch;
#
#            OUTER: while( defined(next_chr()) ){
#
#                if($ch eq $boundChar){
#                    next_chr();
#
#                    if ($utf16) {
#                        decode_error("missing low surrogate character in surrogate pair");
#                    }
#
#                    utf8::decode($s) if($is_utf8);
#
#                    return $s;
#                }
#                elsif($ch eq '\\'){
#                    next_chr();
#                    if(exists $escapes{$ch}){
#                        $s .= $escapes{$ch};
#                    }
#                    elsif($ch eq 'u'){ 
#                        my $u = '';
#
#                        for(1..4){
#                            $ch = next_chr();
#                            last OUTER if($ch !~ /[0-9a-fA-F]/);
#                            $u .= $ch;
#                        }
#
#                        if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { 
#                            $utf16 = $u;
#                        }
#                        elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { 
#                            unless (defined $utf16) {
#                                decode_error("missing high surrogate character in surrogate pair");
#                            }
#                            $is_utf8 = 1;
#                            $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
#                            $utf16 = undef;
#                        }
#                        else {
#                            if (defined $utf16) {
#                                decode_error("surrogate pair expected");
#                            }
#
#                            if ( ( my $hex = hex( $u ) ) > 127 ) {
#                                $is_utf8 = 1;
#                                $s .= JSON_PP_decode_unicode($u) || next;
#                            }
#                            else {
#                                $s .= chr $hex;
#                            }
#                        }
#
#                    }
#                    else{
#                        unless ($loose) {
#                            $at -= 2;
#                            decode_error('illegal backslash escape sequence in string');
#                        }
#                        $s .= $ch;
#                    }
#                }
#                else{
#
#                    if ( ord $ch  > 127 ) {
#                        unless( $ch = is_valid_utf8($ch) ) {
#                            $at -= 1;
#                            decode_error("malformed UTF-8 character in JSON string");
#                        }
#                        else {
#                            $at += $utf8_len - 1;
#                        }
#
#                        $is_utf8 = 1;
#                    }
#
#                    if (!$loose) {
#                        if ($ch =~ /[\x00-\x1f\x22\x5c]/)  { 
#                            if (!$relaxed or $ch ne "\t") {
#                                $at--;
#                                decode_error('invalid character encountered while parsing JSON string');
#                            }
#                        }
#                    }
#
#                    $s .= $ch;
#                }
#            }
#        }
#
#        decode_error("unexpected end of string while parsing JSON string");
#    }
#
#
#    sub white {
#        while( defined $ch  ){
#            if($ch eq '' or $ch =~ /\A[ \t\r\n]\z/){
#                next_chr();
#            }
#            elsif($relaxed and $ch eq '/'){
#                next_chr();
#                if(defined $ch and $ch eq '/'){
#                    1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
#                }
#                elsif(defined $ch and $ch eq '*'){
#                    next_chr();
#                    while(1){

script/platform-info  view on Meta::CPAN

#        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;
#                }
#            |;
#        }
#    }
#
#
#    sub JSON::PP::incr_parse {
#        local $Carp::CarpLevel = 1;
#        ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
#    }
#
#
#    sub JSON::PP::incr_skip {
#        ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
#    }
#
#
#    sub JSON::PP::incr_reset {
#        ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
#    }
#
#    eval q{
#        sub JSON::PP::incr_text : lvalue {
#            $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
#
#            if ( $_[0]->{_incr_parser}->{incr_pos} ) {
#                Carp::croak("incr_text cannot be called when the incremental parser already started parsing");
#            }
#            $_[0]->{_incr_parser}->{incr_text};
#        }
#    } if ( $] >= 5.006 );
#
#} 
#
#
#
#BEGIN {
#    eval 'require Scalar::Util';
#    unless($@){
#        *JSON::PP::blessed = \&Scalar::Util::blessed;
#        *JSON::PP::reftype = \&Scalar::Util::reftype;
#        *JSON::PP::refaddr = \&Scalar::Util::refaddr;
#    }
#    else{ 
#        eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
#        *JSON::PP::blessed = sub {
#            local($@, $SIG{__DIE__}, $SIG{__WARN__});
#            ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;