A YAML like serializer for Active4D

gistfile1.txt

/*
  serialize library
  
  Serialize is beta library that seriailizes deeply nested collection into a blob.
  My need is that these collections never moved from a prototype implmentation in collections
  versues a table approach. The system is still in use, with hopes of moving off of 4D, but not yet!
  
  The current solution is to convert the collection to an objectTools object.  While it works, it is a little.
  slow, probably because as my parser. The xml is also bumping up against the 4.5 32k text limit.
  
  I tried to use JSON but it also has the 32K text limit and I didn't feel like parsing a blob.

  This approach uses a YAML like structure. The current version will only serialize simple data in the key value pairs
  Basically numbers, boolean and text. It does use some of the techniques I used in the JSON parser so
  it will hopefully be easy to add dates and maybe even text and number array, but currently restricted to simple
  data.
  
  The key/value pairs also use the Ruby concept of a symbol, which allows you to define words without quotes
  :a_word is converted to "a_word". It can be used on any string (key or value) that does not contain spaces and
  a few special characters.
  
  In my application the YAML like format is basically private, but a test routine at the end of the library
  starts with a text version to create a collection.
  
   
*/



library "serialize"

/************************************************************************************************
  constructor
  
  Purpose:  Create a serial data object. mainly to define the blob that contains the seralized collection.
  Require:  Nothing
  Promise:  An object is returned to which values can be added.
  Errors:   None
  
  Parameters: none
  RESULT    <-  serial object
************************************************************************************************/

  method "new"
    $c := new collection("__class__"; current library name;"level" ; -1)
    c_blob($c{"_serial"})
    return($c)
  end method
    
  /************************************************************************************************
    serialize

    Purpose:  Add a value to a JSON data object.
    Require:  $self was created with new()
    Promise:  $inValue will be output in YAML format with unserialize().
    Errors:   None

    Parameters:
    $self   ->  serial object
    $inCollection   ->  Collection - The input collection you want to serialize
    RESULT    <-  serial object in a YAML like blob    $self
  ************************************************************************************************/
  
  method "serialize"($self;$inCollection)
    $self{"level"}++
    for each ($inCollection; $key; $value)
      if (_is_a_coll($value))
        $out := '$key' + "\n"
        text to blob(_set_level($self;$out);$self{"_serial"};Text without length;*)
        serialize($self;$value)
        $self{"level"}--
      else
        $val := _set_val($value)
        $out := ':$key -> $val' + "\n"
        text to blob(_set_level($self;$out);$self{"_serial"};Text without length;*)
      end if
    end for each
    return($self{"_serial"})
  end method

  /************************************************************************************************
		unserialize

		Purpose:	Get the values of a YAML like data object and create an A4D collection.
		Require:	$self was created with new()
		Promise:	The result is valid A4D collection.
		Errors:		None

		Parameters:
		$self		->	serial object
		RESULT		<-	Collection
	************************************************************************************************/
	
  method "unserialize"($serial)
    global($keys;$c)
    array text($lines;0)
    blob_to_text_array($serial;$lines)
    $curr := -1
    $c := new collection
    $opt := ""
    array text($keys;10)

    for each ($lines; $line; $index)
      if ($line = "")
        continue
      end if
      $tab := 1
      while ($line[[$tab]] = "-")
        $tab++
      end while
      $tab--
      if ($tab > 0)
        $line := trim(substring($line;$tab + 1))
      else
        $line := trim($line)
      end if

      case of
        :($tab = 0)
          if ($opt)
            _set_opt_node($tab;$opt)
          end if
          if ($line =~ "/:/")
            $c := merge collections($c;rest.options($line))
          else
            $key := $line
            $keys{$tab} := $key
            $c{$key} := new collection
          end if
          $curr := 0
          
        :($tab = $curr)
          if ($line =~ "/:/")
            $opt += $line+";"
          else
             _make_new_node($tab -1;$tab;$line)
          end if
        :($tab > $curr)
          if ($opt)
            _set_opt_node($tab - 1;$opt)
          end if
          if ($line =~ "/:/")
            $opt := $line+";"
          else
            _make_new_node($curr;$tab;$line)
          end if
          $curr := $tab

        :($tab < $curr)
          if ($opt)
            _set_opt_node($curr - 1;$opt)
          end if
          if ($line =~ "/:/")
            $opt := $line+";"
          else
            _make_new_node($tab - 1;$tab;$line)
          end if
          $curr := $tab
      end case
    end for each
    if ($opt) // clean up any options after last line
      _set_opt_node($curr-1;$opt)
    end if
    return($c)
  end method
  
  /************************************************************************************************
		blob_to_text_array

		Purpose:	Convert the serial blob, which is the newline delimited text to a text array.
		Require:	the serial blob and a pointer to the array to store the lines
		Promise:	The result is updated text array.
		Errors:		None

		Parameters:
		$blog		->	An uncompressed blob
		RESULT		<-	Text array
	************************************************************************************************/
  
  method "blob_to_text_array"($blob;&$arr)
    $BlobPos:=0
    $BlobText:=""
    $BlobSize:=BLOB size($Blob)
    While ($BlobPos<$BlobSize)
      $BlobText:=BLOB to text($Blob;Text without length ;$BlobPos;LesserOf (MAXTEXTLEN ;($BlobSize-$BlobPos)))
      if ($blobPos < $blobSize)
        $last_lf := position("\n";$BlobText;-1;*)
        $BlobPos := 0
        $BlobText:=BLOB to text($Blob;Text without length ;$BlobPos;$last_lf )
      end if
      
      if(size of array($arr) = 0)
        $cnt := split string($BlobText;"\n";$arr)
      else
        $cnt := split string($BlobText;"\n";$rem_arr)
        for each ($rem_arr; $value; $index)
          $arr{} := $value
        end for each
      end if
    End while 
  end method
  
  /************************************************************************************************
		optToColl

		Purpose:	Implements a Ruby like scheme to create a new hash to create a new A4D collectiion.
		Require:	a string containing the new collection parameter in the form ":key -> value {; :key -> value; ...}"
		Promise:	The result is ab A4D collection.
		Errors:		None

		Parameters:
		$string		->	modified new collection parameters
		RESULT		<-	Collection
	************************************************************************************************/
  
  
   method "optToColl"($string;$removelf=true)
     if (type($string) = 9 ) // is longint
       return($string)
     end if
     // TODO date conversion disabled  
     //$re1 := "~\"?(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)( \\d\\d*, \d{4})\"~"
     //$rp1 := "newDate(\"\1\2\")"
     //regex replace($re1; $string; $rp1; $string)

     regex replace("/(->[^\"'])/";$string;":=";$list)
     $replace := "return (char(34)+trim(\"\1\")+char(34))"
     regex replace("/:([a-zA-Z_\\.0-9\\-][^:=;\\n]+)/e";$list;$replace;$list)
     regex replace("/(:=|=\\>)/";$list;";";$list)
     if ($removelf)
       $list := replace string($list;"\n";"")
     end if
     $result := execute('return(new collection($list))')
     return($result)
   end method
   
  /********* Private Methods**********/
  
  /********* 
  _set_level
  
  Putpose- Used at each line to define the nesting level, should probably use tabs.
  if level > 0, the "-" is prepended on the YAML like line
  **********/
  
  method "_set_level"($self;$val)
    if ($self{"level"} > 0)
      for ($i; 1; $self{"level"})
        $val := "-" + $val
      end for
    end if
    return($val)
  end method
  
  /********* 
  _is_a_coll
  
  alias to "is a collection" to first determine if a "value" in a key,value collection loop is a collection
  **********/
  
  method "_is_a_coll"($value)
    $result := false
    if (type($value) = 9)
      if (is a collection($value))
        $result := true
      end if
    end if
    return($result)
  end method

  /********* 
  _set_val
  
  Purpose: wrap a value in a key/value loop in double quotes if a string
  TODO  Add date and any other types we want to define
  **********/

  method "_set_val"($val)
    $type := type($val)
    if(($type = 8) | ($type = 9)| ($type = 1)| ($type = 11)| ($type = 6))
      return($val)
    else
      if(($type = 0) | ($type = 24) | ($type = 2))
        $val := replace string($val;"\"";"&apos;")
      end if
      return('"$val"')
    end if
  end method
  
  
  /********* 
  _getKeyedCollection
  
  Purpose: create a text version of a collection key ($c{key1}{key2}{key...}) dependant on a tab level in an array of keys
  the result is used in execute statements
  
  **********/
  
  method "_getKeyedCollection"($tab)
    global($keys;$c)
    $ck := "$c"
    for ($i; 0; $tab)
      $ck += '{"$keys{$i}"}'
    end for
    return($ck)
  end method
  
  /********* 
  _make_new_node
  
  add a new node/level to a collection (nesting)
  
  **********/
  
  method  "_make_new_node"($tab;$keyp;$line)
    global($keys;$c)
    $t := $c
    for ($i; 0; $tab)
      $t := $t{$keys{$i}}
    end for
    $key := $line
    $keys{$keyp} := $key
    $t{$key} := new collection
  end method

  /********* 
  _set_opt_node
  
  create new node(s) in a nested collection based on an option string (children)
  
  **********/
  
  method  "_set_opt_node"($tab;&$opt)
    global($keys;$c)
    $ck := _getKeyedCollection($tab)
    $o := optToColl(substring($opt;1;length($opt) - 1))
    execute($ck+" := merge collections("+$ck+";$o)")
    $opt := ""
  end method

