#!/usr/local/bin/perl -w
#$Id: hdfgen.pl,v 1.21 1997/05/07 21:31:18 steves Exp $

######################################################################
# hdfgen.pl is a perl script that converts a C structure into C code.

# The C code is in the form of functions that will initialize, read and
# write HDF files.

# Its use: allow minimal knowledge of HDF read and write code by the user.

#######################################################################
# hdfgen.pl uses 2 or 3 command line ARGUMENTS
#
# The 1st ARGUMENT is the input file
#	and is in the form of a single C structure in a .h file.
#
# The 2nd ARGUMENT is the name of the output file (.c)
#
# The 3rd ARGUMENT (opitional) is part of the function name to be given
#	to the created functions (in order to create unique functions).
#   Leaving off the 3rd ARGUMENT defaults to using the filename in
#	the 1st ARGUMENT (minus the .h) as part of the function names.
#	This also preserves uniqueness.
#
# example: use mag_hskp.h to create mag_hskp.c
#	   hdfgen.pl mag_hskp.h mag_hskp.c (partial_function_name)
# or in more generic terms:
#	   hdfgen.pl input_file output_file (partial_function_name)

#!each variable in the structure must be declared on an individual line!#
#########################################################################
	#get command line ARGUMENTS
$input_file = $ARGV[0];
$output_file = $ARGV[1];
if ($#ARGV == 2){
  $func_name = $ARGV[2];
}elsif ($#ARGV == 1){
  $func_name = $ARGV[0];
  $func_name =~ s/.h$//;
}else{
  die "Error: hdfgen.pl uses 2 or 3 arguments.\n";
}
	#setup include file.  
	#This assumes that -I option is being used by the compiler
	#If not, then comment out the following 2 lines
