mirrors/webmin--webmin
1
0
Fork 0
Code Issues Pull Requests Actions Deployments Models Agent Notes Packages Projects Releases Wiki Activity

chore: import upstream snapshot with attribution

Browse Source
This commit is contained in:
wehub-resource-sync
2026-07-13 13:12:17 +08:00
commit cf8edb9f21
44281 changed files with 1655134 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
vendor_perl/QRCode/Encoder/Matrix.pm
+394
View File
@@ -0,0 +1,394 @@
package QRCode::Encoder::Matrix;
use v5.24;
use experimental qw< signatures >;
use List::Util qw< sum >;
use QRCode::Encoder::QRSpec qw<
qrspec_version_pattern
qrspec_format_pattern
qrspec_alignment_patterns
>;
use Exporter qw< import >;
our @EXPORT_OK = qw< add_matrix >;
# Parts liberally taken from libqrencode/qrspec.c, which is distributed
# with LGPL license
sub add_matrix ($data) {
add_base_matrix($data);
add_quiet($data);
add_finders($data);
add_format_reservations($data); # MUST: before add_timing
add_version($data);
add_timing($data);
add_alignments($data);
add_codewords($data);
add_mask($data);
return $data;
}
sub stringify_matrix ($data) {
my @chunks;
my $matrix = $data->{matrix};
for my $row ($matrix->@*) {
push @chunks, join '', map { chr($_) } $row->@*;
}
return join "\n", @chunks;
}
sub stringify_matrix_2 ($data) {
my @chunks;
my $matrix = $data->{matrix};
for my $row ($matrix->@*) {
push @chunks, join '', map { ($_ & 0x1) ? '#' : ' ' } $row->@*;
}
return join "\n", @chunks;
}
sub add_base_matrix ($data) {
my $side = $data->{side_size} = 17 + 4 * $data->{version};
my $eside = $data->{eside_size} = $side + 8;
$data->{matrix} = [ map { [ ( 0x38 ) x $eside ] } 1 .. $eside ];
return $data;
}
sub add_finders ($data) {
my $eside_size = $data->{eside_size};
add_finder($data, 4 - 1, 4 - 1);
add_finder($data, 4 - 1, $eside_size - 8 - 4);
add_finder($data, $eside_size - 8 - 4, 4 - 1);
return $data;
}
sub add_quiet ($data) {
my $es = $data->{eside_size};
my $matrix = $data->{matrix};
for my $i (0 .. 3) {
for my $j (0 .. $es - 1) {
$matrix->[$i][$j] =
$matrix->[$es - 1 - $i][$j] =
$matrix->[$j][$i] =
$matrix->[$j][$es - 1 - $i] = 0x30;
}
}
return $data;
}
sub add_finder ($data, $x, $y) {
state $shape = [
[ 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30 ],
[ 0x30, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x30 ],
[ 0x30, 0x31, 0x30, 0x30, 0x30, 0x30, 0x30, 0x31, 0x30 ],
[ 0x30, 0x31, 0x30, 0x31, 0x31, 0x31, 0x30, 0x31, 0x30 ],
[ 0x30, 0x31, 0x30, 0x31, 0x31, 0x31, 0x30, 0x31, 0x30 ],
[ 0x30, 0x31, 0x30, 0x31, 0x31, 0x31, 0x30, 0x31, 0x30 ],
[ 0x30, 0x31, 0x30, 0x30, 0x30, 0x30, 0x30, 0x31, 0x30 ],
[ 0x30, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x30 ],
[ 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30 ],
];
my $matrix = $data->{matrix};
for my $yoff (0 .. 8) {
my $Y = $y + $yoff;
for my $xoff (0 .. 8) {
my $X = $x + $xoff;
$matrix->[$Y][$X] = $shape->[$yoff][$xoff];
}
}
return $data;
}
sub add_format_reservations ($data) {
my $matrix = $data->{matrix};
my $es = $data->{eside_size};
for my $i (0 .. 7) {
$matrix->[12][$i + 4] =
$matrix->[12][$i + $es - 4 - 8] =
$matrix->[$i + $es - 4 - 8][12] =
$matrix->[$i + 4][12] = 0x32;
}
$matrix->[12][12] = 0x32;
$matrix->[$es - 4 - 8][12] = 0x31;
return $data;
}
sub add_version_reservations ($data) {
return $data->{version} <= 6;
my $matrix = $data->{matrix};
my $ecstart = $data->{eside_size} - 4 - 7 - 4;
for my $i (4 .. 9) {
for my $j ($ecstart .. ($ecstart + 2)) {
$matrix->[$i][$j] = $matrix->[$j][$i] = 0x32;
}
}
return $data;
}
sub add_timing ($data) {
my $matrix = $data->{matrix};
my $es = $data->{eside_size};
for my $i (12 .. ($es - 4 - 8 - 1)) {
$matrix->[$i][10] = $matrix->[10][$i] = 0x35 ^ ($i & 1);
}
return $data;
}
sub try_add_alignment_pattern ($data, $x, $y) {
state $shape = [
[ 0x31, 0x31, 0x31, 0x31, 0x31 ],
[ 0x31, 0x30, 0x30, 0x30, 0x31 ],
[ 0x31, 0x30, 0x31, 0x30, 0x31 ],
[ 0x31, 0x30, 0x30, 0x30, 0x31 ],
[ 0x31, 0x31, 0x31, 0x31, 0x31 ],
];
$x += 4; # offset by quiet zone
$y += 4; # offset by quiet zone
my $matrix = $data->{matrix};
return if $matrix->[$y][$x] < 0x34
|| $matrix->[$y][$x + 4] < 0x34
|| $matrix->[$y + 4][$x] < 0x34;
for my $i (0 .. 4) {
for my $j (0 .. 4) {
$matrix->[$y + $i][$x + $j] = $shape->[$i][$j];
}
}
}
sub add_alignments ($data) {
my @offset = qrspec_alignment_patterns($data->{version});
for my $y_center (@offset) {
for my $x_center (@offset) {
try_add_alignment_pattern($data, $x_center - 2, $y_center - 2);
}
}
return $data;
}
sub bits_iterator ($data) {
my $n_expanded = length($data->{expanded});
my $rem = $data->{remainder};
my $i = 0;
my @queue;
return sub {
if (! @queue) {
if ($i < $n_expanded) {
push @queue, split m{}mxs, unpack 'B*', substr($data->{expanded}, $i++, 1);
}
else {
push @queue, ('0') x $rem;
$rem = 0;
}
}
return shift(@queue);
};
}
sub add_codewords ($data) {
my $it = bits_iterator($data);
my $matrix = $data->{matrix};
my $side_size = $data->{side_size};
# start from a fake position that would be the last bit of a
# hypothetical "-1" codeword
my $x = $side_size - 2;
my $y = $side_size;
my $left = 1;
my $d = -1; # direction
while (defined(my $bit = $it->())) {
while ('necessary') {
if ($x % 2 == $left) {
++$x;
$y += $d;
}
else {
--$x;
}
if ($d < 0 && $y < 0) { # reset condition
$x -= 2;
$y = 0;
$d = 1;
}
elsif ($d > 0 && $y >= $side_size) { # other reset condition
$x -= 2;
$y = $side_size - 1;
$d = -1;
}
if ($x == 6) { # left timing column, skip a column entirely
$x = 5;
$left = 0;
}
last if $matrix->[$y + 4][$x + 4] > 0x37; # found suitable position
}
$matrix->[$y + 4][$x + 4] = $bit ? 0x37 : 0x36;
}
return $data;
}
sub evaluate_matrix ($matrix) {
return 0
+ evaluate_matrix_adjacents_and_11311($matrix)
+ evaluate_matrix_blocks($matrix)
+ evaluate_matrix_proportion($matrix);
}
sub __row ($matrix, $i) {
my $max_idx = $matrix->[0]->$#* - 4;
join('', map { $matrix->[$i + 4][$_] & 0x01 ? 1 : 0 } 4 .. $max_idx);
}
sub __col ($matrix, $i) {
my $max_idx = $matrix->[0]->$#* - 4;
join('', map { $matrix->[$_][$i + 4] & 0x01 ? 1 : 0 } 4 .. $max_idx);
}
sub evaluate_matrix_adjacents_and_11311 ($matrix) {
my $side_size = $matrix->[0]->@* - 8;
my $penalty = 0;
my $penalty2 = 0;
for my $i (0 .. ($side_size - 1)) {
for my $seq (__row($matrix, $i), __col($matrix, $i)) {
# adjacences
my @contributions =
map { $_ - 2 }
grep { $_ >= 5 }
map { length }
split m{(0+)}mxs, $seq;
$penalty += sum(@contributions) if @contributions;
# 000011311 | 113110000
my @matches = $seq =~ m{
(
(?: (?<=0000) 1011101 ) # look behind...
| (?: 1011101 (?=0000) ) # or look ahead
)
}gmxs;
$penalty2 += 40 * scalar(@matches);
}
}
return $penalty + $penalty2;
}
sub evaluate_matrix_blocks ($matrix) {
my $side_size = $matrix->[0]->@* - 8;
my $penalty = 0;
for my $i (0 .. ($side_size - 2)) {
for my $j (0 .. ($side_size - 2)) {
my $count = 0;
for my $offset ([0, 0], [0, 1], [1, 0], [1, 1]) {
my ($oi, $oj) = $offset->@*;
$count++ if $matrix->[$i + $oi + 4][$j + $oj + 4] & 1;
}
$penalty += 3 if ($count == 0) || ($count == 4);
}
}
return $penalty;
}
sub evaluate_matrix_proportion ($matrix) {
my $count = sum( map { map { $_ & 0x1 ? 1 : 0 } $_->@* } $matrix->@* );
my $side_size = $matrix->[0]->@* - 8;
my $total = $side_size * $side_size;
my $percentage = 100 * $count / $total;
my $deviation = abs($percentage - 50);
my $penalty = 10 * int($deviation / 5);
return $penalty;
}
sub masked_matrix ($data, $mask_id) {
state $mask_for = {
0 => sub ($i, $j) { (($i + $j) % 2) == 0 },
1 => sub ($i, $j) { ($i % 2) == 0 },
2 => sub ($i, $j) { ($j % 3) == 0 },
3 => sub ($i, $j) { (($i + $j) % 3) == 0 },
4 => sub ($i, $j) { ((int($i / 2) + int($j / 3)) % 2) == 0 },
5 => sub ($i, $j) { ((($i * $j) % 2) + (($i * $j) % 3)) == 0 },
6 => sub ($i, $j) { (((($i * $j) % 2) + (($i * $j) % 3)) % 2) == 0 },
7 => sub ($i, $j) { (((($i + $j) % 2) + (($i * $j) % 3)) % 2) == 0 },
};
my $matrix = $data->{matrix};
my @masked;
my $eside_size = $data->{eside_size};
my $mask = $mask_for->{$mask_id};
for my $i (0 .. ($eside_size - 1)) {
for my $j (0 .. ($eside_size - 1)) {
if (($matrix->[$i][$j] >= 0x36) && $mask->($i - 4, $j - 4)) {
$masked[$i][$j] = $matrix->[$i][$j] ^ 0x01;
}
else {
$masked[$i][$j] = $matrix->[$i][$j];
}
}
}
return \@masked;
}
sub add_mask ($data) {
my ($best_mask_id, $best_matrix, $best_penalty);
$data->{masked} = \my @masked;
for my $mask_id (0 .. 7) {
my $matrix = masked_matrix($data, $mask_id);
add_format($matrix, $data->{level}, $mask_id);
push @masked, $matrix;
my $penalty = evaluate_matrix($matrix);
($best_mask_id, $best_matrix, $best_penalty) = ($mask_id, $matrix, $penalty)
if (! $best_matrix) || $penalty < $best_penalty;
}
$data->{original_matrix} = delete($data->{matrix});
$data->{matrix} = $best_matrix;
$data->{mask_id} = $best_mask_id;
return $data;
}
sub add_format ($matrix, $level, $mask_id) {
my $fmt = qrspec_format_pattern($level, $mask_id);
my $es = $matrix->[0]->@*;
# 1st copy
my $format = $fmt;
for my $i (0 .. 7) {
$matrix->[12][$es - 1 - 4 - $i] = $format & 0x01 ? 0x31 : 0x30;
$format >>= 1;
}
for my $i (8 .. 14) {
$matrix->[$es - 1 - 4 - 14 + $i][12] = $format & 0x01 ? 0x31 : 0x30;
$format >>= 1;
}
# 2nd copy
$format = $fmt;
for my $i (0 .. 5) {
$matrix->[4 + $i][12] = $format & 0x01 ? 0x31 : 0x30;
$format >>= 1;
}
for my $i (6, 7) {
$matrix->[4 + 1 + $i][12] = $format & 0x01 ? 0x31 : 0x30;
$format >>= 1;
}
# 8
$matrix->[4 + 1 + 7][11] = $format & 0x01 ? 0x31 : 0x30;
$format >>= 1;
for my $i (9 .. 14) {
$matrix->[4 + 1 + 7][9 + 9 - $i] = $format & 0x01 ? 0x31 : 0x30;
$format >>= 1;
}
return $matrix;
}
sub add_version ($data) {
my $vp = qrspec_version_pattern($data->{version}) // return;
my $matrix = $data->{matrix};
my $ecstart = $data->{eside_size} - 4 - 7 - 4;
for my $i (4 .. 9) {
for my $j ($ecstart .. ($ecstart + 2)) {
$matrix->[$i][$j] = $matrix->[$j][$i] = 0x30 ^ ($vp & 1);
$vp >>= 1;
}
}
return $data;
}
1;
vendor_perl/QRCode/Encoder/QRSpec.pm
+292
View File
@@ -0,0 +1,292 @@
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;