#!/usr/local/bin/awk -f
#
# Copyright (c) 1995, 1996 Gunther Schadow.  All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

BEGIN {
# We use the following global arrays:
#
#   rel[i,column,row] - holds the relation(s)   
#   att_name[column] - holds the attribute names
#   att_type[column] - holds the types of the attributes
#   dom_name[i] - holds the list of domains
#   sym_cnt[dom] - holds the counters of the symbol tables 
#   sym_name[dom,i] - holds the list of symbols per domain
#

# Field separator is a colon
FS=":" ;

# The encoding of the null value
NIL="''";

# The string delimiter
STR_DELIM="\"";

# Change case of all strings to lower? 
LOWER_STRING=1;

# Include domain test predicates?
DOMAIN=0

# We have to initialize the global pointers 
row_cnt=0 ;
dom_cnt=0 ;

# Will there be subtables?
SUBTABLES=0;
# Error exit?
ERROR=0;
}

#######
#
# Function declaration section
#
#######

# Print error message and abort
#
function error(msg, obj) {
  printf("%s:%d at `%s':error %s\n", FILENAME, FNR, obj, msg) > "/dev/stderr" ; 
  ERROR=1 ;
  exit 3 ;
}

function warning(msg, obj) {
  printf("%s:%d at `%s':warning %s\n", FILENAME, FNR, obj, msg) > "/dev/stderr" ; 
}

# Internalize a symbol
#
function intern_sym(dom,sym,     i, sc) {
  sc=sym_cnt[dom];
  for (i=0; (i<sc) && (sym_name[dom,i]!=sym); i++) ;
  if (i==sc)  {
    sym_name[dom,sc]=sym;
    sym_cnt[dom]=sc + 1;
  }
}

# Internalize a domain,
#
function intern_dom(dom,     i) {
  for (i=0; (i<dom_cnt) && (dom_name[i]!=dom); i++) ;
  if (i==dom_cnt)  {
    dom_name[dom_cnt]=dom;
    sym_cnt[dom]=0;
    dom_cnt++;
  }

}

######
#
# Rules section
#
######

# The first line
#   is the name of the table (i.e. the name of the relation)
#
FNR == 1 { 
  rel_name=tolower($1) ;
  gsub(" ", "_", rel_name);

  next;
}

# The second line
#   holds the column titles (i.e. the names of the attributes)
#
FNR == 2 {
  degree = NF
  for (i=1; i<=degree; i++) {
    a=tolower($i) ;
    gsub(" ", "_", a) ;
    att_name[i]=a ;
  }

  next;
}

# The third line
#   declares the type of each attribute
#   if it is `sym', then we internalize the attribute name as the
#   a domain name if we will have to declare domains.   
#
FNR == 3 {
  if (NF > degree) error("too many columns", $(degree+1)) ;

  for (i=1; i<=degree; i++) {
    x=tolower($i);
    att_type[i]=x ;
    if (x == "sym") intern_dom(att_name[i]) ;
    else 
      if ((x != "str") && (x != "num"))
	error("illegal type identifier", x) ;
  }
  next;
}

#########
#
# Subtables
#

#    attribute names
#
(FNR == 4) && sub("^-","",$1) {
  SUBTABLES=1;
  getline SUBFILE < "/dev/pid"
  SUBFILE=("tmp." SUBFILE ".tb")

  su_degree = NF
  for (i=1; i<=su_degree; i++) {
    su_att_name[i]=$i ;
  }


# title is the su_att_name of the first column
  printf("%s\n", su_att_name[1]) > SUBFILE;

  printf("%s%c", att_name[1], FS) > SUBFILE;
  for(i=1; i<su_degree; i++) 
    printf("%s%c", su_att_name[i], FS) > SUBFILE;
  printf("%s\n", su_att_name[i]) > SUBFILE;
  
  next;
}

#   attribute types
#
(FNR == 5) && SUBTABLES {

  if (NF > su_degree) error("too many columns", $(su_degree+1)) ;

  if (!sub("^-","",$1)) error("subtable type line expected", $1) ;

  for (i=1; i<=su_degree; i++)
    su_att_type[i]=$i ;
  
  printf("%s%c", att_type[1], FS) > SUBFILE;
  for(i=1; i<su_degree; i++) 
    printf("%s%c", su_att_type[i], FS) > SUBFILE;
  printf("%s\n", su_att_type[i]) > SUBFILE;

  next;
}

#   any row of a subtable
#
sub("^-","",$1) && (FNR > 5) {

  if (NF > su_degree) error("too many columns", $(su_degree+1)) ;
  
# add the first field of current row of the main table 
  printf("%s%c", rel[(row_cnt-1),1], FS) > SUBFILE;
  for(i=1; i<su_degree; i++)
    printf("%s%c", $i, FS) > SUBFILE; 
  printf("%s\n", $i) > SUBFILE;

  next;
}

#
########

# Any other row
#   is a row of the table
#
{
  if (NF > degree) error("too many columns", $(degree+1)) ;

  for(i=1; i<=degree; i++) {
    x=$i
      if (att_type[i]=="sym") {
	x=tolower(x);
	if (x ~ "^[ 	]*$")  {
#	  warning("symbol field made nil", x);
	  x=NIL;
	}
	else {
	  gsub(" +","_",x);
	  if (x !~ "^[a-z_][A-Za-z_0-9]*$")
	    x="'" x "'";
	}
	intern_sym(att_name[i],x) ;
      }
      else if (att_type[i]=="num") {
	if (x !~ "^ *(+|-)?[0-9]+(\\.[0-9]*)? *$") {
	  if (x ~ "^[ 	]*$") {
 #          warning("symbol field made nil", x);
            x=NIL;
          }
	  else error("number expected", x);
	}
      }
      else if (att_type[i]=="str") {
	if (LOWER_STRING) x=tolower(x);
	gsub(STR_DELIM, "'", x);
	x=(STR_DELIM x STR_DELIM);
      }
    rel[row_cnt,i]=x;
  }
  row_cnt++;
}


# Finally produce the output
#
END{
  if (ERROR) exit 3;

# descriptive header
  printf("%% tb2pl.awk output from `%s', %s\n\n", \
	FILENAME, \
	strftime("%D %T",systime()));
  printf("%%%s/%u\n", rel_name, degree) ;
  for (i=1; i<=degree; i++)
    printf("%%    %s %s;\n", att_type[i], att_name[i]);

# domain section
  if (DOMAINS) {
    printf("\n%%\n");

    for (i=0; i<dom_cnt; i++) {
      dom=dom_name[i];
      printf("%% domain %s\n", dom);
      sc=sym_cnt[dom];
      for (j=0; j<sc; j++) {
	printf("%s(%s).\n", dom, sym_name[dom,j]);
      }
    }
    
    printf("\n%%\n");
  }	

#main section
  for(i=0; i<row_cnt; i++) {
    printf("%s(", rel_name);
    for(j=1; j<degree; j++)
      printf("%s,", rel[i,j]);
    printf("%s).\n", rel[i,j]);
  }

  printf("\n");
}