Math-Base-Convert-0.11/0000755000000000000000000000000012612261756013320 5ustar rootrootMath-Base-Convert-0.11/t/0000755000000000000000000000000012612261756013563 5ustar rootrootMath-Base-Convert-0.11/t/isnotp2.t0000644000000000000000000000162512064663635015355 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..63\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert; $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; my $bc = new Math::Base::Convert; sub ok { print "ok $test\n"; ++$test; } # test 2 - 3 foreach(0,1) { print "is power of 2 - $_\nnot " if $bc->isnotp2($_); &ok; } # test 4 - 63 foreach(2..31) { my $n = 2 ** $_; print "is power of 2 - $n\nnot " if $bc->isnotp2($n); &ok; $n++; print "is NOT power of 2 - $n\nnot " unless $bc->isnotp2($n); &ok; } Math-Base-Convert-0.11/t/vet.t0000644000000000000000000000506612064663635014560 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..34\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert; $loaded = 1; print "ok 1\n"; ######################### End of black magic. sub ok { print "ok $test\n"; ++$test; } $test = 2; my $class = 'Math::Base::Convert'; *vet = \&Math::Base::Convert::vet; # check vet and _want ######### defaults # test 2 check that proper keys are returned my $bc = vet($class); my $keys = join ' ', sort keys %$bc; my $exp = 'fbase fhsh from prefix tbase to'; print "got: $keys\nexp: $exp\nnot " unless $keys eq $exp; &ok; # test 3 check 'to' assignment ref($bc->{to}) =~ /_bs\:\:(.+)$/g; my $got = $1; print "expected to 'HEX', got '$got'\nnot " unless $got eq 'HEX'; &ok; # test 4 check 'from' assignment ref($bc->{from}) =~ /_bs\:\:(.+)$/; $got = $1; print "expected from 'dec', got '$got'\nnot " unless $got eq 'dec'; &ok; # test 5 check dec length print "got: $bc->{fbase},exp: 10\nnot " unless $bc->{fbase} == 10; &ok; # test 6 check hex length print "got: $bc->{tbase},exp: 16\nnot " unless $bc->{tbase} == 16; &ok; ########## from 'm64' # test 7 $bc = vet($class,'m64'); ref($bc->{from}) =~ /_bs\:\:(.+)$/g; $got = $1; print "expected from 'm64', got '$got'\nnot " unless $got eq 'm64'; &ok; # test 8 check base length print "got: $bc->{fbase},exp: 64\nnot " unless $bc->{fbase} == 64; &ok; # test 9 check 'from' assignment ref($bc->{to}) =~ /_bs\:\:(.+)$/; $got = $1; print "expected to 'HEX', got '$got'\nnot " unless $got eq 'HEX'; &ok; # test 10 check hex length print "got: $bc->{fbase},exp: 64\nnot " unless $bc->{fbase} == 64; &ok; ########## from 'hex' # test 11 $bc = vet($class,'heX','m64'); ref($bc->{from}) =~ /_bs\:\:(.+)$/; $got = $1; print "expected from 'heX', got '$got'\nnot " unless $got eq 'heX'; &ok; # test 12 check hex length print "got: $bc->{fbase},exp: 16\nnot " unless $bc->{fbase} == 16; &ok; # test 13 - 34 check 'from' hash my @ary = ('0'..'9','A'..'F'); foreach(0..$#ary) { my $char = $ary[$_]; print "got: $bc->{fhsh}->{$char}, exp: $_\nnot " unless $bc->{fhsh}->{$char} == $_; &ok; if ($char =~ /\D/) { # if a digit $char = lc $char; print "got: $bc->{fhsh}->{$char}, exp: $_[$_]\nnot " unless $bc->{fhsh}->{$char} == $_; &ok; } } Math-Base-Convert-0.11/t/overload.t0000644000000000000000000001002312073136541015551 0ustar rootrootuse diagnostics; BEGIN { $| = 1; print "1..23\n"; } END {print "not ok 1\n" unless $loaded;} $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } sub skipit { my($skipcount,$reason) = @_; $skipcount = 1 unless $skipcount; $reason = $reason ? ":\t$reason" : ''; foreach (1..$skipcount) { print "ok $test # skipped$reason\n"; ++$test; } } use strict; #use diagnostics; use Math::Base::Convert qw(oct hex); require './recurse2txt'; my $bc = new Math::Base::Convert(); my $bi = eval { # try stripped bigint $bc->newb10(8); }; my $benchmark = exists $ENV{BENCHMARK} && $ENV{BENCHMARK} > 0 && eval { require Benchmark; }; unless ($bi || $benchmark) { # else enabled and real BigInt $bi = eval { require Math::BigInt; new Math::BigInt(8); }; } #$bi = new Math::BigInt(8) if $bi; # test 2 if ($bi) { $bi += 2; print "got: $bi, exp: 10\nnot " unless $bi == 10; &ok; } else { skipit(1,'no BigInt'); } # hex thinks any string it gets is hex # with any arguments, return hex value # hex or octal called with arguments or with a BI pointer # should alway use CORE::xxx. It will return a ref pointer otherwise # test 3 my $rv = hex 10; $rv = ref($rv) if ref $rv; print "got: $rv, exp: 'a'\nnot " unless $rv eq '16'; &ok; # test 4 $rv = hex(10); $rv = ref($rv) if ref $rv; print "got: $rv, exp: '16'\nnot " unless $rv eq '16'; &ok; # test 5 if ($bi) { (my $biv = "$bi") =~ s/\+//; # strip objectionable + sign $rv = hex $biv; $rv = ref($rv) if ref $rv; print "got: $rv, exp: '16'\nnot " unless $rv eq '16'; &ok; # test 6 $rv = hex($biv); $rv = ref($rv) if ref $rv; print "got: $rv, exp: '16'\nnot " unless $rv eq '16'; &ok; unless (ref($bi) =~ /Math\:\:BigInt/) { # test 7 $rv = $bi->hex; $rv = ref($rv) if ref $rv; print "got: $rv, exp: '16'\nnot " unless $rv eq '16'; &ok; # test 8 $rv = $bi->hex; $rv = ref($rv) if ref $rv; print "got: $rv, exp: '16'\nnot " unless $rv eq '16'; &ok; } else { skipit(2,'removed'); } } else { skipit(4,'no BigInt'); } # ============= check for proper detection of internal hex function ========= # test 9 $rv = hex; print "got: $rv, exp: ref\nnot " unless ref $rv; &ok; # test 10 check that we got an array pointer for hex my $exp = q|16 = [0,1,2,3,4,5,6,7,8,9,'a','b','c','d','e','f',]; |; my $got = Dumper($rv); print "got: $got\nexp: $exp\nnot " unless $got eq $exp; &ok; # test 11 $rv = &hex; print "got: $rv, exp: ref\nnot " unless ref $rv; &ok; # test 12 $rv = $bc->hex; print "got: $rv, exp: ref\nnot " unless ref $rv; &ok; # test 13 $rv = oct 12; $rv = ref($rv) if ref $rv; print "got: $rv, exp: 'a'\nnot " unless $rv eq '10'; &ok; # test 14 $rv = oct(12); $rv = ref($rv) if ref $rv; print "got: $rv, exp: '10'\nnot " unless $rv eq '10'; &ok; if ($bi) { # test 15 $bi += 3; print "got: $bi, exp: 10\nnot " unless $bi == 13; &ok; # test 16 (my $biv = "$bi") =~ s/\+//; # strip + sign $rv = oct $biv; $rv = ref($rv) if ref $rv; print "got: $rv, exp: '11'\nnot " unless $rv eq '11'; &ok; # test 17 $rv = oct($biv); $rv = ref($rv) if ref $rv; print "got: $rv, exp: '11'\nnot " unless $rv eq '11'; &ok; unless (ref($bi) =~ /Math\:\:BigInt/) { # test 18 $rv = $bi->oct; $rv = ref($rv) if ref $rv; print "got: $rv, exp: '11'\nnot " unless $rv eq '11'; &ok; # test 19 $rv = $bi->oct; $rv = ref($rv) if ref $rv; print "got: $rv, exp: '11'\nnot " unless $rv eq '11'; &ok; } else { skipit(2,'removed'); } } else { skipit(5,'no BigInt'); } # ============= check for proper detection of internal oct function ========= # test 20 $rv = oct; print "got: $rv, exp: ref\nnot " unless ref $rv; &ok; # test 21 check that we got an array pointer for oct $exp = q|8 = [0,1,2,3,4,5,6,7,]; |; $got = Dumper($rv); print "got: $got\nexp: $exp\nnot " unless $got eq $exp; &ok; # test 22 $rv = &oct; print "got: $rv, exp: ref\nnot " unless ref $rv; &ok; # test 23 $rv = $bc->oct; print "got: $rv, exp: ref\nnot " unless ref $rv; &ok; Math-Base-Convert-0.11/t/basemap.t0000644000000000000000000000473112064663635015370 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..113\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert qw(oct basemap); $loaded = 1; print "ok 1\n"; ######################### End of black magic. sub ok { print "ok $test\n"; ++$test; } $test = 2; sub equal { my($a,$b) = @_; if ($a.$b =~ /\D/) { return $a eq $b; } else { return $a == $b; } } # test 2 user array returned my @userary = reverse (0..9); my $hsh = basemap(\@userary); my $exp = 'HASH'; # check what returned print "got: '". ref $hsh ."', exp: '$exp'\nnot " unless ref $hsh eq $exp; &ok; # test 3 size my @keys = sort keys %$hsh; my $len = @keys; print "length not 10, got: $len\nnot " unless $len == 10; &ok; # test 4 - 13 check for correct map, sum of key + val equal 9 while (my ($key,$val) = each %$hsh) { print "mismatched key/val pair '$key, $val'\nnot " unless $key + $val == 9; &ok; } # test 14 check hex, which is special $hsh = basemap(16); # check what returned print "got: '". ref $hsh ."', exp: '$exp'\nnot " unless ref $hsh eq $exp; &ok; # test 15 size, 22 = 16 + 6 extra digits @keys = sort keys %$hsh; $len = @keys; print "length not 22, got: $len\nnot " unless $len == 22; &ok; # test 16 - 59 content my @hex = qw( 0 1 2 3 4 5 6 7 8 9 A B C D E F a b c d e f); foreach(0..$#hex) { print "key mismatch got: $keys[$_], exp: $hex[$_]\nnot " unless equal($keys[$_],$hex[$_]); &ok; my $val = $keys[$_] =~ /[a-f]/ ? $_ -6 : $_; print "index value mismatch got: $hsh->{$keys[$_]}, exp: $val\nnot " unless $hsh->{$keys[$_]} == $val; &ok; } # test 60 - 113 check array specifier variants foreach(8,oct,'oct') { $hsh = basemap($_); # check what returned print "got: '". ref $hsh ."', exp: '$exp'\nnot " unless ref $hsh eq $exp; &ok; # size @keys = sort keys %$hsh; $len = @keys; print "octal hash length not 8, got: $len\nnot " unless $len == 8; &ok; # content; foreach(0..$#keys) { # there are eight in order print "index '$_' does not match key '$keys[$_]'\nnot " unless $_ == $keys[$_]; &ok; print "index '$_' does not match value '$hsh->{$keys[$_]}'\nnot " unless $_ == $hsh->{$keys[$_]}; &ok; } } Math-Base-Convert-0.11/t/frontend.t0000644000000000000000000002251712065526665015603 0ustar rootroot BEGIN { $| = 1; print "1..139\n"; } END {print "not ok 1\n" unless $loaded;} $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } sub skipit { my($skipcount,$reason) = @_; $skipcount = 1 unless $skipcount; $reason = $reason ? ":\t$reason" : ''; foreach (1..$skipcount) { print "ok $test # skipped$reason\n"; ++$test; } } use strict; #use diagnostics; use Math::Base::Convert qw(:base); require './recurse2txt'; my $simulatenew = 0; # set to 1 for benchmarks my $benchmark = 0; # test plan; # # setup for numbers of various length for one base # benchmark conversion times for standard and shortcut # my @bas32 = ('a'..'z',3,2,6,4,1,8); my @bas128 = (@{&b85},':',' ',('.') x (128 - 87)); # dummy base's my @bas256 = (@{&b85},':',' ',('.') x (256 - 87)); my %bas128 = ( # alter 128 base so characters mapped into null upper half # are replaced with unused chars in lower half for this test 84 => 126, 82 => 123, 78 => 121, 76 => 120, 75 => 118, 74 => 117, 73 => 115, 71 => 114, 70 => 113, 69 => 112, 67 => 111, 66 => 110, 65 => 106, 64 => 104, 63 => 103, 62 => 102, 60 => 100, 59 => 96, 58 => 94, 57 => 89, 56 => 86, ); while (my($unused,$replace) = each %bas128) { my $tmp = $bas128[$replace]; $bas128[$replace] = $bas128[$unused]; $bas128[$unused] = $tmp; } my %bas256 = ( 85 => 254, 83 => 240, 82 => 222, 81 => 220, 80 => 188, 79 => 186, 78 => 154, 77 => 152, 76 => 120, 75 => 118, 74 => 86, ); while (my($unused,$replace) = each %bas256) { my $tmp = $bas256[$replace]; $bas256[$replace] = $bas256[$unused]; $bas256[$unused] = $tmp; } my @reg = ( [533], # very short [0x123456], # fits in one register [0x789abcde, 0x123456], # two registers [0xf0123456, 0x789abcde, 0x123456], # three [0x789abcde, 0xf0123456, 0x789abcde, 0x123456], # 4 [0xfedcba98, 0x789abcde, 0xf0123456, 0x789abcde, 0x123456], # 5 [0x76543210, 0xfedcba98, 0x789abcde, 0xf0123456, 0x789abcde, 0x123456] # 6 ); sub bas32 { \@bas32 } sub bas128 { \@bas128 } sub bas256 { \@bas256 } # only test powers of two (2) my @bases = ( \@{&bin}, \@{&dna}, \@{&oct}, \@{&hex}, \@{&bas32}, \@{&b64}, \@{&bas128}, \@{&bas256} ); my @bnams = qw( bin dna oct hex bas32 b64 bas128 bas256 ); my %in = ( bin => [qw( 1000010101 100100011010001010110 10010001101000101011001111000100110101011110011011110 1001000110100010101100111100010011010101111001101111011110000000100100011010001010110 100100011010001010110011110001001101010111100110111101111000000010010001101000101011001111000100110101011110011011110 10010001101000101011001111000100110101011110011011110111100000001001000110100010101100111100010011010101111001101111011111110110111001011101010011000 1001000110100010101100111100010011010101111001101111011110000000100100011010001010110011110001001101010111100110111101111111011011100101110101001100001110110010101000011001000010000 )], dna => [qw( taccc catagcaccct catagcaccctcgtatctttggagcgt catagcaccctcgtatctttggagcgtggaaacatagcaccct catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgt catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgtgggtgcgatgtttcta catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgtgggtgcgatgtttctacgctcccaagatacaa )], oct => [qw( 1025 4432126 221505317046536336 11064254742325715736004432126 443212636115274675700221505317046536336 22150531704653633674011064254742325715737667135230 1106425474232571573600443212636115274675773345651416625031020 )], dec => [qw( 533 1193046 5124095576030430 22007822920628982378542166 94522879700260683065598897150409950 405972677036361916441368285914678332518873752 1743639370940744633935561489495120884528376069578043920 )], hex => [qw( 215 123456 123456789abcde 123456789abcdef0123456 123456789abcdef0123456789abcde 123456789abcdef0123456789abcdefedcba98 123456789abcdef0123456789abcdefedcba9876543210 )], b62 => [qw( 8B 50mG nt2zIAA8u 1M1s0mWC5r1P9Ay 8jNYV0IWlg3SwHNKpVtY D0aVppMuKI36nsunsAHJ36aSY 2WQLMo2pQMbq1zeL2FCZdyOFilbPFZK )], b64 => [qw( 8L 4ZHM ID5PuchpU 18qLdYQlDxm4ZHM 4ZHMU9gytl0ID5PuchpU ID5PuchpUy18qLdYQlDx.tBgO 18qLdYQlDxm4ZHMU9gytlxSkfXsL38G )], b85 => [ '6N', '1`A-', '1=-W5GUc>', '1*zQ4qheMgs|qk', '1$%ENQ_e^wm5RL(?XZo', '1x|h(^RlllR@_dM2+b$su!nC', '1tR@^OA7H9k~6zWw%G;~G$1 [qw( qv bencw erukz6jvpg1 sgrlhrgv622ybencw ci3fm1e3xtppaerukz6jvpg1 jdivtytk1n46asgrlhrgv6228nzouy bencwpcnlzxxqci3fm1e3xtpp4xf3tb2fimqq )], bas128 => [ '4L', ';$u', '9DA#)%^w', '1H{i?@lR(0;$u', 'IQL_9:-=O', 'aqhUJh!|xIQL_9: [ '2L', 'Iq=', 'Iq=?^`|', 'Iq=?^`|}Iq=', 'Iq=?^`|}Iq=?^`|', 'Iq=?^`|}Iq=?^`|:{_@', 'Iq=?^`|}Iq=?^`|:{_@>~oG', ], ); # test 2 - 8 hex create input block foreach (0..$#reg) { my $L = @{$reg[$_]}; my $h = $L * 8; (my $hex = unpack("H$h",pack("N$L", reverse @{$reg[$_]}))) =~ s/^0+//; print "got: $hex\nexp: $in{hex}->[$_]\nnot " unless $hex eq $in{hex}->[$_]; &ok; } # test 9 - 18 create input for other base's { no strict; foreach my $base (sort keys %in) { next if $base eq 'hex'; # skip, it is our template #next unless $base eq 'bas128'; #print "BASE $base\n"; my $bc = new Math::Base::Convert(hex => &{$base}); foreach (0..$#{$in{hex}}) { my $str = $bc->_cnvtst($in{hex}->[$_]); print 'got: ', $str, "\nexp: ", $in{$base}->[$_], "\nnot " unless $str eq $in{$base}->[$_]; } &ok; #last if $base eq 'bas128'; } } my $haveBI = exists $ENV{BENCHMARK} && $ENV{BENCHMARK} == 2 && eval { require Math::BigInt; }; my $ptr; my $optr; my $t3; # BigInt front end my $t4; # below as 'init' my @bc; # initialize 'bc' for each base to convert "from" to default # this will be used for all further tests # test 19 Math::BigInt equivalents if ($haveBI) { $t3 = sub { # convert base to decimal my($str,$base,$fhsh) = @{$bc[$ptr]}{qw( nstr fbase fhsh )}; my $bi = new Math::BigInt(0); for(split(//, $str)) { while(length($str)) { $bi += $fhsh->{substr($str,0,1,'')}; $bi *= $base; } } $bc[$ptr]->{BigInt} = (''. $bi / $base); }; $t4 = sub { # BigInt back end my($base,$to,$n) = @{$bc[$ptr]}{qw( tbase to BigInt )}; my $bi = Math::BigInt->new($n); my $str = ''; while(int($bi)) { $str = $to->[($bi % $base)] . $str; $bi = $bi/$base; } # return $str; unless ($benchmark) { print "got: $str\nexp: $in{hex}->[$optr]\nnot " unless $str eq $in{hex}->[$optr]; &ok; } }; } else { skipit(1,'no BigInt or benchmark 2'); } if ($haveBI) { # test that it works $ptr = 0; $optr = 3; $bc[0] = { nstr => $in{dna}->[$optr], fbase => scalar(@{&dna}), fhsh => &basemap(&dna), tbase => scalar(@{&hex}), to => &hex, }; &$t3; &$t4; } else { skipit(1,'no BigInt or benchmark 2'); } ################### creation verification complete ################## sub init { my $indx = shift; # base index foreach(0..$#reg) { # set up conversion numbers $bc[$_] = new Math::Base::Convert($bases[$indx],'m64'); # m64 unused $bc[$_]->{nstr} = $in{$bnams[$indx]}->[$_]; # each ptr with various conversion strings } } sub do_a_new { my($from,$to) = @{$_[0]}{qw( from to )}; my $bc = new Math::Base::Convert($from => $to); return; } my $t1 = sub { do_a_new($bc[$ptr]) if $simulatenew; $bc[$ptr]->useFROMbaseto32wide; unless ($benchmark) { my $got = hexDumper($bc[$ptr]->{b32str}); my $exp = hexDumper($reg[$ptr]); print "got: ${got}exp: ${exp}not " unless $got eq $exp; &ok; } }; my $t2 = sub { do_a_new($bc[$ptr]) if $simulatenew; $bc[$ptr]->useFROMbaseShortcuts; unless ($benchmark) { my $got = hexDumper($bc[$ptr]->{b32str}); my $exp = hexDumper($reg[$ptr]); print "got: ${got}exp: ${exp}not " unless $got eq $exp; &ok; } }; foreach(0..$#bnams) { init($_); # init this base $ptr = 0; foreach(0..$#reg) { # do all numbers for each base # test 20 - 131 odd &$t1; # test 21 - 132 evem &$t2; $ptr++; } } $benchmark = eval { require Benchmark; }; if ($benchmark && exists $ENV{BENCHMARK} && $ENV{BENCHMARK} == 2) { print STDERR "\n\nmake test BENCHMARK=2 t.frontend.t\n\n"; $simulatenew = 1; # closer to reality, BigInt must do this; # tests 133 - 139 benchmark bases 2,4,8,16,32,64 my $bm = { 'mbc::calcPP' => $t1, mbcshortcut => $t2 }; $bm->{math_bigint} = $t3 if $haveBI; my $bmr = {}; #$benchmark = 0; print STDERR "\t# benchmark FROM base to internal format\n"; foreach(0..$#bnams) { init($_); $ptr = $ptr = 0; print STDERR "\t\t # $bnams[$_]\n"; foreach(0..$#reg) { print STDERR "\t\t\t\t\ # ",$in{hex}->[$_], "\n"; foreach(sort keys %$bm) { if ($benchmark) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); printf STDERR ("\t# %s\t%2.3f ms\n",$_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } else { &{$bm->{$_}}; } } $ptr++ } &ok; } } else { skipit(7,'no BigInt or benchmark 2'); } Math-Base-Convert-0.11/t/useTObaseShortcuts.t0000644000000000000000000001413312065527013017554 0ustar rootroot BEGIN { $| = 1; print "1..69\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert qw(:base); $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } sub skipit { my($skipcount,$reason) = @_; $skipcount = 1 unless $skipcount; $reason = $reason ? ":\t$reason" : ''; foreach (1..$skipcount) { print "ok $test # skipped$reason\n"; ++$test; } } require './recurse2txt'; my $benchmark = 0; my @bas2 = ('x','y'); # w1 my @bas4 = ('w','x','y','z'); # w2 my @bas8 = ('a'..'d','w'..'z'); # w3 my @bas16 = @{&hex}; # w4 my @bas32 = ('a'..'z',3,2,6,4,1,8); # w5 my @bas64 = @{&m64}; # w6 # use unpopulated b85 for base 128, 256 my @bas128 = (@{&b85},':',' ',('.') x (128 - 87)); # w7 my @bas256 = (@{&b85},':',' ',('.') x (256 - 87)); # w8 my @lowbase = ( \@bas2, \@bas4, \@bas8 ); my $Lexp = q|0x4 = [0xdeadbeef,0x23456789,0xadbeef01,0xde,]; |; my $ShortConvert_number = '12345'; # test 11 - 13 generate base number for next test sequence my @exp = ( q|yyxxxxxxyyyxxy|, q|zwwwzyx|, q|daazb| ); # test 2 - 4 setup for short, low base test/benchmark my @Sbc; foreach(0..$#lowbase) { $Sbc[$_] = new Math::Base::Convert(dec =>$lowbase[$_]); my $rv = $Sbc[$_]->_cnvtst($ShortConvert_number); print "got: $rv\nexp: $exp[$_]\nnot " unless $rv eq $exp[$_]; &ok; } my @testbc = @Sbc; my $t1 = sub { foreach(0..$#lowbase) { my $rv = $testbc[$_]->use32wideTObase; unless ($benchmark) { print "R got: $rv\n exp: $exp[$_]\nnot " unless $exp[$_] eq $rv; &ok; } } }; my $t2 = sub { foreach (0..$#lowbase) { my $got = $testbc[$_]->useTObaseShortcuts; unless ($benchmark) { print "W got: $got\n exp: $exp[$_]\nnot " unless $exp[$_] eq $got; &ok; } } }; # test 5 - 7 duplicates test 2 - 4 from the standard internal register half-way-point &$t1; # test 8 - 10 check shortcut 32wide -> base &$t2; # test 11 - 13 setup for long, low base test/benchmark @exp = ( q|yyxyyyyxyxyxyyxyyxyyyyyxyyyxyyyyxxxxxxxyxxyxxxyyxyxxxyxyxyyxxyyyyxxxyxxyyyxyyyyxyxyxyyxyyxyyyyyxyyyxyyyy|, q|zxzyyyzxyzzyzyzzwwwxwywzxwxxxyxzywyxzxzyyyzxyzzyzyzz|, q|ddyxdddzdxzaaccbxaxdbzawzdyxdddzdxz| ); my $BaseConvert_number = '17642423809438080123524818517743'; my @Lbc; foreach(0..$#lowbase) { $Lbc[$_] = new Math::Base::Convert(dec =>$lowbase[$_]); my $rv = $Lbc[$_]->_cnvtst($BaseConvert_number); print "got: $rv\nexp: $exp[$_]\nnot " unless $rv eq $exp[$_]; &ok; } @testbc = @Lbc; # test 14 - 16 duplicates test 2 - 4 from the standard internal register half-way-point &$t1; # test 17 - 19 check shortcut 32wide -> base &$t2; # ================== my $commonstring = '183deadbeef2feed1baddad123468'; # # base 16 decimal is 7866934940423497751608207554524264 # LSB MSB #my $b32str = [0xad123468,0xeed1badd,0xadbeef2f,0x183de,]; my @common = ( \@bas16, \@bas32, \@bas64, \@bas128, \@bas256 ); my @starters = ( [ # base 183deadbeef2feed1baddad123468 # to decimal '7866934940423497751608207554524264', '43199659972086582067436706122106865662654367', '20185480588568783073476025771304392678392993115246268', '106731002248906537881566885134755281972276190436002074002184', '27803742051471350500322413252999924537290117412683890126949076698632' ], [ # base123468 # to decimal '1193064', '1035827103', '57828937404', '34902967048', '1108152157704' ], [ # base f2feed1baddad123468', # to decimal '71719702955621440697448', '7240412717070196058997225375', '10336381493601060622710739350556348', '3489438008472462688744320966690059911944', '914518782666265638208644233257663391844271624' ] ); my @answers = qw( 183deadbeef2feed1baddad123468 123468 f2feed1baddad123468 ); my $ai; my @bc; sub init { foreach (0..$#common) { $bc[$_] = new Math::Base::Convert(dec,$common[$_]); # do this separately to facilitate benchmark testing my $rv = $bc[$_]->_cnvtst($starters[$ai]->[$_]); unless ($benchmark) { print "got: $rv\nexp: $answers[$ai]\nnot " unless $rv eq $answers[$ai]; &ok; } } } my $t3 = sub { foreach (0..$#common) { my $got = $bc[$_]->use32wideTObase; unless ($benchmark) { print "R got: $got\n exp: $answers[$ai]\nnot " unless $answers[$ai] eq $got; &ok; } } }; my $t4 = sub { foreach (0..$#common) { $got = $bc[$_]->useTObaseShortcuts; unless ($benchmark) { print "W got: $got\n exp: $answers[$ai]\nnot " unless $answers[$ai] eq $got; &ok; } } }; # 183deadbeef2feed1baddad123468 # 123468 # f2feed1baddad123468 foreach (0..$#answers) { # x3 $ai = $_; # tests x5 20-24, 35-39, 50-54 &init; # tests x5 25-29, 40-44, 55-59 &$t3; # tests x5 30-34, 45-49, 60-64 &$t4 } $benchmark = eval { require Benchmark; }; if ($benchmark && exists $ENV{BENCHMARK} && $ENV{BENCHMARK} == 3) { print STDERR "\n\nmake test BENCHMARK=3 t/useTObaseShortcuts.t\n\n"; # tests 65 - 66 benchmark bases 2,4,8 my $bmr; my $bm = { 'b2->b8_divideTObase' => $t1, 'b2->b8-wide32->base' => $t2 }; # test 65 short @testbc = @Sbc; print STDERR "\n"; foreach(sort keys %$bm) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); printf STDERR ("\t# %s\t%2.3f ms\n",'short '. $_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } &ok; sleep 1; # test 66 long @testbc = @Lbc; print STDERR "\n"; foreach(sort keys %$bm) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); printf STDERR ("\t# %s\t%2.3f ms\n",'long '. $_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } &ok; # test 67 - 69 benchmark base's 16,32,64,128,256 $bm = { 'b16->256_divideTObase' => $t3, 'b16->256-wide32->base' => $t4 }; foreach (0..$#answers) { # x3 $ai = $_; &init; print STDERR "\n"; foreach(sort keys %$bm) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); printf STDERR ("\t# %s\t%2.3f ms\n",'benchmark '. $answers[$ai] ."\n\t# ". $_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } &ok; } } else { skipit(5,'benchmark 3'); } Math-Base-Convert-0.11/t/basefunct.t0000644000000000000000000000165112066627057015730 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..17\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert qw(:all); $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } foreach (qw(bin oct dec hex HEX b62 b64 m64 iru url rex id0 id1 xnt xid b85)) { my $ary = &{$_} || 'NOTHING'; # test for ary ref ending in subroutine name my $ref = ref $ary; $ref =~ s/ocT/oct/; # special treatment $ref =~ s/heX/hex/; print "got: $ref, exp: blessing ending in '$_'\nnot " unless $ref =~ /_bs\:\:$_$/; &ok; } Math-Base-Convert-0.11/t/benchmarkcnv.t0000644000000000000000000002276512065774501016424 0ustar rootrootBEGIN { $| = 1; print "1..157\n"; } END {print "not ok 1\n" unless $loaded;} $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } sub skipit { my($skipcount,$reason) = @_; $skipcount = 1 unless $skipcount; $reason = $reason ? ":\t$reason" : ''; foreach (1..$skipcount) { print "ok $test # skipped$reason\n"; ++$test; } } use strict; #use diagnostics; use Math::Base::Convert qw(:all); my $benchmark = 0; # test plan; # # using dec as a non-tested source/destination, # benchmark: # From all bases to dec # from dec TO all bases # my @bas32 = ('a'..'z',3,2,6,4,1,8); my @bas128 = (@{&b85},':',' ',('.') x (128 - 87)); # dummy base's my @bas256 = (@{&b85},':',' ',('.') x (256 - 87)); my %bas128 = ( # alter 128 base so characters mapped into null upper half # are replaced with unused chars in lower half for this test 84 => 126, 82 => 123, 78 => 121, 76 => 120, 75 => 118, 74 => 117, 73 => 115, 71 => 114, 70 => 113, 69 => 112, 67 => 111, 66 => 110, 65 => 106, 64 => 104, 63 => 103, 62 => 102, 60 => 100, 59 => 96, 58 => 94, 57 => 89, 56 => 86, ); while (my($unused,$replace) = each %bas128) { my $tmp = $bas128[$replace]; $bas128[$replace] = $bas128[$unused]; $bas128[$unused] = $tmp; } my %bas256 = ( 85 => 254, 83 => 240, 82 => 222, 81 => 220, 80 => 188, 79 => 186, 78 => 154, 77 => 152, 76 => 120, 75 => 118, 74 => 86, ); while (my($unused,$replace) = each %bas256) { my $tmp = $bas256[$replace]; $bas256[$replace] = $bas256[$unused]; $bas256[$unused] = $tmp; } sub bas32 { \@bas32 } sub bas128 { \@bas128 } sub bas256 { \@bas256 } # only test powers of two (2) my @bases = ( \@{&bin}, \@{&dna}, \@{&oct}, \@{&dec}, \@{&hex}, \@{&bas32}, \@{&b62}, \@{&b64}, \@{&bas128}, \@{&bas256} ); my @bnams = qw( bin dna oct dec hex bas32 b62 b64 bas128 bas256 ); my %in = ( bin => [qw( 100100011010001010110 10010001101000101011001111000100110101011110011011110 100100011010001010110011110001001101010111100110111101111000000010010001101000101011001111000100110101011110011011110 1001000110100010101100111100010011010101111001101111011110000000100100011010001010110011110001001101010111100110111101111111011011100101110101001100001110110010101000011001000010000 )], dna => [qw( catagcaccct catagcaccctcgtatctttggagcgt catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgt catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgtgggtgcgatgtttctacgctcccaagatacaa )], oct => [qw( 4432126 221505317046536336 443212636115274675700221505317046536336 1106425474232571573600443212636115274675773345651416625031020 )], dec => [qw( 1193046 5124095576030430 94522879700260683065598897150409950 1743639370940744633935561489495120884528376069578043920 )], hex => [qw( 123456 123456789abcde 123456789abcdef0123456789abcde 123456789abcdef0123456789abcdefedcba9876543210 )], b62 => [qw( 50mG nt2zIAA8u 8jNYV0IWlg3SwHNKpVtY 2WQLMo2pQMbq1zeL2FCZdyOFilbPFZK )], b64 => [qw( 4ZHM ID5PuchpU 4ZHMU9gytl0ID5PuchpU 18qLdYQlDxm4ZHMU9gytlxSkfXsL38G )], b85 => [ '1`A-', '1=-W5GUc>', '1$%ENQ_e^wm5RL(?XZo', '1tR@^OA7H9k~6zWw%G;~G$1 [qw( bencw erukz6jvpg1 ci3fm1e3xtppaerukz6jvpg1 bencwpcnlzxxqci3fm1e3xtpp4xf3tb2fimqq )], bas128 => [ ';$u', '9DA#)%^w', 'IQL_9: [ 'Iq=', 'Iq=?^`|', 'Iq=?^`|}Iq=?^`|', 'Iq=?^`|}Iq=?^`|:{_@>~oG', ], m64 => [qw( EjRW SNFZ4mrze EjRWeJq83vASNFZ4mrze BI0VniavN7wEjRWeJq83v7cuph2VDIQ )] ); my $haveBI = exists $ENV{BENCHMARK} && $ENV{BENCHMARK} == 1 && eval { require Math::BigInt; }; my $ptr; my $src; my $dest; my $t1; my $t2; my $t3; # below as 'init' my $bc; # initialize 'bc' for each base to convert # this will be used for all further tests # test 2 Math::BigInt equivalents if ($haveBI) { $t1 = sub { my($fbase,$fhsh,$tbase,$to) = @{$bc}{qw( fbase fhsh tbase to)}; my $bi = new Math::BigInt(0); my $str = $in{$src}->[$ptr]; for(split(//, $str)) { while(length($str)) { $bi += $fhsh->{substr($str,0,1,'')}; $bi *= $fbase; } } $bi = $bi / $fbase; # converted $str = ''; while(int($bi)) { $str = $to->[($bi % $tbase)] . $str; $bi = $bi/$tbase; } # return $str; unless ($benchmark) { print "got: $str\nexp: $in{$dest}->[$ptr]\nnot " unless $str eq $in{$dest}->[$ptr]; &ok; } $str; }; } else { $t1 = sub { # skipit(1) unless $benchmark; &ok; }; } $ptr = 3; $bc = new Math::Base::Convert($bases[0],$bases[$#bnams]); $src = $bnams[0]; $dest = $bnams[$#bnams]; if ($haveBI) { # test that it works &$t1; } else { skipit(1,'no BigInt or benchmark 1'); } $t2 = sub { my $str = $bc->cnv($in{$src}->[$ptr]); unless ($benchmark) { print "got: $str\nexp: $in{$dest}->[$ptr]\nnot " unless $str eq $in{$dest}->[$ptr]; &ok; } $str; }; $t3 = sub { # my $str = $bc->cnv($in{$src}->[$ptr]); # do it the slow way with function my $str = cnvabs($in{$src}->[$ptr],@{$bc}{qw(from to)}); unless ($benchmark) { print "got: $str\nexp: $in{$dest}->[$ptr]\nnot " unless $str eq $in{$dest}->[$ptr]; &ok; } $str; }; # test 3 check that method works &$t2; # test 4 check that function works &$t3; # test 5 - 76 check conversion TO decimal foreach (0..$#bnams) { next if $bnams[$_] eq 'dec' || $bnams[$_] eq 'm64'; my $i = $_; $src = $bnams[$_]; $dest = 'dec'; foreach (0..$#{$in{$dest}}) { $ptr = $_; $bc = new Math::Base::Convert($bases[$i],$dest); &$t1; &$t2; } } # test 77 - 148 check conversion FROM decimal foreach (0..$#bnams) { next if $bnams[$_] eq 'dec' || $bnams[$_] eq 'm64'; my $i = $_; $dest = $bnams[$_]; $src = 'dec'; foreach (0..$#{$in{$src}}) { $ptr = $_; $bc = new Math::Base::Convert($src,$bases[$i]); &$t1; &$t2; } } my $fln; sub formlines { my $str = shift; print STDERR $str,"\n"; if ($haveBI) { printf STDERR ("%6s%10.3fms%14.3fms%14.3fms\n",$fln,@_); } else { printf STDERR ("%6s%10.3fms%14.3fms%14s\n",$fln,@_,'missing'); } $fln = ''; } $benchmark = eval { require Benchmark; }; if ($benchmark && exists $ENV{BENCHMARK} && $ENV{BENCHMARK} == 1) { my $format = 1; my $countoff = 1; #$countoff = 0; print STDERR "\n\nmake test BENCHMARK=1 t.benchmarkcnv.t\n\n" unless $format; # tests 149 - 183 benchmark bases my $bm = { 'cnv-meth' => $t2, 'cnv_func' => $t3, }; $bm->{'math::bi'} = $t1 if $haveBI; #$count = 0; my $stderr; my $sep = '------------------------------------------------------- '; if ($format && $countoff) { print STDERR q| Benchmarks are FROM and TO decimal. The decimal test set is: |; foreach(0..$#{$in{dec}}) { print STDERR "\t",$in{dec}->[$_],"\n"; } print STDERR q| t/benchmarkcnv.t make test BENCHMARK=1 FROM base to 'dec' Math::Base::Convert using Math::BigInt method function function $bc->cnv(n) cnv(n) convert(n) |; } else { print STDERR "\n\t# benchmark various => decimal\n\n"; } foreach (0..$#bnams) { next if $bnams[$_] eq 'dec' || $bnams[$_] eq 'm64'; print STDERR $sep if $format; my $i = $_; $fln = $src = $bnams[$_]; $dest = 'dec'; foreach (0..$#{$in{$dest}}) { $ptr = $_; $bc = new Math::Base::Convert($bases[$i],$dest); print STDERR "\t\t$src # $in{$src}->[$_]\n" unless $format; my $bmr = {}; my @t; foreach(sort { $b cmp $a } keys %$bm) { if ($benchmark && $countoff) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); } else { $bm->{$_}->(); } if ($benchmark && ! $format) { printf STDERR ("\t# %s\t%2.3f ms\n",$_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } else { unshift @t, $bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5] if $countoff; } } if ($benchmark && $format && $countoff) { # $bs = $src; formlines($in{$src}->[$ptr],@t); } } } if ($format && $countoff) { print STDERR q| t/benchmarkcnv.t make test BENCHMARK=1 from 'dec' TO base Math::Base::Convert using Math::BigInt method function function $bc->cnv(n) cnv(n) convert(n) |; } else { print STDERR "\n\t# benchmark decimal => various bases\n\n"; } foreach (0..$#bnams) { next if $bnams[$_] eq 'dec' || $bnams[$_] eq 'm64'; print STDERR $sep if $format; my $i = $_; $fln = $dest = $bnams[$_]; $src = 'dec'; foreach (0..$#{$in{$src}}) { $ptr = $_; $bc = new Math::Base::Convert($src,$bases[$i]); print STDERR "\t\t$dest # $in{$dest}->[$_]\n" unless $format; my $bmr = {}; my @t; foreach(sort { $b cmp $a } keys %$bm) { if ($benchmark && $countoff) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); } else { $bm->{$_}->(); } if ($benchmark && ! $format) { printf STDERR ("\t# %s\t%2.3f ms\n",$_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } else { unshift @t, $bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5] if $countoff; } } if ($benchmark && $format && $countoff) { formlines($in{$dest}->[$ptr],@t); } } &ok; } } else { skipit(9,'no BigInt or benchmark 1'); } Math-Base-Convert-0.11/t/vetcontext.t0000644000000000000000000000305112064663635016155 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..13\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert qw(dec oct); $loaded = 1; print "ok 1\n"; ######################### End of black magic. sub ok { print "ok $test\n"; ++$test; } $test = 2; my $class = 'Math::Base::Convert'; *vet = \&Math::Base::Convert::vet; my $bc; # test 2 - 10 foreach (8, 'oct', oct) { $bc = vet($class,dec,$_); print "missing key 'tbase'\nnot " unless exists $bc->{tbase}; &ok; my $tbase = $bc->{tbase}; print "tbase should be: 8, is: $tbase\nnot " unless $tbase == 8; &ok; ref($bc->{to}) =~ /_bs\:\:(.+)$/; print "got: $1, exp: 'ocT'\nnot " unless $1 eq 'ocT'; &ok; } # check method pointers # test 11 - 13 { bless $bc,'Math::Base::Convert'; $bc = vet($class,dec,$bc->b64); print "missing key 'tbase'\nnot " unless exists $bc->{tbase}; &ok; my $tbase = $bc->{tbase}; print "tbase should be: 64, is: $tbase\nnot " unless $tbase == 64; &ok; ref($bc->{to}) =~ /_bs\:\:(.+)$/; print "got: $1, exp: 'b64'\nnot " unless $1 eq 'b64'; &ok; } # check empty array if to/from are the same __END__ # test 14 $bc = vet($class,oct,'oct'); print "'sameness' not identified\nnot " if keys %$bc; &ok; Math-Base-Convert-0.11/t/validbase.t0000644000000000000000000000500712073132767015704 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..40\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert; $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; *validbase = \&Math::Base::Convert::validbase; sub ok { print "ok $test\n"; ++$test; } sub skipit { my($skipcount,$reason) = @_; $skipcount = 1 unless $skipcount; $reason = $reason ? ":\t$reason" : ''; foreach (1..$skipcount) { print "ok $test # skipped$reason\n"; ++$test; } } # test for each valid internal base # test 2 check fail on invalid numeric base my $rv = eval { validbase(11); }; print "accepted bad base '11'\nnot " unless $@ =~ /not a valid base\: 11/; &ok; # test 3 check fail for invalid string base $rv = eval { validbase('xxx'); }; print "accepted bad base 'xxx'\nnot " unless $@ =~ /not a valid base\: xxx/; &ok; # test 4 - 8 check validity of each numeric base my %num2sub = ( 2 => 'bin', 8 => 'oct', 10 => 'dec', 16 => 'HEX', 64 => 'm64' ); foreach (sort keys %num2sub) { $rv = eval { validbase($_); }; print "failed to find base '$_'\nnot " if $@ || ref $rv !~ /_bs\:\:$num2sub{$_}$/; &ok; } # test 9 - 25 check validity of each text value foreach (qw( bin oct dec heX HEX b62 b64 m64 iru url rex id0 id1 xnt xid b85 )) { # removed ebcdic $rv = eval { validbase($_); }; print "failed to find base '$_'\nnot " if $@ || ref $rv !~ /_bs\:\:$_$/; &ok; } #skipit(1,'removed'); # removed ebcdic &ok; # test 26 check invalid reference $rv = eval { validbase({}); # invalid hash reference }; print "accepted bad hash reference as base\nnot " unless $@ =~ /not a valid base\: reference/; &ok; # test 27 check valid user array my $ua = [0..11]; $rv = eval { validbase($ua); }; print "failed to accept user base\nnot " if $@ || ref $rv !~ /_bs\:\:user$/; &ok; # test 28 check array's the same length print "in/out not the same length\nnot " unless scalar(@$ua) == scalar(@$rv); &ok; # test 29 - 40 check array's contain same values foreach(0..$#$ua) { my $exp = $$ua[$_]; my $got = $$rv[$_]; print "got: $got, exp: $exp\nnot " unless $got == $exp; &ok; } Math-Base-Convert-0.11/t/zstrings.t0000644000000000000000000000466012065423343015633 0ustar rootroot BEGIN { $| = 1; print "1..4357\n"; } END {print "not ok 1\n" unless $loaded;} $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } sub test { $test++ }; #use diagnostics; use Math::Base::Convert qw( cnv cnvpre cnvabs ); my $usr = ['Z',1]; # user defined base my @bases = (qw( bin dna DNA oct hex HEX dec b62 m64 b64 ), $usr); sub getref { return $_[0] if ref $_[0]; my $sub = 'Math::Base::Convert::'. $_[0]; no strict; &{$sub}; } sub getlen { my $ref = ref($_[0]) ? $_[0] : getref($_[0]); scalar @{$ref}; } use strict; sub getzero { my $base = shift; return ('', $base->[0]) if ref $base; return ('0b', 0) if $base eq 'bin'; # unique return ('0x', 0) if $base =~ /hex/i; # unique return ('0', 0) if $base =~ /oct/i; # unique my $ref = getref($base); return ('', $ref->[0]); # return zero digit } my $signedBase = $Math::Base::Convert::signedBase; my $useprefix; my $tcnv; sub testit { my $sign = shift; foreach my $from (@bases) { my $flab = ref($from) ? 'usr' : $from; my $flen = getlen($from); my($prefix, $in) = getzero($from); $sign = '' if $flen <= $Math::Base::Convert::signedBase; my $isign = $sign =~ /([+-])/ ? $1 : ''; $in = $isign . $prefix. $in; foreach my $to (@bases) { my $tlab = ref($to) ? 'usr' : $to; my $tlen = getlen($to); my $osign = ($sign =~ /(\-)/ && $tlen <= $Math::Base::Convert::signedBase) ? $1 : ''; my $out; ($prefix, $out) = getzero($to); my $ayprfx = $prefix; # array output prefix $prefix = '' unless $useprefix; $out = $osign . $prefix . $out; my ($gsign,$ofix,$data) = $tcnv->($in,$from,$to); my $got = $tcnv->($in,$from,$to); print "$flab -> $tlab value got: $got, exp: $out\nnot " unless $got eq $out; &ok; print "$flab -> $tlab sign got: |$gsign|, exp: |$isign|\nnot " unless $gsign eq $isign; &ok; print "$flab -> $tlab prefx got: |$ofix|, exp: |$ayprfx|\nnot " unless $ofix eq $ayprfx; &ok; my $ref = getref($to); print "$flab -> $tlab data got: |$data|, exp: |$ref->[0]|\nnot " unless $data eq $ref->[0]; &ok; } } } $useprefix = 1; $tcnv = \&cnvpre; foreach ('','-','+') { testit($_); } $useprefix = 0; $tcnv = \&cnv; foreach ('','-','+') { testit($_); } $useprefix = 0; $tcnv = \&cnvabs; foreach ('','-','+') { testit($_); } Math-Base-Convert-0.11/t/useFROMbaseto32wide.t0000644000000000000000000000313312065004530017427 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..6\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert qw(dec b62); $loaded = 1; print "ok 1\n"; ######################### End of black magic. sub ok { print "ok $test\n"; ++$test; } my $num = '999999999999999'; my $str = '4zXyLE1Gv'; my $b32str = [ '2764472319', 232830 ]; $test = 2; my $bcto = new Math::Base::Convert(dec,b62); my $bcfrom = new Math::Base::Convert(b62 =>dec); sub equal { my($a,$b) = @_; if ($a.$b =~ /\D/) { return $a eq $b; } else { return $a == $b; } } # test 2 to b63, check b2-32 conversion $bcfrom->_cnv($str); print "nstr missing\nnot " unless exists $bcfrom->{nstr} && $bcfrom->{nstr} eq $str; &ok; $bcfrom->useFROMbaseto32wide; # test 3 check for b32 conversion vector print "b32str missing\nnot " unless exists $bcfrom->{b32str} && ref $bcfrom->{b32str} eq 'ARRAY'; &ok; # test 4 - 5 check contents foreach my $i (0..$#{$b32str}) { print "b32 vector mismatch, index '$i', got: ", $bcfrom->{b32str}->[$i], " exp: ", $b32str->[$i], "\nnot " unless equal($bcfrom->{b32str}->[$i], $b32str->[$i]); &ok; } ## test 6 check base2-32 value my $rv = $bcfrom->use32wideTObase; print "from-tobase conversion error, got: $rv, exp: $num\nnot " unless $rv eq $num; &ok; Math-Base-Convert-0.11/t/backend.t0000644000000000000000000002236412065526703015344 0ustar rootroot BEGIN { $| = 1; print "1..133\n"; } END {print "not ok 1\n" unless $loaded;} $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } sub skipit { my($skipcount,$reason) = @_; $skipcount = 1 unless $skipcount; $reason = $reason ? ":\t$reason" : ''; foreach (1..$skipcount) { print "ok $test # skipped$reason\n"; ++$test; } } use strict; #use diagnostics; use Math::Base::Convert qw(:base); require './recurse2txt'; my $simulatenew = 0; # set to 1 for benchmarks my $benchmark = 0; # test plan; # # setup for numbers of various length for one base # benchmark conversion times for standard and shortcut # my @bas32 = ('a'..'z',3,2,6,4,1,8); my @bas128 = (@{&b85},':',' ',('.') x (128 - 87)); # dummy base's my @bas256 = (@{&b85},':',' ',('.') x (256 - 87)); my %bas128 = ( # alter 128 base so characters mapped into null upper half # are replaced with unused chars in lower half for this test 84 => 126, 82 => 123, 78 => 121, 76 => 120, 75 => 118, 74 => 117, 73 => 115, 71 => 114, 70 => 113, 69 => 112, 67 => 111, 66 => 110, 65 => 106, 64 => 104, 63 => 103, 62 => 102, 60 => 100, 59 => 96, 58 => 94, 57 => 89, 56 => 86, ); while (my($unused,$replace) = each %bas128) { my $tmp = $bas128[$replace]; $bas128[$replace] = $bas128[$unused]; $bas128[$unused] = $tmp; } my %bas256 = ( 85 => 254, 83 => 240, 82 => 222, 81 => 220, 80 => 188, 79 => 186, 78 => 154, 77 => 152, 76 => 120, 75 => 118, 74 => 86, ); while (my($unused,$replace) = each %bas256) { my $tmp = $bas256[$replace]; $bas256[$replace] = $bas256[$unused]; $bas256[$unused] = $tmp; } my @reg = ( [533], # very short [0x123456], # fits in one register [0x789abcde, 0x123456], # two registers [0xf0123456, 0x789abcde, 0x123456], # three [0x789abcde, 0xf0123456, 0x789abcde, 0x123456], # 4 [0xfedcba98, 0x789abcde, 0xf0123456, 0x789abcde, 0x123456], # 5 [0x76543210, 0xfedcba98, 0x789abcde, 0xf0123456, 0x789abcde, 0x123456] # 6 ); sub bas32 { \@bas32 } sub bas128 { \@bas128 } sub bas256 { \@bas256 } # only test powers of two (2) my @bases = ( \@{&bin}, \@{&dna}, \@{&oct}, \@{&hex}, \@{&bas32}, \@{&b64}, \@{&bas128}, \@{&bas256} ); my @bnams = qw( bin dna oct hex bas32 b64 bas128 bas256 ); my %in = ( bin => [qw( 1000010101 100100011010001010110 10010001101000101011001111000100110101011110011011110 1001000110100010101100111100010011010101111001101111011110000000100100011010001010110 100100011010001010110011110001001101010111100110111101111000000010010001101000101011001111000100110101011110011011110 10010001101000101011001111000100110101011110011011110111100000001001000110100010101100111100010011010101111001101111011111110110111001011101010011000 1001000110100010101100111100010011010101111001101111011110000000100100011010001010110011110001001101010111100110111101111111011011100101110101001100001110110010101000011001000010000 )], dna => [qw( taccc catagcaccct catagcaccctcgtatctttggagcgt catagcaccctcgtatctttggagcgtggaaacatagcaccct catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgt catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgtgggtgcgatgtttcta catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgtgggtgcgatgtttctacgctcccaagatacaa )], oct => [qw( 1025 4432126 221505317046536336 11064254742325715736004432126 443212636115274675700221505317046536336 22150531704653633674011064254742325715737667135230 1106425474232571573600443212636115274675773345651416625031020 )], dec => [qw( 533 1193046 5124095576030430 22007822920628982378542166 94522879700260683065598897150409950 405972677036361916441368285914678332518873752 1743639370940744633935561489495120884528376069578043920 )], hex => [qw( 215 123456 123456789abcde 123456789abcdef0123456 123456789abcdef0123456789abcde 123456789abcdef0123456789abcdefedcba98 123456789abcdef0123456789abcdefedcba9876543210 )], b62 => [qw( 8B 50mG nt2zIAA8u 1M1s0mWC5r1P9Ay 8jNYV0IWlg3SwHNKpVtY D0aVppMuKI36nsunsAHJ36aSY 2WQLMo2pQMbq1zeL2FCZdyOFilbPFZK )], b64 => [qw( 8L 4ZHM ID5PuchpU 18qLdYQlDxm4ZHM 4ZHMU9gytl0ID5PuchpU ID5PuchpUy18qLdYQlDx.tBgO 18qLdYQlDxm4ZHMU9gytlxSkfXsL38G )], b85 => [ '6N', '1`A-', '1=-W5GUc>', '1*zQ4qheMgs|qk', '1$%ENQ_e^wm5RL(?XZo', '1x|h(^RlllR@_dM2+b$su!nC', '1tR@^OA7H9k~6zWw%G;~G$1 [qw( qv bencw erukz6jvpg1 sgrlhrgv622ybencw ci3fm1e3xtppaerukz6jvpg1 jdivtytk1n46asgrlhrgv6228nzouy bencwpcnlzxxqci3fm1e3xtpp4xf3tb2fimqq )], bas128 => [ '4L', ';$u', '9DA#)%^w', '1H{i?@lR(0;$u', 'IQL_9:-=O', 'aqhUJh!|xIQL_9: [ '2L', 'Iq=', 'Iq=?^`|', 'Iq=?^`|}Iq=', 'Iq=?^`|}Iq=?^`|', 'Iq=?^`|}Iq=?^`|:{_@', 'Iq=?^`|}Iq=?^`|:{_@>~oG', ], m64 => [qw( IV EjRW SNFZ4mrze BI0VniavN7wEjRW EjRWeJq83vASNFZ4mrze SNFZ4mrze8BI0VniavN7+3LqY BI0VniavN7wEjRWeJq83v7cuph2VDIQ )] ); # test 2 - 12 create input for other base's { no strict; foreach my $base (sort keys %in) { next if $base eq 'hex'; # skip, it is our template #next unless $base eq 'bas128'; #print "BASE $base\n"; my $bc = new Math::Base::Convert(hex => &{$base}); foreach (0..$#{$in{hex}}) { my $str = $bc->_cnvtst($in{hex}->[$_]); print 'got: ', $str, "\nexp: ", $in{$base}->[$_], "\nnot " unless $str eq $in{$base}->[$_]; } &ok; #last if $base eq 'bas128'; } } my $haveBI = exists $ENV{BENCHMARK} && $ENV{BENCHMARK} == 2 && eval { require Math::BigInt; }; my $ptr; my $indx; my $t3; # BigInt front end my $t4; # below as 'init' my @bc; # initialize 'bc' for each base to convert "from" to default # this will be used for all further tests # test 13 Math::BigInt equivalents if ($haveBI) { $t3 = sub { # convert base to decimal my($str,$base,$fhsh) = @{$bc[$ptr]}{qw( nstr fbase fhsh )}; my $bi = new Math::BigInt(0); for(split(//, $str)) { while(length($str)) { $bi += $fhsh->{substr($str,0,1,'')}; $bi *= $base; } } $bc[$ptr]->{BigInt} = (''. $bi / $base); }; $t4 = sub { # BigInt back end my($base,$to,$n) = @{$bc[$ptr]}{qw( tbase to BigInt )}; my $bi = Math::BigInt->new($n); my $str = ''; while(int($bi)) { $str = $to->[($bi % $base)] . $str; $bi = $bi/$base; } # return $str; unless ($benchmark) { print "got: $str\nexp: $in{$bnams[$indx]}->[$ptr]\nnot " unless $str eq $in{$bnams[$indx]}->[$ptr]; &ok; } $str; }; } else { skipit(1,'no BigInt or benchmark 2'); } if ($haveBI) { # test that it works $ptr = 3; $indx = 3; $bc[$ptr] = { nstr => $in{m64}->[$indx], fbase => scalar(@{&m64}), fhsh => &basemap(&m64), tbase => scalar(@{&hex}), to => &hex, }; &$t3; &$t4; } else { skipit(1,'no BigInt or benchmark 2'); } ################### creation verification complete ################## sub init { foreach(0..$#reg) { # set up conversion numbers $bc[$_] = new Math::Base::Convert('m64',$bases[$indx],); @{$bc[$_]->{b32str}} = @{$reg[$_]}; #print hexDumper($bc[$_]->{b32str}); $bc[$_]->{nstr} = $in{m64}->[$_]; $ptr = $_; &$t3 if $haveBI; #print $bc[$_]->{BigInt},"\n"; } } sub do_a_new { my($from,$to) = @{$_[0]}{qw( from to )}; my $bc = new Math::Base::Convert($from => $to); return; } my $t1 = sub { do_a_new($bc[$ptr]) if $simulatenew; my $got = $bc[$ptr]->use32wideTObase; unless ($benchmark) { print "got: $got\nexp: $in{$bnams[$indx]}->[$ptr]\nnot " unless $got eq $in{$bnams[$indx]}->[$ptr]; &ok; } $got; }; my $t2 = sub { do_a_new($bc[$ptr]) if $simulatenew; my $got = $bc[$ptr]->useTObaseShortcuts; unless ($benchmark) { print "got: $got\nexp: $in{$bnams[$indx]}->[$ptr]\nnot " unless $got eq $in{$bnams[$indx]}->[$ptr]; &ok; } $got; }; foreach(0..$#bnams) { $indx = $_; init(); # init this base $ptr = 0; foreach(0..$#reg) { # do all numbers for each base # test 15 - 125 odd &$t1; # test 16 - 126 even &$t2; $ptr++; } } $benchmark = eval { require Benchmark; }; if ($benchmark && exists $ENV{BENCHMARK} && $ENV{BENCHMARK} == 2) { print STDERR "\n\nmake test BENCHMARK=2 t.backend.t\n\n"; $simulatenew = 1; # closer to reality, BigInt must do this; # tests 127 - 133 benchmark bases 2,4,8,16,32,64 my $bm = { 'mbc::calcPP' => $t1, mbcshortcut => $t2 }; $bm->{math_bigint} = $t3 if $haveBI; my $bmr = {}; #$benchmark = 0; print STDERR "\t# benchmark TO base from internal format\n"; foreach(0..$#bnams) { $indx = $_; init(); $ptr = $ptr = 0; print STDERR "\t\t # $bnams[$_]\n"; foreach(0..$#reg) { print STDERR "\t\t\t\t\ # ",$in{hex}->[$_], "\n"; foreach(sort keys %$bm) { if ($benchmark) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); printf STDERR ("\t# %s\t%2.3f ms\n",$_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } else { &{$bm->{$_}}; } } $ptr++ } &ok; } } else { skipit(7,'no BigInt or benchmark 2'); } Math-Base-Convert-0.11/t/longmultiply.t0000644000000000000000000000267012065004461016502 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..5\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert qw(dec b62); $loaded = 1; print "ok 1\n"; ######################### End of black magic. sub ok { print "ok $test\n"; ++$test; } my $num = '999999999999999'; my $str = '4zXyLE1Gv'; my $b32str = [ '2764472319', 232830 ]; $test = 2; my $bcto = new Math::Base::Convert(dec,b62); my $bcfrom = new Math::Base::Convert(b62); sub equal { my($a,$b) = @_; if ($a.$b =~ /\D/) { return $a eq $b; } else { return $a == $b; } } # test 2 to b63, check b2-32 conversion $bcfrom->_cnv($str); print "nstr missing\nnot " unless exists $bcfrom->{nstr} && $bcfrom->{nstr} eq $str; &ok; $bcfrom->useFROMbaseto32wide; # test 3 check for b32 conversion vector print "b32str missing\nnot " unless exists $bcfrom->{b32str} && ref $bcfrom->{b32str} eq 'ARRAY'; &ok; # test 4 - 5 check contents foreach my $i (0..$#{$b32str}) { print "b32 vector mismatch, index '$i', got: ", $bcfrom->{b32str}->[$i], " exp: ", $b32str->[$i], "\nnot " unless equal($bcfrom->{b32str}->[$i], $b32str->[$i]); &ok; } Math-Base-Convert-0.11/t/basemethods.t0000644000000000000000000000171612064663635016256 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..17\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert; $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } my $bc = bless {},'Math::Base::Convert'; foreach (qw(bin oct dec hex HEX b62 b64 m64 iru url rex id0 id1 xnt xid b85)) { my $ary = $bc->$_ || 'NOTHING'; # test for ary ref ending in subroutine name my $ref = ref $ary; $ref =~ s/ocT/oct/; # special treatment $ref =~ s/heX/hex/; print "got: $ref, exp: blessing ending in '$_'\nnot " unless $ref =~ /_bs\:\:$_$/; &ok; } Math-Base-Convert-0.11/t/benchmarkcalc.t0000644000000000000000000001131212065775043016524 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..70\n"; } END {print "not ok 1\n" unless $loaded;} #use diagnostics; use Math::Base::Convert qw(dec b62); $loaded = 1; print "ok 1\n"; ######################### End of black magic. my $benchmark = 0; sub ok { print "ok $test\n"; ++$test; } sub skipit { my($skipcount,$reason) = @_; $skipcount = 1 unless $skipcount; $reason = $reason ? ":\t$reason" : ''; foreach (1..$skipcount) { print "ok $test # skipped$reason\n"; ++$test; } } my @short = qw( 999999999999999 88888888888888 7777777777777 666666666666 55555555555 4444444444 333333333 22222222 1111111 121212 23232 3434 454 56 6 ); my @shortexp = qw( 4zXyLE1Gv peWcv72o 2cVN8VbP bJHboo2 YDLrRF 4QMr1O myDe5 1vf0W 4F39 vx2 62I To 7k U 6 ); my @long = qw( 10000000000000001000000000000000 1234567890123456712345678901234567 111111111111111111111111111111111111 22222222222222222222222222222222222222 3333333333333333333333333333333333333333 444444444444444444444444444444444444444444 55555555555555555555555555555555555555555555 6666666666666666666666666666666666666666666666 777777777777777777777777777777777777777777777777 88888888888888888888888888888888888888888888888888 9999999999999999999999999999999999999999999999999999 121212121212121212121212121121212121212121212121212121 23232323232323232323232323232323232323232323232323232323 3434343434343434343434343434334343434343434343434343434343 454545454545454545454545454545454545454545454545454545454545 56565656565656565656565656565655656565656565656565656565656565 6767676767676767676767676767676767676767676767676767676767676767 787878787878787878787878787878787787878787878787878787878787878787 89898989898989898989898989898989898989898989898989898989898989898989 ); my @longexp = qw( 3nLqycrSaCzgSYXTTG 6JGUpwFOWWt2Q9OAcD5 9MkhUm3ZJsNRLe45h167 vxTrLNaT8EURqlnb0TxIW 1ek09bCYloWZzfJI4EanAIR 2E8lEql96GZx4tQiMF2ZoYtm 5kUPEv6DmuG3G2arS6L1NlVcf aktZYocQbxnp7mcdWJ51twqHI6 jrd7hDyacntngvLFzQa7rymfAkx zPAsR5bPEOHi1RHAm49vIN310Y9G 1316FmjUYeyZydnWAt2xg3LZYlg9Aj cI5Uo7wTx5zfeyuQLGh0vEs9Bd5vp7 DijBjTWH0CSCLkEp7It3YXhxLv9h9E7 1vGT5fbUIYYm4fsNTNCteIMfs9JAD20w7 3e0ntjunknzy3bIy3DS0zKglcBBO5lk2jv 6trEdWTDusEf0QppURuThYQ73pntZfCWHfT cuG8H3RVZzhEGyHUe5Yl5ljTjaJ4RcpXahT9 nsCAz0upn2A8zJCpHh1MZ6O8AYiLaG7GdFPMf Hb298A1UABPtSWFP8FlWXAU4PvH5T5mSPu9AzH ); $test = 2; my $bcto = new Math::Base::Convert(dec,b62); my $bcfrom = new Math::Base::Convert(b62,dec); sub equal { my($a,$b) = @_; if ($a.$b =~ /\D/) { return $a eq $b; } else { return $a == $b; } } my $tshortfrom = sub { foreach(0..$#short) { my $bc = $bcto->_cnv($short[$_]); $bc->useFROMbaseto32wide; my $str = $bc->use32wideTObase; unless ($benchmark) { print "got: $str\nexp: $shortexp[$_]\nnot " unless equal($str, $shortexp[$_]); &ok; } } }; my $tshortto = sub { foreach(0..$#shortexp) { my $bc = $bcfrom->_cnv($shortexp[$_]); $bc->useFROMbaseto32wide; my $num = $bc->use32wideTObase; unless ($benchmark) { print "got: $num\nexp: $short[$_]\nnot " unless equal($num, $short[$_]); &ok; } } }; my $tlongfrom = sub { foreach(0..$#long) { my $bc = $bcto->_cnv($long[$_]); $bc->useFROMbaseto32wide; my $str = $bc->use32wideTObase; unless ($benchmark) { print "got: $str\nexp: $longexp[$_]\nnot " unless equal($str, $longexp[$_]); &ok; } } }; my $tlongto = sub { foreach(0..$#longexp) { my $bc = $bcfrom->_cnv($longexp[$_]); $bc->useFROMbaseto32wide; my $num = $bc->use32wideTObase; unless ($benchmark) { print "got: $num\nexp: $long[$_]\nnot " unless equal($num, $long[$_]); &ok; } } }; &$tshortfrom; # test 2 - 16 &$tshortto; # test 17 - 31 &$tlongfrom; # test 32 - 50 &$tlongto; # test 51 - 69 $benchmark = eval { require Benchmark; }; if ($benchmark && exists $ENV{BENCHMARK} && $ENV{BENCHMARK} == 3) { print STDERR "\n\nmake test BENCHMARK=3 t.benchmarkcalc.t\n\n"; my $bm = { _4long_from => $tlongfrom, _3long_to => $tlongto, _2short_from => $tshortfrom, _1short_to => $tshortto }; my $bmr = {}; print STDERR "\n"; foreach(sort keys %$bm) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); $_ =~ /([a-z]+)_+([a-z]+)/; my $title = "$1 $2"; my $len = $title =~ /short/ ? @short : @long; printf STDERR ("\t# %s\t%2.3f ms\n",$title,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5] / $len); } &ok; } else { &skipit(1,'benchmark 3'); } Math-Base-Convert-0.11/t/shiftright.t0000644000000000000000000000773112064663635016136 0ustar rootrootBEGIN { $| = 1; print "1..10\n"; } END {print "not ok 1\n" unless $loaded;} $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } use strict; #use diagnostics; use Math::Base::Convert; require './recurse2txt'; #=pod my $reg = [ 0xfffffffe, 0xffffffff, 0xfffffffc, 0xffffffff, 0xfffffff8, 0xffffffff, 0xfffffff0, 0xffffffff, 0xffffffe0, 0xffffffff, 0xffffffc0, 0xffffffff, 0xffffff80, 0xffffffff, 0xffffff00, 0xffffffff, 0xffffffff ]; my @exp = (0, # unused position # shift 1 q|0x11 = [0xffffffff,0x7fffffff,0xfffffffe,0x7fffffff,0xfffffffc,0x7fffffff,0xfffffff8,0x7fffffff,0xfffffff0,0x7fffffff,0xffffffe0,0x7fffffff,0xffffffc0,0x7fffffff,0xffffff80,0xffffffff,0x7fffffff,]; |, # shift 2 q|0x11 = [0xffffffff,0x3fffffff,0xffffffff,0x3fffffff,0xfffffffe,0x3fffffff,0xfffffffc,0x3fffffff,0xfffffff8,0x3fffffff,0xfffffff0,0x3fffffff,0xffffffe0,0x3fffffff,0xffffffc0,0xffffffff,0x3fffffff,]; |, # shift 3 q|0x11 = [0xffffffff,0x9fffffff,0xffffffff,0x1fffffff,0xffffffff,0x1fffffff,0xfffffffe,0x1fffffff,0xfffffffc,0x1fffffff,0xfffffff8,0x1fffffff,0xfffffff0,0x1fffffff,0xffffffe0,0xffffffff,0x1fffffff,]; |, # shift 4 q|0x11 = [0xffffffff,0xcfffffff,0xffffffff,0x8fffffff,0xffffffff,0xfffffff,0xffffffff,0xfffffff,0xfffffffe,0xfffffff,0xfffffffc,0xfffffff,0xfffffff8,0xfffffff,0xfffffff0,0xffffffff,0xfffffff,]; |, # shift 5 q|0x11 = [0xffffffff,0xe7ffffff,0xffffffff,0xc7ffffff,0xffffffff,0x87ffffff,0xffffffff,0x7ffffff,0xffffffff,0x7ffffff,0xfffffffe,0x7ffffff,0xfffffffc,0x7ffffff,0xfffffff8,0xffffffff,0x7ffffff,]; |, # shift 6 q|0x11 = [0xffffffff,0xf3ffffff,0xffffffff,0xe3ffffff,0xffffffff,0xc3ffffff,0xffffffff,0x83ffffff,0xffffffff,0x3ffffff,0xffffffff,0x3ffffff,0xfffffffe,0x3ffffff,0xfffffffc,0xffffffff,0x3ffffff,]; |, # shift 7 q|0x11 = [0xffffffff,0xf9ffffff,0xffffffff,0xf1ffffff,0xffffffff,0xe1ffffff,0xffffffff,0xc1ffffff,0xffffffff,0x81ffffff,0xffffffff,0x1ffffff,0xffffffff,0x1ffffff,0xfffffffe,0xffffffff,0x1ffffff,]; |, # shift 8 q|0x11 = [0xffffffff,0xfcffffff,0xffffffff,0xf8ffffff,0xffffffff,0xf0ffffff,0xffffffff,0xe0ffffff,0xffffffff,0xc0ffffff,0xffffffff,0x80ffffff,0xffffffff,0xffffff,0xffffffff,0xffffffff,0xffffff,]; | ); my $ta = bless [0], 'Math::Base::Convert'; # test 2 shift a zero register $ta->shiftright(2); (my $got = Dumper($ta)) =~ s/(\b\d+)/sprintf("0x%x",$1)/ge; my $exp = qq|0x1\t= [0x0,]; |; print "got: $got\nexp: $exp\nnot " unless $got eq $exp; &ok; # test 3 - 10 simple shift foreach (1..8) { @$ta = @$reg; $ta->shiftright($_); (my $got = Dumper($ta)) =~ s/(\b\d+)/sprintf("0x%x",$1)/ge; print "got: $got\nexp: $exp[$_]\nnot " unless $got eq $exp[$_]; &ok; } __END__ # test 11 - 18 complex shift foreach (1..8) { @$ta = @$reg; $ta->xshiftright($_); (my $got = Dumper($ta)) =~ s/(\b\d+)/sprintf("0x%x",$1)/ge; print "got: $got\nexp: $exp[$_]\nnot " unless $got eq $exp[$_]; &ok; } __END__ #=cut my $reg = [ 0xfffffffe, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff ]; my $exp; my $iter = 2; xshiftright = \&Math::Base::Convert::CalcPP::shiftright; my $t1 = sub { # foreach my $shift(1..4) { my $shift = 1; my $ep = ($iter * 32/$shift)-1; my @test = @$reg; foreach(0..$ep) { shiftright(\@test,$shift); # ($exp = Dumper(\@test)) =~ s/(\b\d+)/sprintf("0x%x",$1)/ge; # print "$_ ", $exp; } # } }; *xshiftright = \&Math::Base::Convert::CalcPP::xshiftright; my $t2 = sub { # foreach my $shift(1..4) { my $shift = 1; my $ep = ($iter * 32/$shift)-1; my @test = @$reg; foreach(0..$ep) { xshiftright(\@test,$shift); # ($exp = Dumper(\@test)) =~ s/(\b\d+)/sprintf("0x%x",$1)/ge; # print "$_ ", $exp; } # } }; &$t1; &$t2; use Benchmark qw(timethese); timethese(-3,{ new => $t1, old => $t2 },'noc'); Math-Base-Convert-0.11/t/convert.t0000644000000000000000000001140112065376166015431 0ustar rootroot BEGIN { $| = 1; print "1..45\n"; } END {print "not ok 1\n" unless $loaded;} $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } use strict; #use diagnostics; use Math::Base::Convert qw(:base); require './recurse2txt'; my @bas4 = @{&DNA}; # w2 my @bas8 = @{&oct}; # w3 my @bas16 = @{&hex}; # w4 my @bas32 = ('a'..'z',3,2,6,4,1,8); # w5 my @bas64 = @{&m64}; # w6 # use unpopulated b85 for base 128, 256 my @bas128 = (@{&b85},':',' ',('.') x (128 - 87)); # w7 my @bas256 = (@{&b85},':',' ',('.') x (256 - 87)); # w8 # test 2 check for typo's in base statements print "base wrong length", scalar(@bas256), "nnot " unless 256 == scalar(@bas256); &ok; my $word = 'DeadBeef 123456789'; my $exp = '8849146568042648639992597815658398729'; # test 3 check 128 -> 10 conversion my $b128to10 = new Math::Base::Convert(\@bas128 =>dec); my $got = $b128to10->_cnvtst($word); print "got: $got\nexp: $exp\nnot " unless $got eq $exp; &ok; # test 4 check that reverse works my $b10to128 = new Math::Base::Convert(10,\@bas128); $got = $b10to128->_cnvtst($got); print "got: $got\nexp: $exp\nnot " unless $got eq $word; &ok; # test 5 create 'finish' statement and check that it is OK my %bas128 = ( # alter 128 base so characters mapped into null upper half 2, 110, # are replaced with unused chars in lower half for this test 3, 121, 4, 89, 7, 99, 8, 98, 9, 108, 11, 92, 14, 100, 15, 112, 16, 120 ); # to generate the above array, comment this out, comment out hexDumper test, uncomment foreach (6..6) below, # uncomment __END__, and uncomment print statements in CalcPP use32wideTObase to get values for substitution # while (my($unused,$replace) = each %bas128) { my $tmp = $bas128[$replace]; $bas128[$replace] = $bas128[$unused]; $bas128[$unused] = $tmp; } my $b256to10 = new Math::Base::Convert(\@bas256 =>dec); my $f10exp = '16064749080984572013478665934710512025531948996015099423733838076951077683421663398922255188875825521313661619253019618312613497203478509352'; my $finish = ' useFROMbaseShortcuts: Math::Base::Convert tests complete'; my $fin10 = $b256to10->_cnvtst($finish); print "got: $fin10\nexp: $f10exp\nnot " unless $fin10 eq $f10exp; &ok; # test 7 - 21 check all base's my @exp = ( '1010110010101100011100000110110001010000000111100011011000110000001011000100101001001000011011000101000000111000010101100110010001101010011011100100110001110000011011100110110010101010101011000010110001001000011011100101011010101010101010100001011001001000011011000101000010101010101010100001100001100100011000100111001001010000011010100110111010101100011011100101000001101100011011100110110010101100010011000110010001100000011001100101111001010000011011100101000', 'CCCTCCCTAGTAAGCTATTAAAGGACTGACTAACCTATCCATCAAGCTATTAACGAATTGAGATAGCCAGCGATCTAGTAAGCGAGCTCCCCCCCTACCTATCAAGCGATTGCCCCCCCCAATGATCAAGCTATTACCCCCCCCAAGAAGATAGACAGTCATTAAGCCAGCGCCCTAGCGATTAAGCTAGCGAGCTCCCTATCTAGATAGAAAGAGATGGATTAAGCGATTA', '12625434066120074330601304511033050070254621523344616033466252530261103345325252413110330502525241414430471120324672543345015433466254230621403145712033450', '56563836280f1b1816252436281c2b3235372638373655561624372b55550b24362855550c32313928353756372836373656263230332f283728', 'fmvrygyua1gyycyssinridqvtenjxey6donsvkylcinzlkvkqwjbwfbkvkdbsge6sqnjxky2sqnrxgzlcmmrqgmxsqnzi', 'BWVjg2KA8bGBYlJDYoHCsyNTcmODc2VVYWJDcrVVULJDYoVVUMMjE5KDU3VjcoNjc2ViYyMDMvKDco', '1i SD*0G9mMI<68$F oQ@E7%B9:h5)(vjg:5<68&:gCPCdI%~2 R=67v4icPC6o3W2e', ' useFROMbaseShortcuts: Math::Base::Convert tests complete' ); my @base = ( &bin, \@bas4, \@bas8, \@bas16, \@bas32, \@bas64, \@bas128, \@bas256); $exp = q|0xf = [0x2f283728,0x26323033,0x36373656,0x37563728,0x31392835,0x55550c32,0xb243628,0x372b5555,0x55561624,0x26383736,0x2b323537,0x2436281c,0x1b181625,0x3836280f,0x5656,]; |; foreach (0..$#base) { # comment out above, uncomment below for base128 corrections #foreach (6..6) { my $bc10tobase = new Math::Base::Convert(dec,$base[$_]); $got = $bc10tobase->_cnvtst($fin10); print "got: $got\nexp: $exp[$_]\nnot " unless $got eq $exp[$_]; &ok; # comment out these two tests for base128 corrections $got = hexDumper($bc10tobase->{b32str}); print "got: $got\nexp: $exp\nnot " unless $got eq $exp; &ok; } #__END__ # test 22 - 45 test reversibility foreach (0..$#base) { my $bcbaseto10 = new Math::Base::Convert($base[$_] =>dec); $got = $bcbaseto10->_cnvtst($exp[$_]); print "got: $got\nexp: $f10exp\nnot " unless $got eq $f10exp; &ok; $got = hexDumper($bcbaseto10->{b32str}); print "got: $got\nexp: $exp\nnot " unless $got eq $exp; &ok; delete $bcbaseto10->{b32str}; my $rv = $bcbaseto10->useFROMbaseShortcuts; $got = hexDumper($rv); print "got: $got\nexp: $exp\nnot " unless $got eq $exp; &ok; } Math-Base-Convert-0.11/t/ascii.t0000644000000000000000000000063212066627224015040 0ustar rootrootBEGIN { $| = 1; print "1..2\n"; } END {print "not ok 1\n" unless $loaded;} $loaded = 1; print "ok 1\n"; ######################### End of black magic. use Math::Base::Convert qw( ascii ); my $exp = q| !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|.'|'.q|}~|; my $got = join '',@{&ascii}; print "got: $got\nexp: $exp\nnot " unless $got eq $exp; print "ok 2\n"; Math-Base-Convert-0.11/t/useFROMbaseShortcuts.t0000644000000000000000000001720512065526763020013 0ustar rootroot BEGIN { $| = 1; print "1..37\n"; } END {print "not ok 1\n" unless $loaded;} $loaded = 1; print "ok 1\n"; ######################### End of black magic. $test = 2; sub ok { print "ok $test\n"; ++$test; } sub skipit { my($skipcount,$reason) = @_; $skipcount = 1 unless $skipcount; $reason = $reason ? ":\t$reason" : ''; foreach (1..$skipcount) { print "ok $test # skipped$reason\n"; ++$test; } } #use diagnostics; use Math::Base::Convert qw(:base); require './recurse2txt'; my $benchmark = 0; my @bas2 = ('x','y'); # w1 my @bas4 = ('w','x','y','z'); # w2 my @bas8 = ('a'..'d','w'..'z'); # w3 my @bas16 = @{&hex}; # w4 my @bas32 = ('a'..'z',3,2,6,4,1,8); # w5 my @bas64 = @{&m64}; # w6 # use unpopulated b85 for base 128, 256 my @bas128 = (@{&b85},':',' ',('.') x (128 - 87)); # w7 my @bas256 = (@{&b85},':',' ',('.') x (256 - 87)); # w8 my @common = ( \@bas16, \@bas32, \@bas64, \@bas128, \@bas256 ); sub alwayslongconvert { my $bc = &Math::Base::Convert::_cnv; $bc->useFROMbaseto32wide; $bc->use32wideTObase; } my $BaseConvert_number = '17642423809438080123524818517743'; # test 2 generate dead beef my $exp = $BaseConvert_number; my $bc16to10 = new Math::Base::Convert(hex =>dec); my $decDEADBEEF = alwayslongconvert($bc16to10,'DEADBEEF0123456789deadbeef'); print "got: $decDEADBEEF, exp: $exp\nnot " unless $decDEADBEEF == $exp; &ok; # test 3 verify base 32 values - these are always without shortcuts $exp = q|4 = [3735928559,591751049,2914971393,222,]; |; my $got = Dumper($bc16to10->{b32str}); print "got: $got\nexp: $exp\nnot " unless $exp eq $got; &ok; # test 4 verify base 32 values from shortcut delete $bc16to10->{b32str}; $bc16to10->useFROMbaseShortcuts; $got = Dumper($bc16to10->{b32str}); print "got: $got\nexp: $exp\nnot " unless $exp eq $got; &ok; # test 5 - 7 generate base number for next test sequence my @exp = ( q|yyxyyyyxyxyxyyxyyxyyyyyxyyyxyyyyxxxxxxxyxxyxxxyyxyxxxyxyxyyxxyyyyxxxyxxyyyxyyyyxyxyxyyxyyxyyyyyxyyyxyyyy|, q|zxzyyyzxyzzyzyzzwwwxwywzxwxxxyxzywyxzxzyyyzxyzzyzyzz|, q|ddyxdddzdxzaaccbxaxdbzawzdyxdddzdxz| ); my @lowbase = ( \@bas2, \@bas4, \@bas8 ); foreach (0..$#lowbase) { my $bc = new Math::Base::Convert(dec,$lowbase[$_]); my $str = $bc->_cnvtst($BaseConvert_number); print "got: $str\nexp: $exp[$_]\nnot " unless $str eq $exp[$_]; &ok; } my $Lexp = q|0x4 = [0xdeadbeef,0x23456789,0xadbeef01,0xde,]; |; # test 8 - 10 convert back to decimal with shortcut # setup for low base benchmarks with long number my @Lbc; foreach(0..$#lowbase) { $Lbc[$_] = new Math::Base::Convert($lowbase[$_] =>dec); my $num = $Lbc[$_]->_cnvtst($exp[$_]); print "got: $num\nexp: $BaseConvert_number\nnot " unless $num eq $BaseConvert_number; &ok; } my $ShortConvert_number = '12345'; # test 11 - 13 generate base number for next test sequence @exp = ( q|yyxxxxxxyyyxxy|, q|zwwwzyx|, q|daazb| ); foreach (0..$#lowbase) { my $bc = new Math::Base::Convert(dec,$lowbase[$_]); my $str = $bc->_cnvtst($ShortConvert_number); print "got: $str\nexp: $exp[$_]\nnot " unless $str eq $exp[$_]; &ok; } # test 14 - 16 convert back to decimal with shortcut # setup for low base benchmarks with short number my @Sbc; foreach(0..$#lowbase) { $Sbc[$_] = new Math::Base::Convert($lowbase[$_] =>dec); my $num = $Sbc[$_]->_cnvtst($exp[$_]); print "got: $num\nexp: $ShortConvert_number\nnot " unless $num eq $ShortConvert_number; &ok; } my @testbc; my $testexp; my $Sexp = q|0x1 = [0x3039,]; |; my $t1 = sub { foreach(0..$#lowbase) { $testbc[$_]->useFROMbaseto32wide; unless ($benchmark) { $got = hexDumper($testbc[$_]->{b32str}); print "got: ${got}exp: $testexp\nnot " unless $testexp eq $got; &ok; } } }; my $t2 = sub { foreach (0..$#lowbase) { #print $testbc[$_]->{nstr},"\n"; delete $testbc[$_]->{b32str}; $testbc[$_]->useFROMbaseShortcuts($testbc[$_]); unless ($benchmark) { $got = hexDumper($testbc[$_]->{b32str}); print "got: ${got}exp: $testexp\nnot " unless $testexp eq $got; &ok; } } }; # test 17 - 19 base to decimal, check short b32str @testbc = @Sbc; $testexp = $Sexp; &$t1; @testbc = @Lbc; $testexp = $Lexp; # test 20 - 22 shortcut short base to decimal &$t2; # test 23 - 32 check all base 2 conversions using both alpha and numeric @exp = ( # input is 183deadbeef2feed1baddad123468 # Math::BaseConvert is 7866934940423497751608207554524264 # base 16 decimal is 7866934940423497751608207554524264 q|0x4 = [0xad123468,0xeed1badd,0xadbeef2f,0x183de,]; |, # base 32 q|0x5 = [0xfdbd779f,0xe0806300,0x17652107,0x6400c242,0x1efe8,]; |, # base 64 q|0x6 = [0x76df8ebc,0xa75d69dd,0x79e7756d,0xde79fd9f,0x775e69d6,0x35f3,]; |, # base 128 q|0x7 = [0x20610308,0xa7489c08,0x3814a913,0x412950a1,0x9d2a850a,0xd3a848,0x11,]; |, # base 256 q|0x8 = [0x3040608,0x24270102,0x25242727,0x28282701,0x28290229,0x24272528,0x8032728,0x1,]; | ); #my $commonstring = '183deadbeef2feed1baddad123468'; # $commonstring = 'daaaaamaaaaaaaaaaaa'; my $commontest; my @bc; sub init { foreach (0..$#common) { #foreach (1..1) { $bc[$_] = new Math::Base::Convert($common[$_] =>dec); # do this separately to facilitate benchmark testing $bc[$_]->_cnvtst($commontest); #print scalar(@{$common[$_]}),' ',ref($bc[$_]->{from}),' ',ref($bc[$_]->{fhsh}),' ', $bc[$_]->{fbase},"\n"; #print hexDumper($bc[$_]->{b32str}); } } # test 23 - 27 regular my $t3 = sub { foreach (0..$#common) { $bc[$_]->useFROMbaseto32wide; unless ($benchmark) { $got = hexDumper($bc[$_]->{b32str}); print "got: ${got}exp: $exp[$_]\nnot " unless $exp[$_] eq $got; &ok; #print hexDumper($bc[$_]->{b32str}); #print $bc[$#common]->{nstr},"\n"; } } }; # test 28 - 32 shortcut my $t4 = sub { foreach (0..$#common) { delete $bc[$_]->{b32str}; $bc[$_]->useFROMbaseShortcuts; unless ($benchmark) { $got = hexDumper($bc[$_]->{b32str}); print "got: ${got}exp: $exp[$_]\nnot " unless $exp[$_] eq $got; &ok; #print hexDumper($bc[$_]->{b32str}); #print $bc[$#common]->{nstr},"\n"; #print "----\n"; #last if $_ == 1; } } }; my $commonstring = '183deadbeef2feed1baddad123468'; # $commonstring = '123468'; # $commonstring = 'f2feed1baddad123468'; # $commonstring = 'daaaaamaaaaaaaaaaaa'; $commontest = $commonstring; &init; &$t3; &$t4; # test 33 - 37 run benchmarks $benchmark = eval { require Benchmark; }; if ($benchmark && exists $ENV{BENCHMARK} && $ENV{BENCHMARK} == 3) { print STDERR "\n\nmake test BENCHMARK=3 t.useFROMbaseShortcuts.t\n\n"; # test 33 - 34 bench mark base's 2,4,8 my $bm = { 'b2->b8_multiplyTo_b32' => $t1, 'b2->b8_directTObase32' => $t2 }; my $bmr; # test 33 short @testbc = @Sbc; $testexp = $Sexp; print STDERR "\n"; foreach(sort keys %$bm) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); printf STDERR ("\t# %s\t%2.3f ms\n",'short '. $_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } &ok; sleep 1; # test 34 long @testbc = @Lbc; $testexp = $Lexp; print STDERR "\n"; foreach(sort keys %$bm) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); printf STDERR ("\t# %s\t%2.3f ms\n",'long '. $_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } &ok; # test 35 - 37 benchmark base's 16,32,64,128,256 $bm = { 'b16->256_multiplyTo_b32' => $t3, 'b16->256_directTObase32' => $t4 }; foreach(qw( 183deadbeef2feed1baddad123468 123468 f2feed1baddad123468 )) { $commontest = $_; &init; my $bmr = {}; print STDERR "\n"; foreach(sort keys %$bm) { $bmr->{$_} = Benchmark::countit(3,$bm->{$_}); printf STDERR ("\t# %s\t%2.3f ms\n",'benchmark '. $commontest ."\n\t# ". $_,$bmr->{$_}->[1] * 1000 / $bmr->{$_}->[5]); } &ok; } } else { skipit(5,'benchmark 3'); } Math-Base-Convert-0.11/MANIFEST0000644000000000000000000000121312612261756014446 0ustar rootrootMANIFEST MANIFEST.SKIP README Makefile.PL Convert.pm Changes bitmaps recurse2txt benchmarks/benchmark1.txt benchmarks/benchmark2.txt benchmarks/benchmark3.txt lib/Math/Base/Convert/Bases.pm lib/Math/Base/Convert/CalcPP.pm lib/Math/Base/Convert/Shortcuts.pm t/ascii.t t/backend.t t/basefunct.t t/basemap.t t/basemethods.t t/benchmarkcalc.t t/benchmarkcnv.t t/convert.t t/frontend.t t/isnotp2.t t/longmultiply.t t/overload.t t/shiftright.t t/useFROMbaseShortcuts.t t/useFROMbaseto32wide.t t/useTObaseShortcuts.t t/validbase.t t/vet.t t/vetcontext.t t/zstrings.t META.yml Module meta-data (added by MakeMaker) Math-Base-Convert-0.11/Changes0000644000000000000000000000325012612261714014605 0ustar rootrootRevision history for Perl extension Math::Base::Convert 0.11 Thu Oct 22 15:31:10 PDT 2015 fix one more typo 0.10 Wed Oct 21 19:56:19 PDT 2015 finish the typo corrections started in 0.09, sigh... 0.09 Wed Oct 21 18:53:44 PDT 2015 corrected numerous typos thanks to patch by gregor herrmann 0.08 Mon Jan 27 11:59:58 PST 2014 modify Makefile.PL to bypass missing 'pod2text' correct documentation typo 0.07 Tue Jan 8 13:47:58 PST 2013 revise Shortcuts 0.02 srindx table use to mask after shift floating point error detected ONLY in fail 2012-12-30T20:29:47 v5.16.2/127e fail 2013-01-03T03:49:32 v5.12.5/a2da fail 2013-01-03T05:24:45 v5.14.3/127e fail 2013-01-03T05:43:01 v5.17.6/127e 64 bit perl compiled with -Duselongdouble wrap base calculation with int( ... +0.5) in Shortcuts.pm $bp = int(log($base/log(2) + 0.5) MANY thanks to Andreas Koenig for all the help he provide in tracking this bug down and to David Cantrell for providing a guest account on his system to do the testing. 0.06 Wed Dec 26 00:08:52 PST 2012 changed Bases.pm array returns from arrays built in the sub to arrays built in the package and already blessed scalars add ascii lookup table 0.05 Sun Dec 23 22:46:42 PST 2012 initial release 0.04 Sat Dec 22 21:07:56 PST 2012 \Q \E metaquoting escape sequence to disable all metacharacters in later versions of Perl 0.03 Tue Dec 18 17:44:58 PST 2012 archive before TO <-> FROM switch 0.02 Wed Dec 5 17:56:47 PST 2012 separated math into CalcPP.pm 0.01 Wed Dec 5 13:59:41 PST 2012 first development package Math-Base-Convert-0.11/benchmarks/0000755000000000000000000000000012612261756015435 5ustar rootrootMath-Base-Convert-0.11/benchmarks/benchmark1.txt0000644000000000000000000001670712065772474020232 0ustar rootroot Benchmarks are FROM and TO decimal. The decimal test set is: 1193046 5124095576030430 94522879700260683065598897150409950 1743639370940744633935561489495120884528376069578043920 t/benchmarkcnv.t make test BENCHMARK=1 FROM base to 'dec' Math::Base::Convert using Math::BigInt method function function $bc->cnv(n) cnv(n) convert(n) ------------------------------------------------------- 100100011010001010110 bin 0.782ms 1.341ms 32.041ms 10010001101000101011001111000100110101011110011011110 1.333ms 1.887ms 78.000ms 100100011010001010110011110001001101010111100110111101111000000010010001101000101011001111000100110101011110011011110 2.696ms 3.303ms 173.333ms 1001000110100010101100111100010011010101111001101111011110000000100100011010001010110011110001001101010111100110111101111111011011100101110101001100001110110010101000011001000010000 4.438ms 4.992ms 270.000ms ------------------------------------------------------- catagcaccct dna 0.824ms 1.562ms 21.189ms catagcaccctcgtatctttggagcgt 1.397ms 2.131ms 49.219ms catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgt 2.791ms 3.503ms 110.000ms catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgtgggtgcgatgtttctacgctcccaagatacaa 4.542ms 5.359ms 171.111ms ------------------------------------------------------- 4432126 oct 0.828ms 1.649ms 17.005ms 221505317046536336 1.406ms 2.225ms 40.385ms 443212636115274675700221505317046536336 2.848ms 3.652ms 87.778ms 1106425474232571573600443212636115274675773345651416625031020 4.735ms 5.552ms 138.182ms ------------------------------------------------------- 123456 hex 0.794ms 1.929ms 16.020ms 123456789abcde 1.333ms 2.441ms 36.364ms 123456789abcdef0123456789abcde 2.671ms 3.787ms 79.000ms 123456789abcdef0123456789abcdefedcba9876543210 4.405ms 5.552ms 123.200ms ------------------------------------------------------- bencw bas32 0.846ms 1.341ms 15.000ms erukz6jvpg1 1.449ms 1.948ms 33.333ms ci3fm1e3xtppaerukz6jvpg1 2.930ms 3.420ms 72.791ms bencwpcnlzxxqci3fm1e3xtpp4xf3tb2fimqq 4.945ms 5.448ms 114.815ms ------------------------------------------------------- 50mG b62 0.894ms 1.827ms 14.395ms nt2zIAA8u 1.608ms 2.528ms 31.584ms 8jNYV0IWlg3SwHNKpVtY 3.418ms 4.367ms 70.000ms 2WQLMo2pQMbq1zeL2FCZdyOFilbPFZK 5.699ms 6.653ms 110.000ms ------------------------------------------------------- 4ZHM b64 0.934ms 1.923ms 14.484ms ID5PuchpU 1.544ms 2.528ms 31.782ms 4ZHMU9gytl0ID5PuchpU 2.999ms 4.066ms 69.773ms 18qLdYQlDxm4ZHMU9gytlxSkfXsL38G 5.000ms 6.004ms 110.000ms ------------------------------------------------------- ;$u bas128 0.968ms 1.782ms 13.403ms 9DA#)%^w 1.562ms 2.403ms 30.792ms IQL_9:~oG 4.600ms 5.735ms 101.290ms t/benchmarkcnv.t make test BENCHMARK=1 from 'dec' TO base Math::Base::Convert using Math::BigInt method function function $bc->cnv(n) cnv(n) convert(n) ------------------------------------------------------- 100100011010001010110 bin 0.465ms 1.078ms 35.682ms 10010001101000101011001111000100110101011110011011110 1.085ms 1.705ms 89.429ms 100100011010001010110011110001001101010111100110111101111000000010010001101000101011001111000100110101011110011011110 1.970ms 2.602ms 199.375ms 1001000110100010101100111100010011010101111001101111011110000000100100011010001010110011110001001101010111100110111101111111011011100101110101001100001110110010101000011001000010000 3.068ms 3.698ms 318.000ms ok 149 ------------------------------------------------------- catagcaccct dna 0.558ms 1.190ms 22.606ms catagcaccctcgtatctttggagcgt 1.239ms 1.869ms 54.407ms catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgt 2.223ms 2.848ms 118.077ms catagcaccctcgtatctttggagcgtggaaacatagcaccctcgtatctttggagcgtgggtgcgatgtttctacgctcccaagatacaa 3.402ms 4.040ms 184.706ms ok 150 ------------------------------------------------------- 4432126 oct 0.528ms 1.157ms 17.112ms 221505317046536336 1.202ms 1.833ms 41.600ms 443212636115274675700221505317046536336 2.116ms 2.756ms 90.882ms 1106425474232571573600443212636115274675773345651416625031020 3.312ms 3.917ms 142.857ms ok 151 ------------------------------------------------------- 123456 hex 0.455ms 1.071ms 15.911ms 123456789abcde 1.081ms 1.702ms 36.477ms 123456789abcdef0123456789abcde 1.964ms 2.573ms 78.250ms 123456789abcdef0123456789abcdefedcba9876543210 3.049ms 3.652ms 121.600ms ok 152 ------------------------------------------------------- bencw bas32 0.550ms 1.593ms 14.630ms erukz6jvpg1 1.202ms 2.237ms 32.188ms ci3fm1e3xtppaerukz6jvpg1 2.130ms 3.140ms 70.227ms bencwpcnlzxxqci3fm1e3xtpp4xf3tb2fimqq 3.283ms 4.272ms 108.621ms ok 153 ------------------------------------------------------- 50mG b62 0.529ms 1.143ms 13.277ms nt2zIAA8u 1.433ms 2.051ms 29.907ms 8jNYV0IWlg3SwHNKpVtY 3.068ms 3.698ms 65.000ms 2WQLMo2pQMbq1zeL2FCZdyOFilbPFZK 5.129ms 5.753ms 100.645ms ok 154 ------------------------------------------------------- 4ZHM b64 0.531ms 1.157ms 13.235ms ID5PuchpU 1.209ms 1.838ms 29.537ms 4ZHMU9gytl0ID5PuchpU 2.143ms 2.765ms 64.286ms 18qLdYQlDxm4ZHMU9gytlxSkfXsL38G 3.262ms 3.886ms 100.000ms ok 155 ------------------------------------------------------- ;$u bas128 0.484ms 1.111ms 11.894ms 9DA#)%^w 1.202ms 3.242ms 28.288ms IQL_9:~oG 3.222ms 6.604ms 88.571ms ok 157 Math-Base-Convert-0.11/benchmarks/benchmark2.txt0000644000000000000000000002741212065650541020214 0ustar rootroot make test BENCHMARK=2 t.backend.t # benchmark TO base from internal format # bin # 215 # math_bigint 3.410 ms # mbc::calcPP 1.422 ms # mbcshortcut 1.029 ms # 123456 # math_bigint 5.230 ms # mbc::calcPP 1.904 ms # mbcshortcut 1.098 ms # 123456789abcde # math_bigint 10.590 ms # mbc::calcPP 3.781 ms # mbcshortcut 1.084 ms # 123456789abcdef0123456 # math_bigint 17.166 ms # mbc::calcPP 5.768 ms # mbcshortcut 1.117 ms # 123456789abcdef0123456789abcde # math_bigint 22.555 ms # mbc::calcPP 8.057 ms # mbcshortcut 1.097 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 27.193 ms # mbc::calcPP 10.724 ms # mbcshortcut 1.142 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 34.505 ms # mbc::calcPP 13.783 ms # mbcshortcut 1.128 ms # dna # 215 # math_bigint 3.538 ms # mbc::calcPP 1.211 ms # mbcshortcut 1.238 ms # 123456 # math_bigint 5.516 ms # mbc::calcPP 1.510 ms # mbcshortcut 1.287 ms # 123456789abcde # math_bigint 10.850 ms # mbc::calcPP 2.418 ms # mbcshortcut 1.319 ms # 123456789abcdef0123456 # math_bigint 17.005 ms # mbc::calcPP 3.463 ms # mbcshortcut 1.347 ms # 123456789abcdef0123456789abcde # math_bigint 22.985 ms # mbc::calcPP 4.614 ms # mbcshortcut 1.432 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 26.333 ms # mbc::calcPP 5.929 ms # mbcshortcut 1.408 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 34.725 ms # mbc::calcPP 7.512 ms # mbcshortcut 1.562 ms # oct # 215 # math_bigint 3.477 ms # mbc::calcPP 1.198 ms # mbcshortcut 1.258 ms # 123456 # math_bigint 5.613 ms # mbc::calcPP 1.377 ms # mbcshortcut 1.258 ms # 123456789abcde # math_bigint 10.714 ms # mbc::calcPP 2.008 ms # mbcshortcut 1.315 ms # 123456789abcdef0123456 # math_bigint 17.421 ms # mbc::calcPP 2.713 ms # mbcshortcut 1.351 ms # 123456789abcdef0123456789abcde # math_bigint 22.394 ms # mbc::calcPP 3.463 ms # mbcshortcut 1.298 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 28.091 ms # mbc::calcPP 4.354 ms # mbcshortcut 1.410 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 32.842 ms # mbc::calcPP 5.431 ms # mbcshortcut 1.377 ms # hex # 215 # math_bigint 3.398 ms # mbc::calcPP 1.107 ms # mbcshortcut 1.115 ms # 123456 # math_bigint 5.633 ms # mbc::calcPP 1.271 ms # mbcshortcut 1.122 ms # 123456789abcde # math_bigint 10.952 ms # mbc::calcPP 1.740 ms # mbcshortcut 1.132 ms # 123456789abcdef0123456 # math_bigint 17.005 ms # mbc::calcPP 2.296 ms # mbcshortcut 1.128 ms # 123456789abcdef0123456789abcde # math_bigint 22.920 ms # mbc::calcPP 2.875 ms # mbcshortcut 1.125 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 27.632 ms # mbc::calcPP 3.598 ms # mbcshortcut 1.098 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 34.835 ms # mbc::calcPP 4.367 ms # mbcshortcut 1.140 ms # bas32 # 215 # math_bigint 3.463 ms # mbc::calcPP 1.090 ms # mbcshortcut 1.209 ms # 123456 # math_bigint 5.534 ms # mbc::calcPP 1.259 ms # mbcshortcut 1.262 ms # 123456789abcde # math_bigint 10.986 ms # mbc::calcPP 1.623 ms # mbcshortcut 1.290 ms # 123456789abcdef0123456 # math_bigint 17.219 ms # mbc::calcPP 2.027 ms # mbcshortcut 1.282 ms # 123456789abcdef0123456789abcde # math_bigint 23.358 ms # mbc::calcPP 2.535 ms # mbcshortcut 1.346 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 28.108 ms # mbc::calcPP 3.058 ms # mbcshortcut 1.359 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 33.723 ms # mbc::calcPP 3.675 ms # mbcshortcut 1.408 ms # b64 # 215 # math_bigint 3.428 ms # mbc::calcPP 1.122 ms # mbcshortcut 1.267 ms # 123456 # math_bigint 5.552 ms # mbc::calcPP 1.213 ms # mbcshortcut 1.243 ms # 123456789abcde # math_bigint 10.986 ms # mbc::calcPP 1.495 ms # mbcshortcut 1.303 ms # 123456789abcdef0123456 # math_bigint 16.528 ms # mbc::calcPP 1.917 ms # mbcshortcut 1.255 ms # 123456789abcdef0123456789abcde # math_bigint 23.015 ms # mbc::calcPP 2.221 ms # mbcshortcut 1.364 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 28.739 ms # mbc::calcPP 2.765 ms # mbcshortcut 1.406 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 34.615 ms # mbc::calcPP 3.313 ms # mbcshortcut 1.417 ms # bas128 # 215 # math_bigint 3.376 ms # mbc::calcPP 1.080 ms # mbcshortcut 1.270 ms # 123456 # math_bigint 5.542 ms # mbc::calcPP 1.153 ms # mbcshortcut 1.217 ms # 123456789abcde # math_bigint 10.986 ms # mbc::calcPP 1.444 ms # mbcshortcut 1.239 ms # 123456789abcdef0123456 # math_bigint 17.273 ms # mbc::calcPP 1.755 ms # mbcshortcut 1.290 ms # 123456789abcdef0123456789abcde # math_bigint 22.014 ms # mbc::calcPP 2.085 ms # mbcshortcut 1.259 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 28.000 ms # mbc::calcPP 2.411 ms # mbcshortcut 1.372 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 33.936 ms # mbc::calcPP 2.940 ms # mbcshortcut 1.391 ms # bas256 # 215 # math_bigint 3.413 ms # mbc::calcPP 1.081 ms # mbcshortcut 1.270 ms # 123456 # math_bigint 5.466 ms # mbc::calcPP 1.160 ms # mbcshortcut 1.235 ms # 123456789abcde # math_bigint 10.884 ms # mbc::calcPP 1.410 ms # mbcshortcut 1.270 ms # 123456789abcdef0123456 # math_bigint 17.166 ms # mbc::calcPP 1.679 ms # mbcshortcut 1.271 ms # 123456789abcdef0123456789abcde # math_bigint 22.761 ms # mbc::calcPP 1.954 ms # mbcshortcut 1.300 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 28.559 ms # mbc::calcPP 2.344 ms # mbcshortcut 1.318 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 34.615 ms # mbc::calcPP 2.702 ms # mbcshortcut 1.377 ms make test BENCHMARK=2 t.frontend.t # benchmark FROM base to internal format # bin # 215 # math_bigint 11.709 ms # mbc::calcPP 0.860 ms # mbcshortcut 0.634 ms # 123456 # math_bigint 22.971 ms # mbc::calcPP 1.239 ms # mbcshortcut 0.628 ms # 123456789abcde # math_bigint 56.182 ms # mbc::calcPP 2.518 ms # mbcshortcut 0.658 ms # 123456789abcdef0123456 # math_bigint 91.176 ms # mbc::calcPP 3.850 ms # mbcshortcut 0.677 ms # 123456789abcdef0123456789abcde # math_bigint 124.400 ms # mbc::calcPP 5.359 ms # mbcshortcut 0.696 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 158.000 ms # mbc::calcPP 6.958 ms # mbcshortcut 0.726 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 192.500 ms # mbc::calcPP 8.702 ms # mbcshortcut 0.745 ms # dna # 215 # math_bigint 6.046 ms # mbc::calcPP 0.852 ms # mbcshortcut 0.844 ms # 123456 # math_bigint 12.045 ms # mbc::calcPP 1.049 ms # mbcshortcut 0.837 ms # 123456789abcde # math_bigint 27.748 ms # mbc::calcPP 1.686 ms # mbcshortcut 0.877 ms # 123456789abcdef0123456 # math_bigint 44.507 ms # mbc::calcPP 2.441 ms # mbcshortcut 0.919 ms # 123456789abcdef0123456789abcde # math_bigint 60.392 ms # mbc::calcPP 3.211 ms # mbcshortcut 0.953 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 76.098 ms # mbc::calcPP 4.028 ms # mbcshortcut 0.998 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 92.353 ms # mbc::calcPP 4.945 ms # mbcshortcut 1.036 ms # oct # 215 # math_bigint 5.113 ms # mbc::calcPP 0.919 ms # mbcshortcut 0.934 ms # 123456 # math_bigint 7.668 ms # mbc::calcPP 1.023 ms # mbcshortcut 0.940 ms # 123456789abcde # math_bigint 18.721 ms # mbc::calcPP 1.494 ms # mbcshortcut 1.010 ms # 123456789abcdef0123456 # math_bigint 29.537 ms # mbc::calcPP 1.984 ms # mbcshortcut 1.071 ms # 123456789abcdef0123456789abcde # math_bigint 39.630 ms # mbc::calcPP 2.478 ms # mbcshortcut 1.133 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 50.317 ms # mbc::calcPP 3.058 ms # mbcshortcut 1.202 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 61.731 ms # mbc::calcPP 3.698 ms # mbcshortcut 1.359 ms # hex # 215 # math_bigint 4.003 ms # mbc::calcPP 1.186 ms # mbcshortcut 1.183 ms # 123456 # math_bigint 6.843 ms # mbc::calcPP 1.275 ms # mbcshortcut 1.179 ms # 123456789abcde # math_bigint 14.630 ms # mbc::calcPP 1.623 ms # mbcshortcut 1.202 ms # 123456789abcdef0123456 # math_bigint 22.463 ms # mbc::calcPP 1.982 ms # mbcshortcut 1.213 ms # 123456789abcdef0123456789abcde # math_bigint 30.385 ms # mbc::calcPP 2.388 ms # mbcshortcut 1.231 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 38.072 ms # mbc::calcPP 2.875 ms # mbcshortcut 1.263 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 45.942 ms # mbc::calcPP 3.291 ms # mbcshortcut 1.278 ms # bas32 # 215 # math_bigint 3.068 ms # mbc::calcPP 0.526 ms # mbcshortcut 0.638 ms # 123456 # math_bigint 5.929 ms # mbc::calcPP 0.624 ms # mbcshortcut 0.633 ms # 123456789abcde # math_bigint 11.825 ms # mbc::calcPP 0.894 ms # mbcshortcut 0.732 ms # 123456789abcdef0123456 # math_bigint 17.640 ms # mbc::calcPP 1.172 ms # mbcshortcut 0.819 ms # 123456789abcdef0123456789abcde # math_bigint 24.646 ms # mbc::calcPP 1.504 ms # mbcshortcut 0.894 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 30.294 ms # mbc::calcPP 1.844 ms # mbcshortcut 1.004 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 37.294 ms # mbc::calcPP 2.239 ms # mbcshortcut 1.213 ms # b64 # 215 # math_bigint 3.068 ms # mbc::calcPP 0.971 ms # mbcshortcut 1.107 ms # 123456 # math_bigint 5.024 ms # mbc::calcPP 1.052 ms # mbcshortcut 1.115 ms # 123456789abcde # math_bigint 9.846 ms # mbc::calcPP 1.279 ms # mbcshortcut 1.205 ms # 123456789abcdef0123456 # math_bigint 15.714 ms # mbc::calcPP 1.562 ms # mbcshortcut 1.287 ms # 123456789abcdef0123456789abcde # math_bigint 20.921 ms # mbc::calcPP 1.827 ms # mbcshortcut 1.368 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 25.600 ms # mbc::calcPP 2.092 ms # mbcshortcut 1.458 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 31.386 ms # mbc::calcPP 2.426 ms # mbcshortcut 1.674 ms # bas128 # 215 # math_bigint 3.078 ms # mbc::calcPP 0.842 ms # mbcshortcut 0.965 ms # 123456 # math_bigint 4.079 ms # mbc::calcPP 0.888 ms # mbcshortcut 0.958 ms # 123456789abcde # math_bigint 8.955 ms # mbc::calcPP 1.108 ms # mbcshortcut 1.042 ms # 123456789abcdef0123456 # math_bigint 14.000 ms # mbc::calcPP 1.337 ms # mbcshortcut 1.235 ms # 123456789abcdef0123456789abcde # math_bigint 17.727 ms # mbc::calcPP 1.553 ms # mbcshortcut 1.329 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 22.687 ms # mbc::calcPP 1.844 ms # mbcshortcut 1.429 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 26.529 ms # mbc::calcPP 2.066 ms # mbcshortcut 1.520 ms # bas256 # 215 # math_bigint 3.068 ms # mbc::calcPP 1.112 ms # mbcshortcut 1.168 ms # 123456 # math_bigint 4.105 ms # mbc::calcPP 1.150 ms # mbcshortcut 1.175 ms # 123456789abcde # math_bigint 7.990 ms # mbc::calcPP 1.337 ms # mbcshortcut 1.209 ms # 123456789abcdef0123456 # math_bigint 11.894 ms # mbc::calcPP 1.539 ms # mbcshortcut 1.254 ms # 123456789abcdef0123456789abcde # math_bigint 15.764 ms # mbc::calcPP 1.727 ms # mbcshortcut 1.274 ms # 123456789abcdef0123456789abcdefedcba98 # math_bigint 19.630 ms # mbc::calcPP 1.954 ms # mbcshortcut 1.311 ms # 123456789abcdef0123456789abcdefedcba9876543210 # math_bigint 23.824 ms # mbc::calcPP 2.223 ms # mbcshortcut 1.341 ms Math-Base-Convert-0.11/benchmarks/benchmark3.txt0000644000000000000000000000252312065530142020203 0ustar rootroot make test BENCHMARK=3 t.benchmarkcalc.t # short to 0.906 ms # short from 0.510 ms # long to 5.416 ms # long from 4.892 ms make test BENCHMARK=3 t.useFROMbaseShortcuts.t # short b2->b8_directTObase32 0.893 ms # short b2->b8_multiplyTo_b32 1.101 ms # long b2->b8_directTObase32 2.105 ms # long b2->b8_multiplyTo_b32 8.422 ms # benchmark 183deadbeef2feed1baddad123468 # b16->256_directTObase32 2.961 ms # benchmark 183deadbeef2feed1baddad123468 # b16->256_multiplyTo_b32 7.581 ms # benchmark 123468 # b16->256_directTObase32 1.299 ms # benchmark 123468 # b16->256_multiplyTo_b32 1.452 ms # benchmark f2feed1baddad123468 # b16->256_directTObase32 2.283 ms # benchmark f2feed1baddad123468 # b16->256_multiplyTo_b32 4.570 ms make test BENCHMARK=3 t/useTObaseShortcuts.t # short b2->b8-wide32->base 0.688 ms # short b2->b8_divideTObase 1.528 ms # long b2->b8-wide32->base 1.381 ms # long b2->b8_divideTObase 12.886 ms # benchmark 183deadbeef2feed1baddad123468 # b16->256-wide32->base 1.582 ms # benchmark 183deadbeef2feed1baddad123468 # b16->256_divideTObase 11.564 ms # benchmark 123468 # b16->256-wide32->base 1.125 ms # benchmark 123468 # b16->256_divideTObase 1.851 ms # benchmark f2feed1baddad123468 # b16->256-wide32->base 1.410 ms # benchmark f2feed1baddad123468 # b16->256_divideTObase 6.742 ms Math-Base-Convert-0.11/lib/0000755000000000000000000000000012612261756014066 5ustar rootrootMath-Base-Convert-0.11/lib/Math/0000755000000000000000000000000012612261756014757 5ustar rootrootMath-Base-Convert-0.11/lib/Math/Base/0000755000000000000000000000000012612261756015631 5ustar rootrootMath-Base-Convert-0.11/lib/Math/Base/Convert/0000755000000000000000000000000012612261756017251 5ustar rootrootMath-Base-Convert-0.11/lib/Math/Base/Convert/CalcPP.pm0000644000000000000000000001245612612033564020713 0ustar rootroot#!/usr/bin/perl package Math::Base::Convert::CalcPP; use strict; use vars qw($VERSION); $VERSION = do { my @r = (q$Revision: 0.03 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # test number < 2^32 is NOT power of 2 # sub isnotp2 { my $ref = ref $_[0]; shift if ref $_[0] || $_[0] =~ /\D/; # class? $_[0] & $_[0] -1; } # add a long n*32 bit number toa number < 65536 # add 'n' to array digits and propagate carry, return carry # sub addbaseno { my($ap,$n) = @_; foreach (@$ap) { $_ += $n; return 0 unless $_ > 0xffffffff; $n = 1; $_ -= 4294967296; } 1; # carry is one on exit, else would have taken return 0 branch } # multiply a register of indeterminate length by a number < 65535 # # ap pointer to multiplicand array # multiplier # sub multiply { my($ap,$m) = @_; # $m is always 2..65535 # $m &= 0xffff; # max value 65535 already done by VETTING # # perl uses doubles for arithmetic, $m << 65536 will fit my $carry = 0; foreach ( @$ap) { $_ *= $m; $_ += $carry; if ($_ > 0xffffffff) { $carry = int($_ / 4294967296); $_ %= 4294967296; } else { $carry = 0; } } push @$ap, $carry if $carry; } sub dividebybase { my($np,$divisor) = @_; my @dividend = @$np; # 3% improvement while ($#dividend) { # 3% improvement last if $dividend[0]; shift @dividend; } my $remainder = 0; my @quotient; while (@dividend) { my $work = ($dividend[0] += ($remainder * 4294967296)); push @quotient, int($work / $divisor); $remainder = $work % $divisor; shift @dividend; } return (\@quotient,$remainder); } # simple versions of conversion, works for N < ~2^49 or 10^16 # #sub frombase { # my($hsh,$base,$str) = @_; # my $number = 0; # for( $str =~ /./g ) { # $number *= $base; # $number += $hsh->{$_}; # } # return $number; #} #sub tobase { #sub to_base # my($bp,$base,$num) = @_; # my $base = shift; # return $bp->[0] if $num == 0; # my $str = ''; # while( $num > 0 ) { # $str = $bp->[$num % $base] . $str; # $num = int( $num / $base ); # } # return $str; #} # convert a number from its base to 32*N bit representation # sub useFROMbaseto32wide { my $bc = shift; my($ary,$hsh,$base,$str) = @{$bc}{qw(from fhsh fbase nstr)}; # check if decimal and interger from within perl's 32bit double representation # cutoff is 999,999,999,999,999 -- a bit less than 2^50 # # convert directly to base 2^32 arrays # my @result = (0); if ($base == 10 && length($str) < 16) { # unless ($str > 999999999999999) { # maximum 32 bit double float integer representation $result[0] = $str % 4294967296; my $quotient = int($str / 4294967296); $result[1] = $quotient if $quotient; $bc->{b32str} = \@result; } else { for ($str =~ /./g) { multiply(\@result,$base); push @result, 1 if addbaseno(\@result,$hsh->{$_}); # propagate carry } # my @rv = reverse @result; $bc->{b32str} = \@result; } $bc; } #my %used = map {$_,0}(0..255); # convert 32*N bit representation to any base < 65536 # sub use32wideTObase { my $bc = shift; my($ary,$base,$rquot) = @{$bc}{qw(to tbase b32str)}; my @quotient = reverse(@$rquot); my $quotient = \@quotient; my @answer; my $remainder; do { ($quotient,$remainder) = dividebybase($quotient,$base); # these commented out print statements are for convert.t DO NOT REMOVE! #$used{$remainder} = 1; #print $remainder; #print " *" if $remainder > 86; #print "\n"; unshift @answer, $ary->[$remainder]; } while grep {$_} @$quotient; #foreach (sort {$b <=> $a} keys %used) { #print " $_,\n" if $used{$_} && $_ > 85; #print "\t$_\t=> \n" if !$used{$_} && $_ < 86; #} join '', @answer; } 1; __END__ =head1 NAME Math::Base::Convert::CalcPP - standard methods used by Math::Base::Convert =head1 DESCRIPTION This module contains the standard methods used by B to convert from one base number to another base number. =over 4 =item * $carry = addbaseno($reg32ptr,$int) This function adds an integer < 65536 to a long n*32 bit register and returns the carry. =item * multiply($reg32ptr,$int) This function multiplies a long n*32 bit register by an integer < 65536 =item * ($qptr,$remainder) = dividebybase($reg32ptr,$int) this function divides a long n*32 bit register by an integer < 65536 and returns a pointer to a long n*32 bit quotient and an integer remainder. =item * $bc->useFROMbaseto32wide This method converts FROM an input base string to a long n*32 bit register using an algorithim like: $longnum = 0; for $char ( $in_str =~ /./g ) { $longnum *= $base; $longnum += $value{$char) } return $number; =item * $output = $bc->use32wideTObase This method converts a long n*32 bit register TO a base number using an algorithim like: $output = ''; while( $longnum > 0 ) { $output = ( $longnum % $base ) . $output; $num = int( $longnum / $base ); } return $output; =back =head1 AUTHOR Michael Robinton, michael@bizsystems.com =head1 COPYRIGHT Copyright 2012-15, Michael Robinton This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut 1; Math-Base-Convert-0.11/lib/Math/Base/Convert/Shortcuts.pm0000644000000000000000000002644112612050462021602 0ustar rootrootpackage Math::Base::Convert::Shortcuts; use vars qw($VERSION); use strict; $VERSION = do { my @r = (q$Revision: 0.05 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # load bitmaps my $xlt = require Math::Base::Convert::Bitmaps; # # base 2 4 8 16 32 64 # base power 1 2 3 4 5 6 # xlt = [ \@standardbases, undef, \%_2wide, undef, undef, \%_5wide, \%_6wide ]; # # base 2 maps directly to lookup key # base 3 maps directly to standard lookup value # base 4 converts directly to hex # # where @standardbases = (\{ # dna => { # '00' => 'a', # '01' => 'c', # '10' => 't', # '11' => 'g', # }, # b64 => { # '000000' => 0, # '000001' => 1, # * - # * - # '001010' => 'A', # '001011' => 'B', # * - # * - # '111111' => '_', # }, # m64 => etc.... # iru # url # rex # id0 # id1 # xnt # xid # }); # # .... and # # hash arrays are bit to value maps of the form # # %_3wide = { # '000' => 0, # '001' => 1, # '010' => 2, # * - # * - # etc... # }; # my @srindx = ( # accomodate up to 31 bit shifts 0, # 0 unused 1, # 1 3, # 2 7, # 3 0xf, # 4 0x1f, # 5 0x3f, # 6 0x7f, # 7 0xff, # 8 0x1ff, # 9 0x3ff, # 10 0x7ff, # 11 0xfff, # 12 0x1fff, # 13 0x3fff, # 14 0x7fff, # 15 0xffff, # 16 0x1ffff, # 17 0x3ffff, # 18 0x7ffff, # 19 0xfffff, # 20 0x1fffff, # 21 0x3fffff, # 22 0x7fffff, # 23 0xffffff, # 24 0x1ffffff, # 25 0x3ffffff, # 26 0x7ffffff, # 27 0xfffffff, # 28 0x1fffffff, # 29 0x3fffffff, # 30 0x7fffffff # 31 ); my @srindx2 = ( # accomodate up to 31 bit shifts 0xffffffff, # 0 unused 0xfffffffe, # 1 0xfffffffc, # 2 0xfffffff8, # 3 0xfffffff0, # 4 0xffffffe0, # 5 0xffffffc0, # 6 0xffffff80, # 7 0xffffff00, # 8 0xfffffe00, # 9 0xfffffc00, # 10 0xfffff800, # 11 0xfffff000, # 12 0xffffe000, # 13 0xffffc000, # 14 0xffff8000, # 15 0xffff0000, # 16 0xfffe0000, # 17 0xfffc0000, # 18 0xfff80000, # 19 0xfff00000, # 20 0xffe00000, # 21 0xffc00000, # 22 0xff800000, # 23 0xff000000, # 24 0xfe000000, # 25 0xfc000000, # 26 0xf8000000, # 27 0xf0000000, # 28 0xe0000000, # 29 0xc0000000, # 30 0x80000000 # 31 ); # # $arraypointer, $shiftright, $mask, $shiftleft # sub longshiftright { my $ap = $_[0]; # perl appears to optimize these variables into registers my $sr = $_[1]; # when they are set in this manner -- much faster!! my $msk = $_[2]; my $sl = $_[3]; my $al = $#$ap -1; my $i = 1; foreach (0..$al) { $ap->[$_] >>= $sr; # $ap->[$_] |= ($ap->[$i] & $msk) << $sl; $ap->[$_] |= ($ap->[$i] << $sl) & $msk; $i++; } $ap->[$#$ap] >>= $sr; } # see the comments at "longshiftright" about the # integration of calculations into the local subroutine # sub shiftright { my($ap,$n) = @_; longshiftright($ap,$n,$srindx2[$n],32 -$n); } # # fast direct conversion of base power of 2 sets to base 2^32 # sub bx1 { # base 2, 1 bit wide x32 = 32 bits - 111 32 1's 111111111111111 my($ss,$d32p) = @_; unshift @$d32p, unpack('N1',pack('B32',$ss)); } my %dna= ('AA', 0, 'AC', 1, 'AT', 2, 'AG', 3, 'CA', 4, 'CC', 5, 'CT', 6, 'CG', 7, 'TA', 8, 'TC', 9, 'TT', 10, 'TG', 11, 'GA', 12, 'GC', 13, 'GT', 14, 'GG', 15, 'Aa', 0, 'Ac', 1, 'At', 2, 'Ag', 3, 'Ca', 4, 'Cc', 5, 'Ct', 6, 'Cg', 7, 'Ta', 8, 'Tc', 9, 'Tt', 10, 'Tg', 11, 'Ga', 12, 'Gc', 13, 'Gt', 14, 'Gg', 15, 'aA', 0, 'aC', 1, 'aT', 2, 'aG', 3, 'cA', 4, 'cC', 5, 'cT', 6, 'cG', 7, 'tA', 8, 'tC', 9, 'tT', 10, 'tG', 11, 'gA', 12, 'gC', 13, 'gT', 14, 'gG', 15, 'aa', 0, 'ac', 1, 'at', 2, 'ag', 3, 'ca', 4, 'cc', 5, 'ct', 6, 'cg', 7, 'ta', 8, 'tc', 9, 'tt', 10, 'tg', 11, 'ga', 12, 'gc', 13, 'gt', 14, 'gg', 15, ); # substr 4x faster than array lookup # sub bx2 { # base 4, 2 bits wide x16 = 32 bits - 3333333333333333 my($ss,$d32p) = @_; my $bn = $dna{substr($ss,0,2)}; # 2 digits as a time => base 16 $bn <<= 4; $bn += $dna{substr($ss,2,2)}; $bn <<= 4; $bn += $dna{substr($ss,4,2)}; $bn <<= 4; $bn += $dna{substr($ss,6,2)}; $bn <<= 4; $bn += $dna{substr($ss,8,2)}; $bn <<= 4; $bn += $dna{substr($ss,10,2)}; $bn <<= 4; $bn += $dna{substr($ss,12,2)}; $bn <<= 4; $bn += $dna{substr($ss,14,2)}; unshift @$d32p, $bn; } sub bx3 { # base 8, 3 bits wide x10 = 30 bits - 07777777777 my($ss,$d32p) = @_; unshift @$d32p, CORE::oct($ss) << 2; shiftright($d32p,2); } sub bx4 { # base 16, 4 bits wide x8 = 32 bits - 0xffffffff my($ss,$d32p) = @_; unshift @$d32p, CORE::hex($ss); } sub bx5 { # base 32, 5 bits wide x6 = 30 bits - 555555 my($ss,$d32p,$hsh) = @_; my $bn = $hsh->{substr($ss,0,1)}; $bn <<= 5; $bn += $hsh->{substr($ss,1,1)}; $bn <<= 5; $bn += $hsh->{substr($ss,2,1)}; $bn <<= 5; $bn += $hsh->{substr($ss,3,1)}; $bn <<= 5; $bn += $hsh->{substr($ss,4,1)}; $bn <<= 5; unshift @$d32p, ($bn += $hsh->{substr($ss,5,1)}) << 2; shiftright($d32p,2); } sub bx6 { # base 64, 6 bits wide x5 = 30 bits - 66666 my($ss,$d32p,$hsh) = @_; my $bn = $hsh->{substr($ss,0,1)}; $bn <<= 6; $bn += $hsh->{substr($ss,1,1)}; $bn <<= 6; $bn += $hsh->{substr($ss,2,1)}; $bn <<= 6; $bn += $hsh->{substr($ss,3,1)}; $bn <<= 6; unshift @$d32p, ($bn += $hsh->{substr($ss,4,1)}) << 2; shiftright($d32p,2); } sub bx7 { # base 128, 7 bits wide x4 = 28 bits - 7777 my($ss,$d32p,$hsh) = @_; my $bn = $hsh->{substr($ss,0,1)}; $bn <<= 7; $bn += $hsh->{substr($ss,1,1)}; $bn <<= 7; $bn += $hsh->{substr($ss,2,1)}; $bn <<= 7; unshift @$d32p, ($bn += $hsh->{substr($ss,3,1)}) << 4; shiftright($d32p,4); } sub bx8 { # base 256, 8 bits wide x4 = 32 bits - 8888 my($ss,$d32p,$hsh) = @_; my $bn = $hsh->{substr($ss,0,1)}; $bn *= 256; $bn += $hsh->{substr($ss,1,1)}; $bn *= 256; $bn += $hsh->{substr($ss,2,1)}; $bn *= 256; unshift @$d32p, $bn += $hsh->{substr($ss,3,1)}; } my @useFROMbaseShortcuts = ( 0, # unused \&bx1, # base 2, 1 bit wide x32 = 32 bits - 111 32 1's 111111111111111 \&bx2, # base 4, 2 bits wide x16 = 32 bits - 3333333333333333 \&bx3, # base 8, 3 bits wide x10 = 30 bits - 07777777777 \&bx4, # base 16, 4 bits wide x8 = 32 bits - 0xffffffff \&bx5, # base 32, 5 bits wide x6 = 30 bits - 555555 \&bx6, # base 64, 6 bits wide x5 = 30 bits - 66666 \&bx7, # base 128, 7 bits wide x4 = 28 bits - 7777 \&bx8, # and base 256, 8 bits wide x4 = 32 bits - 8888 ); # 1) find number of digits of base that will fit in 2^32 # 2) pad msb's # 3) substr digit groups and get value sub useFROMbaseShortcuts { my $bc = shift; my($ary,$hsh,$base,$str) = @{$bc}{qw(from fhsh fbase nstr)}; my $bp = int(log($base)/log(2) +0.5); my $len = length($str); return ($bp,[0]) unless $len; # no value in zero length string my $shrink = 32 % ($bp * $base); # bits short of 16 bits # convert any strings in standard convertable bases that are NOT standard strings to the standard my $basnam = ref $ary; my $padchar = $ary->[0]; if ($base == 16) { # should be hex if ($basnam !~ /HEX$/i) { $bc->{fHEX} = $bc->HEX() unless exists $bc->{fHEX}; my @h = @{$bc->{fHEX}}; $str =~ s/(.)/$h[$hsh->{$1}]/g; # translate string to HEX $padchar = 0; } } elsif ($base == 8) { if ($basnam !~ /OCT$/i) { $bc->{foct} = $bc->ocT() unless exists $bc->{foct}; my @o = @{$bc->{foct}}; $str =~ s/(.)/$o[$hsh->{$1}]/g; $padchar = '0'; } } elsif ($base == 4) { # will map to hex if ($basnam !~ /dna$/i) { $bc->{fDNA} = $bc->DNA() unless exists $bc->{fDNA}; my @d = @{$bc->{fDNA}}; $str =~ s/(.)/$d[$hsh->{$1}]/g; $padchar = 'A'; } } elsif ($base == 2) { # will map to binary if ($basnam !~ /bin$/) { $bc->{fbin} = $bc->bin() unless exists $bc->{fbin}; my @b = @{$bc->{fbin}}; $str =~ s/(.)/$b[$hsh->{$1}]/g; $padchar = '0'; } } # digits per 32 bit register - $dpr # $dpr = int(32 / $bp) = 32 / digit bit width # # number of digits to pad string so the last digit fits exactly in a 32 bit register # $pad = digits_per_reg - (string_length % $dpr) my $dpr = int (32 / $bp); my $pad = $dpr - ($len % $dpr); $pad = 0 if $pad == $dpr; if ($pad) { $str = ($padchar x $pad) . $str; # pad string with zero value digit } # number of iterations % digits/register $len += $pad; my $i = 0; my @d32; while ($i < $len) { # # base16 digit = sub bx[base power](string fragment ) # where base power is the width of each nibble and # base is the symbol value width in bits $useFROMbaseShortcuts[$bp]->(substr($str,$i,$dpr),\@d32,$hsh); $i += $dpr; } while($#d32 && ! $d32[$#d32]) { # waste leading zeros pop @d32; } $bc->{b32str} = \@d32; } # map non-standard user base to bitstream lookup # sub usrmap { my($to,$map) = @_; my %map; while (my($key,$val) = each %$map) { $map{$key} = $to->[$val]; } \%map; } sub useTObaseShortcuts { my $bc = shift; my($base,$b32p,$to) = @{$bc}{qw( tbase b32str to )}; my $bp = int(log($base)/log(2) +0.5); # base power my $L = @$b32p; my $packed = pack("N$L", reverse @{$b32p}); ref($to) =~ /([^:]+)$/; # extract to base name my $bname = $1; my $str; if ($bp == 1) { # binary $L *= 32; ($str = unpack("B$L",$packed)) =~ s/^0+//; # suppress leading zeros $str =~ s/(.)/$to->[$1]/g if $bname eq 'user'; } elsif ($bp == 4) { # hex / base 16 $L *= 8; ($str = unpack("H$L",$packed)) =~ s/^0+//; # suppress leading zeros $str =~ s/(.)/$to->[CORE::hex($1)]/g if $bname eq 'user'; } else { # the rest my $map; if ($bname eq 'user') { # special map request unless (exists $bc->{tmap}) { $bc->{tmap} = usrmap($to,$xlt->[$bp]); # cache the map for speed } $map = $bc->{tmap}; } elsif ($bp == 3) { # octal variant? $map = $xlt->[$bp]; } else { $map = $xlt->[0]->{$bname}; # standard map } $L *= 32; (my $bits = unpack("B$L",$packed)) =~ s/^0+//; # suppress leading zeros #print "bp = $bp, BITS=\n$bits\n"; my $len = length($bits); my $m = $len % $bp; # pad to even multiple base power #my $z = $m; if ($m) { $m = $bp - $m; $bits = ('0' x $m) . $bits; $len += $m; } #print "len = $len, m_init = $z, m = $m, BITS PADDED\n$bits\n"; $str = ''; for (my $i = 0; $i < $len; $i += $bp) { $str .= $map->{substr($bits,$i,$bp)}; #print "MAPPED i=$i, str=$str\n"; } } $str; } 1; __END__ =head1 NAME Math::Base::Convert::Shortcuts - methods for converting powers of 2 bases =head1 DESCRIPTION This module contains two primary methods that convert bases that are exact powers of 2 to and from base 2^32 faster than can be done by pure perl math. =over 4 =item * $bc->useFROMbaseShortcuts This method converts FROM an input base number to a long n*32 bit register =item * $output = $bc->useTObaseShortcuts; This method converts an n*32 bit registers TO an output base number. =item * EXPORTS None =back =head1 AUTHOR Michael Robinton, michael@bizsystems.com =head1 COPYRIGHT Copyright 2012-2015, Michael Robinton This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut 1; Math-Base-Convert-0.11/lib/Math/Base/Convert/Bases.pm0000644000000000000000000001303512612034474020641 0ustar rootroot#!/usr/bin/perl package Math::Base::Convert::Bases; $VERSION = 0.03; package Math::Base::Convert; # into the main package @BASES = qw( bin dna DNA oct dec hex HEX b62 b64 m64 iru url rex id0 id1 xnt xid b85 ascii ); $signedBase = 16; # largest allowable known signed base my $package = __PACKAGE__; my $packageLen = length __PACKAGE__; sub _class { (my $class = (caller(1))[3]) =~ s/([^:]+)$/_bs::$1/; $class; } my $callname = __PACKAGE__ . '::_bs::'; # return a pointer to a sub for the array blessed into Package::sub::name # my $_bin = bless ['0', '1'], $callname . 'bin'; my $_dna = bless [qw( a c t g )], $callname . 'dna'; my $_DNA = bless [qw( A C T G )], $callname . 'DNA'; my $_ocT = bless ['0'..'7'], $callname . 'ocT'; my $_dec = bless ['0'..'9'], $callname . 'dec'; my $_heX = bless ['0'..'9', 'a'..'f'], $callname . 'heX'; my $_HEX = bless ['0'..'9', 'A'..'F'], $callname . 'HEX'; my $_b62 = bless ['0'..'9', 'a'..'z', 'A'..'Z'], $callname . 'b62'; my $_b64 = bless ['0'..'9', 'A'..'Z', 'a'..'z', '.', '_'], $callname . 'b64'; my $_m64 = bless ['A'..'Z', 'a'..'z', '0'..'9', '+', '/'], $callname . 'm64'; my $_iru = bless ['A'..'Z', 'a'..'z', '0'..'9', '[', ']'], $callname . 'iru'; my $_url = bless ['A'..'Z', 'a'..'z', '0'..'9', '*', '-'], $callname . 'url'; my $_rex = bless ['A'..'Z', 'a'..'z', '0'..'9', '!', '-'], $callname . 'rex'; my $_id0 = bless ['A'..'Z', 'a'..'z', '0'..'9', '_', '-'], $callname . 'id0'; my $_id1 = bless ['A'..'Z', 'a'..'z', '0'..'9', '.', '_'], $callname . 'id1'; my $_xnt = bless ['A'..'Z', 'a'..'z', '0'..'9', '.', '-'], $callname . 'xnt'; my $_xid = bless ['A'..'Z', 'a'..'z', '0'..'9', '_', ':'], $callname . 'xid'; my $_b85 = bless ['0'..'9', 'A'..'Z', 'a'..'z', '!', '#', # RFC 1924 for IPv6 addresses, might need to return Math::BigInt objs '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '`', '{', '|', '}', '~'], $callname . 'b85'; my $_ascii = bless [ ' ','!','"','#','$','%','&',"'",'(',')','*','+',',','-','.','/', '0','1','2','3','4','5','6','7','8','9', ':',';','<','=','>','?','@', 'A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', '[','\\',']','^','_','`', 'a','b','c','d','e','f','g','h','i','j','k','l','m', 'n','o','p','q','r','s','t','u','v','w','x','y','z', '{','|','}','~'], $callname . 'ascii'; # 7 bit printable ascii, base 96 #my $_ebcdic = bless [qw # ( 0 1 2 3 37 2D 2E 2F 16 5 25 0B 0C 0D 0E 0F 10 11 12 13 3C 3D 32 26 18 19 3F 27 1C 1D 1E 1F # 40 4F 7F 7B 5B 6C 50 7D 4D 5D 5C 4E 6B 60 4B 61 F0 F1 F2 F3 F4 F5 F6 F7 F8 F9 7A 5E 4C 7E 6E 6F # 7C C1 C2 C3 C4 C5 C6 C7 C8 C9 D1 D2 D3 D4 D5 D6 D7 D8 D9 E2 E3 E4 E5 E6 E7 E8 E9 4A E0 5A 5F 6D # 79 81 82 83 84 85 86 87 88 89 91 92 93 94 95 96 97 98 99 A2 A3 A4 A5 A6 A7 A8 A9 C0 6A D0 A1 7 # 20 21 22 23 24 15 6 17 28 29 2A 2B 2C 9 0A 1B 30 31 1A 33 34 35 36 8 38 39 3A 3B 4 14 3E E1 41 # 42 43 44 45 46 47 48 49 51 52 53 54 55 56 57 58 59 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 # 77 78 80 8A 8B 8C 8D 8E 8F 90 9A 9B 9C 9D 9E 9F A0 AA AB AC AD AE AF B0 B1 B2 B3 B4 B5 B6 B7 B8 # B9 BA BB BC BD BE BF CA CB CC CD CE CF DA DB DC DD DE DF EA EB EC ED EE EF FA FB FC FD FE FF)], $callname . 'ebcdic'; sub bin { $_bin } sub dna { $_dna } sub DNA { $_DNA } sub ocT { $_ocT } sub dec { $_dec } sub heX { $_heX } sub HEX { $_HEX } sub b62 { $_b62 } sub b64 { $_b64 } sub m64 { $_m64 } sub iru { $_iru } sub url { $_url } sub rex { $_rex } sub id0 { $_id0 } sub id1 { $_id1 } sub xnt { $_xnt } sub xid { $_xid } sub b85 { $_b85 } sub ascii { $_ascii } #sub ebcdic { $_ebcdic } # Since we're not using BIcalc, the last test can be eliminated... ################### special treatment for override 'hex' ################################## sub hex { # unless our package and is a BC ref and not a BI number (which is an ARRAY) unless (ref($_[0]) && $package eq substr(ref($_[0]),0,$packageLen) && (local *glob = $_[0]) && *glob{HASH}) { # $package, $filename, $line, $subroutine, $hasargs # 0 1 2 3 4 # if defined and hasargs if ( defined $_[0] && (caller(0))[4] ) { return CORE::hex $_[0]; } } return heX(); } ################### special treatment for override 'oct' ################################# sub oct { # unless our package and is a BC ref and not a BI number (which is an ARRAY) unless (ref($_[0]) && $package eq substr(ref($_[0]),0,$packageLen) && (local *glob = $_[0]) && *glob{HASH}) { # $package, $filename, $line, $subroutine, $hasargs # 0 1 2 3 4 # if defined and hasargs if ( defined $_[0] && (caller(0))[4] ) { return CORE::oct $_[0]; } } return ocT(); } ################################## REMOVE ABOVE CODE ################### # return a hash of all base pointers # sub _bases { no strict; my %bases; foreach (@BASES) { my $base = $_->(); ref($base) =~ /([^:]+)$/; $bases{$1} = $base; } \%bases; } 1; __END__ =head1 NAME Math::Base::Convert::Bases - helper module for bases =head1 DESCRIPTION This package contains no documentation See L instead =head1 AUTHOR Michael Robinton, michael@bizsystems.com =head1 COPYRIGHT Copyright 2012-2015, Michael Robinton This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut 1; Math-Base-Convert-0.11/Convert.pm0000644000000000000000000004070212612261624015273 0ustar rootroot#!/usr/bin/perl package Math::Base::Convert; #use diagnostics; use Carp; use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS @BASES $signedBase); # @Bases, $signedBase imported from Math::Base::Convert::Bases require Exporter; require Math::Base::Convert::Shortcuts; require Math::Base::Convert::CalcPP; require Math::Base::Convert::Bases; # drag in BASES @ISA = qw( Math::Base::Convert::Shortcuts Math::Base::Convert::CalcPP Exporter ); $VERSION = do { my @r = (q$Revision: 0.11 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; @EXPORT_OK = ( qw( cnv cnvpre cnvabs basemap ), @BASES ); %EXPORT_TAGS = ( all => [@EXPORT_OK], base => [ 'basemap', @BASES ] ); my $functions = join '', keys %{__PACKAGE__ .'::'}; # before 'strict' use strict; my $package = __PACKAGE__; my $packageLen = length __PACKAGE__; my $bs = $package .'::_bs::'; # indentify 'base sub' my %num2sub = ( 2 => &bin, 4 => &DNA, 8 => &ocT, 10 => &dec, 16 => &HEX, 64 => &m64 ); # return a hash map of the base array, including upper/lower case variants # sub basemap { shift if ref $_[0] eq $package; # waste if method call my $base = validbase($_[0]); # return array pointer ref($base) =~ /$bs(.+)/; # sub name is $1 if ($1 eq 'user') { # if user array my $aryhsh = {}; @{$aryhsh}{@$base} = (0..$#$base); return $aryhsh; } my @all = $functions =~ /$1/gi; # get all matching sub names regardless of case # names are strings no strict; my %aryhsh; foreach (@all) { $_ = $package->can($_); # return sub ref $_ = &$_; # array pointer foreach my $i (0..$#$_) { $aryhsh{$_->[$i]} = $i; # map keys to index } } return \%aryhsh; } # check for internal base sub validbase { my $base = shift; my $ref; if (($ref = ref $base)) { if ($ref eq 'ARRAY') { # user supplied my @base = @{$base}; my $len = @base; Carp::croak "base to short, < 2" unless $len > 1; Carp::croak "base to long, > 65535" unless $len < 65536; $base = bless \@base, $bs .'user'; return bless $base, $bs . 'user'; } elsif ($ref =~ /^$bs/) { # internal base return $base; } else { $base = 'reference'; } } elsif ($base =~ /\D/) { # is a string my $rv = $package->can($base); return &$rv if $rv; } else { return $num2sub{$base} if exists $num2sub{$base}; } Carp::croak "not a valid base: $base"; } sub vet { my $class = shift; my $from = shift || ''; my $to = shift || ''; $to =~ s/\s+//g if $to && ! ref $to; # strip white space $from =~ s/\s+//g if $from && ! ref $from; unless ($from) { # defaults if not defined $to = &HEX; $from = &dec; } else { $from = validbase($from); unless ($to) { $to = &HEX; } else { $to = validbase($to); } } # convert sub ref's to variables # $to = &$to; # ($from, my $fhsh) = &$from; my $prefix = ref $to; if ($prefix =~ /HEX$/i) { $prefix = '0x'; } elsif ($prefix =~ /OCT$/i) { $prefix = '0'; } elsif ($prefix =~ /bin$/) { $prefix = '0b'; } else { $prefix = ''; } bless { to => $to, tbase => scalar @$to, from => $from, fhsh => basemap($from), fbase => scalar @$from, prefix => $prefix }, $class; } sub new { my $proto = shift; my $class = ref $proto || $proto || $package; vet($class,@_); } sub _cnv { my $bc = shift; my $nstr; if (ref $bc && ref($bc) eq $package) { # method call? $nstr = shift; # yes, number to convert is next arg } else { $nstr = $bc; # no, first arg is number to convert $bc = $package->new(@_); } return $nstr unless keys %$bc; # if there really is no conversion $nstr = '' unless defined $nstr; my($from,$fbase,$fhsh) = @{$bc}{qw( from fbase fhsh )}; my $ref = ref $from; if ($ref eq 'user' || $fbase > $signedBase) { # known, signed character sets? $bc->{sign} = ''; # no } else { # yes $nstr =~ s/^([+-])//; # strip sign $bc->{sign} = $1 && $1 eq '-' ? '-' : ''; # and save for possible restoration if ($ref =~ /(HEX)$/i) { $nstr =~ s/^0x//i; # snip prefix, including typo's } elsif ($ref =~ /bin/i) { $nstr =~ s/^0b//i; # snip prefix, including typo's } $nstr =~ s/^[$from->[0]]+//; # snip leading zeros } my $fclass = join '', keys %$fhsh; if ($nstr =~ /[^\Q$fclass\E]/) { # quote metacharacters $ref =~ /([^:]+)$/; Carp::croak "input character not in '$1'\nstring:\t$nstr\nbase:\t$fclass\n"; } $bc->{nstr} = $nstr; $bc; } # # Our internal multiply & divide = base 32 # Maximum digit length for a binary base = 32*ln(2)/ln(base) # 0bnnnnnnnnnnn # 0nnnnnnnnnnnn # 0xnnnnnnnnnnn # my %maxdlen = (# digits, key is base 2 => 31, # 2^1 4 => 16, # 2^2 8 => 10, # 2^3 16 => 8, # 2^4 32 => 6, # 2^5 64 => 5, # 2^6 128 => 4, # 2^7 256 => 4 # 2^8 ); sub cnv { my @rv = &cnvpre; return @rv if wantarray; return ($rv[0] . $rv[2]); # sign and string only } sub cnvabs { my @rv = &cnvpre; return @rv if wantarray; return $rv[2] # string only } sub cnvpre { my $bc = &_cnv; return $bc unless ref $bc; my($from,$fbase,$to,$tbase,$sign,$prefix,$nstr) = @{$bc}{qw( from fbase to tbase sign prefix nstr)}; my $slen = length($nstr); my $tref = ref($to); unless ($slen) { # zero length input $nstr = $to->[0]; # return zero } elsif (lc $tref eq lc ref($from)) {# no base conversion if ($tref ne ref($from)) { # convert case? if ($tref =~ /(?:DNA|HEX)/) { $nstr = uc $nstr; # force upper case } else { $nstr = lc $nstr; # or force lower case } } } else { # convert my $fblen = length($fbase); if ($fbase & $fbase -1 || # from base is not power of 2 $fblen > 256 ) { # no shortcuts,... $bc->useFROMbaseto32wide; } # if a large base and digit string will fit in a single 32 bit register elsif ( $fblen > 32 && # big base # exists $maxdlen{$fbase} && # has to exist ! $slen > $maxdlen{$fbase}) { $bc->useFROMbaseto32wide; # CalcPP is faster } else { # shortcuts faster for big numbers $bc->useFROMbaseShortcuts; } ################################ # input converted to base 2^32 # ################################ if ($tbase & $tbase -1 || # from base is not power of 2 $tbase > 256 ) { # no shortcuts,... $nstr = $bc->use32wideTObase; } # if big base and digit string fits in a single 32 bit register elsif ( $tbase > 32 && @{$bc->{b32str}} == 1) { $nstr = $bc->use32wideTObase; # CalcPP is faster } else { $nstr = $bc->useTObaseShortcuts; # shortcuts faster for big numbers } } # end convert $nstr = $to->[0] unless length($nstr); return ($sign,$prefix,$nstr) if wantarray; if (#$prefix ne '' && # 0, 0x, 0b $tbase <= $signedBase && # base in signed set $tref ne 'user' ) { # base standard return ($sign . $prefix . $nstr); } return ($prefix . $nstr); } sub _cnvtst { my $bc = &_cnv; return $bc unless ref $bc; $bc->useFROMbaseto32wide; return $bc->use32wideTObase unless wantarray; return (@{$bc}{qw( sign prefix )},$bc->use32wideTObase); } =head1 NAME Math::Base::Convert - very fast base to base conversion =head1 SYNOPSIS =head2 As a function use Math::Base::Convert qw( :all ) use Math::Base::Convert qw( cnv cnvabs cnvpre basemap # comments bin base 2 0,1 dna base 4 lower case dna DNA base 4 upper case DNA oct base 8 octal dec base 10 decimal hex base 16 lower case hex HEX base 16 upper case HEX b62 base 62 b64 base 64 month:C:12 day:V:31 m64 base 64 0-63 from MIME::Base64 iru base 64 P10 protocol - IRCu daemon url base 64 url with no %2B %2F expansion of + - / rex base 64 regular expression variant id0 base 64 IDentifier style 0 id1 base 64 IDentifier style 1 xnt base 64 XML Name Tokens (Nmtoken) xid base 64 XML identifiers (Name) b85 base 85 RFC 1924 for IPv6 addresses ascii base 96 7 bit printible 0x20 - 0x7F ); my $converted = cnv($number,optionalFROM,optionalTO); my $basemap = basmap(base); =head2 As a method: use Math::Base::Convert; use Math::Base::Convert qw(:base); my $bc = new Math::Base::Convert(optionalFROM,optionalTO); my $converted = $bc->cnv($number); my $basemap = $bc->basemap(base); =head1 DESCRIPTION This module provides fast functions and methods to convert between arbitrary number bases from 2 (binary) thru 65535. This module is pure Perl, has no external dependencies, and is backward compatible with old versions of Perl 5. =head1 PREFERRED USE Setting up the conversion parameters, context and error checking consume a significant portion of the execution time of a B base conversion. These operations are performed each time B is called as a function. Using method calls eliminates a large portion of this overhead and will improve performance for repetitive conversions. See the benchmarks sub-directory in this distribution. =head1 BUILT IN NUMBER SETS Number set variants courtesy of the authors of Math::Base:Cnv and Math::BaseConvert. The functions below return a reference to an array $arrayref = function; bin => ['0', '1'] # binary dna => ['a','t','c','g'] # lc dna DNA => ['A','T','C','G'], {default} # uc DNA oct => ['0'..'7'] # octal dec => ['0'..'9'] # decimal hex => ['0'..'9', 'a'..'f'] # lc hex HEX => ['0'..'9', 'A'..'F'] {default} # uc HEX b62 => ['0'..'9', 'a'..'z', 'A'..'Z'] # base 62 b64 => ['0'..'9', 'A'..'Z', 'a'..'z', '.', '_'] # m:C:12 d:V:31 m64 => ['A'..'Z', 'a'..'z', '0'..'9', '+', '/'] # MIMI::Base64 iru => ['A'..'Z', 'a'..'z', '0'..'9', '[', ']'] # P10 - IRCu url => ['A'..'Z', 'a'..'z', '0'..'9', '*', '-'] # url no %2B %2F rex => ['A'..'Z', 'a'..'z', '0'..'9', '!', '-'] # regex variant id0 => ['A'..'Z', 'a'..'z', '0'..'9', '_', '-'] # ID 0 id1 => ['A'..'Z', 'a'..'z', '0'..'9', '.', '_'] # ID 1 xnt => ['A'..'Z', 'a'..'z', '0'..'9', '.', '-'] # XML (Nmtoken) xid => ['A'..'Z', 'a'..'z', '0'..'9', '_', ':'] # XML (Name) b85 => ['0'..'9', 'A'..'Z', 'a'..'z', '!', '#', # RFC 1924 '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '', '{', '|', '}', '~'] An arbitrary base 96 composed of printable 7 bit ascii from 0x20 (space) through 0x7F (tilde ~) ascii => [ ' ','!','"','#','$','%','&',"'",'(',')', '*','+',',','-','.','/', '0','1','2','3','4','5','6','7','8','9', ':',';','<','=','>','?','@', 'A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', '[','\',']','^','_','`', 'a','b','c','d','e','f','g','h','i','j','k','l','m', 'n','o','p','q','r','s','t','u','v','w','x','y','z', '{','|','}','~'] NOTE: Clean text with =~ s/\s+/ /; before applying to ascii =head1 USAGE =over 4 =item * $converted = cnv($number,[from],[to]) SCALAR context: array context covered later in this document. To preserve similarity to other similar base conversion modules, B returns the converted number string with SIGN if both the input and output base strings are in known signed set of bases in this module. In the case of binary, octal, hex, all leading base designator strings such as '0b','0', '0x' are automatically stripped from the input. Base designator strings are NOT applied to the output. The context of base FROM and TO is optional and flexible. Unconditional conversion from decimal to HEX [upper case] $converted = cnv($number); Example conversion from octal to default HEX [upper case] with different context for the 'octal' designator. base as a number $converted = cnv($number,8); base as a function (imported) $converted = cnv($number,oct); base as text $converted = convbase($number,'oct'); Conversion to/from arbitrary bases i.e. $converted = cnv($number); # dec -> hex (default) $converted = cnv($number,oct); # oct to HEX $converted = cnv($number,10,HEX); # dec to uc HEX $converted = cnv($number,10,hex); # dec to lc hex $converted = cnv($number,dec,hex);# same pointer notation $converted = cnv($number, oct => dec); $converted = cnv($number,10 => 23); # dec to base23 $converted = cnv($number,23 => 5); # b23 to base5 etc... =item * $bc = new Math::Base::Convert([from],[to]); This method has the same usage and syntax for FROM and TO as B above. Setup for unconditional conversion from HEX to decimal $bc = new Math::Base::Convert(); Example conversion from octal to decimal base number $bc = new Math::Base::Convert(8); base function (imported) $bc = new Math::Base::Convert(oct); base text $bc = new Math::Base::Convert('oct') The number conversion for any of the above: NOTE: iterative conversions using a method pointer are ALWAYS faster than calling B as a function. $converted = $bc->cnv($number); =item * $converted = cnvpre($number,[from],[to]) Same as B except that base descriptor PREfixes are applied to B, B, and B output strings. =item * $converted = cnvabs($number,[from],[to]) Same as B except that the ABSolute value of the number string is returned without SIGN is returned. i.e. just the raw string. =item * ($sign,$prefix,$string) = cnv($number,[$from,[$to]]) =item * ($sign,$prefix,$string) = cnv($number,[$from,[$to]]) =item * ($sign,$prefix,$string) = cnv($number,[$from,[$to]]) ARRAY context: All three functions return the same items in array context. sign the sign of the input number string prefix the prefix which would be applied to output string the raw output string =item * $basemap = basemap(base); =item * $basemap = $bc->basemap(base); This function / method returns a pointer to a hash that maps the keys of a base to its numeric value for base conversion. It accepts B in any of the forms described for B. The return basemap includes upper and lower case variants of the the number base in cases such as B where upper and lower case a..f, A..F map to the same numeric value for base conversion. i.e. $hex_ptr = { 0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7, 8 => 8, 9 => 9, A => 10, B => 11, C => 12, D => 13, E => 14, F => 15, a => 10, b => 11, c => 12, d => 13, e => 14, f => 15 }; =back =head1 BENCHMARKS Math::Base::Convert includes 2 development and one real world benchmark sequences included in the test suite. Benchmark results for a 500mhz system can be found in the 'benchmarks' source directory. make test BENCHMARK=1 Provides comparison data for bi-directional conversion of an ascending series of number strings in all base powers. The test sequence contains number strings that go from a a single 32 bit register to several. Tested bases are: (note: b32, b128, b256 not useful and are for testing only) base 2 4 8 16 32 64 85 128 256 bin, dna, oct, hex, b32, b64, b85, b128, b256 Conversions are performed FROM all bases TO decimal and are repeated in the opposing direction FROM decimal TO all bases. Benchmark 1 results indicate the Math::Base::Convert typically runs significantly faster ( 10x to 100x) than Math::BigInt based implementations used in similar modules. make test BENCHMARK=2 Provides comparison data for the frontend and backend converters in Math::Base::Convert's CalcPP and Shortcuts packages, and Math::Bigint conversions if it is present on the system under test. make test BENCHMARK=3 Checks the relative timing of short and long number string conversions. FROM a base number to n*32 bit register and TO a base number from an n*32 bit register set. i.e. strings that convert to and from 1, 2, 3... etc.. 32 bit registers =head1 DEPENDENCIES none Math::BigInt is conditionally used in the test suite but is not a requirement =head1 EXPORT_OK Conditional EXPORT functions cnv cnvabs cnvpre basemap bin oct dec heX HEX b62 b64 m64 iru url rex id0 id1 xnt xid b85 ascii =head1 EXPORT_TAGS Conditional EXPORT function groups :all => all of above :base => all except 'cnv,cnvabs,cnvpre' =head1 ACKNOWLEDGEMENTS This module was inspired by Math::BaseConvert maintained by Shane Warden and forked from Math::BaseCnv, both authored by Pip Stuart =head1 AUTHOR Michael Robinton, =head1 COPYRIGHT Copyright 2012-2015, Michael Robinton This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut 1; Math-Base-Convert-0.11/MANIFEST.SKIP0000644000000000000000000000016512065213735015214 0ustar rootrootBitmaps.pm Makefile Makefile.old Template/Makefile Template/Makefile.old ~$ blib tmp unused work \.gz$ \.sav$ \.yml$ Math-Base-Convert-0.11/README0000644000000000000000000002671512612261724014206 0ustar rootrootNAME Math::Base::Convert - very fast base to base conversion SYNOPSIS As a function use Math::Base::Convert qw( :all ) use Math::Base::Convert qw( cnv cnvabs cnvpre basemap # comments bin base 2 0,1 dna base 4 lower case dna DNA base 4 upper case DNA oct base 8 octal dec base 10 decimal hex base 16 lower case hex HEX base 16 upper case HEX b62 base 62 b64 base 64 month:C:12 day:V:31 m64 base 64 0-63 from MIME::Base64 iru base 64 P10 protocol - IRCu daemon url base 64 url with no %2B %2F expansion of + - / rex base 64 regular expression variant id0 base 64 IDentifier style 0 id1 base 64 IDentifier style 1 xnt base 64 XML Name Tokens (Nmtoken) xid base 64 XML identifiers (Name) b85 base 85 RFC 1924 for IPv6 addresses ascii base 96 7 bit printible 0x20 - 0x7F ); my $converted = cnv($number,optionalFROM,optionalTO); my $basemap = basmap(base); As a method: use Math::Base::Convert; use Math::Base::Convert qw(:base); my $bc = new Math::Base::Convert(optionalFROM,optionalTO); my $converted = $bc->cnv($number); my $basemap = $bc->basemap(base); DESCRIPTION This module provides fast functions and methods to convert between arbitrary number bases from 2 (binary) thru 65535. This module is pure Perl, has no external dependencies, and is backward compatible with old versions of Perl 5. PREFERRED USE Setting up the conversion parameters, context and error checking consume a significant portion of the execution time of a single base conversion. These operations are performed each time cnv is called as a function. Using method calls eliminates a large portion of this overhead and will improve performance for repetitive conversions. See the benchmarks sub-directory in this distribution. BUILT IN NUMBER SETS Number set variants courtesy of the authors of Math::Base:Cnv and Math::BaseConvert. The functions below return a reference to an array $arrayref = function; bin => ['0', '1'] # binary dna => ['a','t','c','g'] # lc dna DNA => ['A','T','C','G'], {default} # uc DNA oct => ['0'..'7'] # octal dec => ['0'..'9'] # decimal hex => ['0'..'9', 'a'..'f'] # lc hex HEX => ['0'..'9', 'A'..'F'] {default} # uc HEX b62 => ['0'..'9', 'a'..'z', 'A'..'Z'] # base 62 b64 => ['0'..'9', 'A'..'Z', 'a'..'z', '.', '_'] # m:C:12 d:V:31 m64 => ['A'..'Z', 'a'..'z', '0'..'9', '+', '/'] # MIMI::Base64 iru => ['A'..'Z', 'a'..'z', '0'..'9', '[', ']'] # P10 - IRCu url => ['A'..'Z', 'a'..'z', '0'..'9', '*', '-'] # url no %2B %2F rex => ['A'..'Z', 'a'..'z', '0'..'9', '!', '-'] # regex variant id0 => ['A'..'Z', 'a'..'z', '0'..'9', '_', '-'] # ID 0 id1 => ['A'..'Z', 'a'..'z', '0'..'9', '.', '_'] # ID 1 xnt => ['A'..'Z', 'a'..'z', '0'..'9', '.', '-'] # XML (Nmtoken) xid => ['A'..'Z', 'a'..'z', '0'..'9', '_', ':'] # XML (Name) b85 => ['0'..'9', 'A'..'Z', 'a'..'z', '!', '#', # RFC 1924 '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '', '{', '|', '}', '~'] An arbitrary base 96 composed of printable 7 bit ascii from 0x20 (space) through 0x7F (tilde ~) ascii => [ ' ','!','"','#','$','%','&',"'",'(',')', '*','+',',','-','.','/', '0','1','2','3','4','5','6','7','8','9', ':',';','<','=','>','?','@', 'A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', '[','\',']','^','_','`', 'a','b','c','d','e','f','g','h','i','j','k','l','m', 'n','o','p','q','r','s','t','u','v','w','x','y','z', '{','|','}','~'] NOTE: Clean text with =~ s/\s+/ /; before applying to ascii USAGE * $converted = cnv($number,[from],[to]) SCALAR context: array context covered later in this document. To preserve similarity to other similar base conversion modules, cnv returns the converted number string with SIGN if both the input and output base strings are in known signed set of bases in this module. In the case of binary, octal, hex, all leading base designator strings such as '0b','0', '0x' are automatically stripped from the input. Base designator strings are NOT applied to the output. The context of base FROM and TO is optional and flexible. Unconditional conversion from decimal to HEX [upper case] $converted = cnv($number); Example conversion from octal to default HEX [upper case] with different context for the 'octal' designator. base as a number $converted = cnv($number,8); base as a function (imported) $converted = cnv($number,oct); base as text $converted = convbase($number,'oct'); Conversion to/from arbitrary bases i.e. $converted = cnv($number); # dec -> hex (default) $converted = cnv($number,oct); # oct to HEX $converted = cnv($number,10,HEX); # dec to uc HEX $converted = cnv($number,10,hex); # dec to lc hex $converted = cnv($number,dec,hex);# same pointer notation $converted = cnv($number, oct => dec); $converted = cnv($number,10 => 23); # dec to base23 $converted = cnv($number,23 => 5); # b23 to base5 etc... * $bc = new Math::Base::Convert([from],[to]); This method has the same usage and syntax for FROM and TO as cnv above. Setup for unconditional conversion from HEX to decimal $bc = new Math::Base::Convert(); Example conversion from octal to decimal base number $bc = new Math::Base::Convert(8); base function (imported) $bc = new Math::Base::Convert(oct); base text $bc = new Math::Base::Convert('oct') The number conversion for any of the above: NOTE: iterative conversions using a method pointer are ALWAYS faster than calling cnv as a function. $converted = $bc->cnv($number); * $converted = cnvpre($number,[from],[to]) Same as cnv except that base descriptor PREfixes are applied to binary, octal, and hexadecimal output strings. * $converted = cnvabs($number,[from],[to]) Same as cnv except that the ABSolute value of the number string is returned without SIGN is returned. i.e. just the raw string. * ($sign,$prefix,$string) = cnv($number,[$from,[$to]]) * ($sign,$prefix,$string) = cnv($number,[$from,[$to]]) * ($sign,$prefix,$string) = cnv($number,[$from,[$to]]) ARRAY context: All three functions return the same items in array context. sign the sign of the input number string prefix the prefix which would be applied to output string the raw output string * $basemap = basemap(base); * $basemap = $bc->basemap(base); This function / method returns a pointer to a hash that maps the keys of a base to its numeric value for base conversion. It accepts base in any of the forms described for cnv. The return basemap includes upper and lower case variants of the the number base in cases such as hex where upper and lower case a..f, A..F map to the same numeric value for base conversion. i.e. $hex_ptr = { 0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7, 8 => 8, 9 => 9, A => 10, B => 11, C => 12, D => 13, E => 14, F => 15, a => 10, b => 11, c => 12, d => 13, e => 14, f => 15 }; BENCHMARKS Math::Base::Convert includes 2 development and one real world benchmark sequences included in the test suite. Benchmark results for a 500mhz system can be found in the 'benchmarks' source directory. make test BENCHMARK=1 Provides comparison data for bi-directional conversion of an ascending series of number strings in all base powers. The test sequence contains number strings that go from a a single 32 bit register to several. Tested bases are: (note: b32, b128, b256 not useful and are for testing only) base 2 4 8 16 32 64 85 128 256 bin, dna, oct, hex, b32, b64, b85, b128, b256 Conversions are performed FROM all bases TO decimal and are repeated in the opposing direction FROM decimal TO all bases. Benchmark 1 results indicate the Math::Base::Convert typically runs significantly faster ( 10x to 100x) than Math::BigInt based implementations used in similar modules. make test BENCHMARK=2 Provides comparison data for the frontend and backend converters in Math::Base::Convert's CalcPP and Shortcuts packages, and Math::Bigint conversions if it is present on the system under test. make test BENCHMARK=3 Checks the relative timing of short and long number string conversions. FROM a base number to n*32 bit register and TO a base number from an n*32 bit register set. i.e. strings that convert to and from 1, 2, 3... etc.. 32 bit registers DEPENDENCIES none Math::BigInt is conditionally used in the test suite but is not a requirement EXPORT_OK Conditional EXPORT functions cnv cnvabs cnvpre basemap bin oct dec heX HEX b62 b64 m64 iru url rex id0 id1 xnt xid b85 ascii EXPORT_TAGS Conditional EXPORT function groups :all => all of above :base => all except 'cnv,cnvabs,cnvpre' ACKNOWLEDGEMENTS This module was inspired by Math::BaseConvert maintained by Shane Warden and forked from Math::BaseCnv, both authored by Pip Stuart AUTHOR Michael Robinton, COPYRIGHT Copyright 2012-2015, Michael Robinton This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Math-Base-Convert-0.11/bitmaps0000644000000000000000000000744212612034377014706 0ustar rootroot#!/usr/bin/perl # module to build require './recurse2txt'; require './lib/Math/Base/Convert/Bases.pm'; # pointer to all standard bases # will update the Bitmaps module version below # my $VERSION = do { my @r = (q$Revision: 0.02 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; my $bases = Math::Base::Convert->_bases; my %base2; my %dmaps; my @xmaps = (\%dmaps); # make lookup bit maps - there are two kinds # # 1) for generic in 'xmaps' of the form "bit pattern" => "decimal value" # # 2) for specific in 'dmaps' of the form "bit pattern" => "base character" # # i.e. # # case 1) # %bmap4 = ( # base 16 translation table # '0000' => 0, # '0001' => 1, # '0010' => 2, # '0011' => 3, # '0100' => 4, # '0101' => 5, # '0110' => 6, # '0111' => 7, # '1000' => 8, # '1001' => 9, # '1010' => 10, # '1011' => 11, # '1100' => 12, # '1101' => 13, # '1110' => 14, # '1111' => 15, #); # # case 2) #%dmap4 = ( # heX - base 16 translation table # '0000' => 0, # '0001' => 1, # '0010' => 2, # '0011' => 3, # '0100' => 4, # '0101' => 5, # '0110' => 6, # '0111' => 7, # '1000' => 8, # '1001' => 9, # '1010' => 'a', # '1011' => 'b', # '1100' => 'c', # '1101' => 'd', # '1110' => 'e', # '1111' => 'f', #); # my $mapbits = sub { my($bits,$val) = @_; my $bp = length($bits); # 0, binary, hex not mapped return if $bp == 4 || # hex is direct $bp == 1; # binary maps directly from value $xmaps[$bp]->{$bits} = $val; # build generic translation maps return if $bp == 3; # octal maps from standard lookup, numeric if (exists $base2{$bp}) { # standard base present with this base power? foreach(0..$#{$base2{$bp}}) { my $bnam = $base2{$bp}->[$_]; $dmaps{$bnam}->{$bits} = $bases->{$bnam}->[$val]; } } }; # create a hash of all standard power 2 bases where the key # points to a list of bases associated with each power of 2 # foreach (sort keys %$bases) { my $len = @{$bases->{$_}}; unless ($len & $len -1) { # isnotp2 my $bp = int(log($len)/log(2) +0.5); if (exists $base2{$bp}) { push @{$base2{$bp}}, $_; } else { $base2{$bp} = [$_]; } } } # create an 8 bit wide binary map of the range 0..255 # foreach (0..255) { my $p = pack('c',$_); my $bits = unpack('B*',$p); my @bits = $bits; while ($bits =~ s/^0// && length($bits)) { push @bits, $bits; } foreach $bits (@bits) { $mapbits->($bits,$_); } } my $moduletxt = q|#!/usr/bin/perl -w package Math::Base::Convert::Bitmaps; use vars qw($VERSION); $VERSION = '|. $VERSION .q|'; # created by Makefile.PL |. scalar localtime(). q| # # Do not edit this package, # # edit the 'bitmaps' file in the source directory instead # # Why is this module here? The tables in this module # load from the disk and order of magnitude faster than # they can be created by perl at run time. # $VAR = |. (Dumper(\@xmaps))[0] .q| __END__ =head1 NAME Math::Base::Convert::Bitmaps - pregenerated bit pattern to base power of 2 translation tables This package contains no documentation =head1 AUTHOR Michael Robinton, michael@bizsystems.com =head1 COPYRIGHT Copyright 2012-2015, Michael Robinton This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut 1; |; open (F,'>lib/Math/Base/Convert/Bitmaps.pm') or return 0; select F; $| = 1; print F $moduletxt; close F; 1; Math-Base-Convert-0.11/Makefile.PL0000644000000000000000000000223712271551041015264 0ustar rootrootuse ExtUtils::MakeMaker; use Config; unless ( eval {require './bitmaps'} ) { print STDERR "Makefile.PL invoked the 'bitmaps' script\nwhich failed to create the module\nlib/Math/Base/Convert/Bitmaps.pm\n"; exit 1; } my $pkg = 'Math::Base::Convert'; $pkg =~ /[^:]+$/; my $module = $& .'.pm'; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => $pkg, 'VERSION_FROM' => $module, # finds $VERSION 'clean' => { FILES => "*~ tmp* lib/Math/Base/Convert/*~" }, 'dist' => {COMPRESS=>'gzip', SUFFIX=>'gz'} ); sub MY::top_targets { package MY; my $inherited = shift->SUPER::top_targets(@_); $inherited =~ s/(pure_all\s+::.+)/$1 README/; $inherited; } sub MY::post_constants { my $post_constants = $Config{scriptdirexp} .'/pod2text'; if (-e $post_constants) { $post_constants = q| MY_POD2TEXT = |. $post_constants .q| |; } else { $post_constants = q| MY_POD2TEXT = echo "perl distro missing 'pod2text' to convert " |; } } sub MY::postamble { package MY; my $postamble = q| README : |. $module .q| @$(MY_POD2TEXT) |. $module .q| > README |; } Math-Base-Convert-0.11/recurse2txt0000644000000000000000000000656312064703407015542 0ustar rootroot#!/usr/bin/perl # # recurse2txt routines # # version 1.08, 12-20-12, michael@bizsystems.com # # 10-3-11 updated to bless into calling package # 10-10-11 add SCALAR ref support # 1.06 12-16-12 add hexDumper # 1.07 12-19-12 added wantarray return of data and elements # 1.08 12-20-12 add wantarray to hexDumper # #use strict; #use diagnostics; use overload; # generate a unique signature for a particular hash # # Data::Dumper actually does much more than this, however, it # does not stringify hash's in a consistent manner. i.e. no SORT # # The routine below, while not covering recursion loops, non ascii # characters, etc.... does produce text that can be eval'd and is # consistent with each rendering. # sub hexDumper { if (wantarray) { ($data,$count) = Dumper($_[0]); $data =~ s/(\b\d+)/sprintf("0x%x",$1)/ge; return ($data,$count); } (my $x = Dumper($_[0])) =~ s/(\b\d+)/sprintf("0x%x",$1)/ge; $x; } sub Dumper { unless (defined $_[0]) { return ("undef\n",'undef') if wantarray; return "undef\n"; } my $ref = ref $_[0]; return "not a reference\n" unless $ref; unless ($ref eq 'HASH' or $ref eq 'ARRAY' or $ref eq 'SCALAR') { ($ref) = (overload::StrVal($_[0]) =~ /^(?:.*\=)?([^=]*)\(/); } my $p = { depth => 0, elements => 0, }; (my $pkg = (caller(0))[3]) =~ s/(.+)::Dumper/$1/; bless $p,$pkg; my $data; if ($ref eq 'HASH') { $data = $p->hash_recurse($_[0],"\n"); } elsif ($ref eq 'ARRAY') { $data = $p->array_recurse($_[0]); } else { # return $ref ." unsupported\n"; $data = $p->scalar_recurse($_[0]); } $data =~ s/,\n$/;\n/; return ($data,$p->{elements}) if wantarray; return $p->{elements} ."\t= ". $data; } # input: pointer to scalar, terminator # returns data # sub scalar_recurse { my($p,$ptr,$n) = @_; $n = '' unless $n; my $data = "\\"; $data .= _dump($p,$$ptr); $data .= "\n"; } # input: pointer to hash, terminator # returns: data # sub hash_recurse { my($p,$ptr,$n) = @_; $n = '' unless $n; my $data = "{\n"; foreach my $key (sort keys %$ptr) { $data .= "\t'". $key ."'\t=> "; $data .= _dump($p,$ptr->{$key},"\n"); } $data .= '},'.$n; } # generate a unique signature for a particular array # # input: pointer to array, terminator # returns: data sub array_recurse { my($p,$ptr,$n) = @_; $n = '' unless $n; my $data = '['; foreach my $item (@$ptr) { $data .= _dump($p,$item); } $data .= "],\n"; } # input: self, item, append # return: data # sub _dump { my($p,$item,$n) = @_; $p->{elements}++; $n = '' unless $n; my $ref = ref $item; if ($ref eq 'HASH') { return tabout($p->hash_recurse($item,"\n")); } elsif($ref eq 'ARRAY') { return $p->array_recurse($item,$n); } elsif($ref eq 'SCALAR') { # return q|\$SCALAR,|.$n; return($p->scalar_recurse($item,$n)); } elsif ($ref eq 'GLOB') { my $g = *{$item}; return "\\$g" .','.$n; } elsif(do {my $g = \$item; ref $g eq 'GLOB'}) { return "$item" .','.$n; } elsif($ref eq 'CODE') { return q|sub {'DUMMY'},|.$n; } elsif (defined $item) { return wrap_data($item) .','.$n; } else { return 'undef,'.$n; } } sub tabout { my @data = split(/\n/,shift); my $data = shift @data; $data .= "\n"; foreach(@data) { $data .= "\t$_\n"; } $data; } sub wrap_data { my $data = shift; return ($data =~ /\D/ || $data =~ /^$/) ? q|'|. $data .q|'| : $data; } 1; Math-Base-Convert-0.11/META.yml0000644000000000000000000000052612612261756014574 0ustar rootroot--- #YAML:1.0 name: Math-Base-Convert version: 0.11 abstract: ~ license: ~ author: ~ generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3