From: Michael Wiebusch Date: Thu, 11 Jul 2013 16:26:33 +0000 (+0200) Subject: sorted subs a bit X-Git-Url: https://jspc29.x-matter.uni-frankfurt.de/git/?a=commitdiff_plain;h=5323405b6c15373ead0844f9960af9cf0095d442;p=mvdsensorcontrol.git sorted subs a bit --- diff --git a/tools/jtageditor.pl b/tools/jtageditor.pl index 2b697a2..735bfce 100755 --- a/tools/jtageditor.pl +++ b/tools/jtageditor.pl @@ -75,6 +75,9 @@ if ( !keys %cgiHash ) exit; } + + +# some global variables my $parser = XML::LibXML->new(); my $specFile = ""; my $configFile = ""; @@ -166,494 +169,687 @@ if ( defined $cgiHash{'action'} ) { #################### SUBLAND ###################### + +############################### +## xml file operations +############################### + sub deleteFile { - my $configFileName = $_[0]; - my $configFile = $confDir . "/" . $configFileName; - unless ( -e $configFile ) { - print "

selected file not found

"; - exit; - } - unlink($configFile); - print "

config file was deleted

"; + my $configFileName = $_[0]; + my $configFile = $confDir . "/" . $configFileName; + unless ( -e $configFile ) { + print "

selected file not found

"; + exit; + } + unlink($configFile); + print "

config file was deleted

"; } sub createFile { - my $configFileName = $_[0]; + my $configFileName = $_[0]; - my $specFileName = $_[1]; #config file is based on this specification! - my $configFile = $confDir . "/" . $configFileName; - my $specFile = $specDir . "/" . $specFileName; + my $specFileName = $_[1]; #config file is based on this specification! + my $configFile = $confDir . "/" . $configFileName; + my $specFile = $specDir . "/" . $specFileName; - my $configTree = XML::LibXML->createDocument; - my $specTree = $parser->parse_file($specFile); + my $configTree = XML::LibXML->createDocument; + my $specTree = $parser->parse_file($specFile); - my $configMaps = $configTree->createElementNS( "", "MAPS" ); - $configTree->setDocumentElement($configMaps); + my $configMaps = $configTree->createElementNS( "", "MAPS" ); + $configTree->setDocumentElement($configMaps); - my $specMaps = $specTree->findnodes("/MAPS")->shift(); + my $specMaps = $specTree->findnodes("/MAPS")->shift(); - my $mapsType = $specMaps->findvalue("./\@type"); + my $mapsType = $specMaps->findvalue("./\@type"); - $configMaps->setAttribute( "type", $mapsType ); - $configMaps->setAttribute( "specDbFile", $specFileName ); - - open( SCHREIBEN, "> $configFile" ) - or print "could not open file $configFile for writing: $!\n"; - - print SCHREIBEN $configTree->toString(); - close SCHREIBEN; - -} - -sub print_ancestorInfo { - print "
"; - - #print "my ancestry:
"; - print "
"; - - #print "
"; - if (@ancestryList) - { # if ancestry is not empty, print current ancestry as a nested table - # and also a button that can unlink the heritage - - my $tableNestingDepth = @ancestryList; - for my $ancestor ( reverse(@ancestryList) ) { - print ""; - print ""; - if ( $fileLevelHash{$ancestor} eq "1" ) { - print < X  -EOF + $configMaps->setAttribute( "type", $mapsType ); + $configMaps->setAttribute( "specDbFile", $specFileName ); - } - print "
"; - } - for my $ancestor (@ancestryList) { - - print "
$ancestor "; - print ""; - print -"
"; - } - } - else { # print an ancestor selector! - print "include settings from:
"; - print_fileSelector( "", "ancestorSelector", - "changeAncestor(this.options[this.selectedIndex].text)" ); + open( SCHREIBEN, "> $configFile" ) + or print "could not open file $configFile for writing: $!\n"; - } + print SCHREIBEN $configTree->toString(); + close SCHREIBEN; - #print "
"; - print "
"; - print "$configFileName"; - print "
"; - print "
"; } -sub prepare_text { - my $t = $_[0]; - chomp $t; - $t = encode_entities($t); - $t =~ s/^\s//; - $t =~ s/^\n//; - $t =~ s/\t//; - return $t; -} sub parseConfigAndSpec { - parseConfig( $_[0] ); - $specFileName = $configTree->findvalue("/MAPS/\@specDbFile"); - $specFile = $specDir . "/" . $specFileName; - unless ( -e $specFile ) { - print + parseConfig( $_[0] ); + $specFileName = $configTree->findvalue("/MAPS/\@specDbFile"); + $specFile = $specDir . "/" . $specFileName; + unless ( -e $specFile ) { + print "

