#!/usr/server/arc/bin/sybperl 
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.IDENTIFICATION  mkfdf
#.LANGUAGE	  SybPerl script
#
#.PURPOSE	  Make a Form Definition File, suitable for wdb.
#
#.AUTHOR	  Bo Frese Rasmussen [ST-ECF]	<bfrasmus@eso.org>
#
#.VERSION	1.0	14/06-1994	Creation
#		1.1	02/01-1995
#
#.COPYRIGHT NOTICE
# ==========================================================================
# Copyright Bo Frese Rasmussen 1994 - All Rights Reserved
# Copyright European Southern Observatory(ESO) 1994 - All Rights Reserved
# Copyright Space Telescope - European Coordinating Facility(ST-ECF) 1994 
# - All Rights Reserved
# 
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose is hereby granted without fee, provided
# that the above copyright notice appear in all copies and that both that
# copyright notice, this permission notice, and the following disclaimer
# appear in supporting documentation, and that the names of the copyright
# holders, not be used in advertising or publicity pertaining to
# distribution of the software without specific, written prior
# permission.
# 
# BO FRESE RASMUSSEN, EUROPEAN SOUTHERN OBSERVATORY, AND OTHER
# CONTRIBUTORS OF THIS SOFTWARE DISCLAIM ALL WARRANTIES WITH REGARD TO
# THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
# FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL BO FRESE
# RASMUSSEN, EUROPEAN SOUTHERN OBSERVATORY OR ANY OTHER CONTRIBUTOR BE
# LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA, OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE, OR OTHER TORTIOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
#------------------------------------------------------------------------------
$helptext="
    Usage: mkfdf [ -U user ] [ -P passwd ] [ -S server ] -d database
		  -t table [ -k keyfield ] [ -n formname ] | -h 
	
		-U -P -S	As in isql

		-d database	Obvious :-)
		-t table	

		-k keyfield	The name of the field in the table which are
				the key field. If not specified the first
				column are assumed.
		
		-n formname	The name of the form produced. (Defaults to 
				table name). The file 'formname.fdf' are 
				produced as output.

		-h 		Produces help text (you are looking at it !)

";
#------------------------------------------------------------------------------
# These might have to be changed ....
unshift(@INC, "/usr/server/gnu/lib/perl");	
unshift(@INC, "/usr/server/arc/lib/perl");

require	"sybperl.pl";
require	"getopts.pl";

$opt_U = 'www';
#$opt_P = '';
$opt_S = $ENV{'DSQUERY'} if $ENV{'DSQUERY'};

$wdb_url='$WDB';

$NO_TAB_LEN = 50;  # Fields longer than this gets 'no_tab' attribute.

#-------------------------
# Get commandline options.
#-------------------------
$ret = &Getopts('U:P:S:d:t:k:n:h');

if ( $opt_h || ! $ret ) {
    print $helptext;
    exit;
}

if ( ! $opt_d ) {
    die "Database name missing (-d option)\n";
}
if ( ! $opt_t ) {
    die "Table name missing (-t option)\n";
}
if ( ! $opt_n ) {
    warn "Form name missing (-n option) - using table name\n";
    $opt_n = $opt_t;
}
if ( ! $opt_P ) {
    print "\nPassword for user $opt_U: ";
    system("stty -echo");
    chop($opt_P = <STDIN>);
    system("stty echo");
    print "\n";
}
if ( $opt_k ) {
    @keys = split( ',' , $opt_k );
}

#--------------------
# Open fdf file .
#--------------------
open(STDOUT,">$opt_n.fdf") || die "Can't redirect stdout to $opt_n.fdf: $!\n";

#------------------------------
# Define type conversion table
#------------------------------
%typ = (
    'varchar', 'char',
    'text', 'char',
    'floatn', 'float',
    'datetimn', 'datetime', 
    'intn', 'int',
    'integer', 'int',
);

#---------------------
# Connect to database
#---------------------
$dbproc = &dblogin($opt_U, $opt_P, $opt_S);
$dbproc != -1 || die "Can't login ...\n";

&dbuse( $opt_d );

