Next: The Parts Server Code Previous: Searching for Parts
Searching for Parts Using a WWW Browser

#!/utils/perl
# perl is linked from /utils/perl on cae003
$id = '$Id: check_family_part.pl,v 1.6 1996/07/23 17:44:26 fparts Exp $';

# last modified date (had to seperate $ from Date to keep RCS from
# expanding the Date in the replacement command) 
($last_mod = '$Date: 1996/07/23 17:44:26 $') =~ s/[\$]Date: (.*)[\$]/\1 GMT/;

# this is the filename of the other script
$search_url = "search_family_parts.pl";

# name of the file listing the family parts   
$family_file = "/usr2/std/fpts/family-list";

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

print "Content-type: text/html\n".
      "\n".
      "<HTML>\n".
      "<HEAD>\n".
      "<TITLE>Family Part Check</TITLE>\n".
      "<LINK REV=made HREF=\"mailto:gmm7689@sudcv91.ed.ray.com\">\n".
      "<!-- $id -->\n".
      "</HEAD>\n".
      "<BODY BGCOLOR=\"#00af00\" TEXT=\"#060600\" LINK=\"#0000aa\" \n".
      "BACKGROUND=\"/graphics/webtiles/gifs64/paper1/ab____64.gif\">\n".
      "<H1>Family Part Check</H1>\n";  

# if there is no QUERY_STRING environment variable, this is the first
# time through the script.

unless($partname = $ENV{'QUERY_STRING'})
  {
    print "<P>\n".
	  "This program checks whether or not a particular Family of\n".
	  "Parts member exists.  It takes a full part name, and\n".
	  "checks to see if it is a valid Family of Parts partname.\n".
	  "If it is,the program checks to see if the part exists.".
          "<P>\n".
	  "Enter the part name below.\n".
          "<ISINDEX>\n".
          "<P>\n".
	  "Last Modified: $last_mod\n".
          "</BODY>\n".
          "</HTML>\n";
    exit 0;
  }

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

# open file listing family names
unless(open(FAMILIES, $family_file))
  { 
    open(MAIL, "|/usr/ucb/mail -s 'Check_Family_Part error' $maintainer");
    print MAIL "Unable to open family list.";
    close MAIL;
    &form_die("Search Error\n".
              "<P>\n".
              "Unable to open family list.\n"); 
  }

# check the partname for the proper format, then pull the family name
# and family member out of the partname
($partname =~ /(.*)-family\.(.+)/) || &form_die("Invalid Part Name: $partname.");
$family = $1;
$member = $2;

# find the right family
while(<FAMILIES>)
  {
    # skip blank lines
    unless(/\w/) { next; }

    # remove the trailing newline
    chop;

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

    # if there is no colon, split has problems, so add a colon
    $_ .= ":";

    # split line into its parts
    ($directory, $partname) = split(':');

    # check the partname to see if it matches requested family
    if($partname eq $family) {
      # check to see if a valid member was requested.
      if(`grep -c -i "^$member " $directory/_tbl` == 0)
        {
          &form_die("There is no member named $member in the family $family.");
        }

      # build filename and convert to lowercase
      ($filename = "${directory}-family/${member}") =~ s/(.*)/\L\1\E/;

      # if the part doesn't exist, give the command to generate it.
      unless(-e $filename) {
        print "<P>\n".
              "This part has not been generated.\n";

        print "<FORM METHOD=POST ACTION=\"$search_url\">\n".
              "<INPUT TYPE=hidden NAME=\"function\" VALUE=\"generate\">\n".
              "<INPUT TYPE=hidden NAME=\"partname\" VALUE=\"$partname\">\n".
              "<INPUT TYPE=hidden NAME=\"member\" VALUE=\"$member\">\n".
              "<INPUT TYPE=hidden NAME=\"directory\" VALUE=\"$directory\">\n".
              "<INPUT TYPE=submit VALUE=\"Generate This Part\">\n".
              "</FORM>\n"; 

        print "<P>\n".
              "It will take a few minutes to generate this part.\n".
              "Please be patient and do not interrupt the next page.\n";
        }
      else {
        print "<P>\n".
              "This part has been generated.<BR>\n";
        }
        
      # make the member name lowercase for the activate part command
      s/(.*)/\L$1\E/;
	
      # give command to activate the part
      print "<P>\nTo activate the part, use the command<BR>\n".
            "<TT>activate part $partname-family.$member</TT>\n";

      print "<P>\n".
            "Last Modified: $last_mod\n".
            "</BODY>\n".
            "</HTML>\n";

      # done with this file
      close(FAMILIES);
      exit 0;
      }
  }

# done with this file
close(FAMILIES);

# report failure.
&form_die("Family $family is not in the Family of Parts Catalog.");

exit 0;

sub form_die {
  local ($error) = @_;

  print "<P>\n".
        "$error\n".
        "<P>Last Modified: $last_mod".
        "</BODY>\n".
        "</HTML>\n";  

  exit 0;
}
Last Modified: Wed Aug 28 14:41:29 EDT 1996
Gregory Marr <gregm@alum.wpi.edu>