#!/usr/bin/perl use strict ; use English ; use File::Basename ; my ($language) ; # catalog stuff our (%attr_type) ; # key= val= our (%attr_unit) ; # key= val= our (%attr_size) ; # key= val= our (%attr_dims) ; # key= val= # save a mapping of what is produced my (%result_map) ; # key= val= $OUTPUT_AUTOFLUSH = 1 ; # always flush when printing to console #----------------------------------------------------------- # print help text if -h or --help is 1st arg if (($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) { print "-------------------------------------------------------------------------------------\n" ; print " dd_convert\n" ; print " A perl script to convert .d file(s) to C or C++ source code.\n" ; print "-------------------------------------------------------------------------------------\n" ; print "\n" ; print " INPUT: the Trick 07.22.x (where x>0) CP generated .d file(s) contained in a directory\n" ; print " (These files are located in the Default_data directory under the SIM directory,\n" ; print " but a different default data directory can be specified.)\n" ; print "\n" ; print " OUTPUT: all output is placed in the directory used for input (the default is Default_data)...\n" ; print " 1. C (.c) or C++ (.cpp) source code file in new src subdirectory\n" ; print " has the form dd_________\n" ; print " language is determined by header file (.h or .hh) containing the data type\n" ; print " 2. dd_catalog file used by dd_convert that contains all of sim's data type info\n" ; print " generated by reading S_library_list and all relevant io_src files\n" ; print " 3. dd_result_map.csv file that shows mapping of .d file to source file\n" ; print " column1 : original user .d file name\n" ; print " column2 : Trick generated Default_data .d file name\n" ; print " column3 : new source file name\n" ; print " column4 : data type name of the variable\n" ; print " column5 : the variable name from the S_define (.)\n" ; print "\n" ; print " USAGE: Specify the default data directory or one or more .d file name(s) as\n" ; print " arguments on the command line.\n" ; print " Run this command in your SIM directory after successful CP with Trick 07.22.x.\n" ; print " to convert one or more .d files:\n" ; print " dd_convert [-h|--help] [7|10] [/][, [,...]]\n" ; print " to convert all .d files:\n" ; print " dd_convert [-h|--help] [7|10] []\n" ; print " where:\n" ; print " -h | --help = print this text and exit\n" ; print " 7 | 10 = generate source for use in Trick 7, or Trick 10 (default)\n" ; print " = directory containing Trick generated .d files\n" ; print " (when not specified, Default_data is assumed)\n" ; print " ... = Trick generated .d file name(s)\n"; print "\n" ; print " EXAMPLES:\n" ; print " to convert one .d file for Trick 7:\n" ; print " dd_convert 7 S_orion_sm_eclss_hw_ws_ECLSS_ws.d\n" ; print " to convert two .d files for Trick 10 from a different directory:\n" ; print " dd_convert my_dd_dir/S_env_ares_us_ic_icopt.d S_env_iss_ic_icopt.d\n" ; print " to convert all .d files for Trick 10 from Default_data directory:\n" ; print " dd_convert\n" ; print "\n" ; print " NOTE: The only difference between Trick 7 vs. 10 generated source code\n" ; print " is the data allocation method (ip_alloc vs. TMM_declare_var_1d).\n" ; print "-------------------------------------------------------------------------------------\n" ; exit ; } #----------------------------------------------------------- # determine the target Trick version (7 or 10) from 1st arg my ($trick_version) = 10 ; # default is 10 $ARGV[0] =~ /\d+/ ; if ($MATCH eq $ARGV[0]) { $trick_version = shift @ARGV ; if ($trick_version ne 7) { $trick_version = 10 ; } } #----------------------------------------------------------- # determine the directory we are using (assume its Default_data) my ($default_data_dir) = "Default_data"; my $ARGC = scalar @ARGV ; if ($ARGC eq 0) { # no args just use Default_data directory push @ARGV , $default_data_dir ; } my @dfiles = @ARGV ; if (-d $ARGV[0]) { # directory specified on command line - use it as default data dir $default_data_dir = $ARGV[0] ; $default_data_dir =~ s/\/$// ; # remove ending slash opendir my $DIR, $default_data_dir or die "XXX dd_convert: Can't open dir on command line: \"$default_data_dir\"\n"; @dfiles = readdir $DIR ; } else { # file(s) specified on command line - get default dir from its path $ARGV[0] =~ /(.*)\/(.*)/ ; if ($1 ne "") { $default_data_dir = $1 ; } } print "Getting data files from this directory: $default_data_dir\n" ; #----------------------------------------------------------- # parse all io_src code files so we can handle units and allocs # and put into a catalog file parse_io_src() ; #----------------------------------------------------------- # parse the .d file contents for each .d file specified on command line my ($file_contents) ; my (%dfile_cfile) ; # key= val= my $argcount = 0 ; foreach my $arg ( sort @dfiles ) { my (@lines) ; my $new_file_name ; my ($c_param_name ) = "test" ; my ($dfile, $hfile) ; my ($main_type, $instance_name) ; # ignore any files not ending with .d or .dd, and any Trick .d files if (($arg !~ /\.[d]+$/) || ($arg =~ /^S_sys_/)) { if (($arg ne ".") && ($arg ne "..")) { print "\nIgnoring $arg\n\n"; } next ; # prepend default_data_dir onto filename if it's not there } else { if ($arg !~ /\//) { $arg = $default_data_dir . "/" . $arg ; } } print "--------------------------------------------------------------------\n" ; print "$arg\n" ; #----------------------------------------------------------- # PASS 1 : parse comments from the .d file open ( FILE, $arg ) ; my $comment = 0 ; my $comment_end = 0 ; while ( ) { my $prevline ; $prevline = join "", @lines[-1] ; if ($prevline =~ /\s\*\sThis default data file was taken from:\n/) { /\s\*\s(.*)\n/ ; $dfile = $1 ; print "DFILE= $dfile\n" ; } if ($prevline =~ /\s\*\sThe header file is:\n/) { /\s\*\s(.*)\n/ ; $hfile = $1 ; print "HFILE= $hfile\n" ; if ($hfile =~ /$\.hh/) { $language = "cpp"; } else { $language = "c"; } print "LANG = $language\n" ; } if ($prevline =~ /\s\*\sThe type substitution is:\n/) { /\s\*\s(.*)\s\-\>\s(.*)\n/ ; $main_type = $1 ; $main_type =~ s/\:\:/__/g ; # replace class colons with underscores $instance_name = $2 ; print "TYPE = $main_type\n" ; print "INST = $instance_name\n" ; } # massage some comments to make them be processed properly in PASS2- my $last_open = rindex $_, "\/\*"; my $last_close = rindex $_, "\*\/"; # keep track of when a comment begins and ends if ($last_open ne -1) { $comment = 1 ; } if ($last_close > $last_open) { $comment_end = 1 ; } # 1) put a space between back to back C comments *//* -> */ /* s/\*\/\/\*/\*\/ \/\*/g ; # 2) convert // style comments to /* */ style my $slash_slash = rindex $_, "\/\/"; if ( (($comment) && ($comment_end) && ($slash_slash > $last_open) && ($slash_slash < $last_close)) || (($comment) && (!$comment_end) && ($slash_slash > $last_open)) ) { # if // occurs within /* */ comment, leave it alone } else { if (s/^\/\/(.*)\n/\/\* \/\/$1 \*\/\n/) { # whole line $comment_end = 1 ; s/\*\/\s*\*\//\*\// ; # in case it ended with /* */ comment, remove extra */ #print "NEW // WHOLE LINE\n"; } else { if (s/\/\/(.*)\n$/\n/) { # end of line my $eol_comment = "\/\* //" . $1 . " \*\/\n"; $eol_comment =~ s/\*\/ \*\//\*\// ; # in case it ended with /* */ comment, remove extra */ #print "NEW // END LINE\n"; #print "<$eol_comment>"; push @lines , $eol_comment ; $comment_end = 1 ; } } } if ($comment_end) { $comment = 0 ; $comment_end = 0 ; } # change unit braces {} to <> so PASS2 can distinguish from code block braces s/\{(.*?)\}\s*=/\<$1\> =/g ; #print "<$_>"; push @lines , $_ ; } # end while $file_contents = join "" , @lines ; #----------------------------------------------------------- # if no header file comment was found, then probably not built with Trick 07.22.x if ($hfile eq "") { print "XXX dd_convert: Expected header comments not found in \"$arg\".\n" ; print "XXX Input must be a Trick 07.22.1 or later generated .d file (in Default_data dir), b-bye.\n" ; exit ; } #----------------------------------------------------------- # create new source file name and function name # if this class has more than one .d file, add its repetition number to function name # the generated .d file we are processing ($arg) has this form: S__<.d filename> # where the repetition number will only be there if there is more than one .d file for this class # (the instance name is .) $dfile =~ /(.*)\/(.*)/ ; my $dfile_dir = $1 ; my $dfile_name = $2 ; $arg =~ /(.*)\/(.*)/ ; my $arg_name = $2 ; $arg =~ /S_$instance_name([0-9]*)_$dfile_name/ ; my $repeat_num = $1 ; #print "DFILE NAME($repeat_num) = $dfile_name\n" ; my $function_name = "dd___" . "$main_type$repeat_num" . "___" . $instance_name ; $function_name =~ s/\./___/g ; # change dot in instance name to ___ # put the new source file in src directory in same directory as .d file we are processing (presumably Default_data) mkdir "$default_data_dir/src", 0777 unless -d "$default_data_dir/src" ; $new_file_name = "$default_data_dir/src/$function_name" . "." . $language ; $argcount++ ; print "$argcount new_file_name = $new_file_name\n" ; # result map: key= val= $result_map{$dfile . "," . $arg_name} = $function_name . "." .$language . "," . $main_type . "," . $instance_name ; # no need to process this .d file if we already processed a .d file that was produced from the same (original) .d file if (exists $dfile_cfile{$dfile . $repeat_num}) { print "*** SKIP DFILE $dfile -> $dfile_cfile{$dfile . $repeat_num}\n"; # add a comment to the end of the source file open ( CFILE, ">>" . $dfile_cfile{$dfile . $repeat_num} ); print CFILE "/* $main_type -> $instance_name : $new_file_name */\n" ; close CFILE ; next ; } $dfile_cfile{$dfile . $repeat_num} = $new_file_name ; #----------------------------------------------------------- # PASS 2 : process all statements in .d file my @source_code ; # save all source code to print here my @declared_local_vars = (); # save all needed local declares here my $include_trick_alloc = 0 ; # true if an alloc() statement is present my $include_trick_convert = 0 ; # true if a unit conversion is needed my $indent = 4 ; my $spaces = " " x $indent ; while ( $file_contents =~ s/^(.*?)([;\{])//s ) { my ($key, $type, $from_unit, $to_unit, $dims) ; my ($left_side, $right_side) ; my (@right_list) ; my ($need_index) = 0 ; my ($need_unit_conversion) = 0 ; my $statement = $MATCH ; # $& #------------------------------------------------------- # print any /* */ comments and # directives #print "\nSTMT=$statement"; # 1) comment only: a semicolon or brace occuring inside a comment made us stop there- # find end of comment, print it, and go back to top of loop my $last_open = rindex $statement, "\/\*"; my $last_close = rindex $statement, "\*\/"; if ($last_open > $last_close) { $file_contents =~ s/.*?\*\///s; push @source_code, "$statement" . "$MATCH\n"; next ; } # 2) comment occuring prepended to statement- # print it and continue processing statement while ($statement =~ s/\/\*.*?\*\///s ) { my $comment = $MATCH ; #print "\nCMNT=<$comment>"; push @source_code, "$comment\n"; } # 3) preprocessor "#" directive occuring prepended to statement- # print it and continue processing statement while ($statement =~ s/\#.*\n?// ) { my $comment = $MATCH ; #print "\n####=<$comment>"; push @source_code, "$comment"; } #------------------------------------------------------- # if a semicolon or brace occuring inside a string made us stop there- # go get end of statement and add it on my $num_quotes = 0 ; $num_quotes++ while ($statement =~ /\"/g) ; if ($num_quotes % 2) { # odd number of quotes $file_contents =~ s/.*?;//s; $statement = $statement . "$MATCH\n"; } #------------------------------------------------------- # get any unit specification (remember we changed {} to <> in PASS1) $from_unit = ""; if ($statement =~ s/\s*\<(.*)\>//) { $from_unit = $1 ; } #------------------------------------------------------- # handle closing brace(s) from previous if/for statement(s)- # print each brace on its own line my $closing_brace = 0 ; if ($statement =~ /\}/) { $closing_brace = 1 ; # if this brace is in a quoted string, leave it alone if ($num_quotes % 2) { $closing_brace = 0 ; } } if ($closing_brace) { while ($statement =~ s/\}//) { $indent -= 4 ; $spaces = " " x $indent ; push @source_code, $spaces . "}\n"; } } #------------------------------------------------------- # remove any newlines or leading spaces from statement $statement =~ s/\n//g ; $statement =~ s/^\s*//g ; my $original_stmt = $statement ; #########push @source_code, "/* ORIGINAL: $original_stmt */\n" ; #------------------------------------------------------- # handle for/if/else statements- # process & print up to opening brace if ( ($statement =~ /.*(for|if)\s*\(/) || ($statement =~ /.*(else)\s*\{/) ) { # declare the for loop variable if this is its first use if ($statement =~ s/(.*for\s*\()(.*int\s+)(\w+)(.*)/$1$3$4/) { my $found_var = grep(/$3/, @declared_local_vars) ; if (! $found_var) { #push @source_code, "\n$spaces" . "int $3 ;" ; push @declared_local_vars, "int $3" ; } # get rest of for stmt $file_contents =~ s/.*?\{//s; push @source_code, "\n$spaces$statement" . "$MATCH\n"; # if/else statement, print as is } else { push @source_code, "\n$spaces$statement\n" ; } $indent += 4 ; $spaces = " " x $indent ; next ; } #------------------------------------------------------- # substitute out the instance name my $substitution_done = 0 ; if ($language eq "cpp") { if ($statement =~ s/$instance_name\.\s*(\.|\[)?//g) { $substitution_done = 1 ; } # also substitute for address of the main_type $statement =~ s/\&$instance_name/this/g ; } else { # instance has array index, do not precede it with * if ($statement =~ s/$instance_name\s*\[/($c_param_name)\[/g) { $substitution_done = 1 ; } # instance has no array index, precede it with * if ($statement =~ s/$instance_name\s*\./(\*$c_param_name)\./g) { $substitution_done = 1 ; } # also substitute for address of the main_type $statement =~ s/\&$instance_name/$c_param_name/g ; } #$statement =~ /(.*)=\s*?(.*)/ ; $statement =~ /([^=]+)=\s*(.*)/ ; $left_side = $1; $right_side = $2; $left_side =~ s/\s$//; #push @source_code, "/* LEFT: $left_side */\n" ; #push @source_code, "/* RITE: $right_side */\n" ; # if this is not an assignment stmt, print it and go back to top of loop if (($left_side eq "") && ($right_side eq "")) { push @source_code, "$spaces$statement\n" ; next ; } #------------------------------------------------------- # look up this variable's attributes if a substitution was done if ($substitution_done) { ############push @source_code, "/* ATTRS :" ; #################### my @left_list = split /\./, $left_side ; #push @source_code, " split=<@left_list>"; $type = $main_type ; foreach my $var ( @left_list ) { $var =~ s/\s//g ; # remove spaces from var $var =~ s/\[.*\]//g ; # remove array index from var if ($var =~ /\(\*$c_param_name\)/) { next ;} # ignore the c name we subbed in if ($var =~ /\($c_param_name\)/) { next ;} # ignore the c name we subbed in $key = $type . "." . $var ; #push @source_code, " <$key>"; $type = $attr_type{$key} ; $to_unit = $attr_unit{$key} ; $dims = $attr_dims{$key} ; ################push @source_code, " (type=$type, unit=$to_unit, dims=$dims)" ; ###################### } ############push @source_code, " */\n" ; ##################### } #------------------------------------------------------- # handle unit conversion if unit was specified (convert to lowercase so M == m) if ( ($from_unit ne "") && (lc($from_unit) ne lc($to_unit)) ) { ############push @source_code, "/* CONVERT FROM {$from_unit} TO {$to_unit} */\n" ; ################### push @source_code, $spaces . "conv_fn_s(\"$from_unit\" , \"$to_unit\" , &my_convert) ;\n"; $need_unit_conversion = 1 ; } $right_side =~ s/;//g ; #------------------------------------------------------- # print string assignment statement, substituting strdup() or strcpy() for the assignment if ( $right_side =~ /\".*\"/ ) { my $string_const = $MATCH ; if ($dims eq 0) { # assign into a char pointer $right_side = "strdup(" . $string_const . ")" ; push @source_code, "$spaces$left_side = $right_side ;\n"; } else { # assign into a char array $left_side = "strcpy(" . $left_side; push @source_code, "$spaces$left_side, $right_side );\n"; } } else { #------------------------------------------------------- # print alloc statement, substitute out any alloc() for: # TMM_declare_var_1d (Trick 10) or ip_alloc (Trick 7) if ( $right_side =~ /alloc/ ) { # note: should have gotten $dims attribute above when substitution_done my $temp_left = $left_side ; my ($num_dim_specified, $cast_star, $type_star) ; $num_dim_specified = 0 ; while ($temp_left =~ s/\s*\[.*?\]\s*$//) { $num_dim_specified++ ; } $cast_star = "*" x ($dims - $num_dim_specified) ; $type_star = "*" x ($dims - $num_dim_specified - 1) ; my $size = $attr_size{$key} ; # = sizeof() if ($trick_version eq 10) { my $type_decl = $size ; $type_decl =~ s/sizeof\((.*)\)/$1$type_star/ ; # = + any asterisks $right_side =~ s/alloc\s*\((.*)\)/($type $cast_star)TMM_declare_var_1d\(\"$type_decl\", $1\)/ ; } else { # trick 7 $size =~ s/sizeof\((.*)\)/sizeof\($1$type_star\)/ ; # = sizeof( + any asterisks) # for a basic C type pointer (int, double, etc) call ip_alloc my $found_type = grep(/$type\..*/, keys %attr_type) ; if (! $found_type) { $right_side =~ s/alloc\s*\((.*)\)/($type $cast_star)ip_alloc\($1, $size\)/ ; # for a pointer to user data (struct, class, etc) call ip_alloc_type } else { my $attr_var = "attr" . $type ; $right_side =~ s/alloc\s*\((.*)\)/($type $cast_star)ip_alloc_type\($1, $size, $attr_var, \"$type\"\)/ ; #@right_list[0] = $right_side ; # first must declare an extern to the trick attributes to pass to ip_alloc_type my $found_var = grep(/$attr_var/, @declared_local_vars) ; if (! $found_var) { #push @source_code, "\n$spaces" . "extern ATTRIBUTES $attr_var\[\] ;\n" ; push @declared_local_vars, "extern ATTRIBUTES $attr_var\[\]" ; } } } push @source_code, "$spaces$left_side = $right_side ;\n"; $include_trick_alloc = 1; } else { #------------------------------------------------------- # print assignment statement, and handle multiple assignment like x[0] = 1, 2, 3; my ($index_is_integer) = 0 ; my ($index, $offset) ; @right_list = split /,/, $right_side ; if ( $left_side =~ s/\[([^\]]+)\]\s*$// ) { ($index) = $1 ; $need_index = 1 ; $index =~ s/(^\s+|\s+$)//g ; #push @source_code, "/* index = $index */\n" ; if ( $index =~ /^\d+$/ ) { $index_is_integer = 1 ; } } $offset = 0 ; foreach my $r ( @right_list ) { $r =~ s/^\s*// ; # remove leading spaces my ($index_print) ; if ( $need_index ) { if ( $index_is_integer == 1 ) { $index_print = "\[" . ($index + $offset++) . "\]" ; } else { $index_print = "\[$index + " . $offset++ . "\]" ; } } push @source_code, "$spaces$left_side$index_print = " ; if ( $need_unit_conversion ) { push @source_code, "convert_units( $r , \&my_convert ) ;\n" ; $include_trick_convert = 1; } else { push @source_code, "$r ;\n" ; } } } } } # end while file contents # properly indent any ending braces at end of file while ($file_contents =~ s/(.*?)\}//s) { $indent -= 4 ; $spaces = " " x $indent ; push @source_code, "$1$spaces\}" ; } push @source_code, "$file_contents" ; push @source_code, "\n}\n" ; # print out source code open ( NEWFILE, ">$new_file_name" ); print NEWFILE "/* dd_convert $arg */\n\n" ; # includes if ($include_trick_alloc) { if ($trick_version eq 10) { print NEWFILE "#include \"sim_services/MemoryManager/include/memorymanager_c_intf.h\" /* for TMM_declare_var */\n"; } else { # trick 7 print NEWFILE "#include \"sim_services/include/exec_proto.h\" /* for ip_alloc */\n"; } } if ($include_trick_convert) { print NEWFILE "#include \"trick_utils/units/include/units_conv.h\" /* for unit conversion */\n"; } print NEWFILE "#include \"$hfile\"\n\n" ; # relevant model header file # function beginning if ($language eq "cpp") { print NEWFILE "void $main_type\:\:$function_name() {\n\n" ; } else { print NEWFILE "void $function_name( $main_type * $c_param_name ) ;\n\n" ; print NEWFILE "void $function_name( $main_type * $c_param_name ) {\n\n" ; } if ($include_trick_convert) { print NEWFILE " UnitsConvFn_t my_convert ; /* for unit conversion */\n"; } # local variables foreach my $v (@declared_local_vars) { print NEWFILE " $v ;\n" ; } # code print NEWFILE "\n" ; foreach my $code (@source_code) { print NEWFILE $code ; } } # end for each arg # sort and print result_map: # original .d file name, trick generated .d file name, dd_convert generated source file name, data type, sim object instance my @list_map ; while ( my ($key, $val) = each %result_map ) { push @list_map, $key . "," . $val ; } open ( MAPFILE, ">$default_data_dir/dd_result_map.csv" ) ; foreach my $item ( sort @list_map ) { print MAPFILE "$item\n" ; } print "--------------------------------------------------------------------\n" ; #------------------------------------------------------- # parse all relevant io_src code files to get attributes and save in catalog file # store in hashes: # (%attr_type) # key= val= # (%attr_unit) # key= val= # (%attr_size) # key= val= # (%attr_dims) # key= val= sub parse_io_src() { my ($name, $path, $suffix) ; # catalog is built, read it and return if (-e "$default_data_dir/dd_catalog") { print "Reading attributes from catalog..." ; require "$default_data_dir/dd_catalog" ; print "done\n" ; return 1 ; } # otherwise must build catalog... # 1) determine where the io_src directories are by reading S_library_list if (! -e "S_library_list") { print "XXX dd_convert: S_library_list file not found - it's needed to build catalog, b-bye.\n" ; exit ; } if (! -d "$default_data_dir") { print "XXX dd_convert: Directory \"$default_data_dir\" not found - it's needed to store catalog in, b-bye.\n" ; exit ; } print "Reading S_library_list to determine io_src dirs for catalog..." ; open ( SLIBFILE, "S_library_list" ) ; my @idir_list ; while ( ) { s/\s1// ; # some files in S_library_list have a "1" after them ($name, $path, $suffix) = fileparse($_, "(.h|.hh|.c|.cc|.cpp|.d|.dd)"); if (($suffix eq ".h") || ($suffix eq ".hh")) { my $innermost_dir = basename($path); if ($innermost_dir eq "include") { # if innermost dir name is include, chop it off $path = dirname($path) ; } my $idir = $path . "/io_src" ; if (! -d $idir) { print ("XXX dd_convert: Could not find io_src directory \"$idir\"\n"); } my $prevdir = join "", @idir_list[-1] ; if ($idir ne $prevdir) { push @idir_list, $idir ; } } } # add the trick io_src directories push @idir_list, $ENV{TRICK_HOME} . "/trick_source/trick_utils/comm/io_src" ; push @idir_list, $ENV{TRICK_HOME} . "/trick_source/trick_utils/math/io_src" ; push @idir_list, $ENV{TRICK_HOME} . "/trick_source/sim_services/include/io_src" ; print "done\n" ; # 2) read attributes from each io_src file in all io_src directories # the catalog of attributes will go in "dd_catalog" file in Default_data directory print "Building catalog...\n" ; open ( ATTRFILE, ">$default_data_dir/dd_catalog" ); foreach my $idir ( @idir_list ) { opendir my $DIR, $idir or die "XXX dd_convert: Can't open io_src dir: \"$idir\"\n"; my @ls_ifiles = readdir $DIR ; foreach my $ifilename ( @ls_ifiles ) { # readdir returns . and .. which we ignore if (($ifilename eq ".") || ($ifilename eq "..")) { next ; } my $ifile = $idir . "/" . $ifilename ; print "Get attributes in $ifile\n"; print ATTRFILE "#================ $ifile\n"; open ( FILE, $ifile ) ; my ($attr, $key, $type, $var, $unit, $size, $dims) ; # each attribute is 4 lines in the io_src file- pick out stuff we need... my $lineno = 0 ; while ( ) { if (/ATTRIBUTES attr(.*)\[\]\s=/) { $attr = $1 ; #print "ATTR=$attr\n" ; $lineno = 1 ; next ; } # LINE1: "varname", "type", "unit", "alias", "userdefined", if (($lineno eq 1) && (/\{\s\"(.+)\",\s\"(.*)\",\s\"(.*)\",\s\".*\",\s\".*\",\n/)) { $var = $1 ; $type = $2 ; $type =~ s/\:\:/__/g ; # replace class colons with underscores $unit = $3 ; $key = $attr . "." . $var ; # note that derived classes will also have base class variables listed, # so if a variable occurs twice, use the 1st one and ignore the base variable if (exists $attr_type{$key}) { print ATTRFILE "# SKIPPING BASE CLASS VARIABLE $key\n"; next ; } $attr_type{$key} = $type ; $attr_unit{$key} = $unit ; print ATTRFILE "\$attr_type{'$key'} = \"$type\" ;\n"; print ATTRFILE "\$attr_unit{'$key'} = \"$unit\" ;\n"; #print " key=$key : $attr_type{$key} $attr_unit{$key}\n"; $lineno++ ; next ; } # LINE2: "description", if (($lineno eq 2) && (/\s\"(.*)\",\n/)) { #print " desc= $1\n"; $lineno++ ; next ; } # LINE3: iospec, tricktype, size, rangemin, rangemax, language, mods, if (($lineno eq 3) && (/\s(0|1|2|3),(.*),(.*),\d,\d,.*,.*,\n/)) { $size = $3 ; $attr_size{$key} = $size ; print ATTRFILE "\$attr_size{'$key'} = \"$size\" ;\n"; #print " size= $size\n" ; $lineno++ ; next ; } # LINE4: offset, *attr, dims, index0, index1, index2, index3, index4, index5, index6, index7 if (($lineno eq 4) && (/\s[0-9]+,\(char\*\).*,\s([0-9]),\{\{.*\}\}\s\}\s,/)) { $dims = $1 ; $attr_dims{$key} = $dims ; print ATTRFILE "\$attr_dims{'$key'} = \"$dims\" ;\n"; #print " dims= $dims\n" ; $lineno = 1 ; next ; } } } # end foreach ifile } # end foreach idir print ATTRFILE "return 1;\n" ; print "done\n" ; } print "dd_convert complete.\n" ; exit ;