+sub pack_Ql {
+ my $num = shift;
+ require Config;
+ if ($Config::Config{ivsize} < 8) {
+ if (blessed $num && $num->can('as_hex')) {
+ return "\xff\xff\xff\xff\xff\xff\xff\xff" if Math::BigInt->new('18446744073709551615') <= $num;
+ return "\x00\x00\x00\x00\x00\x00\x00\x80" if $num <= Math::BigInt->new('-9223372036854775808');
+ my $neg;
+ if ($num < 0) {
+ $neg = 1;
+ $num = -$num;
+ }
+ my $hex = $num->as_hex;
+ $hex =~ s/^0x/000000000000000/;
+ my $bytes = reverse pack('H16', substr($hex, -16));
+ $bytes .= "\0" x (8 - length $bytes) if length $bytes < 8;
+ if ($neg) {
+ # two's compliment
+ $bytes = join('', map { chr(~ord($_) & 0xff) } split(//, $bytes));
+ substr($bytes, 0, 1, chr(ord(substr($bytes, 0, 1)) + 1));
+ }
+ return $bytes;
+ }
+ else {
+ my $pad = $num < 0 ? "\xff" : "\0";
+ return pack('L<', $num) . ($pad x 4);
+ };
+ }
+ return pack('Q<', $num);
+}
+
+=func pack_ql
+
+ $bytes = pack_ql($int);
+
+Like C<pack('qE<lt>', $int)>, but also works on 32-bit perls.
+
+=cut
+
+sub pack_ql { goto &pack_Ql }
+
+=func unpack_Ql
+
+ $int = unpack_Ql($bytes);
+
+Like C<unpack('QE<lt>', $bytes)>, but also works on 32-bit perls.
+
+=cut
+
+sub unpack_Ql {
+ my $bytes = shift;
+ require Config;
+ if ($Config::Config{ivsize} < 8) {
+ require Math::BigInt;
+ return Math::BigInt->new('0x' . unpack('H*', scalar reverse $bytes));
+ }
+ return unpack('Q<', $bytes);
+}
+
+=func unpack_ql
+
+ $int = unpack_ql($bytes);
+
+Like C<unpack('qE<lt>', $bytes)>, but also works on 32-bit perls.
+
+=cut
+
+sub unpack_ql {
+ my $bytes = shift;
+ require Config;
+ if ($Config::Config{ivsize} < 8) {
+ require Math::BigInt;
+ if (ord(substr($bytes, -1, 1)) & 128) {
+ return Math::BigInt->new('-9223372036854775808') if $bytes eq "\x00\x00\x00\x00\x00\x00\x00\x80";
+ # two's compliment
+ substr($bytes, 0, 1, chr(ord(substr($bytes, 0, 1)) - 1));
+ $bytes = join('', map { chr(~ord($_) & 0xff) } split(//, $bytes));
+ return -Math::BigInt->new('0x' . unpack('H*', scalar reverse $bytes));
+ }
+ else {
+ return Math::BigInt->new('0x' . unpack('H*', scalar reverse $bytes));
+ }
+ }
+ return unpack('q<', $bytes);
+}
projects / chaz / p5-File-KDBX / blobdiff