From: Michael Wiebusch Date: Fri, 12 Jul 2013 11:23:58 +0000 (+0200) Subject: cleaned up around build ancestry, is now capsuled within integrateAncestry() X-Git-Url: https://jspc29.x-matter.uni-frankfurt.de/git/?a=commitdiff_plain;h=ea0fbb1c22c08d8ccf12926528b19ae5d34d5e86;p=mvdsensorcontrol.git cleaned up around build ancestry, is now capsuled within integrateAncestry() --- diff --git a/tools/Common.pm b/tools/Common.pm index 4cb5036..3b84553 100644 --- 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 aff6d30..ddf7beb 100755 --- 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 "

config file was deleted

"; } +#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 "

It's a bad idea to try to include yourself!

"; print "

The faulty include directive was removed.

"; print "

"; @@ -226,7 +244,7 @@ sub buildAncestry { # recursive print "

No circular includes, please!

"; print "

"; - print $parentXmlFileName. "->" + print $descendantXmlFileName. "->" . join( "->", @ancestryList ) . "->" . $configFileName; print "

"; @@ -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;