#  openinfo.pl -- Open INFO table to read specified items
#
#  Purpose:
#	This subroutine searches the INFO tables directory file for an
#	Arc/Info workspace, uses the corresonding item description
#	(.nit) file to create a template for extracting a specified list
#	of items using unpack(), and then opens the actual table file
#	for input only.
#
#	The template for unpacking data treats INFO C, D, I, and N data
#	types as ASCII strings with blank fill; type B data are unpacked
#	as short or long binary values, depending on item width; and
#	type F, as float or double, depending on width.  Note that D
#	(date) type are left in the INFO internal format:  YYYYMMDD.
#
#	The search for the name of the INFO table to be opened and the
#	names of the items to be extracted from it is performed in a
#	case-independent manner.
#
#  Usage:
#	require 'openinfo.pl';
#
#	($reclen, $template) = &openinfo ($handle, $workspace, $table,
#			       @itemlist);
#	while (read ($handle, $inbuf, $reclen) == $reclen)
#	    {
#	    ($item1, $item2, ..., $itemN) = unpack ($template, $inbuf);
#		...
#	    }
#	close $handle;
#
#  Arguments:
#	$handle		Character string to be used as filehandle.
#	$workspace	Pathname of Arc/Info workspace (Unix directory)
#			under which the info/ subdirectory containing
#			a description of the desired table is located.
#			A null string will be interpreted as ".".
#	$table		Name of table to be opened; case is ignored.
#	@itemlist	List of names of items to be extracted from
#			table; case is ignored.
#
#  Return Values:
#	$reclen		Length of each table record, in bytes.
#	$template	Template for using unpack() to extract values
#			for the items specified in @itemlist from each
#			record of the table.  The template will unpack
#			the items in the order in which they are given
#			in @itemlist.
#
#	An empty array is returned if the table cannot be opened or if
#	any of the specified items cannot be found. 
#
#  External files accessed:
#	$workspace/info/arc.dir		READ to get names of item
#					descriptions and data files.
#	$workspace/info/arcNNNN.nit	READ to get item format
#					descriptions.
#	$workspace/info/arcNNNN.dat	READ to get filepath for
#					external table file or OPENed
#					for input if table not external
#	<external-table-file>		OPENed for data input if table
#					is in external file.
#
#  Script history:
#	02-96	Initial version, R. A. White, PSU/ESSC
#	10-98	Replaced incorrect grep() usage, R. A. White
#	02-99	Added check for INFO directory-deleted flag, R. A. White
#	05-04	Fixed problem when external table has absolute rather
#		than relative pathname in arc000n.dat file, raw.
#
############   End of Prolog for Subroutine openinfo   ############

