view release on metacpan or  search on metacpan

lib/Mojo/Webqq/Util.pm  view on Meta::CPAN

    my @bytes = unpack('C*', $input);
    my $i = 0;
    while (1)
    {
        my $utf8_bytes;
        if (($bytes[$i] & 0x80) == 0) {
            $utf8_bytes = 1;
        }
        elsif (($bytes[$i] & 0xc0) != 0 and ($bytes[$i] & 0x20) == 0) {
            $utf8_bytes = 2;
        }
        elsif (($bytes[$i] & 0xe0) != 0 and ($bytes[$i] & 0x10) == 0) {
            $utf8_bytes = 3;
        }
        elsif (($bytes[$i] & 0xf0) != 0 and ($bytes[$i] & 0x08) == 0) {
            $utf8_bytes = 4;
        }
        else {
            $utf8_bytes = 1;
        }

        if ($i + $utf8_bytes > $truncate_length) {
            last;
        }
        elsif ($i + $utf8_bytes == $truncate_length) {
            $i = $truncate_length;
            last;
        }
        else {
            $i += $utf8_bytes;
        }
    }
    return substr($input, 0, $i);
}

sub truncate {
    my $self = shift;
    my $out_and_err = shift || '';
    my %p = @_;
    my $max_bytes = $p{max_bytes} || 200;
    my $max_lines = $p{max_lines} || 8;
    my $is_truncated = 0;
    if(length($out_and_err)>$max_bytes){
        $out_and_err = substr($out_and_err,0,$max_bytes);
        $is_truncated = 1;
    }
    my @l =split /\n/,$out_and_err,$max_lines+1;
    if(@l>$max_lines){
        $out_and_err = join "\n",@l[0..$max_lines-1];
        $is_truncated = 1;
    }
    return $out_and_err. ($is_truncated?"\n(已截断)":"");
}
sub code2state {
    my $self = shift;
    my %c = qw(
        10  online
        20  offline
        30  away
        40  hidden
        50  busy
        60  callme
        70  silent
    );
    return $c{$_[0]} || "online";
}
sub code2client {
    my $self = shift;
    my %c = qw(
        1   pc
        21  mobile
        24  iphone
        41  web
    );
    return $c{$_[0]} || 'unknown';
}

sub reform{
    my $self = shift;
    my $ref = shift;
    my %opt = @_;
    my $unicode = $opt{unicode} // 0;
    my $recursive = $opt{recursive} // 1;
    my $cb = $opt{filter};
    my $deep = $opt{deep} // 0;
    if(ref $ref eq 'HASH'){
        my @reform_hash_keys;
        for (keys %$ref){
            next if ref $cb eq "CODE" and !$cb->("HASH",$deep,$_,$ref->{$_});
            if($_ !~ /^[[:ascii:]]+$/){
                if($unicode and not Encode::is_utf8($_)){
                    push @reform_hash_keys,[ $_,Encode::decode_utf8($_) ];
                }
                elsif(!$unicode and Encode::is_utf8($_)){ 
                    push @reform_hash_keys,[ $_,Encode::encode_utf8($_) ];
                }
            }
        
            if(ref $ref->{$_} eq ""){
                if($unicode and not Encode::is_utf8($ref->{$_}) ){
                    Encode::_utf8_on($ref->{$_});
                }
                elsif( !$unicode and Encode::is_utf8($ref->{$_}) ){
                    Encode::_utf8_off($ref->{$_});
                }
            }
            elsif( $recursive and ref $ref->{$_} eq "ARRAY" or ref $ref->{$_} eq "HASH"){
                $self->reform($ref->{$_},@_,deep=>$deep+1);
            }
            #else{
            #    $self->die("不支持的hash结构\n");
            #}
        }

        for(@reform_hash_keys){ $ref->{$_->[1]} = delete $ref->{$_->[0]} }
    }
    elsif(ref $ref eq 'ARRAY'){
        for(@$ref){
            next if ref $cb eq "CODE" and !$cb->("ARRAY",$deep,$_);
            if(ref $_ eq ""){
                if($unicode and not Encode::is_utf8($_) ){