File: //usr/share/webmin/vendor_perl/QRCode/Encoder/QRSpec.pm
package QRCode::Encoder::QRSpec;
use v5.24;
use warnings;
use experimental qw< signatures >;
use Exporter qw< import >;
our @EXPORT_OK = qw<
qrspec_ecc_spec
qrspec_data_size
qrspec_ecc_size
qrspec_width
qrspec_remainder
qrspec_min_version
qrspec_min_version_for
qrspec_length_indicator
qrspec_maximum_words
qrspec_mode_indicator
qrspec_alignment_patterns
qrspec_format_pattern
qrspec_version_pattern
>;
our %EXPORT_TAGS = (all => [@EXPORT_OK]);
# Liberally taken from libqrencode/qrspec.c, which is distributed with
# LGPL license
sub qrspec_ecc_spec ($version, $level) {
state $ecc_table = [
map { _zip_hash([qw< L M Q H >], $_) } (
# L M Q H
[[ 1, 0], [ 1, 0], [ 1, 0], [ 1, 0]],
[[ 1, 0], [ 1, 0], [ 1, 0], [ 1, 0]],
[[ 1, 0], [ 1, 0], [ 2, 0], [ 2, 0]],
[[ 1, 0], [ 2, 0], [ 2, 0], [ 4, 0]],
[[ 1, 0], [ 2, 0], [ 2, 2], [ 2, 2]],
[[ 2, 0], [ 4, 0], [ 4, 0], [ 4, 0]],
[[ 2, 0], [ 4, 0], [ 2, 4], [ 4, 1]],
[[ 2, 0], [ 2, 2], [ 4, 2], [ 4, 2]],
[[ 2, 0], [ 3, 2], [ 4, 4], [ 4, 4]],
[[ 2, 2], [ 4, 1], [ 6, 2], [ 6, 2]],
[[ 4, 0], [ 1, 4], [ 4, 4], [ 3, 8]],
[[ 2, 2], [ 6, 2], [ 4, 6], [ 7, 4]],
[[ 4, 0], [ 8, 1], [ 8, 4], [12, 4]],
[[ 3, 1], [ 4, 5], [11, 5], [11, 5]],
[[ 5, 1], [ 5, 5], [ 5, 7], [11, 7]],
[[ 5, 1], [ 7, 3], [15, 2], [ 3, 13]],
[[ 1, 5], [10, 1], [ 1, 15], [ 2, 17]],
[[ 5, 1], [ 9, 4], [17, 1], [ 2, 19]],
[[ 3, 4], [ 3, 11], [17, 4], [ 9, 16]],
[[ 3, 5], [ 3, 13], [15, 5], [15, 10]],
[[ 4, 4], [17, 0], [17, 6], [19, 6]],
[[ 2, 7], [17, 0], [ 7, 16], [34, 0]],
[[ 4, 5], [ 4, 14], [11, 14], [16, 14]],
[[ 6, 4], [ 6, 14], [11, 16], [30, 2]],
[[ 8, 4], [ 8, 13], [ 7, 22], [22, 13]],
[[10, 2], [19, 4], [28, 6], [33, 4]],
[[ 8, 4], [22, 3], [ 8, 26], [12, 28]],
[[ 3, 10], [ 3, 23], [ 4, 31], [11, 31]],
[[ 7, 7], [21, 7], [ 1, 37], [19, 26]],
[[ 5, 10], [19, 10], [15, 25], [23, 25]],
[[13, 3], [ 2, 29], [42, 1], [23, 28]],
[[17, 0], [10, 23], [10, 35], [19, 35]],
[[17, 1], [14, 21], [29, 19], [11, 46]],
[[13, 6], [14, 23], [44, 7], [59, 1]],
[[12, 7], [12, 26], [39, 14], [22, 41]],
[[ 6, 14], [ 6, 34], [46, 10], [ 2, 64]],
[[17, 4], [29, 14], [49, 10], [24, 46]],
[[ 4, 18], [13, 32], [48, 14], [42, 32]],
[[20, 4], [40, 7], [43, 22], [10, 67]],
[[19, 6], [18, 31], [34, 34], [20, 61]],
)
];
my ($b1, $b2) = $ecc_table->[$version - 1]{$level}->@*;
my $data_size = qrspec_data_size($version, $level);
my $ecc_size = qrspec_ecc_size($version, $level);
my @retval;
push @retval, {
count => $b1,
data => int($data_size / ($b1 + $b2)),
ecc => int($ecc_size / ($b1 + $b2)),
};
push @retval, {
count => $b2,
data => ($retval[0]{data} + 1),
ecc => $retval[0]{ecc},
} if $b2;
return @retval;
}
sub qrspec_width ($version) { 17 + $version * 4 }
{
state $table = [
map { $_->{ec} = _zip_hash([qw< L M Q H >], $_->{ec}); $_ } (
{ words => 26, remainder => 0, ec => [ 7, 10, 13, 17]},
{ words => 44, remainder => 7, ec => [ 10, 16, 22, 28]},
{ words => 70, remainder => 7, ec => [ 15, 26, 36, 44]},
{ words => 100, remainder => 7, ec => [ 20, 36, 52, 64]},
{ words => 134, remainder => 7, ec => [ 26, 48, 72, 88]},
{ words => 172, remainder => 7, ec => [ 36, 64, 96, 112]},
{ words => 196, remainder => 0, ec => [ 40, 72, 108, 130]},
{ words => 242, remainder => 0, ec => [ 48, 88, 132, 156]},
{ words => 292, remainder => 0, ec => [ 60, 110, 160, 192]},
{ words => 346, remainder => 0, ec => [ 72, 130, 192, 224]},
{ words => 404, remainder => 0, ec => [ 80, 150, 224, 264]},
{ words => 466, remainder => 0, ec => [ 96, 176, 260, 308]},
{ words => 532, remainder => 0, ec => [ 104, 198, 288, 352]},
{ words => 581, remainder => 3, ec => [ 120, 216, 320, 384]},
{ words => 655, remainder => 3, ec => [ 132, 240, 360, 432]},
{ words => 733, remainder => 3, ec => [ 144, 280, 408, 480]},
{ words => 815, remainder => 3, ec => [ 168, 308, 448, 532]},
{ words => 901, remainder => 3, ec => [ 180, 338, 504, 588]},
{ words => 991, remainder => 3, ec => [ 196, 364, 546, 650]},
{ words =>1085, remainder => 3, ec => [ 224, 416, 600, 700]},
{ words =>1156, remainder => 4, ec => [ 224, 442, 644, 750]},
{ words =>1258, remainder => 4, ec => [ 252, 476, 690, 816]},
{ words =>1364, remainder => 4, ec => [ 270, 504, 750, 900]},
{ words =>1474, remainder => 4, ec => [ 300, 560, 810, 960]},
{ words =>1588, remainder => 4, ec => [ 312, 588, 870, 1050]},
{ words =>1706, remainder => 4, ec => [ 336, 644, 952, 1110]},
{ words =>1828, remainder => 4, ec => [ 360, 700, 1020, 1200]},
{ words =>1921, remainder => 3, ec => [ 390, 728, 1050, 1260]},
{ words =>2051, remainder => 3, ec => [ 420, 784, 1140, 1350]},
{ words =>2185, remainder => 3, ec => [ 450, 812, 1200, 1440]},
{ words =>2323, remainder => 3, ec => [ 480, 868, 1290, 1530]},
{ words =>2465, remainder => 3, ec => [ 510, 924, 1350, 1620]},
{ words =>2611, remainder => 3, ec => [ 540, 980, 1440, 1710]},
{ words =>2761, remainder => 3, ec => [ 570, 1036, 1530, 1800]},
{ words =>2876, remainder => 0, ec => [ 570, 1064, 1590, 1890]},
{ words =>3034, remainder => 0, ec => [ 600, 1120, 1680, 1980]},
{ words =>3196, remainder => 0, ec => [ 630, 1204, 1770, 2100]},
{ words =>3362, remainder => 0, ec => [ 660, 1260, 1860, 2220]},
{ words =>3532, remainder => 0, ec => [ 720, 1316, 1950, 2310]},
{ words =>3706, remainder => 0, ec => [ 750, 1372, 2040, 2430]},
)
];
sub qrspec_data_size ($version, $level) {
my $item = $table->[$version - 1];
return $item->{words} - $item->{ec}{$level};
}
sub qrspec_ecc_size ($version, $level) {
return $table->[$version - 1]{ec}{$level};
}
sub qrspec_remainder ($version) { $table->[$version - 1]{remainder} }
sub qrspec_min_version ($size, $level) {
state $arefs = {};
# first run goes through all items in the table, so this function
# is inefficient if called once per process but gets better when it
# is used multiple times per process.
my $aref = $arefs->{$level} //= do {
[ map { $_->{words} - $_->{ec}{$level} } $table->@* ]
};
# do not bother looking for a version if none is possible
return if $size > $aref->[-1];
# binary search over $aref
my ($lo, $hi) = (0, $aref->$#*);
while ($lo < $hi) {
my $mi = int(($lo + $hi) / 2);
my $misz = $aref->[$mi];
if ($misz < $size) { $lo = $mi + 1 } # move ahead
elsif ($misz == $size) { $lo = $hi = $mi } # exact match
else { $hi = $mi } # set upper limit
}
return $lo + 1;
}
}
{
state $table = {
numeric => '0001',
alphanumeric => '0010',
byte => '0100',
kanji => '1000',
eci => '0111',
structured_append => '0011',
fnc1_1 => '0101',
fnc1_2 => '1001',
terminator => '0000',
};
sub qrspec_mode_indicator ($mode) { $table->{$mode} }
}
{
state $table = {
numeric => [10, 12, 14],
alphanumeric => [ 9, 11, 13],
byte => [ 8, 16, 16],
kanji => [ 8, 10, 12],
};
sub qrspec_min_version_for ($mode, $size, $level) {
state $size_bits_for = {
numeric => sub ($s) { 10 * int($s / 3) + [0, 4, 7]->[$s % 3] },
alphanumeric => sub ($s) { 11 * int($s / 2) + 6 * ($s % 2) },
byte => sub ($s) { return 8 * $s },
kanji => sub ($s) { return 13 * $s },
};
my $min_bits = 4 + $size_bits_for->{$mode}->($size);
my $lengths = $table->{$mode};
for my $i (0 .. $lengths->$#*) {
my $n_bits = $min_bits + $lengths->[$i];
my $rem = $n_bits % 8;
my $n_words = (($n_bits - $rem) / 8) + ($rem ? 1 : 0);
my $version = qrspec_min_version($n_words, $level);
return if !defined($version);
my $j = $version <= 9 ? 0 : $version <= 26 ? 1 : 2;
return $version if $i == $j;
}
return;
}
sub qrspec_length_indicator ($mode, $version) {
my $l = $version <= 9 ? 0 : $version <= 26 ? 1 : 2;
return $table->{$mode}[$l];
}
sub qrspec_maximum_words ($mode, $version) {
my $l = $version <= 9 ? 0 : $version <= 26 ? 1 : 2;
my $bits = $table->{$mode}[$l];
my $words = (1 << $bits) - 1;
$words *= 2 if $mode eq 'kanji';
return $words;
}
}
sub qrspec_format_pattern ($level, $mask_id) {
state $formats_for = {
L => [0x77c4, 0x72f3, 0x7daa, 0x789d, 0x662f, 0x6318, 0x6c41, 0x6976],
M => [0x5412, 0x5125, 0x5e7c, 0x5b4b, 0x45f9, 0x40ce, 0x4f97, 0x4aa0],
Q => [0x355f, 0x3068, 0x3f31, 0x3a06, 0x24b4, 0x2183, 0x2eda, 0x2bed],
H => [0x1689, 0x13be, 0x1ce7, 0x19d0, 0x0762, 0x0255, 0x0d0c, 0x083b],
};
return $formats_for->{$level}[$mask_id];
}
sub qrspec_version_pattern ($version) {
state $version_pattern_for = [
0x07c94, 0x085bc, 0x09a99, 0x0a4d3, # 7-10
0x0bbf6, 0x0c762, 0x0d847, 0x0e60d, 0x0f928, # 11-15
0x10b78, 0x1145d, 0x12a17, 0x13532, 0x149a6, # 16-20
0x15683, 0x168c9, 0x177ec, 0x18ec4, 0x191e1, # 21-25
0x1afab, 0x1b08e, 0x1cc1a, 0x1d33f, 0x1ed75, # 26-30
0x1f250, 0x209d5, 0x216f0, 0x228ba, 0x2379f, # 31-35
0x24b0b, 0x2542e, 0x26a64, 0x27541, 0x28c69, # 36-40
];
return $version <= 6 ? undef : $version_pattern_for->[$version - 7];
}
sub qrspec_alignment_patterns ($version) {
state $base = [
[18 ], [22 ], [26 ], [30 ], # 2- 5
[34 ], [22, 38], [24, 42], [26, 46], [28, 50], # 6-10
[30, 54], [32, 58], [34, 62], [26, 46], [26, 48], # 11-15
[26, 50], [30, 54], [30, 56], [30, 58], [34, 62], # 16-20
[28, 50], [26, 50], [30, 54], [28, 54], [32, 58], # 21-25
[30, 58], [34, 62], [26, 50], [30, 54], [26, 52], # 26-30
[30, 56], [34, 60], [30, 58], [34, 62], [30, 54], # 31-35
[24, 50], [28, 54], [32, 58], [26, 54], [30, 58], # 35-40
];
state $cache = { 1 => [] };
my $aref = $cache->{$version} //= do {
my @offset = (6, $base->[$version - 2]->@*);
my $width = qrspec_width($version);
while ('necessary') {
my $next = 2 * $offset[-1] - $offset[-2];
last if $next + 2 >= $width;
push @offset, $next;
}
\@offset;
};
return $aref->@*;
}
sub _zip_hash ($aref1, $aref2) {
my %hash;
@hash{$aref1->@*} = $aref2->@*;
return \%hash;
}
1;