Searching for Parts

#!/usr/local/bin/perl/perl
&init_socket;

# machine and port for the familyd generate server
$server = "cae016.ed.ray.com";
$server_port = 4000;

# username of person to receive error mail
$maintainer = "gmm7689@sudcv91.ed.ray.com";

$family_file = "/usr2/std/fpts/family-list";
$fmt = "/usr/ucb/fmt";
$more = "/usr/ucb/more";

MAIN: while(1) {
system("clear");

# get the string to find in the family list.
print "Family of Parts Search\n\n".
      "Enter LIST to get a list of all families.\n".
      "Spaces match any character.  Search is case-insensitive.\n".
      "Enter string to match against family names and comments\nor q to ".
      "quit (e.g. 38999, T55164, connector): ";

chop($pattern = <STDIN>);

if($pattern eq "LIST")
  {
    &list_all;
    goto MAIN;
  }

# restart loop if an empty string was entered.
goto MAIN if ($pattern =~ /^$/);

# exit if input starts with q or Q
exit if($pattern =~ /^q/i);

# open the list of Families of Parts.  Only families which are listed in this 
# file will be available for searching
open(FAMILIES, $family_file) || 
  print "Unable to open family list.\nPress Return to continue." && <STDIN>
  && goto MAIN; 

# quote all .'s so they match only .'s (as in 0.5)
$pattern =~ s#\.#\\.#g;

# change all spaces to .'s (since space in input string will match
# any character.)
$pattern =~ s/ /./g;

# found_a_match becomes 1 when an entry is found that matches
# the search string
$found_a_match = 0;

# clear out the lists.
$#directories = -1;
$#partnames = -1;
$#comments = -1;
$#images = -1;

# check each of the families for the string
while(<FAMILIES>)
  {
    # remove the trailing newline
    chop;

    # skip blank lines
    next unless(/\w/);

    # deal with continuation lines
    while (s/\\$//) { $_ .= <FAMILIES>; chop; }

    # split lines into its parts
    ($directory, $partname, $comment, $image) = split(':');

    # wordwrap using fmt(1), use 55 columns instead of 72 because of
    # leading tab and 65 column xterm.
    if(open(OUT, ">/tmp/sfp-$$"))
      {
	print OUT $comment;
	close(OUT);
	if(open(IN, "$fmt -55 /tmp/sfp-$$|"))
          {
	    $comment = join("\t", <IN>);
	    close(IN);
	  }
	unlink("/tmp/sfp-$$");
      }

    # search in the pattern and comments
    if(($partname =~ /$pattern/i) || ($comment =~ /$pattern/i))
      {
        # add the directory to the list of directories, the part name 
        # to the list of part names, and set the found_a_match flag.
	push(@directories, $directory);
	push(@partnames, $partname);
	push(@comments, $comment);
	push(@images, $image);
        $found_a_match = 1;
      }
  }

# done with this file
close(FAMILIES);

# if no matches were found, exit the search
unless ($found_a_match == 1) 
  { 
    print "\nNo matches found.\nPress Return to continue.";
    <STDIN>;
    goto MAIN; 
  }

# report the matches, giving each a number.
print "\nMatches: \n"; $i = 1;

if(open(MORE, "|$more")) { select(MORE); $| = 1; }

foreach (@partnames) 
  { 
    printf("%2d: %s\n\t%s\n", $i, $_, $comments[$i - 1]); $i++;
  }

close(MORE);
select(STDOUT);

# keep asking for a family number until a valid one is entered.
do
  {
    # find which family to search
    print "\nEnter desired master part number (e.g 1, 2, 3) (0 to exit): ";
    chop($partno = <STDIN>);

    unless($partno =~ /^$/)
      {
        # exit on zero
        goto MAIN if($partno eq "0");

        # check part number 
        print "\nInvalid master part number.\n" 
          if(($partno >= $i) || ($partno <= 0));
      }
  }
while(($partno >= $i) || ($partno <= 0));

FAMILYCHOSEN:

# get the partname and directory for desired family
$partname = $partnames[$partno - 1];
$directory = $directories[$partno - 1];
($image = $images[$partno - 1]);

# open the family of parts table
open (TABLE, $directory . "/_tbl") || 
  print "Unable to open table.\nPress Return to continue." && <STDIN>
  && next MAIN;

print "\n";

# skip the header lines, but print lines beginning with #!, they're 
# messages for the users.
while(($_ = <TABLE>) =~ /^\#/) 
{
  if (s/^#! *//) { print; }
}

# the first non-header line contains the variable names
@fields = split;

# ask if the user wants to see the image
if ($image =~ /\w/)
  {
    print "\nView an image of the part? (y/N) ";
    if (<STDIN> =~ /^y/)
      {
	system("xv ".$image." &");
      }
  }

# list the variable names
print "\nThe following variables are defined for this part: \n"; $i = 1;
foreach (@fields) { printf("%2d: %s\n", $i++, $_); }

$entered_a_field = 0;

# keep looping until either a valid field number or 0 is entered
ENTERFIELDS:
while($entered_a_field == 0) {

  # find out which fields to search
  print "\nEnter the numbers of the variables you want to search,\n".
        "seperated by spaces (e.g. 1 2 5 12) (0 to quit): ";
  next unless(($_ = <STDIN>) =~ /\d/);

  @field_nos = split;

  goto MAIN if($field_nos[0] eq "0");

  print "\nThis is a string comparison.\n".
        "Spaces match any character.  Search is case-insensitive.\n".
	"\n".
        "Examples: given the values 8.0, 18.0, 28.0, 8.125 and 1.825,\n".
        "8 will match 8.0, 18.0, 28.0, 8.125 and 1.825\n".
        "8. will match 8.0, 18.0, 28.0, and 8.125, but not 1.825\n".
        "8.0 will match 8.0, 18.0, 28.0, but not 8.125 or 1.825.\n".
        "^8. will match 8.0, and 8.125 but not 18.0, 28.0, or 1.825.\n".
	"\n";

  $entered_a_string = 0;

  # get search string for each field
  foreach $field_no (@field_nos) {

    goto MAIN if($field_nos[0] eq "0");

    # $i is one more than the highest field number 
    if(($field_no > 0) && ($field_no < $i)) {

      # flag to tell whether or not a field number and string were entered.
      $entered_a_field = 1;

      print "Enter string to match in variable ".$fields[$field_no - 1].": ";

      chop($_ = <STDIN>);

      # if nothing was typed, don't add this string.
      next if($_ =~ /^$/);

      $entered_a_string = 1;

      # quote all .'s so they match only .'s (as in 0.5)
      s#\.#\\.#g;

      # change all spaces to .'s (space in input string will match)
      # any character.
      s/ /./g;

      $strings[$field_no - 1] = $_;
      }
    elsif($field_no eq "0") 
      { last ENTERFIELDS; }
    else
      { print "Invalid field number: $field_no\n"; }

    }
}

# if no field number was entered, stop the search.
($entered_a_string == 1) || next MAIN;

# found_a_match becomes 1 when an entry is found that matches all of
# the search strings
$found_a_match = 0;

# skip the master_part entry in the table, and any comments before it.
do {<TABLE>;} while(/^#/);

# clear out the list
$#matches = -1;

# step through each of the entries, and compare the 
# entered search strings to the fields
WHILE: while(<TABLE>)
  {
    # skip any comment lines
    next if(/^#/);

    # split entry into fields seperated by spaces or tabs
    @entry = split;

    for ($i = 0; $i <= $#field_nos; $i++)
      {
	# j is the field number to search, i is which match (1 of 2, 2 of 2)
	$j = $field_nos[$i] - 1;

        # if one string doesn't match, the entry doesn't match
	(($entry[$j]) =~ /($strings[$j])/i) || next WHILE ;
      }

    # add it to the list of matches and set the found_a_match flag.
    push(@matches, $_);
    $found_a_match = 1;
  }

# done with the table file
close(TABLE);

# stop here if nothing matched.
unless ($found_a_match == 1) { print "No matches found.\n"; next MAIN; }

print "\nThere were ".($#matches+1).
      " parts found matching all the search strings.\n".
      "The matched entries will be displayed one at a time.\n".
      "At the y/N/q prompt, enter y to see if the part exists,\n".
      "q to exit this search, or anything else to see the next entry.\n".
      "Press Return to continue.";

<STDIN>;

# display each match and ask if this is the proper one
foreach (@matches)
  {
    print "\n\n";

    @entry = split;

    # display each field of the entry
    $i = 0;
    foreach (@fields) { printf("%-20s: %s\n", $_, $entry[$i++]); }

    # ask if this is the one
    print "\nDo you want to see if this part exists? (y/N/q) ";

    # exit the search if entry begins with q or Q
    next MAIN if (($_ = <STDIN>) =~ /^q/i);

    # if yes look for the part
    if(/^y/i)
      {
	$filename = "$directory-family/$entry[0]";

	# make the filename all lowercase
	$filename =~ s/(.*)/\L\1\E/;

        # if the part doesn't exist, ask if it should be generated
        unless(-e $filename)
          {
	    print "Member $entry[0] has not been generated.\n".
		  "Do you want to generate it now (y/N)? ";
	    if(<STDIN> =~ /^y/)
	      {
		&generate_part($partname, $entry[0], $directory);
	      }
          }
        else
          {
	    print "\nThis part has been generated.\n";
	 	
	    $entry[0] =~ s/(.*)/\L\1\E/;

            print "To activate the part, use the command\n";
	    print "activate part $partname-family.$entry[0]";
 	  }

        print "\n\nDo you want to continue this search? (Y/n) ";

	next MAIN if(<STDIN> =~ /^n/i);
      }
   } 
} #end MAIN
continue
{
print "Do you want to search the same part family again? (y/N) ";
if(<STDIN> =~ /^y/i) { goto FAMILYCHOSEN; }
}

sub generate_part {
  local ($partname, $member, $directory) = @_;

  $| = 1;

  print "Part generation in progress, please wait.";

  # networking setup
  chop($hostname = `hostname`);
  ($name, $aliases, $proto) = getprotobyname('tcp');
  ($name, $aliases, $type, $len, $thataddr) = gethostbyname($server);

  $sockaddr = 'S n a4 x8';
  $thatport = pack($sockaddr, &AF_INET, $server_port, $thataddr);

  print ".";

  socket(S, &PF_INET, &SOCK_STREAM, $proto) || 
    &form_die("Unable to create socket.");

  print ".";

  connect(S, $thatport) || 
    print("Can not connect to server $server.") && return;

  print ".";

  select(S); $| = 1; select(STDOUT);
  # end networking setup

  # send part information
  print S "$partname $member $directory\n";

  print ".";

  # get result code
  $_ = <S>;

  print "\n";

  # determine proper response based on result code
  if($_ == 0)
    {
      # generate succeeded
      print "Member $member was generated successfully.\n";

      # make the member name lowercase for the activate part command
      $member =~ s/(.*)/\L$1\E/;
	
      # give command to activate the part
      print "To activate the part, use the command\n".
            "activate part $partname-family.$member\n";
    }
  elsif ($_ == 2)
    {
      # so the maintainer knows who was generating the part...
      system("echo $partname-family.$member failed | ".
	     "/usr/ucb/mail -s check_family_part_failure $maintainer");

      # part may exist
      print "Unable to generate member $member because the part directory\n".
            "already exists.  The part may already have been generated.\n".
            "You will be contacted when the problem has been corrected.\n";
   
      # make the member name lowercase for the activate part command
      $member =~ s/(.*)/\L$1\E/;
	
      # give command to activate the part
      print "You may also try to activating the part using the command\n".
            "activate part ${partname}-family.$member\n";
    }
  else  
    {
      # so the maintainer knows who was generating the part...
      system("echo $partname-family.$member failed | ".
	     "/usr/ucb/mail -s check_family_part_failure $maintainer");

      # generate failed
      print "Member $member failed to generate.\n".
            "You will be contacted when the problem has been corrected.\n";
    }
}

sub list_all {
# open the list of Families of Parts.  Only families which are listed in this 
# file will be available for searching
open(FAMILIES, $family_file) || 
  print "Unable to open family list.\nPress Return to continue." && <STDIN>
  && goto MAIN; 

if(open(MORE, "|$more")) { select(MORE); $| = 1; }

while(<FAMILIES>)
  {
    # remove the trailing newline
    chop;

    # skip blank lines
    next unless(/\w/);

    # deal with continuation lines
    while (s/\\$//) { $_ .= <FAMILIES>; chop; }

    # split lines into its parts
    ($directory, $partname, $comment, $image) = split(':');

    # wordwrap using fmt(1), use 61 columns instead of 72 because of
    # leading spaces and 65 column xterm.
    if(open(OUT, ">/tmp/sfp-$$"))
      {
	print OUT $comment;
	close(OUT);
	if(open(IN, "$fmt -55 /tmp/sfp-$$|"))
          {
	    $comment = join("  ", <IN>);
	    close(IN);
	  }
	unlink("/tmp/sfp-$$");
      }

    print "$partname\n  $comment\n";

  }

# done with this file
close(FAMILIES);

close(MORE);
select(STDOUT);

print "Press Return to Continue.\n";
<STDIN>;
}
sub init_socket {
# included contents of sys/socket.ph so it doesn't have to be require'd.
if (!defined &_sys_socket_h) {
    eval 'sub _sys_socket_h {1;}';
    eval 'sub SOCK_STREAM {1;}';
    eval 'sub SOCK_DGRAM {2;}';
    eval 'sub SOCK_RAW {3;}';
    eval 'sub SOCK_RDM {4;}';
    eval 'sub SOCK_SEQPACKET {5;}';
    eval 'sub SO_DEBUG {0x0001;}';
    eval 'sub SO_ACCEPTCONN {0x0002;}';
    eval 'sub SO_REUSEADDR {0x0004;}';
    eval 'sub SO_KEEPALIVE {0x0008;}';
    eval 'sub SO_DONTROUTE {0x0010;}';
    eval 'sub SO_BROADCAST {0x0020;}';
    eval 'sub SO_USELOOPBACK {0x0040;}';
    eval 'sub SO_LINGER {0x0080;}';
    eval 'sub SO_OOBINLINE {0x0100;}';
    eval 'sub SO_DONTLINGER {(~ &SO_LINGER);}';
    eval 'sub SO_SNDBUF {0x1001;}';
    eval 'sub SO_RCVBUF {0x1002;}';
    eval 'sub SO_SNDLOWAT {0x1003;}';
    eval 'sub SO_RCVLOWAT {0x1004;}';
    eval 'sub SO_SNDTIMEO {0x1005;}';
    eval 'sub SO_RCVTIMEO {0x1006;}';
    eval 'sub SO_ERROR {0x1007;}';
    eval 'sub SO_TYPE {0x1008;}';
    eval 'sub SOL_SOCKET {0xffff;}';
    eval 'sub AF_UNSPEC {0;}';
    eval 'sub AF_UNIX {1;}';
    eval 'sub AF_INET {2;}';
    eval 'sub AF_IMPLINK {3;}';
    eval 'sub AF_PUP {4;}';
    eval 'sub AF_CHAOS {5;}';
    eval 'sub AF_NS {6;}';
    eval 'sub AF_NBS {7;}';
    eval 'sub AF_ECMA {8;}';
    eval 'sub AF_DATAKIT {9;}';
    eval 'sub AF_CCITT {10;}';
    eval 'sub AF_SNA {11;}';
    eval 'sub AF_DECnet {12;}';
    eval 'sub AF_DLI {13;}';
    eval 'sub AF_LAT {14;}';
    eval 'sub AF_HYLINK {15;}';
    eval 'sub AF_APPLETALK {16;}';
    eval 'sub AF_NIT {17;}';
    eval 'sub AF_802 {18;}';
    eval 'sub AF_OSI {19;}';
    eval 'sub AF_X25 {20;}';
    eval 'sub AF_OSINET {21;}';
    eval 'sub AF_GOSIP {22;}';
    eval 'sub AF_MAX {21;}';
    eval 'sub PF_UNSPEC { &AF_UNSPEC;}';
    eval 'sub PF_UNIX { &AF_UNIX;}';
    eval 'sub PF_INET { &AF_INET;}';
    eval 'sub PF_IMPLINK { &AF_IMPLINK;}';
    eval 'sub PF_PUP { &AF_PUP;}';
    eval 'sub PF_CHAOS { &AF_CHAOS;}';
    eval 'sub PF_NS { &AF_NS;}';
    eval 'sub PF_NBS { &AF_NBS;}';
    eval 'sub PF_ECMA { &AF_ECMA;}';
    eval 'sub PF_DATAKIT { &AF_DATAKIT;}';
    eval 'sub PF_CCITT { &AF_CCITT;}';
    eval 'sub PF_SNA { &AF_SNA;}';
    eval 'sub PF_DECnet { &AF_DECnet;}';
    eval 'sub PF_DLI { &AF_DLI;}';
    eval 'sub PF_LAT { &AF_LAT;}';
    eval 'sub PF_HYLINK { &AF_HYLINK;}';
    eval 'sub PF_APPLETALK { &AF_APPLETALK;}';
    eval 'sub PF_NIT { &AF_NIT;}';
    eval 'sub PF_802 { &AF_802;}';
    eval 'sub PF_OSI { &AF_OSI;}';
    eval 'sub PF_X25 { &AF_X25;}';
    eval 'sub PF_OSINET { &AF_OSINET;}';
    eval 'sub PF_GOSIP { &AF_GOSIP;}';
    eval 'sub PF_MAX { &AF_MAX;}';
    eval 'sub SOMAXCONN {5;}';
    eval 'sub MSG_OOB {0x1;}';
    eval 'sub MSG_PEEK {0x2;}';
    eval 'sub MSG_DONTROUTE {0x4;}';
    eval 'sub MSG_MAXIOVLEN {16;}';
}}

Last Modified: Wed Aug 28 14:41:29 EDT 1996