specification file \"$specFileName\" could not be found in the specification directory \"$specDir\"

"; - exit; - } - $specTree = $parser->parse_file($specFile); + exit; + } + $specTree = $parser->parse_file($specFile); } sub parseConfig { - $configFileName = $_[0]; - $configFile = $confDir . "/" . $_[0]; - $configTree = $parser->parse_file($configFile); - $configMapsType = $configTree->findvalue("/MAPS/\@type"); + $configFileName = $_[0]; + $configFile = $confDir . "/" . $_[0]; + $configTree = $parser->parse_file($configFile); + $configMapsType = $configTree->findvalue("/MAPS/\@type"); } sub buildAncestry { # recursive - my $xmlfileName = $_[0]; - my $parentXmlFileName = $_[1]; - if ( $xmlfileName eq "" ) { - return; - } + my $xmlfileName = $_[0]; + my $parentXmlFileName = $_[1]; + if ( $xmlfileName eq "" ) { + return; + } - # check if you are not including yourself - if ( $parentXmlFileName eq $xmlfileName ) { - print "

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

"; - print "

The faulty include directive was removed.

"; - print "

"; - changeAncestor(""); # break the evil circle where it was closed! - exit; - } + # check if you are not including yourself + if ( $parentXmlFileName eq $xmlfileName ) { + print "

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

"; + print "

The faulty include directive was removed.

"; + print "

"; + changeAncestor(""); # break the evil circle where it was closed! + exit; + } - # check against circular dependencies - for (@ancestryList) { # suppres circular dependencies! - if ( $xmlfileName eq $_ ) { - - print "

No circular includes, please!

"; - print "

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

"; - print "

The faulty include directive was removed.

"; - print - "

"; - changeAncestor(""); # break the evil circle where it was closed! - exit; - - #die "no circular includes please! $!"; - return; - } - } + # check against circular dependencies + for (@ancestryList) { # suppres circular dependencies! + if ( $xmlfileName eq $_ ) { + + print "

No circular includes, please!

"; + print "

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

"; + print "

The faulty include directive was removed.

"; + print + "

"; + changeAncestor(""); # break the evil circle where it was closed! + exit; + + #die "no circular includes please! $!"; + return; + } + } - my $xmlfile = $confDir . "/" . $xmlfileName; - - # check if all files in the ancestry really exist! - unless ( -e $xmlfile ) { - - print "

You are trying to include a file that does not exist

"; - print "

"; - print "" - . $xmlfileName - . "" . "->" - . join( "->", @ancestryList ) . "->" - . $configFileName; - print "

"; - print "

The faulty include directive was removed.

"; - print "

"; - changeAncestor(""); # break the evil circle where it was closed! - exit; - return; - } + my $xmlfile = $confDir . "/" . $xmlfileName; + + # check if all files in the ancestry really exist! + unless ( -e $xmlfile ) { + + print "

You are trying to include a file that does not exist

"; + print "

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

"; + print "

The faulty include directive was removed.

"; + print "

