# pack('B',$x), pack('C',$x) のテスト
use strict;
use warnings;
use utf8;
use Encode;
use YAML::Syck;
$YAML::Syck::ImplicitUnicode = 1;
$YAML::Syck::ImplicitTyping = 1;
$YAML::Syck::SortKeys = 1;
my $charsetConsole = 'CP932';
#my $charsetConsole = 'UTF-8';
my $charsetFile = 'UTF-8';
my @in = qw(
0 1 10 100 1000 10000
01 001 0001 00001
2 3 4 5 02 03 04 05
256 512 513
);
my @result = ();
foreach my $in ( @in ){
my $pb = pack( 'B4', $in );
my $upb = unpack( 'B4', $pb );
my $pc = pack( 'C*', Int2Array( $in ) );
my $upc = [ unpack( 'C*', $pc ) ];
push( @result, {
_in => $in,
bit_pack => $pb,
bit_unpack => $upb,
char_pack => $pc,
char_unpack => $upc,
});
}
print "Perl version: $]\n";
print join( "\t", qw( _in bit_pack bit_unpack char_pack char_unpack ) ) . "\n";
my $result = Dump( \@result );
{
no warnings 'uninitialized';
$result =~ s{
^-\s*\n
\s+[^:]+:\s+(.*)\n
\s+[^:]+:\s+(.*)\n
\s+[^:]+:\s+(.*)\n
\s+[^:]+:\s+(.*)\n
\s+[^:]+:\s*\n
\s+-\s+([^\s]+)\n
(?:\s+-\s+([^\s]+)\n)?
}{
$1\t$2\t$3\t$4\t$5,$6\n
}gmx;
}
$result =~ s/^\s+//gmx;
print $result;
exit;
sub Int2Array
{
my $arg = shift || 0;
my @ret = ();
if ( !!$arg ){
while( !!$arg ){
my $m = $arg & 0xff;
unshift( @ret, $m );
$arg >>= 8;
}
} else {
@ret = ( 0 );
}
return @ret;
}
# EOF
Perl version: 5.014002
_in bit_pack bit_unpack char_pack char_unpack
---
0 "\0" '0000' "\0" 0,
1 "\x80" 1000 "\x01" 1,
10 "\x80" 1000 "\n" 10,
100 "\x80" 1000 d 100,
1000 "\x80" 1000 "\x03\xE8" 3,232
10000 "\x80" 1000 "'\x10" 39,16
'01' "@" '0100' "\x01" 1,
'001' " " '0010' "\x01" 1,
'0001' "\x10" '0001' "\x01" 1,
'00001' "\0" '0000' "\x01" 1,
2 "\0" '0000' "\x02" 2,
3 "\x80" 1000 "\x03" 3,
4 "\0" '0000' "\x04" 4,
5 "\x80" 1000 "\x05" 5,
'02' "\0" '0000' "\x02" 2,
'03' "@" '0100' "\x03" 3,
'04' "\0" '0000' "\x04" 4,
'05' "@" '0100' "\x05" 5,
256 "@" '0100' "\x01\0" 1,0
512 "\xC0" 1100 "\x02\0" 2,0
513 "\xE0" 1110 "\x02\x01" 2,1
Perl/MySQL-BIT