head	1.2;
access;
symbols;
locks; strict;
comment	@# @;


1.2
date	2001.08.23.21.31.56;	author leonardr;	state Exp;
branches;
next	1.1;

1.1
date	2001.07.10.20.48.09;	author leonardr;	state Exp;
branches;
next	;


desc
@@


1.2
log
@Fixed invalid Perl.
@
text
@#!/usr/bin/perl
use DBI;
use strict;
use XML::Parser;
BEGIN { unshift(@@INC, "$ENV{SANDBOX}/scripts"); }
use HelmDB;

#File to parse.
my $FILE = "$ENV{SANDBOX}/helm/sql/schema/helm-schema.xml";

#Table currently being processed.
my $Table = "";

#Table of foreign key currently beign processed.
my $ForeignTable = "";

#Foreign keys of current table, in the format [foreign table, local
#field, foreign field].
my @@ForeignKeys = ();

#Primary keys of current table.
my @@PrimaryKeys = ();

#Database connection
my $dbh = HelmDB::connect
  ($ENV{DATABASE_NAME}, $ENV{DATABASE_ADMIN_USER}, 
   $ENV{DATABASE_ADMIN_PASSWORD});

main();

$dbh->disconnect();

#Parses the XML schema file and prints out records which violate
#foreign key constraints.
sub main()
{
  my $parser = new XML::Parser(Handlers => 
			       {"Start" => \&handleStart,
			        "End" => \&handleEnd});
  print "Checking referential integrity of tables.\n";
  $parser->parsefile($FILE);
  print "\nDone.\n";
}

#Handles the beginning of a tag.
sub handleStart
{
  my ($expat, $element, %attributes) = @@_;
  if ($element eq "table")
  {
    #We've found a new table to process.
    $Table = $attributes{"name"};
    #Clear out the lists of foreign and primary keys for the new table.
    @@ForeignKeys = ();
    @@PrimaryKeys = ();
  }

  if ($element eq "column")
  {
    #We've found a table column; if it's part of the foreign key
    #for this table, add it to the list.
    my $primaryKey = $attributes{"primaryKey"};
    if ($primaryKey eq "true")
    {
      push(@@PrimaryKeys, $attributes{"name"});
    }
  }

  if ($element eq "foreign-key")
  {
    #We've found the start of a foreign key definition.
    $ForeignTable = $attributes{"foreignTable"};
  }

  if ($element eq "reference")
  {
    #We've found a reference for a foreign key in the current table.
    #Add it to the list.
    my $localField = $attributes{"local"};
    my $foreignField = $attributes{"foreign"};
    my @@fields = ($ForeignTable, $localField, $foreignField);
    push(@@ForeignKeys, \@@fields);
  }
}

#Handles the end of a tag.
sub handleEnd
{
  my ($expat, $element) = @@_;
  if ($element eq "table")
  {
    #We're done parsing a table; check its integrity.
    checkTableIntegrity();
  }
}

#Prints out lists of records in the current table which violate any
#of the foreign key constraints defined in the XML schema.
sub checkTableIntegrity()
{
  #Turn the list of this table's primary keys into a string for use as
  #the list of fields to select in a SELECT statement.
  my $selectFields = "";
  my $numPrimaryKeys = scalar(@@PrimaryKeys);
  for (my $i = 0; $i < $numPrimaryKeys; $i++)
  {
    $selectFields .= "a." . $PrimaryKeys[$i];
    if ($i < $numPrimaryKeys-1)
    {
      $selectFields .= ", ";
    }
  }

  #For each foreign key in this table, find all the records which
  #violate the foreign key relation and print out their primary keys.
  foreach my $key (@@ForeignKeys)
  {
    my $foreignTable = $key->[0];
    my $nativeKey = $key->[1];
    my $foreignKey = $key->[2];

    my $entryQuery = "select $selectFields from $Table as a where $nativeKey is not null";
    my @@allEntries = HelmDB::runQuery($dbh, $entryQuery);

    my $query = 
     "select $selectFields from $Table as a, $foreignTable as b "
       . "where a.$nativeKey is not null and a.$nativeKey = b.$foreignKey";
    my @@matchingEntries = (HelmDB::runQuery($dbh, $query));
    my $difference = scalar(@@allEntries)-scalar(@@matchingEntries);

    if ($difference > 0)
    {
      my $plural = "s";
      if ($difference == 1)
      {
	$plural = "";
      }
      print "\n Found $difference $Table record$plural having $nativeKey\n";
      print " with no corresponding value in $foreignTable.$foreignKey:\n";

      #Turn the primary keys into strings so that the intersection of the
      #lists will be easier to sort out.
      my @@allKeys = stringRepresentationsOfEntries(@@allEntries);
      my @@matchingKeys = stringRepresentationsOfEntries(@@matchingEntries);

      #Take the intersection of the two lists of keys; these are
      #the entries which have bad foreign key references.
      my %count = ();
      my @@diff = ();
      foreach my $key (@@matchingKeys, @@allKeys)
      {
	$count{$key}++;
      }
      foreach my $key (keys %count)
      {
	if ($count{$key} != 2)
	{
	  push @@diff, $key
	}
      }
      foreach $key (@@diff)
      {
	print "  $key\n";
      }
    }      
  }
}

#Takes an array of references to arrays of strings (such as one
#returned by runQuery) and turns it into an array of string
#representations of the referenced arrays.
sub stringRepresentationsOfEntries(@@)
{
  my @@entries = @@_;
  my @@stringRepresentations = ();
  foreach my $entry (@@entries)
  {	  
    my $key = "";
    my $len = scalar(@@{ $entry });
    for (my $i = 0; $i < $len; $i++)
    {
      $key .= $entry->[$i];
      if ($i < $len-1)
      {
	$key .= " | ";
      }
    }
    push(@@stringRepresentations, $key);
  } 
  return @@stringRepresentations;
}
@


1.1
log
@New test script which checks the database against referential integrity constraints defined by the foreign keys in the Torque schema.
@
text
@d9 1
a9 1
my $FILE = $ENV{SANDBOX}/helm/sql/schema/helm-schema.xml
@