"; + changeAncestor(""); # break the evil circle where it was closed! + exit; + return; + } - my $xmltree; - if ( $xmlfile eq $configFile ) { - $xmltree = $configTree; - } - else { + my $xmltree; + if ( $xmlfile eq $configFile ) { + $xmltree = $configTree; + } + else { - # we got an ancestor here, write him to the ancestor list - unshift( @ancestryList, $xmlfileName ); - $xmltree = $parser->parse_file($xmlfile); + # we got an ancestor here, write him to the ancestor list + unshift( @ancestryList, $xmlfileName ); + $xmltree = $parser->parse_file($xmlfile); - # tag all the fields with an heritage attribute - for my $field ( $xmltree->findnodes("//field") ) { - $field->setAttribute( "isHeritageFrom", "$xmlfileName" ); - } - } + # tag all the fields with an heritage attribute + for my $field ( $xmltree->findnodes("//field") ) { + $field->setAttribute( "isHeritageFrom", "$xmlfileName" ); + } + } - my $ancestorFileName = $xmltree->findvalue("/MAPS/\@inheritSettingsFrom") - || ""; - my $currentMapsType = $xmltree->findvalue("/MAPS/\@type"); - my $currentSpecFileName = $xmltree->findvalue("/MAPS/\@specDbFile"); + my $ancestorFileName = $xmltree->findvalue("/MAPS/\@inheritSettingsFrom") + || ""; + my $currentMapsType = $xmltree->findvalue("/MAPS/\@type"); + my $currentSpecFileName = $xmltree->findvalue("/MAPS/\@specDbFile"); - # compliance checking MAPS type - unless ( $currentMapsType eq $configMapsType ) { - print + # compliance checking MAPS type + unless ( $currentMapsType eq $configMapsType ) { + print "

the included config file does not comply with the MAPS type of the current config file

"; - print "

The faulty include directive was removed.

"; - print "

"; - changeAncestor(""); # break the evil circle where it was closed! - exit; - } + print "

The faulty include directive was removed.

"; + print "

"; + changeAncestor(""); # break the evil circle where it was closed! + exit; + } - # compliance checking specDbFile - unless ( $currentSpecFileName eq $specFileName ) { - print + # compliance checking specDbFile + unless ( $currentSpecFileName eq $specFileName ) { + print "

the included config file is not based on the same specification file as current config file

"; - print "

The faulty include directive was removed.

"; - print "

"; - changeAncestor(""); # break the evil circle where it was closed! - exit; - } - unless ( $ancestorFileName eq "" ) { + print "

The faulty include directive was removed.

"; + print "

