osunderdog has asked for the wisdom of the Perl Monks concerning the following question:

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...

[download]

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.

UPDATE: My Solution (for now)

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;
}

[download]

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 -

[download]
"Look, Shiny Things!" is not a better business strategy than compatibility and reuse.

OSUnderdog

Replies are listed 'Best First'.
Re: Emulating VB Format function in Perl
by hardburn (Abbot) on Nov 12, 2004 at 17:22 UTC

    I don't know much about VB formats, but I think Perl's formats will do what you want: perlform. It's not in a CPAN module (though it should be, and will be for Perl6).

    "There is no shame in being self-taught, only in not trying to learn in the first place." -- Atrus, Myst: The Book of D'ni.

[reply]
Re: Emulating VB Format function in Perl
by Zed_Lopez (Chaplain) on Nov 12, 2004 at 18:10 UTC

    Perl6::Form has formats on steroids, and, unlike just about all the other Perl6 modules, it doesn't use source filters or come with scary disclaimers about its unsuitability for production code.

[reply]
Re: Emulating VB Format function in Perl
by TedPride (Priest) on Nov 12, 2004 at 20:54 UTC
    I'd use method 1 myself. You only have to construct the sprintf spec once per line format, so your regex can be as inefficient as you like, and you're going to have to parse the format somehow regardless of which method you use to output the text.
[reply]

Back to Seekers of Perl Wisdom