sub openinfo
    {
    local ($handle,	# Character string to be used as filehandle.
	   $workspace,	# Pathname of Arc/Info workspace.
	   $table,	# Name of table to be opened.
	   @itemlist)	# List of items to be extracted from table.
	   = @_;

    local ($DIRRECLEN);	# Length of each record in INFO directory.
    local ($NITRECLEN);	# Length of each record in .nit file.
    local (*DAT);	# Filehandle for reading external file name.
    local (*INFODIR);	# Filehandle for INFO directory file.
    local (*NIT);	# Filehandle for .nit file.
    local ($delflag);	# Flag for deleted Arc/Info directory record.
    local ($dirtemplt);	# Template for unpacking directory entries.
    local ($extflag);	# Flag set to "XX" if table is external.
    local ($i);		# Loop counter/index.
    local (@infotypnam);# Array of names for INFO type codes.
    local ($itemname);	# Name of item in .nit record.
    local ($itempos);	# Position of item in table data record.
    local (%itemtempl);	# Associative array of unpack templates for each
			# item.
    local ($itemtype);	# Type of item in table data record.
    local ($itemwidth);	# Width (bytes) of item in table data record.
    local ($j);		# Loop counter/index.
    local ($nittemplt);	# Template for unpacking .nit file entries.
    local ($tablefile);	# Namebase for file containing table data.
    local ($tablename);	# Name of table in directory entry.
    local ($tabnrec);	# Number of records in table file.
    local ($tabrecl);	# Length of each entry in table data file.
    local ($template);	# Template returned to caller.

#  Define templates and constants defining INFO records

    $DIRRECLEN = 380;
    $NITRECLEN = 144;
    $dirtemplt = "A32 A8 x2 s x18 s l x10 A2";

    $nittemplt = "A16 s x2 s x8 s";

    @infotypnam =  ("Record number",		# 0 (= 99 % 99)
		    "Date",			# 1
		    "Character",		# 2
		    "Integer",			# 3
		    "Decimal number",		# 4
		    "Binary integer",		# 5
		    "Binary floating point",	# 6
		    "Leading fill",		# 7
		    "Packed integer",		# 8
		    "Zero fill",		# 9
		    "Overpunch",		# 10
		    "Trailing sign");		# 11

#  Open INFO directory file and look for table name

    $workspace = "." unless ($workspace);
    open (INFODIR, "$workspace/info/arc.dir")
      || (warn ("Cannot open $workspace/info/arc.dir:  $!")
	&& return () );
    $table =~ tr/A-Z/a-z/;
    while (read (INFODIR, $_, $DIRRECLEN))
	{
	($tablename, $tablefile, $tabrecl, $delflag, $tabnrec, $extflag)
	  = unpack ($dirtemplt, $_);
	$tablename =~ tr/A-Z/a-z/;
	last if (($tablename eq $table) && (! $delflag));
	}
    ($tablename eq $table)
      || (warn ("Table \"$table\" not in INFO directory")
	&& return () );
    close INFODIR;

#  Build unpack template using NIT specifications

    $tablefile =~ tr/A-Z/a-z/;
    open (NIT, "$workspace/info/$tablefile.nit")
     || (warn ("Cannot open $workspace/info/$tablefile.nit:  $!")
	&& return () );
    for ($i = 0; $i <= $#itemlist; $i++)
	{
	$itemlist[$i] =~ tr/A-Z/a-z/;
	}
    while (read (NIT, $_, $NITRECLEN))
	{
	($itemname, $itemwidth, $itempos, $itemtype)
	  = unpack ($nittemplt, $_);
	$itemname =~ tr/A-Z/a-z/;
	for ($j = 0; $j < @itemlist; $j++)
	    {
	    last if ($itemname eq $itemlist[$j]);
	    }
	next if $j == @itemlist;

#  Use type and width of item to construct template entry for each item

	if (defined ($itemtempl{$itemname}))
	    {
	    warn ("Duplicate NIT entry for item $itemname");
	    next;
	    }
	if (($itemtype >= 1) && ($itemtype <= 4))
	    {
	    $itemtempl{$itemname} = sprintf ("@%d A%d ",
	      $itempos - 1, $itemwidth);
	    }
	elsif ($itemtype == 5)
	    {
	    warn ("Bad width for binary integer:  $itemwidth")
	      if (($itemwidth != 2) && ($itemwidth != 4));
	    $itemtempl{$itemname} = sprintf ("@%d %s ",
	      $itempos - 1, ($itemwidth == 2) ? "s" : "l");
	    }
	elsif ($itemtype == 6)
	    {
	    warn ("Bad width for floating-point value:  $itemwidth")
	      if (($itemwidth != 4) && ($itemwidth != 8));
	    $itemtempl{$itemname} = sprintf ("@%d %s ",
	      $itempos - 1, ($itemwidth == 4) ? "f" : "d");
	    }
	elsif (($itemtype == 99)
	  || (($itemtype > 6) && ($itemtype <= 11)))
	    {
	    warn ("Unsupported INFO data type:  $itemtype"
	      . " ($infotypnam[$itemtype % 99])");
	    return ();
	    }
	else
	    {
	    warn ("Unknown INFO data type code:  $itemtype");
	    return ();
	    }
	last unless (--$i);	
	}

#  Assemble template segments in order of items in list

    $template = "";
    while ($itemname = shift (@itemlist))
	{
	(defined ($itemtempl{$itemname})) ?
	  $template .= $itemtempl{$itemname}
	  : warn ("Item \"$itemname\" not found in table".
	   " \"$tablename\"");
	}
    return () if ($i);
    close NIT;

#  Open table file

    $tablefile .= ".dat";
    if ($extflag eq "XX")
	{
	open (DAT, "$workspace/info/$tablefile")
	  || (warn ("Cannot open $workspace/info/$tablefile:  $!")
	    && return () );
	($tablefile) = (<DAT> =~ /^(\S+)($|\s+)/);
	close DAT;
	}
    $tablefile = "$workspace/info/$tablefile"
      unless ($tablefile =~ /^\//);
    open ($handle, "$tablefile")
      || (warn ("Cannot open $tablefile:  $!") && return () );

#  Normal return

    ($tabrecl, $template);
    }
1;		# End of subroutine openinfo