"; + changeAncestor(""); # break the evil circle where it was closed! + exit; + } + unless ( $ancestorFileName eq "" ) { - # this block is executed when an ancestor is found - buildAncestry( $ancestorFileName, $xmlfileName ) - ; # recursion, second argument is the target file from THIS parent recursion call + # this block is executed when an ancestor is found + buildAncestry( $ancestorFileName, $xmlfileName ) + ; # recursion, second argument is the target file from THIS parent recursion call - #integrate the current tree into the ancestryTree, overwrite older settings - mergeTrees( $ancestryTree, $xmltree ); - } - else { + #integrate the current tree into the ancestryTree, overwrite older settings + mergeTrees( $ancestryTree, $xmltree ); + } + else { # this block is called when you are at the root of the ancestry -> you are THE Father # begin the ancestry tree - $ancestryTree = $xmltree; - } - - my $counter = 1; - for my $file ( reverse(@ancestryList) ) { - $fileLevelHash{$file} = $counter; - if ( $counter < 6 ) { - $counter++; - } - } - -} + $ancestryTree = $xmltree; + } -sub mergeTrees -{ # give me two trees, tree1 overwrites everything in tree0 and will consequently be integrated in tree0 - my $tree0 = $_[0]; - my $tree1 = $_[1]; - - my $maps0 = $tree0->findnodes("/MAPS")->shift(); - my $maps1 = $tree1->findnodes("/MAPS")->shift(); - - my @registers0 = $tree0->findnodes("/MAPS/register"); - my @registers1 = $tree1->findnodes("/MAPS/register"); - - for my $register1 (@registers1) { - my $registerName = $register1->findvalue("./\@name"); - if ( $registerName eq "" ) { - die "registerName in tree1 undefined!"; - } - - # if current register does not exist in tree0, create it - my $register0 = - $maps0->findnodes( "./register[\@name='" . $registerName . "']" ) - ->shift(); - if ( $register0 eq "" ) { - $register0 = $maps0->addNewChild( "", "register" ); - $register0->setAttribute( "name", $registerName ); - } - - my @fields1 = $register1->findnodes("./field"); - for my $field1 (@fields1) { - my $fieldName = $field1->findvalue("./\@name"); - - # if field with same name exists in tree0/register0 delete it! - my $field0 = - $register0->findnodes( "./field[\@name='" . $fieldName . "']" ) - ->shift(); - unless ( $field0 eq "" ) { - $register0->removeChild($field0); - } - - # copy current field from tree1/register1 to tree0/register0 - - $register0->addChild($field1); - } + my $counter = 1; + for my $file ( reverse(@ancestryList) ) { + $fileLevelHash{$file} = $counter; + if ( $counter < 6 ) { + $counter++; + } + } - } } sub del { - my $registerName = $_[0]; - my $fieldName = $_[1]; - my $xmlfile = $configFile; - my $xmltree = $configTree; - my $maps = $xmltree->findnodes("/MAPS")->shift(); - my $register = - $xmltree->findnodes( "/MAPS/register[\@name='" . $registerName . "']" ) - ->shift(); + my $registerName = $_[0]; + my $fieldName = $_[1]; + my $xmlfile = $configFile; + my $xmltree = $configTree; + my $maps = $xmltree->findnodes("/MAPS")->shift(); + my $register = + $xmltree->findnodes( "/MAPS/register[\@name='" . $registerName . "']" ) + ->shift(); + + if ( $fieldName eq "" ) { # no field specified, remove whole register + unless ( $register eq "" ) { + $maps->removeChild($register); + } + print "deleted whole register"; + } + else { + + my $field = + $xmltree->findnodes( "/MAPS/register[\@name='" + . $registerName + . "']/field[\@name='" + . $fieldName + . "']" )->shift(); + $register->removeChild($field); + print "deleted field
"; + unless ( $register->hasChildNodes() ) { + $maps->removeChild($register); + print "deleted register as well
"; + } + } + open( SCHREIBEN, "> $xmlfile" ) + or print "could not open file $xmlfile for writing: $!\n"; - if ( $fieldName eq "" ) { # no field specified, remove whole register - unless ( $register eq "" ) { - $maps->removeChild($register); - } - print "deleted whole register"; - } - else { + print SCHREIBEN $xmltree->toString(); + close SCHREIBEN; +} - my $field = - $xmltree->findnodes( "/MAPS/register[\@name='" - . $registerName - . "']/field[\@name='" - . $fieldName - . "']" )->shift(); - $register->removeChild($field); - print "deleted field
"; - unless ( $register->hasChildNodes() ) { - $maps->removeChild($register); - print "deleted register as well
"; - } - } - open( SCHREIBEN, "> $xmlfile" ) - or print "could not open file $xmlfile for writing: $!\n"; - print SCHREIBEN $xmltree->toString(); - close SCHREIBEN; -} +############################### +## subs generating html output +############################### sub print_fileSelector { - my $configFile = $_[0]; - my $elementId = $_[1]; - my $action = $_[2]; - opendir( DIR, $confDir ) or die $!; + my $configFile = $_[0]; + my $elementId = $_[1]; + my $action = $_[2]; + opendir( DIR, $confDir ) or die $!; - print ''; - print ""; - my @xmlfiles; - while ( my $file = readdir(DIR) ) { + print ""; + my @xmlfiles; + while ( my $file = readdir(DIR) ) { - # Use a regular expression to ignore files beginning with a period - next if ( $file =~ m/^\./ ); + # Use a regular expression to ignore files beginning with a period + next if ( $file =~ m/^\./ ); - if ( $file =~ m/\.xml$/ ) { - push( @xmlfiles, $file ); - } - } - for my $file ( sort @xmlfiles ) { - print ''; - } - closedir(DIR); + if ( $file =~ m/\.xml$/ ) { + push( @xmlfiles, $file ); + } + } + for my $file ( sort @xmlfiles ) { + print ''; + } + closedir(DIR); - print ''; + print ''; } sub print_specSelector { - my $configFile = $_[0]; - opendir( DIR, $specDir ) or die $!; + my $configFile = $_[0]; + opendir( DIR, $specDir ) or die $!; - print ''; - my @xmlfiles; - while ( my $file = readdir(DIR) ) { + my @xmlfiles; + while ( my $file = readdir(DIR) ) { - # Use a regular expression to ignore files beginning with a period - next if ( $file =~ m/^\./ ); + # Use a regular expression to ignore files beginning with a period + next if ( $file =~ m/^\./ ); - if ( $file =~ m/\.xml$/ ) { - push( @xmlfiles, $file ); - } - } - for my $file ( sort @xmlfiles ) { - print ''; - } - closedir(DIR); + if ( $file =~ m/\.xml$/ ) { + push( @xmlfiles, $file ); + } + } + for my $file ( sort @xmlfiles ) { + print ''; + } + closedir(DIR); - print ''; + print ''; } sub print_fileSelection { - my $configFile = $_[0]; + my $configFile = $_[0]; - print "

