App-SocialCalc-Multiplayer

 view release on metacpan or  search on metacpan

socialcalc/SocialCalcServersideUtilities.pm  view on Meta::CPAN

      for (my $cpos; ;$cpos++) { # scan for comparisons
         $op = $thisformat->{operators}->[$cpos];
         $operandstr = $thisformat->{operands}->[$cpos]; # get next operator and operand
         if (!$op) { # at end with no match
            if ($gotcomparison) { # if comparison but no match
               $format_string = "General"; # use default of General
               parse_format_string(\%format_definitions, $format_string);
               $thisformat = $format_definitions{$format_string};
               $section = 0;
               }
            last; # if no comparision, matchines on this section
            }
         if ($op == $cmd_section) { # end of section
            if (!$gotcomparison) { # no comparison, so it's a match
               last;
               }
            $gotcomparison = 0;
            $section++; # check out next one
            next;
            }
         if ($op == $cmd_comparison) { # found a comparison - do we meet it?
            my ($compop, $compval) = split(/:/, $operandstr, 2);
            $compval = 0+$compval;
            if (($compop eq "<" && $rawvalue < $compval) ||
                ($compop eq "<=" && $rawvalue <= $compval) ||
                ($compop eq "=" && $rawvalue == $compval) ||
                ($compop eq "<>" && $rawvalue != $compval) ||
                ($compop eq ">=" && $rawvalue >= $compval) ||
                ($compop eq ">" && $rawvalue > $compval)) { # a match
               last;
               }
            $gotcomparison = 1;
            }
         }
      }
   elsif ($section > 0) { # more than one section (separated by ";")
      if ($section == 1) { # two sections
         if ($negativevalue) {
            $negativevalue = 0; # sign will provided by section, not automatically
            $section = 1; # use second section for negative values
            }
         else {
            $section = 0; # use first for all others
            }
         }
      elsif ($section == 2) { # three sections
         if ($negativevalue) {
            $negativevalue = 0; # sign will provided by section, not automatically
            $section = 1; # use second section for negative values
            }
         elsif ($zerovalue) {
            $section = 2; # use third section for zero values
            }
         else {
            $section = 0; # use first for positive
            }
         }
      }

   # Get values for our section
   my ($sectionstart, $integerdigits, $fractiondigits, $commas, $percent, $thousandssep) =
      @{%{$thisformat->{sectioninfo}->[$section]}}{qw(sectionstart integerdigits fractiondigits commas percent thousandssep)};

   if ($commas > 0) { # scale by thousands
      for (my $i=0; $i<$commas; $i++) {
         $value /= 1000;
         }
      }
   if ($percent > 0) { # do percent scaling
      for (my $i=0; $i<$percent; $i++) {
         $value *= 100;
         }
      }

   my $decimalscale = 1; # cut down to required number of decimal digits
   for (my $i=0; $i<$fractiondigits; $i++) {
      $decimalscale *= 10;
      }
   my $scaledvalue = int($value * $decimalscale + 0.5);
   $scaledvalue = $scaledvalue / $decimalscale;

   $negativevalue = 0 if ($scaledvalue == 0 && ($fractiondigits || $integerdigits)); # no "-0" unless using multiple sections or General

   my $strvalue = "$scaledvalue"; # convert to string
   if ($strvalue =~ m/e/) { # converted to scientific notation
      return "$rawvalue"; # Just return plain converted raw value
      }
   $strvalue =~ m/^\+{0,1}(\d*)(?:\.(\d*)){0,1}$/; # get integer and fraction as character arrays
   my $integervalue = $1;
   $integervalue = "" if ($integervalue == 0);
   my @integervalue = split(//, $integervalue);
   my $fractionvalue = $2;
   $fractionvalue = "" if ($fractionvalue == 0);
   my @fractionvalue = split(//, $fractionvalue);

   if ($thisformat->{sectioninfo}->[$section]->{hasdate}) { # there are date placeholders
      if ($rawvalue < 0) { # bad date
         return "??-???-??&nbsp;??:??:??";
         }
      my $startval = ($rawvalue-int($rawvalue)) * $seconds_in_a_day; # get date/time parts
      my $estartval = $rawvalue * $seconds_in_a_day; # do elapsed time version, too
      $hrs = int($startval / $seconds_in_an_hour);
      $ehrs = int($estartval / $seconds_in_an_hour);
      $startval = $startval - $hrs * $seconds_in_an_hour;
      $mins = int($startval / 60);
      $emins = int($estartval / 60);
      $secs = $startval - $mins * 60;
      $decimalscale = 1; # round appropriately depending if there is ss.0
      for (my $i=0; $i<$fractiondigits; $i++) {
         $decimalscale *= 10;
         }
      $secs = int($secs * $decimalscale + 0.5);
      $secs = $secs / $decimalscale;
      $esecs = int($estartval * $decimalscale + 0.5);
      $esecs = $esecs / $decimalscale;
      if ($secs >= 60) { # handle round up into next second, minute, etc.
         $secs = 0;
         $mins++; $emins++;
         if ($mins >= 60) {
            $mins = 0;
            $hrs++; $ehrs++;
            if ($hrs >= 24) {
               $hrs = 0;
               $rawvalue++;
               }
            }
         }
      @fractionvalue = split(//, $secs-int($secs)); # for "hh:mm:ss.00"
      shift @fractionvalue; shift @fractionvalue;
      ($yr, $mn, $dy) = convert_date_julian_to_gregorian(int($rawvalue+$julian_offset));

socialcalc/SocialCalcServersideUtilities.pm  view on Meta::CPAN

            $cval = int($secs);
            $result .= "$cval";
            }
         elsif ($operandstrlc eq "ss") {
            $cval = 1000 + int($secs);
            $result .= substr("$cval", -2);
            }
         elsif ($operandstrlc eq "am/pm" || $operandstrlc eq "a/p") {
            $result .= $ampmstr;
            }
         elsif ($operandstrlc eq "ss]") {
            if ($esecs < 100) {
               $cval = 1000 + int($esecs);
               $result .= substr("$cval", -2);
               }
            else {
               $cval = int($esecs);
               $result = "$cval";
               }
            }
         }

      elsif ($op == $cmd_section) { # end of section
         last;
         }

      elsif ($op == $cmd_comparison) { # ignore
         next;
         }

      else {
         $result .= "!! Parse error !!";
         }
      }

   if ($textcolor) {
      $result = qq!<span style="color:$textcolor;">$result</span>!;
      }
   if ($textstyle) {
      $result = qq!<span style="$textstyle;">$result</span>!;
      }

   return $result;
}

