Oh anointed monks, lend me your ear.
I have been tasked with replacing some Visual Basic code with Perl Code. Most if it is cake, however I ran into a situation where the VB code retrieves a format specifier from the database and calls a VB.OLE function called Format. Format is basicaly a way of picturing the output format for a number.
For example:
Format Value Result 0 4 4 0 45 45 00 4 04 00 45 45 00 4.5 05 00.0 4 04.0 0.00 4 4.00 #0 4.5 5 #0 9.5 10 0E+0 0.34444 3E-1 000.000E+000 0.34444 344.440E-003 000.000E+000 0.34444 344.440E-003 ...etc...
Note. I'm lining up the columns for appearance. The results are all strings with no trailing or leading spaces.
A couple questions I would like to ask before I dive into this too far:
Is this in CPAN somewhere? I have looked, but perhaps someone knows a better search than I.
If not, I have a couple ideas on approaching this. 1) Use regex to grok the picture and then build a printf spec (%02.4F) based on what I find out. 2) Use regex to grok the picture and then the perl formline function to do the rest. 3) A pinch of 1 and dash of 2.
If anyone has any experience with either approach I would appreciate hearing your suggestions.
For those who are interested, here's what I came up with. Any suggestions would be appreciated.
use strict; use Test::More; use Math::Round; my $tests = [ [ '0', 43, '43', 'Can go past one digit.' +], [ '0', 4.4003, '4', 'Rounds down to 4'], [ '0', 4.5003, '5', 'Rounds up to 5'], [ '0', 400.5003, '401', 'Rounds up to 5'], [ '0', -34, '-34', 'no change to negative va +lues'], [ '#0', 4.5003, '5', 'Rounds up to 5'], [ '#0', 99.5003, '100', 'rounds up to 100'], [ '#0', 43, '43', 'as expected'], [ '#0', 4, '4', ''], [ '#0', 3.45E-4, '0', 'exponent negative roun +ded to zero'], [ '#0', 3.45E+4, '34500', 'exponent real ok.'], [ '00', 43, '43', ''], [ '00', 3, '03', ''], [ '00', 999, '999', ''], [ '00', 43, '43', ''], [ '0.0', 43.333, '43.3', ''], [ '0.0', -43.333, '-43.3', ''], [ '0.0', 44.35, '44.4', 'Floating rounded up.'] +, [ '#0.00', 43.3, '43.30', ''], [ '#0.00', 3.3, '3.30', ''], [ '#0.00', 43.3, '43.30', ''], [ '0.00', 43.3, '43.30', ''], [ '0.00', 43.3, '43.30', ''], [ '0.00', 43.3, '43.30', ''], [ '0000', 43, '0043', ''], [ '##0.000', 43.3, '43.300', ''], [ '0.000', 43.3, '43.300', ''], [ '00.00', 43.3, '43.30', ''], [ '000.0', 43.3, '043.3', ''], [ '0.0000', 43.3, '43.3000', ''], [ '000.00', 43.3, '043.30', ''], [ '000000', 43, '000043', ''], ['000.0000', 43.3, '043.3000', ''], ['0.00E-00', 43.3, '4.33E+01', ''], ['0.00E+00', 43.3, '4.33E+01', ''], ]; plan tests => scalar(@$tests); foreach my $test (@$tests) { my $result = formatString($test->[1], $test->[0]); printf("Pattern:[%s] Value:[%s], ExpectedResult:[%s] Result:[%s]\n", + @{$test}[0 .. 2], $result); is($result, $test->[2], $test->[3]); } sub formatString { my $value = shift; my $text = shift; my $debug = shift; my $workingValue = $value; # # will either be a digit or not. It doesn't appear to have any a +ffect on the result. # # 0 will be either 0 or a digit. # 0.00E-00 is a scientific example. # $text =~ s/^#+//; # # doesn't do much at all. my $beforeDotRE = qr{^([\d]+)}; # stuff before the decimal (if t +here is one) my $afterDotRE = qr{\.(\d*)(E[+-](\d+))?$}; # stuff after the d +ecimal. my $scientificRE = qw{E[+-](\d+)$}; # Scientific ending. my $textLength = length($text); my $beforeDot =''; my $beforeDotLen =0; if($text =~ m{$beforeDotRE}) { $beforeDot = $1; $beforeDotLen = length($beforeDot); } my $afterDot =''; my $afterDotLen =0; if($text =~ m{$afterDotRE}) { $afterDot = $1; $afterDotLen = length($afterDot); } my $scientific =''; my $scientificLen =0; if($text =~ m{$scientificRE}) { $scientific = $1; $scientificLen = length($scientific); } if($debug) { printf "Done Analyzing:[%s]\n", $text; printf "Format Length: [%d]\n", $textLength; printf " beforeDot: [%s]\n", $beforeDot; printf " afterDot: [%s]\n", $afterDot; printf " scientific: [%s]\n", $scientific; } my $spec; if ($afterDotLen <= 0) { # if the value is a float of some kind. Then it needs # to get rounded. $workingValue = Math::Round::round($value); # this is some kind of integer number. $spec = sprintf('%%0%d.%dd', $textLength, $textLength); } elsif ($scientificLen <= 0) { # this is a floating point number $spec = sprintf('%%0%d.%df', $textLength, $afterDotLen); } else { # this is a scientific number. $spec = sprintf('%%0%d.%dE', $textLength, $afterDotLen); } my $result = sprintf($spec, $workingValue); if($debug) { print " Original: [$value]\n"; print " Spec: [$spec]\n"; print "Working Value: [$workingValue]\n"; print " Result: [$result]\n\n"; } return $result; }
and some results:
1..35 Pattern:[0] Value:[43], ExpectedResult:[43] Result:[43] ok 1 - Can go past one digit. Pattern:[0] Value:[4.4003], ExpectedResult:[4] Result:[4] ok 2 - Rounds down to 4 Pattern:[0] Value:[4.5003], ExpectedResult:[5] Result:[5] ok 3 - Rounds up to 5 Pattern:[0] Value:[400.5003], ExpectedResult:[401] Result:[401] ok 4 - Rounds up to 5 Pattern:[0] Value:[-34], ExpectedResult:[-34] Result:[-34] ok 5 - no change to negative values Pattern:[#0] Value:[4.5003], ExpectedResult:[5] Result:[5] ok 6 - Rounds up to 5 Pattern:[#0] Value:[99.5003], ExpectedResult:[100] Result:[100] ok 7 - rounds up to 100 Pattern:[#0] Value:[43], ExpectedResult:[43] Result:[43] ok 8 - as expected Pattern:[#0] Value:[4], ExpectedResult:[4] Result:[4] ok 9 - Pattern:[#0] Value:[0.000345], ExpectedResult:[0] Result:[0] ok 10 - exponent negative rounded to zero Pattern:[#0] Value:[34500], ExpectedResult:[34500] Result:[34500] ok 11 - exponent real ok. Pattern:[00] Value:[43], ExpectedResult:[43] Result:[43] ok 12 - Pattern:[00] Value:[3], ExpectedResult:[03] Result:[03] ok 13 - Pattern:[00] Value:[999], ExpectedResult:[999] Result:[999] ok 14 - Pattern:[00] Value:[43], ExpectedResult:[43] Result:[43] ok 15 - Pattern:[0.0] Value:[43.333], ExpectedResult:[43.3] Result:[43.3] ok 16 - Pattern:[0.0] Value:[-43.333], ExpectedResult:[-43.3] Result:[-43.3] ok 17 - Pattern:[0.0] Value:[44.35], ExpectedResult:[44.4] Result:[44.4] ok 18 - Floating rounded up. Pattern:[#0.00] Value:[43.3], ExpectedResult:[43.30] Result:[43.30] ok 19 - Pattern:[#0.00] Value:[3.3], ExpectedResult:[3.30] Result:[3.30] ok 20 - Pattern:[#0.00] Value:[43.3], ExpectedResult:[43.30] Result:[43.30] ok 21 - Pattern:[0.00] Value:[43.3], ExpectedResult:[43.30] Result:[43.30] ok 22 - Pattern:[0.00] Value:[43.3], ExpectedResult:[43.30] Result:[43.30] ok 23 - Pattern:[0.00] Value:[43.3], ExpectedResult:[43.30] Result:[43.30] ok 24 - Pattern:[0000] Value:[43], ExpectedResult:[0043] Result:[0043] ok 25 - Pattern:[##0.000] Value:[43.3], ExpectedResult:[43.300] Result:[43.300 +] ok 26 - Pattern:[0.000] Value:[43.3], ExpectedResult:[43.300] Result:[43.300] ok 27 - Pattern:[00.00] Value:[43.3], ExpectedResult:[43.30] Result:[43.30] ok 28 - Pattern:[000.0] Value:[43.3], ExpectedResult:[043.3] Result:[043.3] ok 29 - Pattern:[0.0000] Value:[43.3], ExpectedResult:[43.3000] Result:[43.300 +0] ok 30 - Pattern:[000.00] Value:[43.3], ExpectedResult:[043.30] Result:[043.30] ok 31 - Pattern:[000000] Value:[43], ExpectedResult:[000043] Result:[000043] ok 32 - Pattern:[000.0000] Value:[43.3], ExpectedResult:[043.3000] Result:[043 +.3000] ok 33 - Pattern:[0.00E-00] Value:[43.3], ExpectedResult:[4.33E+01] Result:[4.3 +3E+01] ok 34 - Pattern:[0.00E+00] Value:[43.3], ExpectedResult:[4.33E+01] Result:[4.3 +3E+01] ok 35 -
In reply to Emulating VB Format function in Perl by osunderdog
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |