Don't like ads? PRO users don't see any ads ;-)
Public Pastes
Guest

Untitled

By: a guest on May 30th, 2012  |  syntax: None  |  size: 12.54 KB  |  hits: 12  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. /*
  2.   serialize library
  3.  
  4.   Serialize is beta library that seriailizes deeply nested collection into a blob.
  5.   My need is that these collections never moved from a prototype implmentation in collections
  6.   versues a table approach. The system is still in use, with hopes of moving off of 4D, but not yet!
  7.  
  8.   The current solution is to convert the collection to an objectTools object.  While it works, it is a little.
  9.   slow, probably because as my parser. The xml is also bumping up against the 4.5 32k text limit.
  10.  
  11.   I tried to use JSON but it also has the 32K text limit and I didn't feel like parsing a blob.
  12.  
  13.   This approach uses a YAML like structure. The current version will only serialize simple data in the key value pairs
  14.   Basically numbers, boolean and text. It does use some of the techniques I used in the JSON parser so
  15.   it will hopefully be easy to add dates and maybe even text and number array, but currently restricted to simple
  16.   data.
  17.  
  18.   The key/value pairs also use the Ruby concept of a symbol, which allows you to define words without quotes
  19.   :a_word is converted to "a_word". It can be used on any string (key or value) that does not contain spaces and
  20.   a few special characters.
  21.  
  22.   In my application the YAML like format is basically private, but a test routine at the end of the library
  23.   starts with a text version to create a collection.
  24.  
  25.    
  26. */
  27.  
  28.  
  29.  
  30. library "serialize"
  31.  
  32. /************************************************************************************************
  33.   constructor
  34.  
  35.   Purpose:  Create a serial data object. mainly to define the blob that contains the seralized collection.
  36.   Require:  Nothing
  37.   Promise:  An object is returned to which values can be added.
  38.   Errors:   None
  39.  
  40.   Parameters: none
  41.   RESULT    <-  serial object
  42. ************************************************************************************************/
  43.  
  44.   method "new"
  45.     $c := new collection("__class__"; current library name;"level" ; -1)
  46.     c_blob($c{"_serial"})
  47.     return($c)
  48.   end method
  49.    
  50.   /************************************************************************************************
  51.     serialize
  52.  
  53.     Purpose:  Add a value to a JSON data object.
  54.     Require:  $self was created with new()
  55.     Promise:  $inValue will be output in YAML format with unserialize().
  56.     Errors:   None
  57.  
  58.     Parameters:
  59.     $self   ->  serial object
  60.     $inCollection   ->  Collection - The input collection you want to serialize
  61.     RESULT    <-  serial object in a YAML like blob    $self
  62.   ************************************************************************************************/
  63.  
  64.   method "serialize"($self;$inCollection)
  65.     $self{"level"}++
  66.     for each ($inCollection; $key; $value)
  67.       if (_is_a_coll($value))
  68.         $out := '$key' + "\n"
  69.         text to blob(_set_level($self;$out);$self{"_serial"};Text without length;*)
  70.         serialize($self;$value)
  71.         $self{"level"}--
  72.       else
  73.         $val := _set_val($value)
  74.         $out := ':$key -> $val' + "\n"
  75.         text to blob(_set_level($self;$out);$self{"_serial"};Text without length;*)
  76.       end if
  77.     end for each
  78.     return($self{"_serial"})
  79.   end method
  80.  
  81.   /************************************************************************************************
  82.                 unserialize
  83.  
  84.                 Purpose:        Get the values of a YAML like data object and create an A4D collection.
  85.                 Require:        $self was created with new()
  86.                 Promise:        The result is valid A4D collection.
  87.                 Errors:         None
  88.  
  89.                 Parameters:
  90.                 $self           ->      serial object
  91.                 RESULT          <-      Collection
  92.         ************************************************************************************************/
  93.        
  94.   method "unserialize"($serial)
  95.     global($keys;$c)
  96.     array text($lines;0)
  97.     blob_to_text_array($serial;$lines)
  98.     $curr := -1
  99.     $c := new collection
  100.     $opt := ""
  101.     array text($keys;10)
  102.  
  103.     for each ($lines; $line; $index)
  104.       if ($line = "")
  105.         continue
  106.       end if
  107.       $tab := 1
  108.       while ($line[[$tab]] = "-")
  109.         $tab++
  110.       end while
  111.       $tab--
  112.       if ($tab > 0)
  113.         $line := trim(substring($line;$tab + 1))
  114.       else
  115.         $line := trim($line)
  116.       end if
  117.  
  118.       case of
  119.         :($tab = 0)
  120.           if ($opt)
  121.             _set_opt_node($tab;$opt)
  122.           end if
  123.           if ($line =~ "/:/")
  124.             $c := merge collections($c;rest.options($line))
  125.           else
  126.             $key := $line
  127.             $keys{$tab} := $key
  128.             $c{$key} := new collection
  129.           end if
  130.           $curr := 0
  131.          
  132.         :($tab = $curr)
  133.           if ($line =~ "/:/")
  134.             $opt += $line+";"
  135.           else
  136.              _make_new_node($tab -1;$tab;$line)
  137.           end if
  138.         :($tab > $curr)
  139.           if ($opt)
  140.             _set_opt_node($tab - 1;$opt)
  141.           end if
  142.           if ($line =~ "/:/")
  143.             $opt := $line+";"
  144.           else
  145.             _make_new_node($curr;$tab;$line)
  146.           end if
  147.           $curr := $tab
  148.  
  149.         :($tab < $curr)
  150.           if ($opt)
  151.             _set_opt_node($curr - 1;$opt)
  152.           end if
  153.           if ($line =~ "/:/")
  154.             $opt := $line+";"
  155.           else
  156.             _make_new_node($tab - 1;$tab;$line)
  157.           end if
  158.           $curr := $tab
  159.       end case
  160.     end for each
  161.     if ($opt) // clean up any options after last line
  162.       _set_opt_node($curr-1;$opt)
  163.     end if
  164.     return($c)
  165.   end method
  166.  
  167.   /************************************************************************************************
  168.                 blob_to_text_array
  169.  
  170.                 Purpose:        Convert the serial blob, which is the newline delimited text to a text array.
  171.                 Require:        the serial blob and a pointer to the array to store the lines
  172.                 Promise:        The result is updated text array.
  173.                 Errors:         None
  174.  
  175.                 Parameters:
  176.                 $blog           ->      An uncompressed blob
  177.                 RESULT          <-      Text array
  178.         ************************************************************************************************/
  179.  
  180.   method "blob_to_text_array"($blob;&$arr)
  181.     $BlobPos:=0
  182.     $BlobText:=""
  183.     $BlobSize:=BLOB size($Blob)
  184.     While ($BlobPos<$BlobSize)
  185.       $BlobText:=BLOB to text($Blob;Text without length ;$BlobPos;LesserOf (MAXTEXTLEN ;($BlobSize-$BlobPos)))
  186.       if ($blobPos < $blobSize)
  187.         $last_lf := position("\n";$BlobText;-1;*)
  188.         $BlobPos := 0
  189.         $BlobText:=BLOB to text($Blob;Text without length ;$BlobPos;$last_lf )
  190.       end if
  191.      
  192.       if(size of array($arr) = 0)
  193.         $cnt := split string($BlobText;"\n";$arr)
  194.       else
  195.         $cnt := split string($BlobText;"\n";$rem_arr)
  196.         for each ($rem_arr; $value; $index)
  197.           $arr{} := $value
  198.         end for each
  199.       end if
  200.     End while
  201.   end method
  202.  
  203.   /************************************************************************************************
  204.                 optToColl
  205.  
  206.                 Purpose:        Implements a Ruby like scheme to create a new hash to create a new A4D collectiion.
  207.                 Require:        a string containing the new collection parameter in the form ":key -> value {; :key -> value; ...}"
  208.                 Promise:        The result is ab A4D collection.
  209.                 Errors:         None
  210.  
  211.                 Parameters:
  212.                 $string         ->      modified new collection parameters
  213.                 RESULT          <-      Collection
  214.         ************************************************************************************************/
  215.  
  216.  
  217.    method "optToColl"($string;$removelf=true)
  218.      if (type($string) = 9 ) // is longint
  219.        return($string)
  220.      end if
  221.      // TODO date conversion disabled  
  222.      //$re1 := "~\"?(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)( \\d\\d*, \d{4})\"~"
  223.      //$rp1 := "newDate(\"\1\2\")"
  224.      //regex replace($re1; $string; $rp1; $string)
  225.  
  226.      regex replace("/(->[^\"'])/";$string;":=";$list)
  227.      $replace := "return (char(34)+trim(\"\1\")+char(34))"
  228.      regex replace("/:([a-zA-Z_\\.0-9\\-][^:=;\\n]+)/e";$list;$replace;$list)
  229.      regex replace("/(:=|=\\>)/";$list;";";$list)
  230.      if ($removelf)
  231.        $list := replace string($list;"\n";"")
  232.      end if
  233.      $result := execute('return(new collection($list))')
  234.      return($result)
  235.    end method
  236.    
  237.   /********* Private Methods**********/
  238.  
  239.   /*********
  240.   _set_level
  241.  
  242.   Putpose- Used at each line to define the nesting level, should probably use tabs.
  243.   if level > 0, the "-" is prepended on the YAML like line
  244.   **********/
  245.  
  246.   method "_set_level"($self;$val)
  247.     if ($self{"level"} > 0)
  248.       for ($i; 1; $self{"level"})
  249.         $val := "-" + $val
  250.       end for
  251.     end if
  252.     return($val)
  253.   end method
  254.  
  255.   /*********
  256.   _is_a_coll
  257.  
  258.   alias to "is a collection" to first determine if a "value" in a key,value collection loop is a collection
  259.   **********/
  260.  
  261.   method "_is_a_coll"($value)
  262.     $result := false
  263.     if (type($value) = 9)
  264.       if (is a collection($value))
  265.         $result := true
  266.       end if
  267.     end if
  268.     return($result)
  269.   end method
  270.  
  271.   /*********
  272.   _set_val
  273.  
  274.   Purpose: wrap a value in a key/value loop in double quotes if a string
  275.   TODO  Add date and any other types we want to define
  276.   **********/
  277.  
  278.   method "_set_val"($val)
  279.     $type := type($val)
  280.     if(($type = 8) | ($type = 9)| ($type = 1)| ($type = 11)| ($type = 6))
  281.       return($val)
  282.     else
  283.       if(($type = 0) | ($type = 24) | ($type = 2))
  284.         $val := replace string($val;"\"";"&apos;")
  285.       end if
  286.       return('"$val"')
  287.     end if
  288.   end method
  289.  
  290.  
  291.   /*********
  292.   _getKeyedCollection
  293.  
  294.   Purpose: create a text version of a collection key ($c{key1}{key2}{key...}) dependant on a tab level in an array of keys
  295.   the result is used in execute statements
  296.  
  297.   **********/
  298.  
  299.   method "_getKeyedCollection"($tab)
  300.     global($keys;$c)
  301.     $ck := "$c"
  302.     for ($i; 0; $tab)
  303.       $ck += '{"$keys{$i}"}'
  304.     end for
  305.     return($ck)
  306.   end method
  307.  
  308.   /*********
  309.   _make_new_node
  310.  
  311.   add a new node/level to a collection (nesting)
  312.  
  313.   **********/
  314.  
  315.   method  "_make_new_node"($tab;$keyp;$line)
  316.     global($keys;$c)
  317.     $t := $c
  318.     for ($i; 0; $tab)
  319.       $t := $t{$keys{$i}}
  320.     end for
  321.     $key := $line
  322.     $keys{$keyp} := $key
  323.     $t{$key} := new collection
  324.   end method
  325.  
  326.   /*********
  327.   _set_opt_node
  328.  
  329.   create new node(s) in a nested collection based on an option string (children)
  330.  
  331.   **********/
  332.  
  333.   method  "_set_opt_node"($tab;&$opt)
  334.     global($keys;$c)
  335.     $ck := _getKeyedCollection($tab)
  336.     $o := optToColl(substring($opt;1;length($opt) - 1))
  337.     execute($ck+" := merge collections("+$ck+";$o)")
  338.     $opt := ""
  339.   end method
  340.  
  341. /********   SIMPLE TEST METHOD ************/
  342.  
  343.   method "test"
  344.    
  345.     $YAML_like_text := """
  346. cu_02
  347. -answers
  348. --01
  349. ---:id -> "01"
  350. ---:name -> :Yes
  351. ---:other -> ""
  352. ---:text -> "Yes"
  353. ---:value -> "1"
  354. --02
  355. ---:id -> "02"
  356. ---:name -> "No"
  357. ---:other -> ""
  358. ---:text -> "No"
  359. ---:value -> "0"
  360. -:critical -> False
  361. -:display -> "list"
  362. -:min -> 0
  363. -:name -> "Ready to Work"
  364. -:score -> "sum"
  365. -:text -> "Do you have an Alabama Certified Worker (ACW) Certificate?"
  366. -:type -> "radio"
  367. -:weight -> 0
  368. cu_03
  369. -answers
  370. --01
  371. ---:id -> "01"
  372. ---:name -> "Shipfitting"
  373. ---:other -> ""
  374. ---:text -> "Shipfitting"
  375. ---:value -> "1"
  376. --02
  377. ---:id -> "02"
  378. ---:name -> "Aluminum/Copper/Nickel Welding"
  379. ---:other -> ""
  380. ---:text -> "Aluminum/Copper/Nickel Welding"
  381. ---:value -> "1"
  382. --03
  383. ---:id -> "03"
  384. ---:name -> "Shipyard Terminology"
  385. ---:other -> ""
  386. ---:text -> "Shipyard Terminology"
  387. ---:value -> "1"
  388. --04
  389. ---:id -> "04"
  390. ---:name -> "Math with Metrics"
  391. ---:other -> ""
  392. ---:text -> "Math with Metrics"
  393. ---:value -> "1"
  394. --05
  395. ---:id -> "05"
  396. ---:name -> "Craft Tools"
  397. ---:other -> ""
  398. ---:text -> "Craft Tools"
  399. ---:value -> "1"
  400. --06
  401. ---:id -> "06"
  402. ---:name -> "None of the above"
  403. ---:other -> ""
  404. ---:text -> "None of the above"
  405. ---:value -> "0"
  406. -:critical -> False
  407. -:display -> "list"
  408. -:min -> 0
  409. -:name -> ""
  410. -:score -> "sum"
  411. -:text -> "Please check all of the skills below that you have used in your work within the last five years."
  412. -:type -> "checkbox"
  413. -:weight -> 100
  414. """
  415.    
  416.     $start := milliseconds
  417.     c_blob($blob)
  418.     // convert text to blob
  419.     text to blob($YAML_like_text;$blob;Text without length;*)
  420.  
  421.     writebr("<b>Test YAML</b>")
  422.     writebr($YAML_like_text)
  423.    
  424.     $start := milliseconds
  425.    
  426.     $inColl := serialize.unserialize($blob)
  427.     writebr("milliseconds for process - " + (milliseconds - $start))
  428.  
  429.     writebr("<b>The input collection</b>")
  430.     a4d.debug.dump collection($inColl)
  431.  
  432.     // serialize it again
  433.     $start := milliseconds
  434.     $serialized := serialize.new
  435.     $outBlob := $serialized->serialize($inColl)
  436.     writebr("milliseconds for process - " +( milliseconds - $start))
  437.  
  438.  
  439.     // serialized results
  440.     $BlobPos:=0
  441.     $BlobText:=BLOB to text($outBlob;Text without length ;$BlobPos)
  442.     writebr("<b>the unserialized results</b>")
  443.     writebr($BlobText)
  444.  
  445.     // one more time
  446.     $start := milliseconds
  447.     $outColl := serialize.unserialize($outBlob)
  448.     writebr("milliseconds for process - " +( milliseconds - $start))
  449.  
  450.     writebr("<b>The output collection</b>")
  451.     a4d.debug.dump collection($outColl)
  452.   end method
  453.  
  454. end library
create a new version of this paste RAW Paste Data