/********   SIMPLE TEST METHOD ************/

  method "test"
    
    $YAML_like_text := """
cu_02
-answers
--01
---:id -> "01"
---:name -> :Yes
---:other -> ""
---:text -> "Yes"
---:value -> "1"
--02
---:id -> "02"
---:name -> "No"
---:other -> ""
---:text -> "No"
---:value -> "0"
-:critical -> False
-:display -> "list"
-:min -> 0
-:name -> "Ready to Work"
-:score -> "sum"
-:text -> "Do you have an Alabama Certified Worker (ACW) Certificate?"
-:type -> "radio"
-:weight -> 0
cu_03
-answers
--01
---:id -> "01"
---:name -> "Shipfitting"
---:other -> ""
---:text -> "Shipfitting"
---:value -> "1"
--02
---:id -> "02"
---:name -> "Aluminum/Copper/Nickel Welding"
---:other -> ""
---:text -> "Aluminum/Copper/Nickel Welding"
---:value -> "1"
--03
---:id -> "03"
---:name -> "Shipyard Terminology"
---:other -> ""
---:text -> "Shipyard Terminology"
---:value -> "1"
--04
---:id -> "04"
---:name -> "Math with Metrics"
---:other -> ""
---:text -> "Math with Metrics"
---:value -> "1"
--05
---:id -> "05"
---:name -> "Craft Tools"
---:other -> ""
---:text -> "Craft Tools"
---:value -> "1"
--06
---:id -> "06"
---:name -> "None of the above"
---:other -> ""
---:text -> "None of the above"
---:value -> "0"
-:critical -> False
-:display -> "list"
-:min -> 0
-:name -> ""
-:score -> "sum"
-:text -> "Please check all of the skills below that you have used in your work within the last five years."
-:type -> "checkbox"
-:weight -> 100
"""
   
    $start := milliseconds
    c_blob($blob)
    // convert text to blob
    text to blob($YAML_like_text;$blob;Text without length;*)
  
    writebr("<b>Test YAML</b>")
    writebr($YAML_like_text)
    
    $start := milliseconds
    
    $inColl := serialize.unserialize($blob)
    writebr("milliseconds for process - " + (milliseconds - $start))
  
    writebr("<b>The input collection</b>")
    a4d.debug.dump collection($inColl)
  
    // serialize it again
    $start := milliseconds
    $serialized := serialize.new
    $outBlob := $serialized->serialize($inColl)
    writebr("milliseconds for process - " +( milliseconds - $start))
  
  
    // serialized results 
    $BlobPos:=0
    $BlobText:=BLOB to text($outBlob;Text without length ;$BlobPos)
    writebr("<b>the unserialized results</b>")
    writebr($BlobText)
  
    // one more time
    $start := milliseconds
    $outColl := serialize.unserialize($outBlob)
    writebr("milliseconds for process - " +( milliseconds - $start))
  
    writebr("<b>The output collection</b>")
    a4d.debug.dump collection($outColl)
  end method

end library