File Coverage

blib/lib/Math/BaseConvert.pm
Criterion Covered Total %
statement 80 95 84.2
branch 26 44 59.0
condition 9 26 34.6
subroutine 15 16 93.7
pod 8 11 72.7
total 138 192 71.8


line stmt bran cond sub pod time code
1             # 3159mLT: Math::BaseConvert.pm created by Pip Stuart to CoNVert between arbitrary number Bases. I'm totally addicted to bass!
2             package Math::BaseConvert;
3             require Exporter;
4 2     2   5094 use strict;
  2         2  
  2         43  
5 2     2   6 use warnings;
  2         2  
  2         45  
6 2     2   6 use base qw(Exporter);
  2         2  
  2         147  
7 2     2   1724 use Math::BigInt;
  2         28711  
  2         6  
8 2     2   19760 use Memoize; memoize('summ'); memoize('fact'); memoize('choo');
  2         3222  
  2         2919  
9             # only export cnv() for 'use Math::BaseConvert;' && all other stuff optionally
10             our @EXPORT = qw(cnv ) ;
11             our @EXPORT_OK = qw( dec hex b10 b64 b64sort dig diginit summ fact choo) ;
12             our %EXPORT_TAGS = ( 'all' =>[ qw(cnv dec hex b10 b64 b64sort dig diginit summ fact choo) ],
13             'hex' =>[ qw( dec hex ) ],
14             'b64' =>[ qw(cnv b10 b64 b64sort ) ],
15             'dig' =>[ qw( dig diginit) ],
16             'sfc' =>[ qw( summ fact choo) ] );
17             our $VERSION = '1.8'; our $PTVR = $VERSION; $PTVR =~ s/^\d+\.\d+\.//; # Please see `perldoc Time::PT` for an explanation of $PTVR.
18             my $d2bs = ''; my %bs2d = (); my $nega = '';
19             my %digsets = (
20             'usr' => [], # this will be assigned if a dig(\@newd) call is made
21             'bin' => ['0', '1'],
22             'oct' => ['0'..'7'],
23             'dec' => ['0'..'9'],
24             'hex' => ['0'..'9', 'a'..'f'],
25             'HEX' => ['0'..'9', 'A'..'F'],
26             'b62' => ['0'..'9', 'a'..'z', 'A'..'Z'],
27             'b64' => ['0'..'9', 'A'..'Z', 'a'..'z', '.', '_'], # month:C:12 day:V:31
28             'm64' => ['A'..'Z', 'a'..'z', '0'..'9', '+', '/'], # 0-63 from MIME::Base64
29             'iru' => ['A'..'Z', 'a'..'z', '0'..'9', '[', ']'], # P10 server-server protocol used by IRCu daemon
30             'url' => ['A'..'Z', 'a'..'z', '0'..'9', '*', '-'], # URL style which avoids %2B && %2F expansions of '+' && '/' respectively
31             'rex' => ['A'..'Z', 'a'..'z', '0'..'9', '!', '-'], # Regular EXpression variant
32             'id0' => ['A'..'Z', 'a'..'z', '0'..'9', '_', '-'], # IDentifier style 0
33             'id1' => ['A'..'Z', 'a'..'z', '0'..'9', '.', '_'], # IDentifier style 1
34             'xnt' => ['A'..'Z', 'a'..'z', '0'..'9', '.', '-'], # XML Name Tokens (Nmtoken)
35             'xid' => ['A'..'Z', 'a'..'z', '0'..'9', '_', ':'], # XML identifiers (Name )
36             'b85' => ['0'..'9', 'A'..'Z', 'a'..'z', '!', '#', # RFC 1924 for IPv6 addresses, might need to return Math::BigInt objs
37             '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '`', '{', '|', '}', '~'],
38             );
39 13     13 0 40 sub bs2init { %bs2d = (); for(my $i = 0; $i < @{ $digsets{$d2bs} }; $i++) { $bs2d{${ $digsets{$d2bs} }[$i]} = $i; } } # build hash digit chars => array indices
  13         14  
  293         158  
  293         337  
  306         387  
40 3     3 1 141 sub diginit { $d2bs = 'b64'; bs2init(); } # reset digit character list to initial Dflt
  3         4  
41             sub dig { # assign a new digit character list
42 12 100   12 1 2433 return( @{ $digsets{$d2bs} } ) unless(@_);
  2         6  
43 10 100       20 if(ref $_[0]) { $d2bs = 'usr'; $digsets{$d2bs} = [ @{ shift() } ]; }
  4         5  
  4         3  
  4         15  
44 6 50       8 else { my $setn = shift(); return(-1) unless(exists $digsets{$setn}); $d2bs = $setn; }
  6         10  
  6         7  
45 10 50       11 diginit() unless(@{ $digsets{$d2bs} });
  10         19  
46 10         14 bs2init(); }
47             sub cnv__10 { # convert from some number base to decimal fast
48 11   50 11 0 19 my $t = shift || '0'; my $s = shift || 64; my $n = Math::BigInt->new(0);
  11   50     17  
  11         25  
49 11 100       600 $nega = ''; $nega = '-' if($t =~ s/^-//);
  11         25  
50 11 50       25 for(split(//, $t)) { return(-1) unless(exists $bs2d{$_}); }
  69         92  
51 11         21 while(length($t)) { $n += $bs2d{substr($t,0,1,'')}; $n *= $s; }
  69         3695  
  69         4575  
52 11         674 return($nega . int($n / $s)); }
53             sub cnv10__ { # convert from decimal to some number base fast
54 12   50 12 0 43 my $n = Math::BigInt->new(shift || '0'); my $s = shift || 64; my $t = '';
  12   50     265  
  12         13  
55 12 50       15 return(-1) if($s > @{ $digsets{$d2bs} });
  12         21  
56 12 100       10 $nega = ''; $nega = '-' if($n =~ s/^-//);
  12         22  
57 12         207 while($n) { $t = $digsets{$d2bs}->[($n % $s)] . $t; $n = int($n / $s); }
  48         3524  
  48         3731  
58 12 50       1026 if(length($t)) { $t = $nega . $t; }
  12         16  
59 0         0 else { $t = $digsets{$d2bs}->[0]; }
60 12         25 return($t); }
61 2     2 1 7 sub dec { return(cnv__10(uc(shift), 16)); }#shortcut for hexadecimal -> decimal
62 4     4 1 12 sub hex { return(cnv10__( shift, 16)); }#shortcut for decimal -> hex
63 4     4 1 129 sub b10 { return(cnv__10( shift, 64)); }#shortcut for base64 -> decimal
64 4     4 1 666 sub b64 { return(cnv10__( shift, 64)); }#shortcut for decimal -> base64
65 0     0 1 0 sub b64sort { return( map { b64($_) } sort { $a <=> $b } map { b10($_) } @_ ); }
  0         0  
  0         0  
  0         0  
66             sub cnv { # CoNVert between any number base
67 9 50 33 9 1 259 my $numb = shift; return(-1) unless(defined($numb) && length($numb));
  9         36  
68 9         7 my $fbas = shift; my $tbas = shift; my $rslt = ''; my $temp = 0;
  9         23  
  9         10  
  9         7  
69 9 50       20 return($digsets{$d2bs}->[0]) if($numb =~ /^-?0+$/); # lots of (negative?) zeros is just zero
70 9 100       14 if(!defined($tbas)) { # makeup reasonable values for missing params
71 4 50       7 if(!defined($fbas)) { $fbas = 10; $tbas = 16;
  0         0  
  0         0  
72 0 0 0     0 if ($numb =~ /^0x/i || ($numb =~ /[A-F]/i && $numb =~ /^[0-9A-F]+$/i )) { $fbas = 16; $tbas = 10; }
  0 0 0     0  
  0 0 0     0  
73 0         0 elsif($numb =~ /[G-Z._]/i && $numb =~ /^[0-9A-Z._]+$/i) { $fbas = 64; $tbas = 10; }
  0         0  
74 0         0 elsif($numb =~ /\D/) { print "!*EROR*! Can't determine reasonable FromBase && ToBase from number:$numb!\n"; }
75 4         3 } else { $tbas = $fbas; $fbas = 10; }
  4         3  
76             }
77 9 50       22 $fbas = 16 if($fbas =~ /\D/); $tbas = 10 if($tbas =~ /\D/);
  9 50       13  
78 9 50       13 if($fbas == 16) { $numb =~ s/^0x//i; $numb = uc($numb); }
  0         0  
  0         0  
79 9 50 33     25 return(-1) if($fbas < 2 || $tbas < 2); # invalid base error
80 9 100 100     45 $numb = cnv__10($numb, $fbas) if($numb =~ /\D/ || $fbas != 10);
81 9 100       534 $numb = cnv10__($numb, $tbas) if( $tbas != 10);
82 9         16 return($numb);
83             }
84             sub summ { # simple function to calculate summation down to 1
85             my $summ = shift; return(0) unless(defined($summ) && $summ && ($summ > 0)); my $answ = Math::BigInt->new($summ);while(--$summ){$answ +=$summ;} return($answ);
86             }
87             sub fact { # simple function to calculate factorials
88             my $fact = shift; return(0) unless(defined($fact) && $fact && ($fact > 0)); my $answ = Math::BigInt->new($fact);while(--$fact){$answ *=$fact;} return($answ);
89             }
90             sub choo { # simple function to calculate n choose m (i.e., (n! / (m! * (n - m)!)))
91             my $ennn = Math::BigInt->new(shift); my $emmm = Math::BigInt->new(shift);
92             return(0) unless(defined($ennn) && defined($emmm) && $ennn && $emmm && ($ennn != $emmm));
93             ($ennn, $emmm) = ($emmm, $ennn) if($ennn < $emmm); my $diff = Math::BigInt->new($ennn - $emmm); my $answ = Math::BigInt->new(fact($ennn));
94             my $mfct = Math::BigInt->new( fact( $emmm));my $dfct = Math::BigInt->new(fact($diff));
95             $mfct *= $dfct; return(0) unless($mfct);
96             $answ /= $mfct; return($answ);
97             }
98             diginit(); # initialize the Dflt digit set whenever BaseConvert is used
99             127;
100             =head1 NAME
101              
102             Math::BaseConvert - fast functions to CoNVert between number Bases
103              
104             =head1 VERSION
105              
106             This documentation refers to version 1.8 of Math::BaseConvert, which was released on Thu Apr 14 2016.
107              
108             =head1 SYNOPSIS
109              
110             use Math::BaseConvert;
111              
112             # CoNVert 63 from base-10 (decimal) to base- 2 (binary )
113             $binary_63 = cnv( 63, 10, 2 );
114             # CoNVert 111111 from base- 2 (binary ) to base-16 (hex )
115             $hex_63 = cnv( 111111, 2, 16 );
116             # CoNVert 3F from base-16 (hex ) to base-10 (decimal)
117             $decimal_63 = cnv( '3F', 16, 10 );
118             print "63 dec->bin $binary_63 bin->hex $hex_63 hex->dec $decimal_63\n";
119              
120             =head1 DESCRIPTION
121              
122             BaseConvert provides a few simple functions for converting between arbitrary number bases. It is as fast as I currently know how to make it (of course
123             relying only on the lovely Perl). If you would rather utilize an object syntax for number-base conversion, please see Ken Williams's
124             fine L module.
125              
126             =head1 PURPOSE
127              
128             The reason I created BaseConvert was that I needed a simple way to convert quickly between the 3 number bases I use most (10, 16, && 64). It turned out
129             that it was trivial to handle any arbitrary number base that is represented as characters. High-bit ASCII has proven somewhat problemmatic but at least
130             BaseConvert can simply && realiably convert between any possible base between 2 && 64 (or 85). I'm happy with it && employ b64() in places I probably
131             shouldn't now =).
132              
133             =head1 USAGE
134              
135             =head2 cnv($numb[,$from[,$tobs]])
136              
137             CoNVert the number contained in $numb from its current number base ($from) into the result number base ($tobs).
138              
139             B
140              
141             If $numb only contains valid decimal (base 10) digits, it will be converted to hexadecimal (base 16).
142              
143             If $numb only contains valid hexadecimal (base 16) digits or begins with '0x', it will be it will be converted to decimal (base 10).
144              
145             B
146              
147             cnv() assumes that $numb is already in decimal format && uses $from as the $tobs.
148              
149             B
150              
151             The normal (&& most clear) usage of cnv() is to provide all three parameters where $numb is converted from $from base to $tobs.
152              
153             cnv() is the only function that is exported from a normal 'use Math::BaseConvert;' command. The other functions below can be imported to local namespaces
154             explicitly or with the following tags:
155              
156             :all - every function described here
157             :hex - only dec() && hex()
158             :b64 - only b10() && b64() && b64sort() && cnv()
159             :dig - only dig() && diginit()
160             :sfc - only summ(), fact(), && choo()
161              
162             =head2 b10($b64n)
163              
164             A shortcut to convert the number given as a parameter ($b64n) from base 64 to decimal (base 10).
165              
166             =head2 b64($b10n)
167              
168             A shortcut to convert the number given as a parameter ($b10n) from decimal (base 10) to base 64.
169              
170             =head2 b64sort(@b64s)
171              
172             A way to sort b64 strings as though they were decimal numbers.
173              
174             =head2 dec($b16n)
175              
176             A shortcut to convert the number given as a parameter ($b16n) from hexadecimal (base 16) to decimal (base 10).
177              
178             =head2 hex($b10n)
179              
180             A shortcut to convert the number given as a parameter ($b10n) from decimal (base 10) to hexadecimal (base 16).
181              
182             Please read the L<"NOTES"> regarding hex().
183              
184             =head2 dig(\@newd)
185              
186             Assign the new digit character list to be used in place of the default one. dig() can also alternately accept a string name matching one of the
187             following predefined digit sets:
188              
189             'bin' => ['0', '1']
190             'oct' => ['0'..'7']
191             'dec' => ['0'..'9']
192             'hex' => ['0'..'9', 'a'..'f']
193             'HEX' => ['0'..'9', 'A'..'F']
194             'b62' => ['0'..'9', 'a'..'z', 'A'..'Z']
195             'b64' => ['0'..'9', 'A'..'Z', 'a'..'z', '.', '_']
196             'm64' => ['A'..'Z', 'a'..'z', '0'..'9', '+', '/'] # MIME::Base64
197             'iru' => ['A'..'Z', 'a'..'z', '0'..'9', '[', ']'] # IRCu
198             'url' => ['A'..'Z', 'a'..'z', '0'..'9', '*', '-'] # URL
199             'rex' => ['A'..'Z', 'a'..'z', '0'..'9', '!', '-'] # RegEx
200             'id0' => ['A'..'Z', 'a'..'z', '0'..'9', '_', '-'] # ID 0
201             'id1' => ['A'..'Z', 'a'..'z', '0'..'9', '.', '_'] # ID 1
202             'xnt' => ['A'..'Z', 'a'..'z', '0'..'9', '.', '-'] # XML Nmtoken
203             'xid' => ['A'..'Z', 'a'..'z', '0'..'9', '_', ':'] # XML ID Name
204             'b85' => ['0'..'9', 'A'..'Z', 'a'..'z', '!', '#', # RFC 1924 for
205             '$', '%', '&', '(', ')', '*', '+', '-', # IPv6 addrs
206             ';', '<', '=', '>', '?', '@', '^', '_', # like in
207             '`', '{', '|', '}', '~' ] # Math::Base85
208              
209             If no \@newd list or digit set name is provided as a parameter, dig() returns the current character list. It's fine to have many more characters
210             in your current digit set than will be used with your conversions (e.g., using dig('b64') works fine for any cnv() call with $from && $tobs params
211             less than or equal to 64).
212              
213             An example of a \@newd parameter for a specified alternate digit set for base 9 conversions is:
214              
215             dig( [ qw( n a c h o z y u m ) ] );
216              
217             =head2 diginit()
218              
219             Resets the used digit list to the initial default order of the predefined digit set: 'b64'. This is simply a shortcut for calling dig('b64') for
220             reinitialization purposes.
221              
222             =head2 summ($numb)
223              
224             A simple function to calculate a memoized summation of $numb down to 1.
225              
226             =head2 fact($numb)
227              
228             A simple function to calculate a memoized factorial of $numb.
229              
230             =head2 choo($ennn, $emmm)
231              
232             A simple function to calculate a memoized function of $ennn choose $emmm.
233              
234             =head1 NOTES
235              
236             The Perl builtin hex() function takes a hex string as a parameter && returns the decimal value (FromBase = 16, ToBase = 10) but this notation seems
237             counter-intuitive to me since a simple reading of the code suggests that a hex() function will turn your parameter into hexadecimal (i.e., It sounds
238             like Perl's hex() will hexify your parameter but it does not.) so I've decided (maybe foolishly) to invert the notation for my similar functions since
239             it makes more sense to me this way && will be easier to remember (I've had to lookup hex() in the Camel book many times already which was part of the
240             impetus for this module... as well as the gut reaction that sprintf() is not a proper natural inverse function for hex()).
241              
242             This means that my b64() function takes a decimal number as a parameter && returns the base64 equivalent (FromBase = 10, ToBase = 64) && my b10()
243             function takes a base64 number (string) && returns the decimal value (FromBase = 64, ToBase = 10). My hex() function overloads Perl's builtin version
244             with this opposite behavior so my dec() function behaves like Perl's normal hex() function. I know it's confusing && maybe bad form of me to do this
245             but I like it so much better this way that I'd rather go against the grain.
246              
247             Please think of my dec() && hex() functions as meaning decify && hexify. Also the pronunciation of dec() is 'dess' (!'deck' which would be the inverse
248             of 'ink' which -- && ++ already do so well). After reading the informative Perl module etiquette guidelines, I now appreciate the need to export as
249             little as is necessary by default. So to be responsible, I have limited BaseConvert exporting to only cnv() under normal circumstances. Please
250             specify the other functions you'd like to import into your namespace or use the tags described above in the cnv() section like:
251              
252             'use Math::BaseConvert qw(:all !:hex);'
253              
254             Error checking is minimal.
255              
256             This module does not handle fractional number inputs because I like using the dot (.) character as a standard base64 digit since it makes for clean filenames.
257              
258             summ(), fact(), && choo() are general Math function utilities which are unrelated to number-base conversion but I didn't feel like making another separate
259             module just for them so they snuck in here.
260              
261             I hope you find Math::BaseConvert useful. Please feel free to e-mail me any suggestions or coding tips or notes of appreciation ("app-ree-see-ay-shun").
262             Thank you. TTFN.
263              
264             =head1 2DO
265              
266             =over 2
267              
268             =item - better error checking
269              
270             =item - handle fractional parts? umm but I like using '.' as a b64 char so ',' comma or some other separator?
271              
272             =item - What else does BaseConvert need?
273              
274             =back
275              
276             =head1 CHANGES
277              
278             Revision history for Perl extension Math::BaseConvert:
279              
280             =over 2
281              
282             =item - 1.7 Tue May 29 2012
283              
284             * forked from Math::BaseCnv to fix version number
285              
286             =item - 1.1.6.A6FGHKE Tue Jun 15 16:17:20:14 2010
287              
288             * bumped minor version number so they'll keep ascending (without PT comprehension)
289              
290             =item - 1.4.A6FAbEb Tue Jun 15 10:37:14:37 2010
291              
292             * added Math::BigInt code for >64-bit number-base conversions
293              
294             * added a bunch more DigitSets: IRCu, URL, RegEx, identifier variants, XML Nmtoken, && XML ID Name
295              
296             =item - 1.4.75O6Pbr Thu May 24 06:25:37:53 2007
297              
298             * added Test::Pod(::Coverage)? tests && PREREQ entries
299              
300             * added b85 for IPv6, gen'd META.yml (w/ newline before EOF), up'd minor ver
301              
302             =item - 1.2.68J9uJQ Sat Aug 19 09:56:19:26 2006
303              
304             * added b64sort() && put pod at bottom
305              
306             =item - 1.2.59M7mRX Thu Sep 22 07:48:27:33 2005
307              
308             * testing Make as primary and BuildPL backup (needing rename for dot)
309              
310             =item - 1.2.59IBlgw Sun Sep 18 11:47:42:58 2005
311              
312             * testing just using Module::Build instead of MakeMaker
313              
314             * fixed test 12 which was failing on AMD64
315              
316             * added Build.PL to pkg
317              
318             =item - 1.2.54HK3pB Sun Apr 17 20:03:51:11 2005
319              
320             * removed 128 digit-set since some hi-bit chars cause probs on Win32
321              
322             * made bin/cnv only executable to go in EXE_FILES
323              
324             * made Math::BaseCalc a link in pod && updated License
325              
326             =item - 1.2.45UC8fo Sun May 30 12:08:41:50 2004
327              
328             * tidied POD && upped minor version number since CPAN can't read PTVR
329              
330             =item - 1.0.44E9ljP Wed Apr 14 09:47:45:25 2004
331              
332             * added test for div-by-zero error in choo()
333              
334             * added summ()
335              
336             =item - 1.0.446EIbS Tue Apr 6 14:18:37:28 2004
337              
338             * snuck in fact() && choo()
339              
340             =item - 1.0.42REDir Fri Feb 27 14:13:44:53 2004
341              
342             * changed test.pl to hopefully pass MSWin32-x86-multi-thread
343              
344             =item - 1.0.428LV46 Sun Feb 8 21:31:04:06 2004
345              
346             * broke apart CHANGES to descend chronologically
347              
348             * made dec() auto uppercase param since dec(a) was returning 36 instead of 10
349              
350             =item - 1.0.41M4GMP Thu Jan 22 04:16:22:25 2004
351              
352             * put cnv in bin/ as EXE_FILES
353              
354             =item - 1.0.418BEPc Thu Jan 8 11:14:25:38 2004
355              
356             * testing new e auto-gen MANIFEST(.SKIP)?
357              
358             =item - 1.0.3CNH37s Tue Dec 23 17:03:07:54 2003
359              
360             * updated POD
361              
362             =item - 1.0.3CG3dIx Tue Dec 16 03:39:18:59 2003
363              
364             * normalized base spelling
365              
366             =item - 1.0.3CD1Vdd Sat Dec 13 01:31:39:39 2003
367              
368             * added ABSTRACT section to WriteMakeFile()
369              
370             * changed synopsis example
371              
372             * updated all POD indenting
373              
374             =item - 1.0.3CCA5Mi Fri Dec 12 10:05:22:44 2003
375              
376             * removed indenting from POD NAME field
377              
378             =item - 1.0.3CB7M43 Thu Dec 11 07:22:04:03 2003
379              
380             * updated package to coincide with Time::Fields release
381              
382             =item - 1.0.39B36Lv Thu Sep 11 03:06:21:57 2003
383              
384             * synchronized POD with README documentation using new e utility
385              
386             * templatized package compilation
387              
388             * fixed boundary bugs
389              
390             =item - 1.0.37SLNGN Mon Jul 28 21:23:16:23 2003
391              
392             * first version (&& my first Perl module... yay!) put on CPAN
393              
394             =item - 1.0.37JKj3w Sat Jul 19 20:45:03:58 2003
395              
396             * reworked interface from shell utility to package
397              
398             =item - 1.0.3159mLT Sun Jan 5 09:48:21:29 2003
399              
400             * original version
401              
402             =back
403              
404             =head1 INSTALL
405              
406             Please run:
407              
408             `perl -MCPAN -e "install Math::BaseConvert"`
409              
410             or uncompress the package && run:
411              
412             `perl Makefile.PL; make; make test; make install`
413             or if you don't have `make` but Module::Build is installed
414             `perl Build.PL; perl Build; perl Build test; perl Build install`
415              
416             =head1 LICENSE
417              
418             Forked from Math::BaseCnv which is (c) 2003-2007, Pip Stuart.
419             Copyleft : This software is licensed under the GNU General Public License (version 3). Please consult the Free Software Foundation (HTTP://FSF.Org)
420             for important information about your freedom.
421              
422             =head1 AUTHOR
423              
424             Pip Stuart
425              
426             =head1 MAINTAINER
427              
428             chromatic ()
429              
430             =cut