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__