cleaned up around build ancestry, is now capsuled within integrateAncestry()

diff --git a/tools/Common.pm b/tools/Common.pm
index 4cb50362f7b84354f37e3f27a0b0062f29e9172e..3b845531392ec331845e1cacea2c9974f401f698 100644 (file)
--- a/tools/Common.pm
+++ b/tools/Common.pm
@@ -2,7 +2,11 @@
 
 
 #TODO
-# padZeros strangely not working!
+
+
+###############################
+## misc utilities
+###############################
 
 sub any2hex {
 
@@ -29,7 +33,6 @@ sub any2hex {
   
 }
 
-
 sub stripBasePrefix{
   my $argument = $_[0];
   
@@ -49,8 +52,6 @@ sub any2dec { # converts numeric expressions 0x, 0b or decimal to decimal
   }
 }
 
-
-
 sub stripLeadingZeros{
   my $string = $_[0];
   $string =~ s/^0+//;
@@ -59,8 +60,6 @@ sub stripLeadingZeros{
   
 }  
 
-
-
 sub hexStr2binStr {
   
   my $hexStr = $_[0];
@@ -105,6 +104,18 @@ sub zeros{
   return sprintf("%0".$_[0]."d",0);
 }
 
+sub padZeros{
+  my $string = $_[0]; # pointer!
+  my $paddingGroupSize = $_[1];
+  # bertram script does not like too short strings, so do not remove leading zeros
+  #$$string =~ s/^0+//; # remove leading zeros
+  my $stringLength = length($$string);
+  #print "strangeString:".$$string."\n";
+  
+  my $neededZeros = ($paddingGroupSize-($stringLength % $paddingGroupSize)) % $paddingGroupSize;
+  
+  $$string=zeros($neededZeros).$$string;
+}
 
 sub getFieldVal {
 
@@ -122,19 +133,6 @@ sub getFieldVal {
 
 }
 
-sub padZeros{
-  my $string = $_[0]; # pointer!
-  my $paddingGroupSize = $_[1];
-  # bertram script does not like too short strings, so do not remove leading zeros
-  #$$string =~ s/^0+//; # remove leading zeros
-  my $stringLength = length($$string);
-  #print "strangeString:".$$string."\n";
-  
-  my $neededZeros = ($paddingGroupSize-($stringLength % $paddingGroupSize)) % $paddingGroupSize;
-  
-  $$string=zeros($neededZeros).$$string;
-}
-
 sub writeFieldInRegister {
 
   my $regStr = $_[0]; # pointer!
@@ -159,6 +157,12 @@ sub writeFieldInRegister {
 
 }
 
+###############################
+## misc utilities
+###############################
+
+
+
 
 1;
 

diff --git a/tools/jtageditor.pl b/tools/jtageditor.pl
index aff6d3007a5ac92ff844fb2adf0143966af14905..ddf7bebabc7a5c0f08f7618645cc645c02693598 100755 (executable)
--- a/tools/jtageditor.pl
+++ b/tools/jtageditor.pl
@@ -12,6 +12,8 @@ print "Content-type: text/html\n\n";
 
 # build ancestry without ancestry tree outside
 
+# find a solution for fileLevel <=6
+
 
 # DONE
 # do not include wrong type, different specfile
@@ -48,22 +50,22 @@ if ( !keys %cgiHash )
 
 
 # some global variables
-my $parser       = XML::LibXML->new();
-my $specFile     = "";
-my $configFile      = "";
-my $specFileName = "";
-my $configFileName  = "";
-my $specTree;
-my $configTree;
-my $configMapsType;
+our $parser       = XML::LibXML->new();
+our $specFile     = "";
+our $configFile      = "";
+our $specFileName = "";
+our $configFileName  = "";
+our $specTree;
+our $configTree;
+our $configMapsType;
 
-my %fileLevelHash;
+our %fileLevelHash;
 
-my $ancestryTree;
-my @ancestryList;
+our $ancestryTree;
+our @ancestryList;
 
-my $confDir = '../config';
-my $specDir = '../specs';
+our $confDir = '../config';
+our $specDir = '../specs';
 
 # end of global variables
 
@@ -93,12 +95,19 @@ if ( $cgiHash{'print'} eq 'settree' ) {
                exit;
        }
        parseConfigAndSpec( $cgiHash{'configFile'} );
-       buildAncestry( $configFileName, "" )
-         ;    #arg1: target file, # arg2: recursion parent target file
+       
+
+       
+## obsolete
+#      buildAncestry( $configFileName, "" )
+#        ;    #arg1: target file, # arg2: recursion parent target file
+# 
+#      $configTree = $ancestryTree;    # not so elegant
+## now use:
 
-       #       assignFieldColors();#obsolete
+  integrateAncestry();
 
-       $configTree = $ancestryTree;    # not so elegant
+       
        print_ancestorInfo();
 
        print_registers($configFile);
@@ -146,7 +155,7 @@ if ( defined $cgiHash{'action'} ) {
 ## xml file operations
 ###############################
 
-sub deleteFile {
+sub deleteFile { 
   my $configFileName = $_[0];
   my $configFile     = $confDir . "/" . $configFileName;
   unless ( -e $configFile ) {
@@ -156,8 +165,9 @@ sub deleteFile {
   unlink($configFile);
   print "<p>config file was deleted</p>";
 }
+#args:configFileName #globs:$confDir
 
-sub createFile {
+sub createFile { 
   my $configFileName = $_[0];
 
   my $specFileName = $_[1];    #config file is based on this specification!
@@ -184,8 +194,9 @@ sub createFile {
   close SCHREIBEN;
 
 }
+#args: configFileName,specFileName #globs:$confDir,$specDir,$parser
 
-sub parseConfigAndSpec {
+sub parseConfigAndSpec { 
   parseConfig( $_[0] );
   $specFileName = $configTree->findvalue("/MAPS/\@specDbFile");
   $specFile     = $specDir . "/" . $specFileName;
@@ -196,23 +207,30 @@ sub parseConfigAndSpec {
   }
   $specTree = $parser->parse_file($specFile);
 }
+#args: configFileName #globs: $specFileName,$configTree,$specFile,$specDir,$specTree,$parser #calls: parseConfig()
 
-sub parseConfig {
+sub parseConfig { 
   $configFileName = $_[0];
   $configFile     = $confDir . "/" . $_[0];
   $configTree     = $parser->parse_file($configFile);
   $configMapsType = $configTree->findvalue("/MAPS/\@type");
 }
+#args: configFileName #globs: $confDir,$configTree,$parser,$configFile,$configMapsType,$configFileName
 
-sub buildAncestry {    # recursive
+sub buildAncestry { 
+  # the file for which the ancestry shall be built
   my $xmlfileName       = $_[0];
-  my $parentXmlFileName = $_[1];
+  # the file that referred $xmlfileName as its ancestor
+  # should be "" if you start building the ancestry from the bottom
+  my $descendantXmlFileName = $_[1];
+  
+  # no target file, no action!
   if ( $xmlfileName eq "" ) {
     return;
   }
 
   # check if you are not including yourself
-  if ( $parentXmlFileName eq $xmlfileName ) {
+  if ( $descendantXmlFileName eq $xmlfileName ) {
     print "<p>It's a bad idea to try to include yourself!</p>";
     print "<p>The faulty include directive was removed.</p>";
     print "<p><input type='button' onclick='loadFile()' value='back'></p>";
@@ -226,7 +244,7 @@ sub buildAncestry {    # recursive
 
       print "<p>No circular includes, please!</p>";
       print "<p>";
-      print $parentXmlFileName. "->"
+      print $descendantXmlFileName. "->"
         . join( "->", @ancestryList ) . "->"
         . $configFileName;
       print "</p>";
@@ -311,13 +329,33 @@ sub buildAncestry {    # recursive
     mergeTrees( $ancestryTree, $xmltree );
   }
   else {
-
-# this block is called when you are at the root of the ancestry -> you are THE Father
+# this block is called when you are at the root of the ancestry -> you are THE father
 # begin the ancestry tree
-
     $ancestryTree = $xmltree;
   }
+}
+# args: xmlfileName,
+#     parentXmlFileName
 
+# globs: @ancestryList,
+#     $ancestryTree,
+#     $configFileName,
+#     $confDir,
+#     $configTree,
+#     $configMapsType,
+#     %fileLevelHash
+
+# calls: changeAncestor(),
+#     mergeTrees()
+
+# usage: buildAncestry($configFile,""), do not use directly, use integrateAncestry()!
+# description: recursively adds the contents of the ancestor files of $configFile to $ancestryTree
+
+
+sub integrateAncestry {
+
+  buildAncestry($configFileName,"");
+  
   my $counter = 1;
   for my $file ( reverse(@ancestryList) ) {
     $fileLevelHash{$file} = $counter;
@@ -325,8 +363,12 @@ sub buildAncestry {    # recursive
       $counter++;
     }
   }
-
+  
+  $configTree = $ancestryTree;
 }
+# globs: @ancestryList,%fileLevelHash,$configFileName,$configTree,$ancestryTree
+# description: this function extends $configTree to include all information that is held
+# by its ancestor (and ancestor's ancestor ... and so on)
 
 sub del {
 
@@ -366,6 +408,87 @@ sub del {
   print SCHREIBEN $xmltree->toString();
   close SCHREIBEN;
 }
+# args: registerName,fieldName,
+# globs: $configFile,$configTree
+# description: deletes field "fieldName" in register "registerName" in $configFile
+
+
+sub save {
+
+  my $registerName = $_[0];
+  my $fieldName    = $_[1];
+  my $xmlfile      = $configFile;
+  my $newValue     = $_[2];
+
+  my $xmltree = $configTree;
+  my $maps    = $xmltree->findnodes("/MAPS")->shift();
+  my $register =
+    $xmltree->findnodes( "/MAPS/register[\@name='" . $registerName . "']" )
+    ->shift();
+
+  if ( $register eq "" ) {
+    $register = $maps->addNewChild( "", "register" );
+    $register->setAttribute( "name", $registerName );
+  }
+
+  my $field =
+    $xmltree->findnodes( "/MAPS/register[\@name='"
+      . $registerName
+      . "']/field[\@name='"
+      . $fieldName
+      . "']" )->shift();
+
+  if ( $field eq "" ) {
+    $field = $register->addNewChild( "", "field" );
+    $field->setAttribute( "name", $fieldName );
+
+  }
+
+  $field->setAttribute( "value", $newValue );
+  print $field->findvalue("./\@value");
+  open( SCHREIBEN, "> $xmlfile" )
+    or print "could not open file $xmlfile for writing: $!\n";
+
+  print SCHREIBEN $xmltree->toString();
+  close SCHREIBEN;
+}
+# args: registerName,fieldName,newValue
+# globs: $configFile,$configTree,
+# description: saves value "newValue" in field "fieldName" in register "registerName" (in the $configFile)
+# if field or register does not exist yet, it is created.
+
+sub copyDefaultRegister {
+  my $registerName = $_[0];
+  #my $configTree      = $parser->parse_file($configFile);
+  #my $specTree     = $parser->parse_file($specFile);
+  my $configmaps      = $configTree->findnodes("/MAPS")->shift();
+  my $specmaps     = $specTree->findnodes("/MAPS")->shift();
+
+  my $specRegister =
+    $specTree->findnodes( "/MAPS/register[\@name='" . $registerName . "']" )
+    ->shift();
+
+  my $configRegister = $configmaps->addNewChild( "", "register" );
+  $configRegister->setAttribute( "name", $registerName );
+
+  my @specFields = $specRegister->findnodes("./field");
+
+  for my $specField (@specFields) {
+    my $fieldName  = $specField->findvalue("./\@name");
+    my $fieldValue = $specField->findvalue("./\@defaultValue");
+    my $configField   = $configRegister->addNewChild( "", "field" );
+    $configField->setAttribute( "name",  $fieldName );
+    $configField->setAttribute( "value", $fieldValue );
+    print $configField->findvalue("./\@value");
+  }
+  open( SCHREIBEN, "> $configFile" )
+    or print "could not open file $configFile for writing: $!\n";
+
+  print SCHREIBEN $configTree->toString();
+  close SCHREIBEN;
+}
+# args: registerName
+# globs: $config
 
 
 ###############################
@@ -851,81 +974,6 @@ sub prepare_text {
        return $t;
 }
 
-sub save {
-
-       my $registerName = $_[0];
-       my $fieldName    = $_[1];
-       my $xmlfile      = $configFile;
-       my $newValue     = $_[2];
-
-       my $xmltree = $configTree;
-       my $maps    = $xmltree->findnodes("/MAPS")->shift();
-
-#my @fields = $xmltree->findnodes("/MAPS/register[\@name='".$registerName."']/field[\@name='".$fieldName."']");
-       my $register =
-         $xmltree->findnodes( "/MAPS/register[\@name='" . $registerName . "']" )
-         ->shift();
-
-       if ( $register eq "" ) {
-               $register = $maps->addNewChild( "", "register" );
-               $register->setAttribute( "name", $registerName );
-       }
-
-       my $field =
-         $xmltree->findnodes( "/MAPS/register[\@name='"
-                 . $registerName
-                 . "']/field[\@name='"
-                 . $fieldName
-                 . "']" )->shift();
-
-       if ( $field eq "" ) {
-               $field = $register->addNewChild( "", "field" );
-               $field->setAttribute( "name", $fieldName );
-
-       }
-
-#my $fieldValue = ($xmltree->findnodes("/MAPS/register[\@name='".$registerName."']/field[\@name='".$fieldName."']/\@name='value'"))[0];
-#print $fieldValue->findvalue("./");
-       $field->setAttribute( "value", $newValue );
-       print $field->findvalue("./\@value");
-       open( SCHREIBEN, "> $xmlfile" )
-         or print "could not open file $xmlfile for writing: $!\n";
-
-       print SCHREIBEN $xmltree->toString();
-       close SCHREIBEN;
-}
-
-sub copyDefaultRegister {
-       my $registerName = $_[0];
-       my $configTree      = $parser->parse_file($configFile);
-       my $specTree     = $parser->parse_file($specFile);
-       my $configmaps      = $configTree->findnodes("/MAPS")->shift();
-       my $specmaps     = $specTree->findnodes("/MAPS")->shift();
-
-       my $specRegister =
-         $specTree->findnodes( "/MAPS/register[\@name='" . $registerName . "']" )
-         ->shift();
-
-       my $configRegister = $configmaps->addNewChild( "", "register" );
-       $configRegister->setAttribute( "name", $registerName );
-
-       my @specFields = $specRegister->findnodes("./field");
-
-       for my $specField (@specFields) {
-               my $fieldName  = $specField->findvalue("./\@name");
-               my $fieldValue = $specField->findvalue("./\@defaultValue");
-               my $configField   = $configRegister->addNewChild( "", "field" );
-               $configField->setAttribute( "name",  $fieldName );
-               $configField->setAttribute( "value", $fieldValue );
-               print $configField->findvalue("./\@value");
-       }
-       open( SCHREIBEN, "> $configFile" )
-         or print "could not open file $configFile for writing: $!\n";
-
-       print SCHREIBEN $configTree->toString();
-       close SCHREIBEN;
-}
-
 # a sorting directive for fields and registers
 sub by_name {
        my $a_name = $a->findvalue("./\@name");
@@ -941,7 +989,6 @@ sub printHash {
        }
 }
 
-
 sub read_input {
        my $buffer;
        my @pairs;