selected config file

"; - print "

"; + print "

selected config file

"; + print "

"; - print_fileSelector( $configFile, "fileSelector", "loadFile()" ); - print + print_fileSelector( $configFile, "fileSelector", "loadFile()" ); + print ""; - print + print ""; - print "

"; - - print "

create new config file

"; - print "

"; - print ""; - print ""; - print ""; - print ""; - print "
filenamebased on specification
"; - print ""; - print ""; - print_specSelector(); - print ""; - print + print "

"; + + print "

create new config file

"; + print "

"; + print ""; + print ""; + print ""; + print ""; + print "
filenamebased on specification
"; + print ""; + print ""; + print_specSelector(); + print ""; + print ""; - print "
"; + print "

"; - print "

"; + print "

"; -# print ""; -# print ""; +# print ""; # -# print ""; +# print ""; # -# print "
"; -# print ""; -# print ""; -# print ""; +# print "
selected config file:"; -# print "
"; +# print "
"; +# print ""; +# print ""; +# print ""; # -# print ""; +# print ""; # -# print ""; +# print ""; # -# print ""; +# print ""; # -# print ""; +# print ""; # -# print "
selected config file:"; +# print "
"; -# print_fileSelector( $configFile, "fileSelector", "loadFile()" ); -# print ""; +# print_fileSelector( $configFile, "fileSelector", "loadFile()" ); +# print ""; -# print +# print ""; +# print #""; -# print +# print #""; -# print "
"; +# print "
"; # -# print "

