[WWcvs] pg: Modified context data objects to provide a copy method so that the

[dpvc v. a. <we...@ma...>]

Log Message:
-----------
Modified context data objects to provide a copy method so that the
various types of data can copy themselves (and can provide a more
comprehensive copy if necessary).

Modified Files:
--------------
    pg/lib/Parser:
        Context.pm
    pg/lib/Value:
        Context.pm
    pg/lib/Value/Context:
        Data.pm

Added Files:
-----------
    pg/lib/Value/Context:
        Diagnostics.pm

Revision Data
-------------
Index: Context.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/Parser/Context.pm -Llib/Parser/Context.pm -u -r1.14 -r1.15
--- lib/Parser/Context.pm
+++ lib/Parser/Context.pm
@@ -21,10 +21,9 @@
   $context->{parser} = {%{$Parser::class}};
   push(@{$context->{data}{values}},'parser');
   $context->{_initialized} = 0;
-  foreach my $list ('functions','variables','constants','operators','strings','parens') {
-    push(@{$context->{data}{hashes}},$list);
-    $context->{$list} = {};
-  }
+  push(@{$context->{data}{objects}},(
+    'functions','variables','constants','operators','strings','parens',
+  ));
   push(@{$context->{data}{values}},'reduction');
   my %data = (
     functions => {},
@@ -45,8 +44,8 @@
   $context->{_strings}   = new Parser::Context::Strings($context,%{$data{strings}});
   $context->{_parens}    = new Parser::Context::Parens($context,%{$data{parens}});
   $context->{_reduction} = new Parser::Context::Reduction($context,%{$data{reduction}});
-  $context->lists->set(%{$data{lists}}) if defined($data{lists});
-  $context->flags->set(%{$data{flags}}) if defined($data{flags});
+  $context->lists->set(%{$data{lists}});
+  $context->flags->set(%{$data{flags}});
   $context->{_initialized} = 1;
   $context->update;
   return $context;
Index: Context.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -Llib/Value/Context.pm -Llib/Value/Context.pm -u -r1.9 -r1.10
--- lib/Value/Context.pm
+++ lib/Value/Context.pm
@@ -13,7 +13,6 @@
 sub new {
   my $self = shift; my $class = ref($self) || $self;
   my $context = bless {
-    flags => {}, 
     pattern => {
       number => '(?:\d+(?:\.\d*)?|\.\d+)(?:E[-+]?\d+)?',
       signedNumber => '[-+]?(?:\d+(?:\.\d*)?|\.\d+)(?:E[-+]?\d+)?',
@@ -29,17 +28,19 @@
       msg => {},  # for localization
     },
     data => {
-      hashes => ['lists'],
+      hashes => [],
       arrays => ['data'],
-      values => ['flags','pattern','format'],
+      values => ['flags','pattern','format','value'],
+      objects => ['diagnostics','lists'],
     },
     value => {
       Formula => "Value::Formula"
     },
   }, $class;
-  my %data = (lists=>{},flags=>{},@_);
+  my %data = (lists=>{},flags=>{},diagnostics=>{},@_);
   $context->{_lists} = new Value::Context::Lists($context,%{$data{lists}});
   $context->{_flags} = new Value::Context::Flags($context,%{$data{flags}});
+  $context->{_diagnostics} = new Value::Context::Diagnostics($context,%{$data{diagnostics}});
   $context->{_initialized} = 1;
   $context->update;
   return $context;
@@ -53,9 +54,10 @@
 #
 #  Access to the data lists
 #
-sub lists     {(shift)->{_lists}}
-sub flags     {(shift)->{_flags}}
-sub flag      {(shift)->{_flags}->get(shift)}
+sub lists         {(shift)->{_lists}}
+sub flags         {(shift)->{_flags}}
+sub flag          {(shift)->{_flags}->get(shift)}
+sub diagnostics   {(shift)->{_diagnostics}}
 
 #
 #  Make a copy of a Context object
@@ -64,12 +66,15 @@
   my $self = shift;
   my $context = $self->new();
   $context->{_initialized} = 0;
+  foreach my $data (@{$context->{data}{objects}}) {
+    $context->{$data} = $self->{"_$data"}->copy;
+    $context->{"_$data"}->update;
+  }
   foreach my $data (@{$context->{data}{hashes}}) {
     $context->{$data} = {};
     foreach my $x (keys %{$self->{$data}}) {
       $context->{$data}{$x} = {%{$self->{$data}{$x}}};
     }
-    $context->{"_$data"}->update;
   }
   foreach my $data (@{$context->{data}{arrays}}) {
     $context->{$data} = {};
Index: Data.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context/Data.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/Value/Context/Data.pm -Llib/Value/Context/Data.pm -u -r1.8 -r1.9
--- lib/Value/Context/Data.pm
+++ lib/Value/Context/Data.pm
@@ -29,6 +29,25 @@
 sub uncreate {shift; shift}
 
 #
+#  Copy the hash data
+#
+sub copy {
+  my $self = shift;
+  my $data = $self->{context}->{$self->{dataName}};
+  my $copy = {};
+  foreach my $name (keys %{$data}) {
+    if (ref($data->{$name}) eq 'ARRAY') {
+      $copy->{$name} = [@{$data->{$name}}];
+    } elsif (ref($data->{$name}) eq 'HASH') {
+      $copy->{$name} = {%{$data->{$name}}};
+    } else {
+      $copy->{$name} = $data->{$name};
+    }
+  }
+  return $copy;
+}
+
+#
 #  Sort names so that they can be joined for regexp matching
 #
 sub byName {
@@ -213,6 +232,7 @@
 
 use Value::Context::Flags;
 use Value::Context::Lists;
+use Value::Context::Diagnostics;
 
 #########################################################################
 
--- /dev/null
+++ lib/Value/Context/Diagnostics.pm
@@ -0,0 +1,67 @@
+#########################################################################
+#
+#  Implement the list of Value::Diagnostics types
+#
+package Value::Context::Diagnostics;
+use strict;
+use vars qw (@ISA);
+@ISA = qw(Value::Context::Data);
+
+sub new {
+  my $self = shift; my $parent = shift;
+  $self->SUPER::new($parent,
+    formulas => {
+      show => 0,
+      showTestPoints => 1,
+      showAbsoluteErrors => 1,
+      showRelativeErrors => 1,
+      showGraphs => 1,
+      graphRelativeErrors => 1,
+      graphAbsoluteErrors => 1,
+      clipRelativeError => 5,
+      clipAbsoluteError => 5,
+      plotTestPoints => 1,
+      combineGraphs => 1,
+      checkNumericStability => 1,
+    },
+    graphs => {
+      divisions => 75,
+      limits => undef,
+      size => 250,
+      grid => [10,10],
+      axes => [0,0],
+    },
+    @_,
+  );
+}
+
+sub init {
+  my $self = shift;
+  $self->{dataName} = 'diagnostics';
+  $self->{name} = 'diagnostics';
+  $self->{Name} = 'Diagnostics';
+  $self->{namePattern} = '[-\w_.]+';
+}
+
+sub update {} # no pattern needed
+
+sub merge {
+  my $self = shift; my $type = shift;
+  my $merge = {%{$self->{context}{$self->{dataName}}}};
+  foreach my $object (@_) {
+    my $data = $object->{$self->{dataName}}; next unless $data;
+    $data = {$type=>{@{$data}}} if ref($data) eq 'ARRAY';
+    $data = {$type=>{show=>$data}} unless ref($data) eq 'HASH';
+    $merge->{$type}{show} = 1 if scalar(keys(%{$data}));
+    foreach my $x (keys %{$data}) {
+      if (ref($merge->{$x}) ne 'HASH') {$merge->{$x} = $data->{$x}}
+        else {$merge->{$x} = {%{$merge->{$x}},%{$data->{$x}}}}
+    }
+  }
+  return $merge;
+}
+
+
+#########################################################################
+
+1;