mirror of
https://github.com/nasa/trick.git
synced 2024-12-25 07:41:08 +00:00
415 lines
15 KiB
Perl
415 lines
15 KiB
Perl
|
package auto_doc;
|
||
|
|
||
|
# $Id: auto_doc.pm 1375 2011-02-01 23:32:36Z wwoodard $
|
||
|
|
||
|
# Note:
|
||
|
# Firefox 3 fails to process XSLT files if they are on the local hard drive plus
|
||
|
# outside of the current XML file's path (or descendant paths). Users may need
|
||
|
# to edit $HOME/.mozilla/firefox/*.default/prefs.js and add a new URI setting:
|
||
|
# - user_pref("security.fileuri.strict_origin_policy", false);
|
||
|
# OR
|
||
|
# - type about:config in the address bar
|
||
|
# - change security.fileuri.strict_origin_policy to false
|
||
|
|
||
|
use Exporter();
|
||
|
@ISA = qw(Exporter);
|
||
|
@EXPORT = qw(print_xml_CP print_xml_mis print_xml_icg);
|
||
|
|
||
|
use File::Basename;
|
||
|
use Text::Balanced qw ( extract_bracketed );
|
||
|
use strict;
|
||
|
use gte;
|
||
|
|
||
|
my(%default_data_files, %object_jobs, @object_names, %jobs, %object_structs, $vt_ref);
|
||
|
|
||
|
sub print_xml_CP($)
|
||
|
{
|
||
|
my($sim_ref) = @_;
|
||
|
my $title;
|
||
|
|
||
|
# Get the title of the sim from the file "Title"
|
||
|
if (open TITLE, "Title") {
|
||
|
$title = <TITLE>;
|
||
|
chomp $title;
|
||
|
} else {
|
||
|
$title = "No Title Specified";
|
||
|
}
|
||
|
|
||
|
open XML_FILE, ">S_document.xml" or die "Could not open S_document.xml\n";
|
||
|
|
||
|
# Start the xml code
|
||
|
print_xml_xml_header("$ENV{TRICK_HOME}/docs/trick_s_define.xsl");
|
||
|
print XML_FILE "<s_define>\n";
|
||
|
print XML_FILE " " x 4, "<title>$title</title>\n";
|
||
|
|
||
|
# Given an array of simulation objects, sort array by 'objname' values
|
||
|
# foreach my $o (sort { ${$a}{objname} cmp ${$b}{objname} } @{$$sim_ref{objs}}) {
|
||
|
#
|
||
|
# print XML_FILE " " x 4, "<sim_object>\n";
|
||
|
#
|
||
|
# print XML_FILE " " x 8,
|
||
|
# "<sim_object_name>$$o{objname}</sim_object_name>\n\n";
|
||
|
#
|
||
|
# # printout the structures found in each object
|
||
|
# print XML_FILE " " x 8, "<structs>\n";
|
||
|
# # Given an array of structures per sim_object, sort array by 'strname' values
|
||
|
# foreach my $s (sort { ${$a}{strname} cmp ${$b}{strname} } @{$$o{structs}}) {
|
||
|
# print XML_FILE " " x 12, "<struct>\n";
|
||
|
# print XML_FILE " " x 16, "<struct_name>$$s{strname}</struct_name>\n";
|
||
|
# $$sim_ref{icg_types}{$$s{strname}}{files}{$$s{file}}{xml} =~ s/^TRICK_HOME\//$ENV{TRICK_HOME}\// ;
|
||
|
# print XML_FILE " " x 16, "<link>$$sim_ref{icg_types}{$$s{strname}}{files}{$$s{file}}{xml}</link>\n";
|
||
|
# print XML_FILE " " x 16, "<default_data>\n";
|
||
|
# foreach my $d (sort @{$$s{def_data}}) {
|
||
|
# print XML_FILE " " x 20, "<file>$d</file>\n";
|
||
|
# }
|
||
|
# print XML_FILE " " x 16, "</default_data>\n";
|
||
|
# print XML_FILE " " x 12, "</struct>\n";
|
||
|
# }
|
||
|
# print XML_FILE " " x 8, "</structs>\n\n";
|
||
|
#
|
||
|
# # print out each job found in this object
|
||
|
# print XML_FILE " " x 8, "<jobs>\n";
|
||
|
# # Given an array of jobs per sim_object, sort array by 'jobname' values
|
||
|
# foreach my $j (sort { ${$a}{jobname} cmp ${$b}{jobname} } @{$$o{jobs}}) {
|
||
|
# my ($file_name, $model_dir, $suffix) =
|
||
|
# fileparse( $$j{file}, ("\.h" , "\.hh" , "\.c" , "\.f", "\.cpp" , "\.cxx" , "\.C" , "\.cc" , "\.c\\+\\+" ));
|
||
|
# ($model_dir = $$j{file}) =~ s/(\/src)?\/([^\/]+)$// ;
|
||
|
# if ($model_dir =~ m/\/include$/ ){
|
||
|
# $model_dir =~ s/(\/include)?\/([^\/]+)$// ;
|
||
|
# }
|
||
|
# print XML_FILE " " x 12, "<job>\n";
|
||
|
# print XML_FILE " " x 16, "<job_name>$$j{jobname}</job_name>\n";
|
||
|
# print XML_FILE " " x 16, "<link>${model_dir}/xml/${file_name}${suffix}.xml</link>\n";
|
||
|
# print XML_FILE " " x 12, "</job>\n";
|
||
|
# }
|
||
|
# print XML_FILE " " x 8, "</jobs>\n";
|
||
|
# print XML_FILE " " x 4, "</sim_object>\n\n";
|
||
|
# }
|
||
|
|
||
|
print XML_FILE "</s_define>\n";
|
||
|
|
||
|
close XML_FILE ;
|
||
|
}
|
||
|
|
||
|
sub print_xml_mis ($$$$) {
|
||
|
|
||
|
my ($curr_file , $entries , $header_ptr, $includes) = @_ ;
|
||
|
my ($out_file_basename , $name , $path , $suffix, $file_path_dir ) ;
|
||
|
my %header = %$header_ptr ;
|
||
|
my ($xml_file , $xml_dir , $file_version ) ;
|
||
|
my ($subme , @inc_paths ) ;
|
||
|
my $i ;
|
||
|
|
||
|
$out_file_basename = $curr_file ;
|
||
|
($name, $path, $suffix) =
|
||
|
fileparse( $curr_file, ("\.h" , "\.hh" , "\.c" , "\.f", "\.cpp" , "\.cxx" , "\.C" , "\.cc" , "\.c\\+\\+" ));
|
||
|
|
||
|
$file_path_dir = dirname($curr_file) ;
|
||
|
if ($file_path_dir eq ".") {
|
||
|
$file_path_dir = cwd();
|
||
|
}
|
||
|
$file_path_dir =~ s/\/+$// ; # remove trailing slash
|
||
|
$path =~ s/\/+$// ; # remove trailing slash
|
||
|
|
||
|
if ($file_path_dir !~ /sim_services\/include/ and $file_path_dir =~ s/\/src$// ) {
|
||
|
$xml_file = $file_path_dir . "/xml/" . $name . $suffix . ".xml" ;
|
||
|
$xml_dir = $file_path_dir . "/xml" ;
|
||
|
}
|
||
|
else {
|
||
|
$xml_file = $path . "/xml/" . $name . $suffix . ".xml" ;
|
||
|
$xml_dir = $path . "/xml" ;
|
||
|
}
|
||
|
|
||
|
if ( ! -e $xml_dir ) {
|
||
|
mkdir $xml_dir, 0775 ;
|
||
|
}
|
||
|
$file_version = $file_path_dir ;
|
||
|
foreach $subme (@inc_paths) {
|
||
|
if ($file_version =~ s,^$subme/,, ) { # if found break out
|
||
|
last ;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
open XML_FILE ,">$xml_file" or die "Couldn't open file for writing $xml_file\n" ;
|
||
|
|
||
|
print_xml_xml_header( "$ENV{TRICK_HOME}/docs/trick_module.xsl") ;
|
||
|
print_xml_body_header();
|
||
|
print_xml_trick_header($curr_file, \%header);
|
||
|
|
||
|
print XML_FILE " " x 4 , "<jobs>\n" ;
|
||
|
foreach my $entry (@$entries) {
|
||
|
if ( !exists $$entry{valid} ) {
|
||
|
next ;
|
||
|
}
|
||
|
print XML_FILE " " x 8 , "<job>\n" ;
|
||
|
print_xml_child("job_name", $$entry{name}, 12);
|
||
|
print_xml_child("return_type", $$entry{return_type}, 12);
|
||
|
print_xml_child("units", $$entry{units}, 12);
|
||
|
print_xml_child("comment", $$entry{desc}, 12);
|
||
|
print XML_FILE " " x 12 , "<argument_list>\n" ;
|
||
|
foreach my $arg ( @{$$entry{arg_list}} ) {
|
||
|
print XML_FILE " " x 16 , "<arg>\n" ;
|
||
|
print_xml_child("arg_name", $$arg{name}, 20);
|
||
|
print_xml_child("type", $$arg{type}, 20);
|
||
|
print_xml_child("dims", "$$arg{pointers} $$arg{array}", 20);
|
||
|
print_xml_child("inout", ucfirst lc $$arg{inout}, 20);
|
||
|
print_xml_child("units", $$arg{unit}, 20);
|
||
|
print_xml_child("comment", $$arg{desc}, 20);
|
||
|
print XML_FILE " " x 16 , "</arg>\n" ;
|
||
|
}
|
||
|
print XML_FILE " " x 12 , "</argument_list>\n" ;
|
||
|
print XML_FILE " " x 8 , "</job>\n" ;
|
||
|
}
|
||
|
print XML_FILE " " x 4 , "</jobs>\n" ;
|
||
|
|
||
|
print XML_FILE " " x 4 , "<includes>\n" ;
|
||
|
foreach (@$includes) {
|
||
|
s/</</g;
|
||
|
s/>/>/g;
|
||
|
s/"/"/g;
|
||
|
print XML_FILE " " x 8 , "<file>$_</file>\n";
|
||
|
}
|
||
|
print XML_FILE " " x 4 , "</includes>\n" ;
|
||
|
|
||
|
print_xml_body_footer();
|
||
|
|
||
|
close XML_FILE ;
|
||
|
}
|
||
|
|
||
|
sub print_xml_icg ($$$$$) {
|
||
|
|
||
|
my ($file_name, $xml_file, $header, $enums_info, $structs_info) = @_ ;
|
||
|
|
||
|
open XML_FILE ,">$xml_file" or die "Couldn't open file for writing $xml_file\n" ;
|
||
|
|
||
|
print_xml_xml_header( "$ENV{TRICK_HOME}/docs/trick_struct.xsl") ;
|
||
|
print_xml_body_header();
|
||
|
print_xml_trick_header( $file_name, $header) ;
|
||
|
|
||
|
# print the enums
|
||
|
print XML_FILE " " x 4 , "<enumerations>\n" ;
|
||
|
foreach my $pe_ret ( @$enums_info ) {
|
||
|
foreach my $enum ( @{$$pe_ret{enum_names}} ) {
|
||
|
print XML_FILE " " x 8 , "<enum>\n" ;
|
||
|
print XML_FILE " " x 12 , "<enum_name>$enum</enum_name>\n" ;
|
||
|
foreach my $name_val ( @{$$pe_ret{enums}} ) {
|
||
|
print XML_FILE " " x 12 , "<member>\n" ;
|
||
|
print XML_FILE " " x 16 , "<mname>$$name_val{name}</mname>\n" ;
|
||
|
print XML_FILE " " x 16 , "<value>$$name_val{value}</value>\n" ;
|
||
|
$$name_val{comment} =~ s/&/&/g ;
|
||
|
$$name_val{comment} =~ s/\\?"/"/g ;
|
||
|
$$name_val{comment} =~ s/</</g ;
|
||
|
$$name_val{comment} =~ s/>/>/g ;
|
||
|
print XML_FILE " " x 16 , "<comment>$$name_val{comment}</comment>\n" ;
|
||
|
print XML_FILE " " x 12 , "</member>\n" ;
|
||
|
}
|
||
|
print XML_FILE " " x 8 , "</enum>\n" ;
|
||
|
}
|
||
|
}
|
||
|
print XML_FILE " " x 4 , "</enumerations>\n\n" ;
|
||
|
|
||
|
# print the structs
|
||
|
print XML_FILE " " x 4 , "<structures>\n" ;
|
||
|
foreach my $ps_ret ( @$structs_info ) {
|
||
|
foreach my $str ( @{$$ps_ret{struct_names}} ) {
|
||
|
print XML_FILE " " x 8 , "<struct>\n" ;
|
||
|
print XML_FILE " " x 12 , "<struct_name>$str</struct_name>\n" ;
|
||
|
foreach my $param ( @{$$ps_ret{param_info}} ) {
|
||
|
print XML_FILE " " x 12 , "<member>\n" ;
|
||
|
print XML_FILE " " x 16 , "<pname>$$param{p_name}</pname>\n" ;
|
||
|
print XML_FILE " " x 16 , "<type>$$param{p_type}</type>\n" ;
|
||
|
if ( $$param{p_link} ne "" ) {
|
||
|
$$param{p_link} =~ s/^TRICK_HOME\//$ENV{TRICK_HOME}\// ;
|
||
|
print XML_FILE " " x 16 , "<link>$$param{p_link}</link>\n" ;
|
||
|
}
|
||
|
if ( $$param{p_is_enum} ) {
|
||
|
print XML_FILE " " x 16 , "<is_enum>$$param{p_is_enum}</is_enum>\n" ;
|
||
|
}
|
||
|
print XML_FILE " " x 16 , "<dims>$$param{p_dim_xml}</dims>\n" ;
|
||
|
print XML_FILE " " x 16 , "<units>$$param{p_unit}</units>\n" ;
|
||
|
$$param{p_desc} =~ s/&/&/g ;
|
||
|
$$param{p_desc} =~ s/\\?"/"/g ;
|
||
|
$$param{p_desc} =~ s/</</g ;
|
||
|
$$param{p_desc} =~ s/>/>/g ;
|
||
|
print XML_FILE " " x 16 , "<comment>$$param{p_desc}</comment>\n" ;
|
||
|
print XML_FILE " " x 12 , "</member>\n" ;
|
||
|
}
|
||
|
print XML_FILE " " x 8 , "</struct>\n\n" ;
|
||
|
}
|
||
|
}
|
||
|
print XML_FILE " " x 4 , "</structures>\n\n" ;
|
||
|
|
||
|
print_xml_body_footer();
|
||
|
close XML_FILE ;
|
||
|
}
|
||
|
|
||
|
sub print_xml_xml_header($)
|
||
|
{
|
||
|
my ($xsl_file) = @_ ;
|
||
|
print XML_FILE "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
|
||
|
print XML_FILE "<?xml-stylesheet type=\"text/xsl\" href=\"$xsl_file\"?>\n";
|
||
|
|
||
|
print XML_FILE "\n" ;
|
||
|
print XML_FILE "<!--Note:\n" ;
|
||
|
print XML_FILE " " x 4 , "Firefox 3 fails to process XSLT files if they are on the local hard drive\n" ;
|
||
|
print XML_FILE " " x 4 , "plus outside of the current XML file's path (or descendant paths). Users\n" ;
|
||
|
print XML_FILE " " x 4 , "may need to edit \$HOME/.mozilla/firefox/*.default/prefs.js and add a new\n" ;
|
||
|
print XML_FILE " " x 4 , "URI setting in order to properly view this file in a firefox browser:\n" ;
|
||
|
print XML_FILE " " x 4 , "- user_pref(\"security.fileuri.strict_origin_policy\", false);\n" ;
|
||
|
print XML_FILE " " x 4 , "OR\n" ;
|
||
|
print XML_FILE " " x 4 , "- type about:config in the address bar\n" ;
|
||
|
print XML_FILE " " x 4 , "- change security.fileuri.strict_origin_policy to false\n" ;
|
||
|
print XML_FILE "-->\n" ;
|
||
|
print XML_FILE "\n" ;
|
||
|
}
|
||
|
|
||
|
sub print_xml_body_header()
|
||
|
{
|
||
|
print XML_FILE "<file>\n" ;
|
||
|
}
|
||
|
|
||
|
sub print_xml_body_footer()
|
||
|
{
|
||
|
print XML_FILE "</file>\n" ;
|
||
|
}
|
||
|
|
||
|
sub print_xml_trick_header($$) {
|
||
|
|
||
|
my ($full_file_name, $header) = @_ ;
|
||
|
my ($tail_name, $path, $suffix) =
|
||
|
fileparse( $full_file_name, ("\.h" , "\.hh" , "\.c" , "\.f", "\.cpp" , "\.cxx" , "\.C" , "\.cc" , "\.c\\+\\+" ));
|
||
|
|
||
|
print_xml_child("file_name", "$tail_name$suffix", 4);
|
||
|
print_xml_child("full_path_file_name", $full_file_name, 4);
|
||
|
print XML_FILE " " x 4 , "<trick_header>\n" ;
|
||
|
print_xml_references($header);
|
||
|
print_xml_parent_children($header, "assumptions", "assumption", "assumptions and limitations");
|
||
|
print_xml_parent_children($header, "requirements", "requirement", "requirements");
|
||
|
print_xml_parent_children($header, "library_dependencies", "library_dependency", "libdep");
|
||
|
print_xml_parent_children($header, "purpose", "", "purpose");
|
||
|
print_xml_parent_children($header, "class", "", "class");
|
||
|
print_xml_programmers($header, "programmers", "programmer", "programmers");
|
||
|
print XML_FILE " " x 4 , "</trick_header>\n\n" ;
|
||
|
}
|
||
|
|
||
|
sub print_xml_parent_children($$$$) {
|
||
|
#
|
||
|
# Print:
|
||
|
# <xml parent name>
|
||
|
# <children xml nodes>
|
||
|
# </xml parent name>
|
||
|
|
||
|
my ($header_ptr, $xml_parent_name, $xml_child_name, $trick_name) = @_ ;
|
||
|
|
||
|
my %header = %$header_ptr ;
|
||
|
|
||
|
print XML_FILE " " x 8 , "<$xml_parent_name>" ;
|
||
|
if ( $xml_child_name ne "" ) {
|
||
|
print XML_FILE "\n" ;
|
||
|
}
|
||
|
foreach my $h ( keys %header ) {
|
||
|
my @list ;
|
||
|
@list = split /\)[ \t\n]*\(/ , $header{$h} ;
|
||
|
foreach my $ll ( @list ) {
|
||
|
if ( $h eq $trick_name ) {
|
||
|
print_xml_child($xml_child_name, $ll, 12);
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
if ( $xml_child_name ne "" ) {
|
||
|
print XML_FILE " " x 8 , "</$xml_parent_name>\n" ;
|
||
|
} else {
|
||
|
print XML_FILE "</$xml_parent_name>\n" ;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub print_xml_child($$$) {
|
||
|
|
||
|
# Print a child xml node
|
||
|
# <child_name>
|
||
|
# value
|
||
|
# </child_name>
|
||
|
|
||
|
my ($xml_name, $value, $indent_level) = @_ ;
|
||
|
|
||
|
$value =~ s/\(|\)//g ;
|
||
|
$value =~ s/&/&/g ;
|
||
|
$value =~ s/\\?"/"/g ;
|
||
|
$value =~ s/</</g ;
|
||
|
$value =~ s/>/>/g ;
|
||
|
$value =~ s/\n/ /g ;
|
||
|
$value =~ s/[ ]+/ /g ;
|
||
|
$value =~ s/\s\s+/ /g ;
|
||
|
|
||
|
if ( $xml_name ne "" ) {
|
||
|
print XML_FILE " " x $indent_level , "<$xml_name>" ;
|
||
|
}
|
||
|
|
||
|
print XML_FILE " $value " ;
|
||
|
|
||
|
if ( $xml_name ne "" ) {
|
||
|
print XML_FILE "</$xml_name>\n" ;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub print_xml_references($) {
|
||
|
|
||
|
my ($header_ptr) = @_ ;
|
||
|
my %header = %$header_ptr ;
|
||
|
my $idx = 0 ;
|
||
|
|
||
|
print XML_FILE " " x 8 , "<references>\n" ;
|
||
|
|
||
|
my @list ;
|
||
|
my ($temp , $ref) ;
|
||
|
$temp = $header{"reference"} ;
|
||
|
$temp =~ s/^\(// ;
|
||
|
|
||
|
do {
|
||
|
($ref, $temp) = extract_bracketed($temp,"()");
|
||
|
if ( $ref ne "" ) {
|
||
|
@list = split /\)[ \t\n]*\(/ , $ref ;
|
||
|
print XML_FILE " " x 12 , "<reference>\n" ;
|
||
|
print_xml_child("author", @list[0], 16) ;
|
||
|
print_xml_child("source", @list[1], 16) ;
|
||
|
print_xml_child("ident", @list[2], 16) ;
|
||
|
print_xml_child("location", @list[3], 16) ;
|
||
|
print_xml_child("date", @list[4], 16) ;
|
||
|
print_xml_child("notes", @list[5], 16) ;
|
||
|
print XML_FILE " " x 12 , "</reference>\n" ;
|
||
|
$idx = $idx + 6 ;
|
||
|
}
|
||
|
} while ( $ref ne "" ) ;
|
||
|
print XML_FILE " " x 8 , "</references>\n" ;
|
||
|
|
||
|
}
|
||
|
|
||
|
sub print_xml_programmers($) {
|
||
|
|
||
|
my ($header_ptr) = @_ ;
|
||
|
my %header = %$header_ptr ;
|
||
|
my $idx = 0 ;
|
||
|
|
||
|
print XML_FILE " " x 8 , "<modifications>\n" ;
|
||
|
foreach my $h ( keys %header ) {
|
||
|
my @list ;
|
||
|
@list = split /\)[ \t\n]*\(/ , $header{$h} ;
|
||
|
if ( $h eq "programmers" ) {
|
||
|
while ( $idx <= $#list ) {
|
||
|
print XML_FILE " " x 12 , "<modification>\n" ;
|
||
|
print_xml_child("programmer", @list[$idx + 0], 16) ;
|
||
|
print_xml_child("employer", @list[$idx + 1], 16) ;
|
||
|
print_xml_child("date", @list[$idx + 2], 16) ;
|
||
|
print_xml_child("ident", @list[$idx + 3], 16) ;
|
||
|
print_xml_child("notes", @list[$idx + 4], 16) ;
|
||
|
print XML_FILE " " x 12 , "</modification>\n" ;
|
||
|
$idx = $idx + 5 ;
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
print XML_FILE " " x 8 , "</modifications>\n" ;
|
||
|
}
|
||
|
|
||
|
|
||
|
1;
|