@parts = split(/\//, $input_file);
$inc_file = pop(@parts);

	#open .h file
open (IN,"$input_file") || die "can't open input file ($input_file)";

	#open the output file
open (OUT,">$output_file") || die "can't create output file ($output_file)";

$V_index=$SD_index=$maxdim=$variable_counter=0;
$_="";

	#get RCS (Revision Control System) header for hdfgen.pl and the
	# include file and put in created file
print OUT "/* The RCS version of hdfgen.pl used to create this file is: */\n";
print OUT "/* \$Id: hdfgen.pl,v 1.21 1997/05/07 21:31:18 steves Exp $_\$ */\n";
	#get first line
$line = <IN>;
	#find RCS header in the include file
if ($line =~ m!.*/\*\s*\$Id.*\*/!i)
{
  print OUT "\n/* The include file used to create this file is: */\n";
  print OUT "$line\n";
}elsif ($line =~ /^\s*struct/){
  die "Structure must start on line 2 or greater for proper processing.\n";
}else{
  print "Alert: An RCS header for the include file not on first line.\n";
  print OUT "\n  /* An RCS (Revision Control System) header for */\n";
  print OUT "\n  /* the include file is not on the first line. */\n\n";
}
#########begin while loop###########

	#read in each line from "datafile" using the filehandle IN
while ( $line = <IN> ) {

	#check for more than ONE statement per line
  $line =~ /;.*;/ && die "Problem on:\n $line Only able to process ONE statement per line (only one ';' per line).\n";
	#end of structure? yes, get out of while loop
  if ($line =~ /.*};/){
	#empty structure? yes. 
    if ($variable_counter == 0){
      print"Process empty structure ($Struct_Name)? (y/n) ";
	#continue reading? no. die
      if (<STDIN> =~ /^n/i) {
        print OUT "\nStructure $Struct_Name NOT Processed! \n";
        die "$Struct_Name not processed\n";
      }
    }
    last;
  }  
	#line contains a comment marker (/*) or (//)? yes, remove comment
  if ($line =~ m!.*/\*!){
    $line =~ s/\/\*.*\*\/// || die "In file '$input_file' on line:\n$line
    Beginning (/*) and ending (*/) comment markers must be on the same line for
    correct processing of file.\n";
	#check for c++ comment markers (//)
  }elsif ($line =~ m!.*//!){
    $line =~ s/\/\/.*//;
  }
  	#find the name of the struct
  if ( $line =~ /struct\s/){
    $structure = $line;
#print"$structure";
    $structure =~ s/.*struct\s+/struct/;
    $structure =~ s/\s+.+//;
    $structure =~ s/{//;
    $structure =~ s/struct/struct /;
    chop($structure);
    $Struct_Name = $structure;
    $Struct_Name =~ s/struct //;
  }
	#line contains a variable because it has ";" or is it to short?
    if ( $line =~ /;/ && length($line) > 7){
      $variable_counter++;
      $declaration = $line;
	#remove ';' and anything after it
      $declaration =~ s/;.*//;
    	#remove wht space from beginning
      $declaration =~ s/^\s+//;
    	#split the declaration at the white space in the middle
    	#get the variable name and it's type
      ($type, $var_name) = split(/\s+/,$declaration);

	#determine if it's an array (SD data) or not (V data)
      if ($var_name =~ /\[.*\]/ ){
        $arrays[$SD_index] = $var_name;
		#split it into it's name and parameters
        @fields = split(/\[/,$arrays[$SD_index]);
        if ($#fields > $maxdim) {
          $maxdim = $#fields;
		#to set the SD arrays to their proper length add 1
	  $maxdimplus1 = $maxdim + 1;
        }
		#get the name of the SD array
        $SD_name[$SD_index] = $fields[0];
		#remove the ending ] of the dimentional values
        chop(@fields);
        $dim[$SD_index][0] = $#fields;
        for ($cc=1; $cc<=$#fields; $cc++) {
          $dim[$SD_index][$cc] = $fields[$cc];
        }
    		#get the array type
        $SD_Type[$SD_index] = $type;
    		#change case for array type
        $SD_Type[$SD_index] =~ tr/a-z/A-Z/;
        $SD_index++;
      }else {
        $V_name[$V_index] = $var_name;
          $V_dim[$V_index] = 1;
    		#get the variable type
        $V_Type[$V_index] = $type;
    		#change case for variable type
        $V_Type[$V_index] =~ tr/a-z/A-Z/;

    		#determine variable byte size: multiply the base byte size
		# by the number of elements in the variable
        $V_base[$V_index] = $V_Type[$V_index];
        $V_base[$V_index] =~ s/int//i;
        $V_base[$V_index] =~ s/u//i;
        $V_base[$V_index] =~ s/float//i;
        ($V_base[$V_index] /= 8) || die "Problem on line:\n$line can't use '$declaration' in '$structure', must explicitly state bit length. Such as: int16 variable_name. (see hdfi.h)\n";
        $V_index++;
      }
    }
} #############end of while loop##################
	#structure ended with "};"? no! give warning
($line =~ /.*};/) || die "Structure '$structure' must end with a '};'.\n";

############ BEGIN OUTPUT TO FILE ############
	#output: the header files
print OUT "#include \"$inc_file\"\n";
	#does the structure contain SD data
$SD_index > 0 && print OUT "#include \"mfhdf.h\"\n";

print OUT "#include \"df.h\"\n\n";
	#does the structure contain V data 
$V_index > 0 &&  print OUT "static int32 vdata_id_r, vdata_id_w, vgrp_id\;\n";

	#does the structure contain SD data
if ($SD_index > 0) {
  print OUT "static int32 ";
  for ($cc=1; $cc<$SD_index; $cc++){
    print OUT "sds_id_r$cc, sds_id_w$cc, ";
  }
  print OUT "sds_id_r$cc, sds_id_w$cc;\n\n";
}
############output: init write function############
print OUT "\n/****  init write function  ****/\n\n";

print OUT "int32 init_wr_$func_name";
print OUT "(int32 hdf_fp, int32 sd_id, char *classname)\n{\n";
print OUT "  int32 retval=0;\n";
	#does the structure contain SD data
if ($SD_index > 0) {
  print OUT "  int32 dim_sizes\[$maxdimplus1\];\n";
  print OUT "  int32 rank;\n\n";
}
print OUT "  void $func_name"."_error();\n\n";


print OUT "  vgrp_id = Vattach(hdf_fp, -1, \"w\");\n";
print OUT "    Vsetname(vgrp_id, \"NVgrp$func_name\");\n";
print OUT "    Vsetclass(vgrp_id, \"CVgrp$func_name\");\n\n";




	#does the structure contain V data
if ($V_index > 0) {
  print OUT "  if ((vdata_id_w = VSattach(hdf_fp, -1, \"w\"))==FAIL) {\n";
  print OUT "    fprintf(stderr,\"VSattach: Could not attach hdf_fp\\n\");\n";
  print OUT "    retval=-1;\n  }\n";
  print OUT "  VSsetname(vdata_id_w, \"$Struct_Name\");\n";
  print OUT "  VSsetclass(vdata_id_w, classname);\n\n";
}


  print OUT "Vinsert(vgrp_id, vdata_id_w);\n\n";




for ($cc=0; $cc<$V_index; $cc++){
  print OUT "   if (VSfdefine(vdata_id_w, \"$V_name[$cc]\", ";
  print OUT "DFNT_$V_Type[$cc], ($V_dim[$cc]) )) {\n";
  print OUT "     $func_name"."_error(\"VSfdefine $V_name[$cc] error\");\n";
  print OUT "     retval = -1;\n   }\n";
}
	#does the structure contain V data
if ($V_index > 0) {
  print OUT "\n  if (VSsetfields(vdata_id_w,\"";
	#output: the names of the variables except the last one
  for ($cc=0; $cc<$V_index-1; $cc++){
    print OUT "$V_name[$cc], ";
  }
	#output: the last variable minus the comma
  print OUT "$V_name[$V_index-1]\")){\n";
  print OUT "    $func_name"."_error(\"VSsetfields error\");\n";
  print OUT "    retval = -1;\n  }\n";
}

for ($c1=0; $c1<$SD_index; $c1++){
  $temp = ($dim[$c1][0]+1);
  print OUT "  dim_sizes\[0\] = SD_UNLIMITED;\n";
  print OUT "  rank = $temp;\n";
  for ($c2=1; $c2<$temp; $c2++){
    print OUT "  dim_sizes\[$c2\] = $dim[$c1][$c2];\n";
  }
  $cplus1 = $c1 + 1;
  print OUT "  if((sds_id_w$cplus1=SDcreate(sd_id, \"$Struct_Name"."_$SD_name[$c1]\", DFNT_$SD_Type[$c1], rank, dim_sizes)) == FAIL)\n";
  print OUT "    fprintf(stderr,\"SDcreate: Could not create $Struct_Name"."_$SD_name[$c1] \\n\");\n\n";
}
print OUT "  return(retval);\n}\n\n";

         #####################
#########output: write function#########
print OUT "/****** write function ******/\n\n";

print OUT "int32 write_$func_name($structure $Struct_Name"."_struc)\n{\n";
	#does the structure contain SD data
$SD_index > 0 &&  print OUT "int32 start\[$maxdimplus1\], edges\[$maxdimplus1\];\n";

print OUT "int32 retval = 0;\nuint8 *odata;\n";
	#does the structure contain SD data
$SD_index > 0 &&  print OUT "static int32 recnum_wr=0;\n";

print OUT "\nvoid pack_$func_name();\n\n";
print OUT "  odata = (uint8 *) malloc(sizeof($structure));\n";
print OUT "  pack_$func_name(odata, &$Struct_Name"."_struc);\n\n";

	#convert the input name to uppercase
	#and replace underscore with a space
  $func_name1 = $func_name;
  $func_name1 =~ tr/a-z/A-Z/;
  $func_name1 =~ tr/_/ /;
	#does the structure contain V data
if ($V_index > 0) {
  print OUT "  if( VSwrite(vdata_id_w, (uint8 *)odata, 1, FULL_INTERLACE) == -1) {\n";
  print OUT "    fprintf(stderr,\"VSwrite: Problem writing $func_name1 data\\n\");\n  } \n";
}

	#does the structure contain SD data
if ($SD_index > 0) {
  print OUT "  start\[0\] = recnum_wr++;\n";
  for ($c2=1; $c2<=$maxdim; $c2++){
    print OUT "  start\[$c2\] = 0;\n";
  }
  print OUT "  edges\[0\] = 1;\n\n";
}
for ($c1=0; $c1<$SD_index; $c1++){
  $temp = ($dim[$c1][0]+1);
  for ($c2=1; $c2<$temp; $c2++){
    print OUT "  edges\[$c2\] = $dim[$c1][$c2];\n";
  }
  $cplus1 = $c1 + 1;
  print OUT "  if (SDwritedata(sds_id_w$cplus1,start,NULL,edges,(VOIDP) ";
  print OUT "($Struct_Name"."_struc.$SD_name[$c1] ))==FAIL) {\n";
  print OUT "    fprintf(stderr,\"SDwritedata: Problem writing $SD_name[$c1] data.\\n\");\n  }\n";
}
print OUT "  memset(&$Struct_Name"."_struc, 0, sizeof($structure));\n";
print OUT "  free(odata);\n  return(retval);\n}\n\n";

	#output: close init write function
  print OUT "void close_wr_$func_name() {\n";
	#does the structure contain V data
$V_index > 0 &&  print OUT "  VSdetach(vdata_id_w);\n";


######################################
print OUT "  Vdetach(vgrp_id);\n";



for ($cc=1; $cc<=$SD_index; $cc++){
  print OUT "  SDendaccess(sds_id_w$cc);\n";
}
  print OUT "}\n\n";

############init read function###############
print OUT "/*     init read function    */\n\n";

print OUT "int32 init_rd_$func_name(int32 hdf_fp, int32 sd_id)\n{\n";
for ($cc=1; $cc<=$SD_index; $cc++){
  print OUT "  static int32 sds_index$cc;\n";
}
	#does the structure contain V data
$V_index > 0 &&  print OUT "  int32 vdata_ref;\n";

print OUT "  int32 retval=0;\n\n";
print OUT "  void $func_name"."_error()\;\n\n";

for ($c1=0; $c1<$SD_index; $c1++){
  $cplus1 = $c1 + 1;
  print OUT "    if((sds_index$cplus1=SDnametoindex(sd_id, \"$Struct_Name"."_$SD_name[$c1]\" ))==FAIL) {\n";
  print OUT "      fprintf(stderr,\"SDnametoindex: Could not find $Struct_Name"."_$SD_name[$c1]\\n\");\n";
  print OUT "      retval = -1;\n    }\n";
  print OUT "    if((sds_id_r$cplus1=SDselect(sd_id, sds_index$cplus1))==FAIL) {\n";
  print OUT "      fprintf(stderr,\"SDselect: Could not select sds_index$cplus1\\n\");\n";
  print OUT "      retval = -1;\n    }\n";
}
	#does the structure contain V data
if ($V_index > 0) {
  print OUT "\n  if ((vdata_ref = VSfind(hdf_fp, \"$Struct_Name\"))==FAIL) {\n";
  print OUT "    fprintf(stderr,\"VSfind: Could not get vdata_ref\\n\")\;\n";
  print OUT "    retval=-1\;\n  }\n";

  print OUT "  if ((vdata_id_r = VSattach(hdf_fp, vdata_ref, \"r\"))==FAIL) {\n";
  print OUT "    fprintf(stderr,\"VSattach: Could not attach hdf_fp\\n\")\;\n";
  print OUT "    retval=-1\;\n  }\n";
}

	#does the structure contain V data
if ($V_index > 0) {
  print OUT "\n  if (VSsetfields(vdata_id_r,\"";
	#output: the names of the variables except the last one
  for ($cc=0; $cc<$V_index-1; $cc++){
    print OUT "$V_name[$cc], ";
  }
	#output: the last variable minus the comma
  print OUT "$V_name[$V_index-1]\")) {\n";
  print OUT "    $func_name"."_error(\"VSsetfields error\");\n  }\n";
}
print OUT "  return(retval);\n}\n\n";

         ####################
#########output: read function#########
print OUT "/****** read function ******/\n\n";

print OUT "int32 read_$func_name($structure *$Struct_Name"."_struc, int32 recnum_rd)\n{\n";
	#does the structure contain SD data
$SD_index > 0 &&  print OUT "int32 start\[$maxdimplus1\], edges\[$maxdimplus1\];\n";

	#does the structure contain V data
if ($V_index > 0) {
  print OUT "static int32 last_recnum = -1;\n";
  print OUT "int32 maxrec;\n";
}
print OUT "int32 retval = 0;\nuint8 *odata;\n\n";
print OUT "void unpack_$func_name();\n\n";

	#does the structure contain SD data
if ($SD_index > 0) {
  print OUT "  start[0] = recnum_rd;\n";
  for ($c2=1; $c2<=$maxdim; $c2++){
    print OUT "  start\[$c2\] = 0;\n";
  }
  print OUT "  edges\[0\] = 1;\n\n";
}
print OUT "  odata = (uint8 *) malloc(sizeof($structure));\n";
	#does the structure contain V data
if ($V_index > 0) {
  print OUT "  VSinquire(vdata_id_r, &maxrec, NULL, NULL, NULL, NULL);\n";
  print OUT "  if (recnum_rd >= maxrec || last_recnum>=maxrec-1) return(-1);\n";
  print OUT "  if (recnum_rd >= 0) {\n";
  print OUT "    last_recnum = recnum_rd;\n";
  print OUT "    if (VSseek(vdata_id_r, recnum_rd)==FAIL) {\n";
  print OUT "      fprintf(stderr,\"VSseek unsuccessful\\n\");\n";
  print OUT "      retval = -1;\n    }\n  } ";
  print OUT "else {\n";
  print OUT "    recnum_rd = ++last_recnum;\n  }\n";
}
for ($c1=0; $c1<$SD_index; $c1++){
  $temp = ($dim[$c1][0]+1);
  for ($c2=1; $c2<$temp; $c2++){
    print OUT "  edges\[$c2\] = $dim[$c1][$c2];\n";
  }
  $cplus1 = $c1 + 1;
  print OUT "  if(SDreaddata(sds_id_r$cplus1,start,NULL,edges, "; 
  print OUT "(VOIDP)($Struct_Name"."_struc->$SD_name[$c1] ))==FAIL) {\n";
  print OUT "    fprintf(stderr,\"SDreaddata: Could not read $SD_name[$c1]\\n\");\n";
  print OUT "    retval = -1;\n  }\n";
}
	#does the structure contain V data
if ($V_index > 0) {
  print OUT "  if(VSread(vdata_id_r, (uint8 *)odata, 1, FULL_INTERLACE)==FAIL) {\n";
  print OUT "    fprintf(stderr,\"VSread: Could not read\\n\");\n";
  print OUT "    retval = -1;\n  }\n";
}
print OUT "  unpack_$func_name(odata, $Struct_Name"."_struc);\n";
print OUT "  free(odata);\n  return(retval);\n}\n\n";

#########output: error function
print OUT "void $func_name"."_error(int8 *mess)\n";
print OUT "  { fprintf(stderr,\"$func_name1: %s\\n\",mess); }\n\n";

#########output: close read function
print OUT "void close_rd_$func_name() {\n";
	#does the structure contain V data
$V_index > 0 &&  print OUT "  VSdetach(vdata_id_r);\n";

for ($cc=1; $cc<=$SD_index; $cc++){
  print OUT "  SDendaccess(sds_id_r$cc);\n";
}
print OUT "}\n";

###########output: pack function################
print OUT "/*   pack function    */\n\n";

print OUT "void pack_$func_name(uint8 *data, ";
print OUT "$structure *$Struct_Name"."_ptr)\n{\n";
print OUT "int32 ptr=0;\n\n";

for ($cc=0; $cc<$V_index; $cc++){
	#if the dimension is reported in a variable name, or has an operator
	# contained within it, mark it as multi-dimensional (ie > 1).
  if ($V_dim[$cc] =~ /[a-zA-Z\*\+\/-]/){
    $dim_value = 999;
  }else {
    $dim_value = $V_dim[$cc];
  }
  if ($dim_value == 1 ){
    print OUT "   memcpy(data+ptr, &$Struct_Name"."_ptr->$V_name[$cc],";
  }else {
    print OUT "   memcpy(data+ptr, &$Struct_Name"."_ptr->$V_name[$cc]"."[0],";
  }
  print OUT " (($V_base[$cc])*($V_dim[$cc])) );\n";
  print OUT "   ptr+= (($V_base[$cc])*($V_dim[$cc]));\n";
}
print OUT "}\n\n";

###########output: unpack function################
print OUT "/*   unpack function    */\n\n";

print OUT "void unpack_$func_name(uint8 *data, ";
print OUT "$structure *$Struct_Name"."_ptr)\n{\n";
print OUT "int32 ptr=0;\n\n";

for ($cc=0; $cc<$V_index; $cc++){
	#if the dimension is contained in a variable name, or has an operator
	# contained within it, mark it as multi-dimensional (ie > 1).
  if ($V_dim[$cc] =~ /[a-zA-Z\*\+\/-]/){
    $dim_value = 999;
  }else {
    $dim_value = $V_dim[$cc];
  }
  if ($dim_value == 1 ){
    print OUT "   memcpy(&$Struct_Name"."_ptr->$V_name[$cc], data+ptr, ";
  }else {
    print OUT "   memcpy(&$Struct_Name"."_ptr->$V_name[$cc]"."[0], data+ptr, ";
  }
  print OUT " (($V_base[$cc])*($V_dim[$cc])) );\n";
  print OUT "   ptr+= (($V_base[$cc])*($V_dim[$cc]));\n";
}
print OUT "}\n";

close (OUT);
close (IN);