"; -# print ""; -# print ""; +# print ""; -# print "
"; -# print "create new config file:"; -# print "
"; +# print ""; +# print ""; # -# print ""; +# print ""; # -# print "
"; +# print "create new config file:"; +# print "
"; -# print ""; -# print ""; -# print_specSelector(); -# print ""; -# print +# print "
"; +# print ""; +# print ""; +# print_specSelector(); +# print ""; +# print #""; -# print "
"; -# print "
"; +# print "
"; +# print ""; +# print ""; +} + +sub print_registers { + my $xmlfile = $_[0]; + my $xmltree; + if ( $xmlfile eq $configFile ) { + $xmltree = $configTree; + } + elsif ( $xmlfile eq $specFile ) { + $xmltree = $specTree; + } + else { + die "xmlfile given to sub print_registers is unknown"; + } + my @registers = sort by_name $xmltree->findnodes("/MAPS/register"); + print ""; + for my $register (@registers) { + + my $registerName = $register->findvalue("./\@name"); + my $registerId = $register->findvalue("./\@id"); + my $registerSize = $register->findvalue("./\@size"); + my $registerDescr = prepare_text( + $specTree->findvalue( + "/MAPS/register[\@name='" . $registerName . "']/description" + ) + || "n/a" + ); + + my $flistid = $xmlfile . "//" . $registerName; + + print ""; + + print < +  +EOF + print ""; + + #print ""; + + if ( $xmlfile eq $configFile ) { # we are printing the Specifications Tree + print < X  +EOF + } + if ( $xmlfile eq $specFile ) { # we are printing the Settings Tree + + print < →  +EOF + } + + print ""; + + #print ""; + + print ''; + print ''; + print '"; + } + print "
$registerName$registerId
'; + print_fields( $xmlfile, $register ); + print ""; + print "
"; } +sub print_fields { + + my $register = $_[1]; + my $xmlfile = $_[0]; + my $registerName = $register->findvalue("./\@name"); + my @fields = sort by_name $register->findnodes("./field"); + print ""; + for my $field (@fields) { + my $fieldName = $field->findvalue("./\@name"); + my $isHeritageFrom = $field->findvalue("./\@isHeritageFrom") || ""; + my $readOnlyFlag = 0; + my $fieldValue = $field->findvalue("./\@value"); + my $fieldSize = + $specTree->findvalue( "/MAPS/register[\@name='" + . $registerName + . "']/field[\@name='" + . $fieldName + . "']/\@size" ) + || "n/a"; + my $fieldDescr = prepare_text( + $specTree->findvalue( + "/MAPS/register[\@name='" + . $registerName + . "']/field[\@name='" + . $fieldName + . "']/description" + ) + || "n/a" + ); + + my $maxFieldVal = 2**$fieldSize; + my $sizeInfo = + sprintf( + "Field contains %d bits, possible values: 0-%d (0x0-0x%x)\n\n", + $fieldSize, $maxFieldVal, $maxFieldVal ); + + $fieldDescr = $sizeInfo . $fieldDescr; + + unless ( $isHeritageFrom eq "" ) { + $fieldDescr = + "Field was inherited from $isHeritageFrom\n\n" . $fieldDescr; + } + + my $fieldId = $xmlfile . "//" . $registerName . "/" . $fieldName; + if ( $fieldValue eq "" ) { + $fieldValue = $field->findvalue("./\@defaultValue"); + $readOnlyFlag = 1; + } + + print ""; + print ""; + print ""; + if ($readOnlyFlag) { + print <$fieldValue +EOF + } + else { + print < + + +EOF + + } + + print ''; + if ( $xmlfile eq $specFile ) { # we are printing the Specifications tree + print < →  +EOF + } + if ( $xmlfile eq $configFile ) { # we are printing the Settings Tree + + if ( $isHeritageFrom eq "" ) + { # these are actual settings, not inherited! + print < X  +EOF + } + else { + print ""; + } + } + print ""; + if ( ( any2dec($fieldValue) < 0 ) + or ( any2dec($fieldValue) > $maxFieldVal ) ) + { + print +"" + ; # just debug + } + } + print "
$fieldName  =  X 
!!!Above value not in allowed range!!!
"; + +} + +sub print_ancestorInfo { + print "
"; + + #print "my ancestry:
"; + print "
"; + + #print "
"; + if (@ancestryList) + { # if ancestry is not empty, print current ancestry as a nested table + # and also a button that can unlink the heritage + + my $tableNestingDepth = @ancestryList; + for my $ancestor ( reverse(@ancestryList) ) { + print ""; + print ""; + if ( $fileLevelHash{$ancestor} eq "1" ) { + print < X  +EOF + + } + print "
"; + } + for my $ancestor (@ancestryList) { + + print "
$ancestor "; + print ""; + print +"
"; + } + } + else { # print an ancestor selector! + print "include settings from:
"; + print_fileSelector( "", "ancestorSelector", + "changeAncestor(this.options[this.selectedIndex].text)" ); + + } + + #print "
"; + print "
"; + print "$configFileName"; + print "
"; + print "
"; +} + + + +############################### +## general xml tools +############################### + + +sub mergeTrees +{ # give me two trees, tree1 overwrites everything in tree0 and will consequently be integrated in tree0 + my $tree0 = $_[0]; + my $tree1 = $_[1]; + + my $maps0 = $tree0->findnodes("/MAPS")->shift(); + my $maps1 = $tree1->findnodes("/MAPS")->shift(); + + my @registers0 = $tree0->findnodes("/MAPS/register"); + my @registers1 = $tree1->findnodes("/MAPS/register"); + + for my $register1 (@registers1) { + my $registerName = $register1->findvalue("./\@name"); + if ( $registerName eq "" ) { + die "registerName in tree1 undefined!"; + } + + # if current register does not exist in tree0, create it + my $register0 = + $maps0->findnodes( "./register[\@name='" . $registerName . "']" ) + ->shift(); + if ( $register0 eq "" ) { + $register0 = $maps0->addNewChild( "", "register" ); + $register0->setAttribute( "name", $registerName ); + } + + my @fields1 = $register1->findnodes("./field"); + for my $field1 (@fields1) { + my $fieldName = $field1->findvalue("./\@name"); + + # if field with same name exists in tree0/register0 delete it! + my $field0 = + $register0->findnodes( "./field[\@name='" . $fieldName . "']" ) + ->shift(); + unless ( $field0 eq "" ) { + $register0->removeChild($field0); + } + + # copy current field from tree1/register1 to tree0/register0 + + $register0->addChild($field1); + } + + } +} + + sub changeAncestor { - my $ancestorFileName = $_[0]; - my $xmltree = $configTree; - my $xmlfile = $configFile; - my $maps = $xmltree->findnodes("/MAPS")->shift(); + my $ancestorFileName = $_[0]; + my $xmltree = $configTree; + my $xmlfile = $configFile; + my $maps = $xmltree->findnodes("/MAPS")->shift(); - $maps->setAttribute( "inheritSettingsFrom", $ancestorFileName ); + $maps->setAttribute( "inheritSettingsFrom", $ancestorFileName ); - open( SCHREIBEN, "> $xmlfile" ) - or print "could not open file $xmlfile for writing: $!\n"; + open( SCHREIBEN, "> $xmlfile" ) + or print "could not open file $xmlfile for writing: $!\n"; - print SCHREIBEN $xmltree->toString(); - close SCHREIBEN; + print SCHREIBEN $xmltree->toString(); + close SCHREIBEN; } sub getAncestor { - my $xmltree = $configTree; - return ( $xmltree->findvalue("/MAPS/\@inheritSettingsFrom") || "" ); + my $xmltree = $configTree; + return ( $xmltree->findvalue("/MAPS/\@inheritSettingsFrom") || "" ); } + + +############################### +## misc utilities +############################### + + +sub prepare_text { + my $t = $_[0]; + chomp $t; + $t = encode_entities($t); + $t =~ s/^\s//; + $t =~ s/^\n//; + $t =~ s/\t//; + return $t; +} + + + sub save { my $registerName = $_[0]; @@ -746,170 +942,6 @@ sub printHash { -sub print_registers { - my $xmlfile = $_[0]; - my $xmltree; - if ( $xmlfile eq $configFile ) { - $xmltree = $configTree; - } - elsif ( $xmlfile eq $specFile ) { - $xmltree = $specTree; - } - else { - die "xmlfile given to sub print_registers is unknown"; - } - my @registers = sort by_name $xmltree->findnodes("/MAPS/register"); - print ""; - for my $register (@registers) { - - my $registerName = $register->findvalue("./\@name"); - my $registerId = $register->findvalue("./\@id"); - my $registerSize = $register->findvalue("./\@size"); - my $registerDescr = prepare_text( - $specTree->findvalue( - "/MAPS/register[\@name='" . $registerName . "']/description" - ) - || "n/a" - ); - - my $flistid = $xmlfile . "//" . $registerName; - - print ""; - - print < +  -EOF - print ""; - - #print ""; - - if ( $xmlfile eq $configFile ) { # we are printing the Specifications Tree - print < X  -EOF - } - if ( $xmlfile eq $specFile ) { # we are printing the Settings Tree - - print < →  -EOF - } - - print ""; - - #print ""; - - print ''; - print ''; - print '"; - } - print "
$registerName$registerId
'; - print_fields( $xmlfile, $register ); - print ""; - print "
"; -} - -sub print_fields { - - my $register = $_[1]; - my $xmlfile = $_[0]; - my $registerName = $register->findvalue("./\@name"); - my @fields = sort by_name $register->findnodes("./field"); - print ""; - for my $field (@fields) { - my $fieldName = $field->findvalue("./\@name"); - my $isHeritageFrom = $field->findvalue("./\@isHeritageFrom") || ""; - my $readOnlyFlag = 0; - my $fieldValue = $field->findvalue("./\@value"); - my $fieldSize = - $specTree->findvalue( "/MAPS/register[\@name='" - . $registerName - . "']/field[\@name='" - . $fieldName - . "']/\@size" ) - || "n/a"; - my $fieldDescr = prepare_text( - $specTree->findvalue( - "/MAPS/register[\@name='" - . $registerName - . "']/field[\@name='" - . $fieldName - . "']/description" - ) - || "n/a" - ); - - my $maxFieldVal = 2**$fieldSize; - my $sizeInfo = - sprintf( - "Field contains %d bits, possible values: 0-%d (0x0-0x%x)\n\n", - $fieldSize, $maxFieldVal, $maxFieldVal ); - - $fieldDescr = $sizeInfo . $fieldDescr; - - unless ( $isHeritageFrom eq "" ) { - $fieldDescr = - "Field was inherited from $isHeritageFrom\n\n" . $fieldDescr; - } - - my $fieldId = $xmlfile . "//" . $registerName . "/" . $fieldName; - if ( $fieldValue eq "" ) { - $fieldValue = $field->findvalue("./\@defaultValue"); - $readOnlyFlag = 1; - } - - print ""; - print ""; - print ""; - if ($readOnlyFlag) { - print <$fieldValue -EOF - } - else { - print < - - -EOF - - } - - print ''; - if ( $xmlfile eq $specFile ) { # we are printing the Specifications tree - print < →  -EOF - } - if ( $xmlfile eq $configFile ) { # we are printing the Settings Tree - - if ( $isHeritageFrom eq "" ) - { # these are actual settings, not inherited! - print < X  -EOF - } - else { - print ""; - } - } - print ""; - if ( ( any2dec($fieldValue) < 0 ) - or ( any2dec($fieldValue) > $maxFieldVal ) ) - { - print -"" - ; # just debug - } - } - print "
$fieldName  =  X 
!!!Above value not in allowed range!!!
"; - -} sub read_input { my $buffer; @@ -939,19 +971,22 @@ sub read_input { %FORM; } -sub any2dec { # converts numeric expressions 0x, 0b or decimal to decimal - - my $argument = $_[0]; - - #print "any2dec input argument $argument\n"; - if ( $argument =~ m/0[bxBX]/ ) { - return oct $argument; - } - else { - return $argument; - } -} +# already in Common.pm + +# sub any2dec { # converts numeric expressions 0x, 0b or decimal to decimal +# +# my $argument = $_[0]; +# +# #print "any2dec input argument $argument\n"; +# +# if ( $argument =~ m/0[bxBX]/ ) { +# return oct $argument; +# } +# else { +# return $argument; +# } +# } sub printJavaScripts {