File Coverage

blib/lib/Convert/VLQ.pm

Criterion	Covered	Total	%
statement	55	55	100.0
branch	12	14	85.7
condition	3	3	100.0
subroutine	11	11	100.0
pod	4	7	57.1
total	85	90	94.4

# $Id: VLQ.pm 2774 2026-04-06 21:17:59Z fil $
package Convert::VLQ;

use 5.010001;
use strict;
use warnings;

use Carp qw( confess );

our $VERSION = '0.01';

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( int2vlqs vlqs2int encode_vlq decode_vlq );

sub VLQ_BASE_SHIFT { 5 }
sub VLQ_BASE_MASK { 0x1f }          # binary:  11111
sub VLQ_CONTINUATION_BIT { 0x20 }   # binary: 100000

my $B64chrs = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
my @B64 = ("A" .. "Z", "a" .. "z", 0 .. 9, "+", "/" );
# my @B64 = ( split //, $B64chrs );
my %_B64;
@_B64{@B64} = (0..length $B64chrs);

sub int2vlqs
{
    my( $v ) = @_;
    $v = int $v;
    return( ((-$v) << 1 ) + 1 ) if $v < 0;
    return( ($v<<1) + 0 );
}

sub vlqs2int
{
    my( $v ) = @_;
    my $shifted = $v >> 1;
    return -$shifted if $v & 1;
    return $shifted;
}


sub encode_vlq
{
    my( $v ) = @_;
    if( ref $v ) {
        return join '', map { encode_vlq( $_ ) } @$v;
    }
    my $ret = '';
    my $vlq = int2vlqs( $v );
    do {
        my $digit = $vlq & VLQ_BASE_MASK;   # grab 5 bits
        $vlq >>= VLQ_BASE_SHIFT;            # remove those bits from input
        $digit |= VLQ_CONTINUATION_BIT if $vlq > 0; # should we continue?
        $ret .= $B64[$digit];               # convert to base64
    } while( $vlq > 0 );
    return $ret;
}


sub decode_vlq
{
    my( $v ) = @_;

    return unless defined $v;

    if( !wantarray ) {
        my @ret;
        my $n;
        while( length $v ) {
            ( $n, $v ) = decode_vlq( $v );
            push @ret, $n;
        }
        return \@ret;
    }

    my @v = split //, $v;

    my $ret = 0;
    my $shift = 0;
    my $cont = 1;
    while( @v and $cont ) {
        my $d = shift @v;
        confess "Invalid base64 digit: ", $d unless exists $_B64{$d};
        my $digit = $_B64{ $d };
        $cont = ($digit & VLQ_CONTINUATION_BIT); # 6th bit is continuation
        $digit &= VLQ_BASE_MASK;        # bottom 5 bits are what we want
        $ret += $digit << $shift;       # shift and add to answer
        $shift += VLQ_BASE_SHIFT;       # next time we shift even more
    }
    return( vlqs2int( $ret ), join '', @v );
}

1;

__END__