SYNOPSIS

use MSSQL::TableReferences;

my $tr = MSSQL::TableReferences->new($dbh); # $dbh obtained elsewhere

# Get information about references FROM this table to other tables

$refs = $tr->tablereferences('this_table');

# $refs is now a hashref that describes how this_table 
# references other_table.

$refs = {
      'table' => 'this_table',
      'alias' => 'tt',
      'related' => [
                     {
                       'name' => 'other_table',
                       'alias' => 'ot',
                       'joins' => [
                                    'tt.person_id = ot.person_id',
                                    'tt.week_id = ot.week_id'
                                  ]
                     }
                   ],
    };

# Now get information about references TO this table FROM other tables

$refs = $tr->tablereferencedby('this_table')

# $refs is now a hashref that describes how two 
# other tables reference this_table.

$refs = {
      'table' => 'this_table',
      'alias' => 'tt',
      'related' => [
                     {
                       'name' => 'other_table',
                       'alias' => 'ot',
                       'joins' => [
                                    'ot.person_id = tt.person_id'
                                  ]
                     },
                     {
                       'name' => 'yet_another_table',
                       'alias' => 'yat',
                       'joins' => [
                                    'yat.person_id = tt.person_id',
                                    'yat.week_id = tt.week_id'
                                  ]
                     } 
                   ]
    };
[download]

DESCRIPTION

MSSQL::TableReferences aims to provide information in a form that is similar to SQL that might actually be used to join tables involved in such relationships. For instance, using $refs obtained in the example above, it would now be easy to derive SQL -

    # get the first relationship
    my $firstrel = shift @{$refs->{related}};
    
    # compose some sql
    my $sql = qq{
        SELECT * FROM $refs->{table} AS $refs->{alias}
        JOIN $firstrel->{name} AS $firstrel->{alias}
          ON }
        .
        join (' AND ', @{$firstrel->{joins}});

    print $sql; 
    __END__

    output:
    
    SELECT * FROM this_table AS tt
      JOIN other_table AS ot
        ON tt.person_id = ot.person_id
       AND tt.week_id = ot.week_id
[download]

While this generated code is probably not suitable for deployment, it is a helpful example of how to join these tables.

Note that the 'alias' is a short name that is commonly used to disambiguate columns from different tables. The algorithm for deriving this short name is very basic - just the first letter of the table plus every letter following an underscore. Some examples -

    my_table        => mt
    my_other_table  => mot
    fred            => f
    dbo.fred        => f   # note that table prefixes are ignored
[download]

If an alias collision occurs, one of the aliases will be suffixed with a '1', for example -

    my_table        => mt
    mother_table    => mt1
[download]

The package depends entirely on the SQL 2k sysreferences table, so it may stop working with the next version of SQL Server. SQL Server does provide INFORMATION_SCHEMA views, but these are far more cumbersome to work with. If someone more familiar with these views can show me an equivalent, I will convert.

TODO

• Check for SQL 2000, do something helpful if some other version is found
• Think of better names for tablereferences and tablereferencedby

CODE

package MSSQL::TableReferences;
use strict;
use warnings;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    $self->{DBH}  = shift or die 'dbh?';
    bless ($self, $class);
    return $self;
}

sub tablereferencedby {

    tablereferences(@_,'Get references TO this table');
    
}

sub tablereferences {
    
    my ($self,$table,$get_refs_TO_this_table) = @_;
    
    my ($fromalias, $toalias, $fromkeyid, $tokeyid) = 
        $get_refs_TO_this_table 
            ? ('?', '¿', 'fkeyid', 'rkeyid') 
            : ('¿', '?', 'rkeyid', 'fkeyid');
    
    my $sql="select object_name(r.$fromkeyid)\n";
    
    $sql .= ",'$fromalias.' + col_name(r.fkeyid,r.fkey$_) + ' = $toali
+as.' + col_name(r.rkeyid,r.rkey$_)\n"
        for (1..16);

    $sql .=qq{
        from sysreferences r
        where $tokeyid=object_id('$table')
        order by constid,object_name($fromkeyid)
    };

    my @relationships;

    push @relationships, {
        name  => $_->[0],
        alias => _FirstLetters($_->[0]),
        joins => [grep {defined} @{$_}[1..16]]
    } for @{$self->{DBH}->selectall_arrayref($sql)};

    my $table_alias = _FirstLetters($table);

    for my $relationships (@relationships) {
        $relationships->{alias} .= '1' if ($relationships->{alias} eq 
+$table_alias);
        for (@{$relationships->{joins}}) {
            s/\?\./$relationships->{alias}\./;
            s/\¿\./$table_alias\./;
        }
    }

    @relationships ? 
    
        {
            table => $table,
            alias => $table_alias,
            related => \@relationships
        }

    : undef;
    
}

sub _FirstLetters {

    # return the first letter and the letters succeeding underscores.
    # useful as alias names in sql.
    # examples  
    #   my_event_history => meh
    #   dbo.my_table => mt
    
    my $text=shift;
    return '' unless $text;
    $text=~s/^\w+\.//ig; # remove prefixes
    my $fl='';
    while ($text=~ /(?:^(\w)|_(\w))/g) {$fl.=$1 || $2;}
    return $fl;
}

1;
__END__
[download]

Update 1: Since submitting this node I have continued to work on MSSQL::TableReferences, I hope improving it, but I'm not changing this node for the sake of posterity. If anyone wants the updated code, send email to edward.guiness at gmail.com, or send a CB /msg. I may even upload it to CPAN if I can find the time+energy to jump through the requisite hoops.

Update 2: I have uploaded this to CPAN as DBIx::TableReferences::MSSQL.