# # # # # # # # #
#
# parse_format_string(\%format_defs, $format_string)
#
# Takes a format string (e.g., "#,##0.00_);(#,##0.00)") and fills in %foramt_defs with the parsed info
#
# %format_defs
#    {"#,##0.0"}->{} # elements in the hash are one hash for each format
#       {operators}->[] # array of operators from parsing the format string (each a number)
#       {operands}->[] # array of corresponding operators (each usually a string)
#       {sectioninfo}->[] # one hash for each section of the format
#          {start}
#          {integerdigits}
#          {fractiondigits}
#          {commas}
#          {percent}
#          {thousandssep}
#          {hasdates}
#       {hascomparison} # true if any section has [<100], etc.
#
# # # # # # # # #

sub parse_format_string {

   my ($format_defs, $format_string) = @_;

   return if ($format_defs->{$format_string}); # already defined - nothing to do

   my $thisformat = {operators => [], operands => [], sectioninfo => [{}]}; # create info structure for this format
   $format_defs->{$format_string} = $thisformat; # add to other format definitions

   my $section = 0; # start with section 0
   my $sectioninfo = $thisformat->{sectioninfo}->[$section]; # get reference to info for current section
   $sectioninfo->{sectionstart} = 0; # position in operands that starts this section

   my @formatchars = split //, $format_string; # break into individual characters

   my $integerpart = 1; # start out in integer part
   my $lastwasinteger; # last char was an integer placeholder
   my $lastwasslash; # last char was a backslash - escaping following character
   my $lastwasasterisk; # repeat next char
   my $lastwasunderscore; # last char was _ which picks up following char for width
   my ($inquote, $quotestr); # processing a quoted string
   my ($inbracket, $bracketstr, $cmd); # processing a bracketed string
   my ($ingeneral, $gpos); # checks for characters "General"
   my $ampmstr; # checks for characters "A/P" and "AM/PM"
   my $indate; # keeps track of date/time placeholders

   foreach my $ch (@formatchars) { # parse
      if ($inquote) {
         if ($ch eq '"') {
            $inquote = 0;
            push @{$thisformat->{operators}}, $cmd_copy;
            push @{$thisformat->{operands}}, $quotestr;
            next;
            }
         $quotestr .= $ch;
         next;
         }
      if ($inbracket) {
         if ($ch eq ']') {
            $inbracket = 0;
            ($cmd, $bracketstr) = parse_format_bracket($bracketstr);
            if ($cmd == $cmd_separator) {
               $sectioninfo->{thousandssep} = 1; # explicit [,]
               next;
               }
            if ($cmd == $cmd_date) {
               $sectioninfo->{hasdate} = 1;
               }
            if ($cmd == $cmd_comparison) {
               $thisformat->{hascomparison} = 1;
               }
            push @{$thisformat->{operators}}, $cmd;
            push @{$thisformat->{operands}}, $bracketstr;
            next;

socialcalc/SocialCalcServersideUtilities.pm  view on Meta::CPAN

         if (substr($indate,0,1) eq $ch) { # another of the same char
            $indate .= $ch; # accumulate it
            next;
            }
         push @{$thisformat->{operators}}, $cmd_date; # something else, save date info
         push @{$thisformat->{operands}}, $indate;
         $sectioninfo->{hasdate} = 1;
         $indate = "";
         }
      if ($ampmstr) {
         $ampmstr .= $ch;
         if ("am/pm" =~ m/^$ampmstr/i || "a/p" =~ m/^$ampmstr/i) {
            if (("am/pm" eq lc $ampmstr) || ("a/p" eq lc $ampmstr)) {
               push @{$thisformat->{operators}}, $cmd_date;
               push @{$thisformat->{operands}}, $ampmstr;
               $ampmstr = "";
               }
            next;
            }
         $ampmstr = "";
         }
      if ($ch eq "#" || $ch eq "0" || $ch eq "?") { # placeholder
         if ($integerpart) {
            $sectioninfo->{integerdigits}++;
            if ($sectioninfo->{commas}) { # comma inside of integer placeholders
               $sectioninfo->{thousandssep} = 1; # any number is thousands separator
               $sectioninfo->{commas} = 0; # reset count of "thousand" factors
               }
            $lastwasinteger = 1;
            push @{$thisformat->{operators}}, $cmd_integer_placeholder;
            push @{$thisformat->{operands}}, $ch;
            }
         else {
            $sectioninfo->{fractiondigits}++;
            push @{$thisformat->{operators}}, $cmd_fraction_placeholder;
            push @{$thisformat->{operands}}, $ch;
            }
         }
      elsif ($ch eq ".") { # decimal point
         $lastwasinteger = 0;
         push @{$thisformat->{operators}}, $cmd_decimal;
         push @{$thisformat->{operands}}, $ch;
         $integerpart = 0;
         }
      elsif ($ch eq '$') { # currency char
         $lastwasinteger = 0;
         push @{$thisformat->{operators}}, $cmd_currency;
         push @{$thisformat->{operands}}, $ch;
         }
      elsif ($ch eq ",") {
         if ($lastwasinteger) {
            $sectioninfo->{commas}++;
            }
         else {
            push @{$thisformat->{operators}}, $cmd_copy;
            push @{$thisformat->{operands}}, $ch;
            }
         }
      elsif ($ch eq "%") {
         $lastwasinteger = 0;
         $sectioninfo->{percent}++;
         push @{$thisformat->{operators}}, $cmd_copy;
         push @{$thisformat->{operands}}, $ch;
         }
      elsif ($ch eq '"') {
         $lastwasinteger = 0;
         $inquote = 1;
         $quotestr = "";
         }
      elsif ($ch eq '[') {
         $lastwasinteger = 0;
         $inbracket = 1;
         $bracketstr = "";
         }
      elsif ($ch eq '\\') {
         $lastwasslash = 1;
         $lastwasinteger = 0;
         }
      elsif ($ch eq '*') {
         $lastwasasterisk = 1;
         $lastwasinteger = 0;
         }
      elsif ($ch eq '_') {
         $lastwasunderscore = 1;
         $lastwasinteger = 0;
         }
      elsif ($ch eq ";") {
         $section++; # start next section
         $thisformat->{sectioninfo}->[$section] = {}; # create a new section
         $sectioninfo = $thisformat->{sectioninfo}->[$section]; # set to point to the new section
         $sectioninfo->{sectionstart} = 1 + scalar @{$thisformat->{operators}}; # remember where it starts
         $integerpart = 1; # reset for new section
         $lastwasinteger = 0;
         push @{$thisformat->{operators}}, $cmd_section;
         push @{$thisformat->{operands}}, $ch;
         }
      elsif ((lc $ch) eq "g") {
         $ingeneral = 1;
         $lastwasinteger = 0;
         }
      elsif ((lc $ch) eq "a") {
         $ampmstr = $ch;
         $lastwasinteger = 0;
         }
      elsif ($ch =~ m/[dmyhHs]/) {
         $indate = $ch;
         }
      else {
         $lastwasinteger = 0;
         push @{$thisformat->{operators}}, $cmd_copy;
         push @{$thisformat->{operands}}, $ch;
         }
      }

   if ($indate) { # last char was part of unsaved date placeholder
      push @{$thisformat->{operators}}, $cmd_date; # save what we got
      push @{$thisformat->{operands}}, $indate;
      $sectioninfo->{hasdate} = 1;
      }

   return;