exit;
}
+
+
+# some global variables
my $parser = XML::LibXML->new();
my $specFile = "";
my $configFile = "";
#################### SUBLAND ######################
+
+###############################
+## xml file operations
+###############################
+
sub deleteFile {
- my $configFileName = $_[0];
- my $configFile = $confDir . "/" . $configFileName;
- unless ( -e $configFile ) {
-
print "<p>selected file not found</p>";
- exit;
- }
- unlink($configFile);
-
print "<p>config file was deleted</p>";
+ my $configFileName = $_[0];
+ my $configFile = $confDir . "/" . $configFileName;
+ unless ( -e $configFile ) {
+ print "<p>selected file not found</p>";
+ exit;
+ }
+ unlink($configFile);
+ print "<p>config file was deleted</p>";
}
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 "<div class='ancestorInfo' align='center'>";
-
- #print "my ancestry:<br>";
- print "<table class='fileLevel'><tr><td>";
-
- #print "<table class='fileLevel1' padding=0 spacing=0><tr><td>";
- 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 "<table class=fileLevel" . $fileLevelHash{$ancestor} . ">";
- print "<tr><td colspan=2>";
- }
- for my $ancestor (@ancestryList) {
-
- print "</td></tr><tr><td>$ancestor </td><td valign='bottom'>";
- print "<img src='../share/eye16.png' onclick=''></img>";
- print
-"<input type='checkbox' checked=true onchange='hideThisFileLevel(\"fileLevel"
- . $fileLevelHash{$ancestor} . "\",this.checked)'></td>";
- if ( $fileLevelHash{$ancestor} eq "1" ) {
- print <<EOF;
-<td class='button_move' title='unlink includes' onclick='changeAncestor("")'> X </td>
-EOF
+ $configMaps->setAttribute( "type", $mapsType );
+ $configMaps->setAttribute( "specDbFile", $specFileName );
- }
- print "</tr></table>";
- }
- }
- else { # print an ancestor selector!
- print "include settings from:<br>";
- 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 "</td></tr></table>";
- print "</td></tr><tr><td>";
- print "$configFileName";
- print "</td></tr></table>";
- print "</div>";
}
-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
"<p>specification file \"$specFileName\" could not be found in the specification directory \"$specDir\"</p>";
- 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 "<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>";
- changeAncestor(""); # break the evil circle where it was closed!
- exit;
- }
+ # check if you are not including yourself
+ if ( $parentXmlFileName 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>";
+ changeAncestor(""); # break the evil circle where it was closed!
+ exit;
+ }
- # check against circular dependencies
- for (@ancestryList) { # suppres circular dependencies!
- if ( $xmlfileName eq $_ ) {
-
-
print "<p>No circular includes, please!</p>";
- print $parentXmlFileName. "->"
- . join( "->", @ancestryList ) . "->"
- . $configFileName;
- print "</p>";
-
print "<p>The faulty include directive was removed.</p>";
- print
-
"<p><input type='button' onclick='loadFile()' value='back'></p>";
- 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 "<p>No circular includes, please!</p>";
+ print "<p>";
+ print $parentXmlFileName. "->"
+ . join( "->", @ancestryList ) . "->"
+ . $configFileName;
+ print "</p>";
+ print "<p>The faulty include directive was removed.</p>";
+ print
+ "<p><input type='button' onclick='loadFile()' value='back'></p>";
+ 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 "<p>You are trying to include a file that does not exist</p>";
- print "<strike>"
- . $xmlfileName
- . "</strike>" . "->"
- . join( "->", @ancestryList ) . "->"
- . $configFileName;
- print "</p>";
-
print "<p>The faulty include directive was removed.</p>";
-
print "<p><input type='button' onclick='loadFile()' value='back'></p>";
- 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 "<p>You are trying to include a file that does not exist</p>";
+ print "<p>";
+ print "<strike>"
+ . $xmlfileName
+ . "</strike>" . "->"
+ . join( "->", @ancestryList ) . "->"
+ . $configFileName;
+ print "</p>";
+ print "<p>The faulty include directive was removed.</p>";
+ print "<p><input type='button' onclick='loadFile()' value='back'></p>";
+ 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
"<p>the included config file does not comply with the MAPS type of the current config file</p>";
-
print "<p>The faulty include directive was removed.</p>";
-
print "<p><input type='button' onclick='loadFile()' value='back'></p>";
- changeAncestor(""); # break the evil circle where it was closed!
- exit;
- }
+ print "<p>The faulty include directive was removed.</p>";
+ print "<p><input type='button' onclick='loadFile()' value='back'></p>";
+ 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
"<p>the included config file is not based on the same specification file as current config file</p>";
-
print "<p>The faulty include directive was removed.</p>";
-
print "<p><input type='button' onclick='loadFile()' value='back'></p>";
- changeAncestor(""); # break the evil circle where it was closed!
- exit;
- }
- unless ( $ancestorFileName eq "" ) {
+ print "<p>The faulty include directive was removed.</p>";
+ print "<p><input type='button' onclick='loadFile()' value='back'></p>";
+ 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<br>";
+ unless ( $register->hasChildNodes() ) {
+ $maps->removeChild($register);
+ print "deleted register as well<br>";
+ }
+ }
+ 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<br>";
- unless ( $register->hasChildNodes() ) {
- $maps->removeChild($register);
- print "deleted register as well<br>";
- }
- }
- 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 '<select name="fileSelectionDropdown" id="'
- . $elementId
- . '" onchange="'
- . $action . '">';
+ print '<select name="fileSelectionDropdown" id="'
+ . $elementId
+ . '" onchange="'
+ . $action . '">';
- print "<option value='...'>...</option>";
- my @xmlfiles;
- while ( my $file = readdir(DIR) ) {
+ print "<option value='...'>...</option>";
+ 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 '<option value="' . $file . '"';
- if ( $file eq $configFile ) {
- print ' selected ';
- }
- print '>' . $file . '</option>';
- }
- closedir(DIR);
+ if ( $file =~ m/\.xml$/ ) {
+ push( @xmlfiles, $file );
+ }
+ }
+ for my $file ( sort @xmlfiles ) {
+ print '<option value="' . $file . '"';
+ if ( $file eq $configFile ) {
+ print ' selected ';
+ }
+ print '>' . $file . '</option>';
+ }
+ closedir(DIR);
- print '</select>';
+ print '</select>';
}
sub print_specSelector {
- my $configFile = $_[0];
- opendir( DIR, $specDir ) or die $!;
+ my $configFile = $_[0];
+ opendir( DIR, $specDir ) or die $!;
- print '<select name="specSelectionDropdown" id="specSelector" >';
+ print '<select name="specSelectionDropdown" id="specSelector" >';
- 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 '<option value="' . $file . '"';
- if ( $file eq $configFile ) {
- print ' selected ';
- }
- print '>' . $file . '</option>';
- }
- closedir(DIR);
+ if ( $file =~ m/\.xml$/ ) {
+ push( @xmlfiles, $file );
+ }
+ }
+ for my $file ( sort @xmlfiles ) {
+ print '<option value="' . $file . '"';
+ if ( $file eq $configFile ) {
+ print ' selected ';
+ }
+ print '>' . $file . '</option>';
+ }
+ closedir(DIR);
- print '</select>';
+ print '</select>';
}
sub print_fileSelection {
- my $configFile = $_[0];
+ my $configFile = $_[0];
- print "<h3>selected config file</h3>";
+ print "<h3>selected config file</h3>";
+ print "<p>";
- print_fileSelector( $configFile, "fileSelector", "loadFile()" );
- print
+ print_fileSelector( $configFile, "fileSelector", "loadFile()" );
+ print
"<input type='button' onclick='loadFile()' value='reload file' class='stdbutton'>";
- print
+ print
"<input type='button' onclick='deleteFile()' value='delete file' class='stdbutton'>";
- print "</p>";
-
- print "<h3>create new config file</h3>";
- print "<td>filename</td><td>based on specification</td><td></td>";
- print "</tr>";
- print "<tr>";
- print "<td>";
- print "<input type='text' value='' id='newFileName'>";
- print "</td><td>";
- print_specSelector();
- print "</td><td>";
- print
+ print "</p>";
+
+ print "<h3>create new config file</h3>";
+ print "<p>";
+ print "<table><tr>";
+ print "<td>filename</td><td>based on specification</td><td></td>";
+ print "</tr>";
+ print "<tr>";
+ print "<td>";
+ print "<input type='text' value='' id='newFileName'>";
+ print "</td><td>";
+ print_specSelector();
+ print "</td><td>";
+ print
"<input type='button' onclick='createFile()' value='create file' class='stdbutton'>";
- print "</td></tr></table>";
+ print "</td></tr></table>";
- print "</p>";
+ print "</p>";
-# print "<tr><td>";
-# print "<tr>";
-# print "<td>selected config file:<td>";
-# print "</tr>";
+# print "<table>";
+# print "<tr><td>";
+# print "<table>";
+# print "<tr>";
+# print "<td>selected config file:<td>";
+# print "</tr>";
#
-# print "<tr>";
+# print "<tr>";
#
-# print "<td>";
-# print_fileSelector( $configFile, "fileSelector", "loadFile()" );
-# print "</td>";
+# print "<td>";
+# print_fileSelector( $configFile, "fileSelector", "loadFile()" );
+# print "</td>";
#
-# print "<td>";
-# print
+# print "<td>";
+# print
#"<input type='button' onclick='loadFile()' value='reload file' class='stdbutton'>";
-# print
+# print
#"<input type='button' onclick='deleteFile()' value='delete file' class='stdbutton'>";
-# print "</td>";
+# print "</td>";
#
-# print "</tr>";
+# print "</tr>";
#
-# print "</table>";
+# print "</table>";
#
-# print "</td>";
+# print "</td>";
#
-# print "<td style='border-right:1px solid #000000'><br></td>";
+# print "<td style='border-right:1px solid #000000'><br></td>";
#
-# print "<td>";
-# print "<tr><td colspan=2>";
-# print "create new config file:";
-# print "</td></tr>";
+# print "<td>";
+# print "<table>";
+# print "<tr><td colspan=2>";
+# print "create new config file:";
+# print "</td></tr>";
#
-# print "<tr><td>";
-# print "<input type='text' value='' id='newFileName'>";
-# print "</td><td>";
-# print_specSelector();
-# print "</td><td>";
-# print
+# print "<tr><td>";
+# print "<input type='text' value='' id='newFileName'>";
+# print "</td><td>";
+# print_specSelector();
+# print "</td><td>";
+# print
#"<input type='button' onclick='createFile()' value='create file' class='stdbutton'>";
-# print "</td></tr>";
+# print "</td></tr>";
#
-# print "</table>";
-# print "</td>";
-# print "</tr></table>";
+# print "</table>";
+# print "</td>";
+# print "</tr></table>";
+}
+
+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 "<table class=\"registers\"";
+ if ( $xmlfile eq $configFile ) {
+ print "id='configFileRegisters'";
+ }
+ 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 "<tr>";
+
+ print <<EOF;
+<td onClick='toggleVis("$flistid",this)' class='regheader'> + </td>
+EOF
+ print "<td title=\"$registerDescr\">$registerName</td>";
+
+ #print "<td>$registerId</td>";
+
+ if ( $xmlfile eq $configFile ) { # we are printing the Specifications Tree
+ print <<EOF;
+<td class='button_move' onclick='deleteSettings("$registerName","");'> X </td>
+EOF
+ }
+ if ( $xmlfile eq $specFile ) { # we are printing the Settings Tree
+
+ print <<EOF;
+<td class='button_move' onclick='copyDefaultRegister("$registerName");'> → </td>
+EOF
+ }
+
+ print "</tr>";
+
+ #print "<tr>";
+
+ print '<tr id="' . $flistid . '" class="bitfield">';
+ print '<td></td>';
+ print '<td class="fieldcontainer">';
+ print_fields( $xmlfile, $register );
+ print "<td>";
+ print "</tr>";
+ }
+ print "</table>";
}
+sub print_fields {
+
+ my $register = $_[1];
+ my $xmlfile = $_[0];
+ my $registerName = $register->findvalue("./\@name");
+ my @fields = sort by_name $register->findnodes("./field");
+ print "<table class=\"fields\">";
+ 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 "<tr class='fileLevel" . $fileLevelHash{$isHeritageFrom} . "'>";
+ print "<td width=120 title=\"$fieldDescr\"";
+ print ">$fieldName</td>";
+ print "<td> = </td>";
+ if ($readOnlyFlag) {
+ print <<EOF;
+ <td width=120 align='right'>$fieldValue</td>
+EOF
+ }
+ else {
+ print <<EOF;
+<td align='right'>
+<input type='text' align='right' value='$fieldValue' onchange='saveSettings("$registerName","$fieldName",this.value)' >
+</td>
+EOF
+
+ }
+
+ print '</td>';
+ if ( $xmlfile eq $specFile ) { # we are printing the Specifications tree
+ print <<EOF;
+<td class='button_move' onclick='saveSettings("$registerName","$fieldName","$fieldValue");'> → </td>
+EOF
+ }
+ if ( $xmlfile eq $configFile ) { # we are printing the Settings Tree
+
+ if ( $isHeritageFrom eq "" )
+ { # these are actual settings, not inherited!
+ print <<EOF;
+<td class='button_move' onclick='deleteSettings("$registerName","$fieldName");'> X </td>
+EOF
+ }
+ else {
+ print "<td class='button_move_deac'> X </td>";
+ }
+ }
+ print "</tr>";
+ if ( ( any2dec($fieldValue) < 0 )
+ or ( any2dec($fieldValue) > $maxFieldVal ) )
+ {
+ print
+"<tr class='fieldError'><td colspan = 4 align='center'>!!!Above value not in allowed range!!!</td></tr>"
+ ; # just debug
+ }
+ }
+ print "</table>";
+
+}
+
+sub print_ancestorInfo {
+ print "<div class='ancestorInfo' align='center'>";
+
+ #print "my ancestry:<br>";
+ print "<table class='fileLevel'><tr><td>";
+
+ #print "<table class='fileLevel1' padding=0 spacing=0><tr><td>";
+ 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 "<table class=fileLevel" . $fileLevelHash{$ancestor} . ">";
+ print "<tr><td colspan=2>";
+ }
+ for my $ancestor (@ancestryList) {
+
+ print "</td></tr><tr><td>$ancestor </td><td valign='bottom'>";
+ print "<img src='../share/eye16.png' onclick=''></img>";
+ print
+"<input type='checkbox' checked=true onchange='hideThisFileLevel(\"fileLevel"
+ . $fileLevelHash{$ancestor} . "\",this.checked)'></td>";
+ if ( $fileLevelHash{$ancestor} eq "1" ) {
+ print <<EOF;
+<td class='button_move' title='unlink includes' onclick='changeAncestor("")'> X </td>
+EOF
+
+ }
+ print "</tr></table>";
+ }
+ }
+ else { # print an ancestor selector!
+ print "include settings from:<br>";
+ print_fileSelector( "", "ancestorSelector",
+ "changeAncestor(this.options[this.selectedIndex].text)" );
+
+ }
+
+ #print "</td></tr></table>";
+ print "</td></tr><tr><td>";
+ print "$configFileName";
+ print "</td></tr></table>";
+ print "</div>";
+}
+
+
+
+###############################
+## 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];
-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 "<table class=\"registers\"";
- if ( $xmlfile eq $configFile ) {
- print "id='configFileRegisters'";
- }
- 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 "<tr>";
-
- print <<EOF;
-<td onClick='toggleVis("$flistid",this)' class='regheader'> + </td>
-EOF
- print "<td title=\"$registerDescr\">$registerName</td>";
-
- #print "<td>$registerId</td>";
-
- if ( $xmlfile eq $configFile ) { # we are printing the Specifications Tree
- print <<EOF;
-<td class='button_move' onclick='deleteSettings("$registerName","");'> X </td>
-EOF
- }
- if ( $xmlfile eq $specFile ) { # we are printing the Settings Tree
-
- print <<EOF;
-<td class='button_move' onclick='copyDefaultRegister("$registerName");'> → </td>
-EOF
- }
-
- print "</tr>";
-
- #print "<tr>";
-
- print '<tr id="' . $flistid . '" class="bitfield">';
- print '<td></td>';
- print '<td class="fieldcontainer">';
- print_fields( $xmlfile, $register );
- print "<td>";
- print "</tr>";
- }
- print "</table>";
-}
-
-sub print_fields {
-
- my $register = $_[1];
- my $xmlfile = $_[0];
- my $registerName = $register->findvalue("./\@name");
- my @fields = sort by_name $register->findnodes("./field");
- print "<table class=\"fields\">";
- 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 "<tr class='fileLevel" . $fileLevelHash{$isHeritageFrom} . "'>";
- print "<td width=120 title=\"$fieldDescr\"";
- print ">$fieldName</td>";
- print "<td> = </td>";
- if ($readOnlyFlag) {
- print <<EOF;
- <td width=120 align='right'>$fieldValue</td>
-EOF
- }
- else {
- print <<EOF;
-<td align='right'>
-<input type='text' align='right' value='$fieldValue' onchange='saveSettings("$registerName","$fieldName",this.value)' >
-</td>
-EOF
-
- }
-
- print '</td>';
- if ( $xmlfile eq $specFile ) { # we are printing the Specifications tree
- print <<EOF;
-<td class='button_move' onclick='saveSettings("$registerName","$fieldName","$fieldValue");'> → </td>
-EOF
- }
- if ( $xmlfile eq $configFile ) { # we are printing the Settings Tree
-
- if ( $isHeritageFrom eq "" )
- { # these are actual settings, not inherited!
- print <<EOF;
-<td class='button_move' onclick='deleteSettings("$registerName","$fieldName");'> X </td>
-EOF
- }
- else {
- print "<td class='button_move_deac'> X </td>";
- }
- }
- print "</tr>";
- if ( ( any2dec($fieldValue) < 0 )
- or ( any2dec($fieldValue) > $maxFieldVal ) )
- {
- print
-"<tr class='fieldError'><td colspan = 4 align='center'>!!!Above value not in allowed range!!!</td></tr>"
- ; # just debug
- }
- }
- print "</table>";
-
-}
sub read_input {
my $buffer;
%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 {
jspc29 / mvdsensorcontrol.git / commitdiff