&dosql( "
    select c.name col_name, t.name type_name, c.length col_len, 
    	   ut.name utyp_name
    from sysobjects o, syscolumns c, systypes t, systypes ut
    where   o.id = c.id
      and   c.type = t.type
      and   t.usertype < 100
      and   c.usertype = ut.usertype
      and   o.name = \"$opt_t\"
      order by c.colid, t.usertype
	");

#----------------------
# Make FORM attributes 
#----------------------
print "NAME         = $opt_n \n";
print "TABLE        = $opt_t \n";
print "DATABASE     = $opt_d \n";
print "TITLE        = $opt_n \n";
print "Q_HEADER     = $opt_n Query Form \n";
print "R_HEADER     = $opt_n Query Result \n";
print "#DOCURL      = # URL to documentation.\n";
print "\n";
print "#JOIN        = # Join condition ..\n";
print "#CONSTRAINTS = # Extra query constraints ....\n";
print "#ORDER       = # ORDER BY columns ...\n";
print "\n";
print "#RECTOP      = #Record title ....\n";
print "#PERL        = # Extra perl commands ....\n";
print "#COMMENTS_TO = # Your e-mail address ....\n";
print "#------------------------------------\n\n";

$num_fields=0;
$old_col_name = "";
while( %col = &dbnextrow($dbproc, 1) ) {
    if ( $old_col_name eq $col{'col_name'}  ) { 
	next; 
    }
    $old_col_name = $col{'col_name'};

    #------------------
    # Convert type name
    #------------------
    if ( $typ{$col{'type_name'}} ) {
	$col{'type_name'} = $typ{$col{'type_name'}};
    }

    #------------------------------------------------
    # Default key is first field ( if no -k option )
    #------------------------------------------------
    if ( ! defined @keys ) {
	@keys = ( $col{'col_name'} );
	warn "-k option missing: Assuming $col{'col_name'} is the unique key.";
    } 

    #------------------------------------------------
    # Create a 'More' field as the first field.
    #------------------------------------------------
    if ( $num_fields == 0 ) {
	
	print "FIELD    = more\n";
	print "label    = More\n";
	print "from_db  = \"<i>MORE</i>\"\n";
	print "url      = \"\$WDB/\$form{'DATABASE'}/\$form{'NAME'}/query/";

	foreach $key (@keys) {
	    $url .= '::' if $url;
	    $url .= "\$val{'" . $key . "'}";
	}
	print "$url\"\n";

	print "length   = 4\n";
	print "computed\n";
	print "forcetab\n";
	print "no_query\n";
	print "no_full\n\n";
    }


    #-----------------------
    # Make field attributes
    #-----------------------
    print "FIELD  = $col{'col_name'} \n";
    $label = $col{'col_name'};
    $label =~ s/_/ /g;
    $label =~ s/\b([a-z])/\U$1/g;
    print "label  = $label\n";
    print "column = $col{'col_name'} \n";
    print "type   = $col{'type_name'}\t\t\t# $col{'utyp_name'} \n";
    print "length = $col{'col_len'}\n";
    if ( grep (/^$col{'col_name'}$/, @keys) ) {
	print "key\n";
	#print "url    = \"$wdb_url/$opt_d/\$form{'NAME'}/query/\$val{'";
	#print $col{'col_name'} . "'}\"\n";
    }

    #-----------------------------------------------------------------
    # This stuff probably needs to be changed / removed if used at
    # other sites than ESO / ST-ECF. It is an example of how
    # site dependant things can be added automaticaly - thus reducing
    # the need to do manual changes.
    #-----------------------------------------------------------------
#
#    if ( $col{'col_name'} =~ /date/ ) {
#	print "### IS THIS A DATE FIELD ? ###\n";
#	print "from_db=&cvdatein(\$val{'".$col{'col_name'}.
#		"'},\"DD MMM YY\");\n";
#	print "to_db  =&cvdateout(\$val);\n";
#	print "length = 9\n";
#    } elsif ( $col{'col_name'} =~ /time/ ) {
#	print "### IS THIS A DATE-TIME FIELD ? ###\n";
#	print "from_db=&cvdatein(\$val{'".$col{'col_name'}.
#		"'},\"DD MMM YY HH:MM:SS\");\n";
#	print "to_db  =&cvdateout(\$val);\n";
#	print "length = 18\n";
#    } elsif ( $col{'col_name'} =~ /(\b|_|^)ra(\b|_|$)/ 
#    	   || $col{'col_name'} =~ /(\b|_|^)r_a(\b|_|$)/ ) {
#	print "### IS THIS A 'ra' FIELD ? - should it be * or / first ? ###\n";
#	print "from_db=&ed_pic( \$val{'".$col{'col_name'}.
#		"'},\"99 59 59.99\");\n";
#	print "to_db  =&tr_pic( \$val ,\"99 59 59.99\");\n";
#	print "length = 11\n";
#    } elsif ( $col{'col_name'} =~ /(\b|_|^)dec(\b|_|$)/ ) {
#	print "### IS THIS A 'dec' FIELD ? - should it be * or / first ? ###\n";
#	print "from_db=&ed_pic( \$val{'".$col{'col_name'}.
#		"'},\"+99 59 59.9\");\n";
#	print "to_db  =&tr_pic( \$val ,\"+99 59 59.9\");\n";
#	print "length = 11\n";
#    }
    #-----------------------------------------------------------------

    if ( $col{'col_len'} > $NO_TAB_LEN ) {
	print "no_tab\n";
    }
    print "\n";
    $num_fields++
}
if ( $num_fields > 20 ) {
  warn "This form has $num_fields fields - That's a bit much for a Mosaic form\n";
  warn "You probably should add some 'no_query' attributes.\n";
}


##### SUBROUTINES #######
sub dosql {
    local($sql) = @_;

    &dbcmd( $sql ) || die "Error in dbcmd.\n" ;
    &dbsqlexec || die "Error in dbsqlexec.\n" ;
    &dbresults;
}