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'
                                  ]
                     } 
                   ]
    };

##</code><code>##

    # 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 


##</code><code>##

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

##</code><code>##

    my_table        => mt
    mother_table    => mt1

##</code><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$_) + ' = $toalias.' + 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__