use strict; 
use DBI;
use URI::Escape;
use CGI qw(:standard);
$|++;

my $odbc_server = "driver={SQL Server}; server=SERVER; uid=UID;pwd=XXX
+XX;";
my $submit = 'Add comments';

my @commontables = map {lc} 
qw(ord..ords ord..ship mark..inform mark..buyers
mail..mailmast mail..emailmast mark..prom mark..promdesc
mark..survey  mail..auto mail..dupes);

print 
    header, 
    start_html(-title=>"SERVER NAME",-style=>{-code=>&css()}),
    h2(a({-href=>&url},"SERVER Schema"));

if (param("showtable")) {
    my $table = param("showtable");
    print &showtable($table), end_html;
    exit(0);
}

if (param($submit)) {
    &addcomments;
    Delete_all;
}

if (param("addcomment")) {
    my $table = param("addcomment");
    print start_form,
    submit(-name=>$submit),
    hidden(-name=>'table',-value=>$table),
    &showtable($table),"<br>",
    submit(-name=>$submit),
    end_form, end_html;
    exit(0);
}

if (param("showcommon")) {
    foreach my $table (sort @commontables) {print &showtable($table);}
    print end_html;
    exit(0);
}

if (param("showall")) {
    my @alltables = &getalltables;
    foreach my $table (map {lc} sort @alltables) {
    param(-name=>"showcomments",-value=>"F");
    print &showtable($table);
    }
    print end_html;
    exit(0);
}

# main menu here
print 
    h3(a({-href=>&url . "?showcomments=T&showcommon=T"},"Often-used ta
+bles")),
    ul(li([
       map {a({-href=>&url . "?showcomments=T&showtable=" . &uri_escap
+e($_)}, $_)}
       sort @commontables])),
    h3(a({-href=>&url . "?showall=T"},"All tables")),
    end_html;
exit(0);

###############################################################

{
my $dbh;
sub showtable {
    my $tname = shift;
    my ($db, $table) = split(/\.\./, $tname);
    if (!defined($dbh)) {$dbh = &getcxn_dbi_server;}
    my ($id, $uid) = &getrow($dbh, qq{
    select id, uid from $db..sysobjects(nolock) where name='$table'});
    my ($uname) = &getrow($dbh, qq{
    select name from $db..sysusers(nolock) where uid=$uid});
    my ($apxrows) = &getrow($dbh, qq{
    select rows from $db..sysindexes(nolock) where id=$id});
    my $sql = qq{
    select name, length, xtype from $db..syscolumns(nolock)
        where id=$id};
    my $sth = $dbh->prepare($sql) or die "bad prep: $sql ", $dbh->errs
+tr;
    $sth->execute or die "bad exec: $sql ", $dbh->errstr;
    my $rowbytes=0;
    my $tablebody = th([qw(column type comments)]);
    while (my ($name,$length, $xtype) = $sth->fetchrow_array) {
    my $comment;
    if (param("showcomments") eq 'T') {
        $comment = &getcomment("SERVER", $db, $table, $name);
    }
    $rowbytes += $length;
    $tablebody .= Tr(td([lc($name), &xtype($xtype) . "($length)" , $co
+mment]));
    }
    my $tblmeg = sprintf("%.1f", ($rowbytes * $apxrows)/(1024 * 1024))
+;
    my $html = h3($tname);
    $html .= "Owned by " . lc($uname) . ", approx $apxrows rows, appro
+x $tblmeg meg<br>";
    if (param("showcomments") eq 'T') {
    $html .= &getcomment("goldmine", $db, $table,"");
    }
    $html .= table({-border=>1},$tablebody);
    if (!param("addcomment")) {
    $html .= a({-href=>&url . "?showcomments=T&addcomment=" . &uri_esc
+ape($tname)},
           "add comment");
    }
    return $html;
}
}  

sub getalltables {
    my $dbh = &getcxn_dbi_server;
    my @dbs = @{$dbh->selectcol_arrayref(q{
    select name from master..sysdatabases(nolock)})}; 
    if ($dbh->err) {die "bad get dbs: ", $dbh->errstr;}
    my @alltbls;
    foreach my $db (@dbs) {
    my $sql = qq{select name from $db..sysobjects(nolock) where type='
+U'};
    my $ref;
    eval {
        $ref = $dbh->selectcol_arrayref($sql)
        };
    if ($ref) {
        my @tbls = @{$ref};
        foreach my $tbl (@tbls) {
        push(@alltbls, $db . ".." . $tbl);
        }
    }
    }
    return @alltbls;
}

{
my ($dbh, $sth);
sub getcomment {
    my ($server, $database, $table, $field) = @_;
    if (!defined($dbh)) {$dbh = &getcxn_dbi_server;}
    if (!defined($sth)) {
    $sth = $dbh->prepare(q{
        select who, ts, comment 
        from work..schema_comments(nolock)
        where server=? and db=? and tbl=? and field=?
        order by ts    
        }) or die "bad prepare";
    }
    $sth->execute($server, $database, $table, $field) or die "bad exec
+ute";
    my @rows;
    while (my ($who, $ts, $comment) = $sth->fetchrow_array) {
    $ts =~ s/(\S+).*/$1/;
    my $html = $comment . font({-class=>"tiny"}, " by " . $who . " on 
+" . $ts); 
    push (@rows, $html);
    }
    if (defined(param("addcomment"))) {
    push (@rows, textfield(-name=>$server . "." . $database . "." . $t
+able . "." . $field,
                   -size=>80, -maxlength=>200));
    }
    return join("<br>", @rows);
}
}


{
my %xtype;
my $dbh;
sub xtype {
    my ($x) = shift;
    if (!defined($xtype{$x})) {
    if (!defined($dbh)) {$dbh = &getcxn_dbi_server;}
    my ($name) = &getrow($dbh, qq{
        select name from master..systypes(nolock) where xtype=$x});
    $xtype{$x}=lc($name);
    }
    return $xtype{$x};
}
} 

sub getrow {
    my ($dbh, $sql) = @_;
    my (@row) = $dbh->selectrow_array($sql);
    if ($dbh->err) {die "sql=$sql\n", $dbh->errstr;}
    if (!@row) {die "sql=$sql\nno rows came back";}
    return @row;
}

sub css {
    my $css=<<CSS;
    .error {color: red} 
    .tiny {font-size: 7pt}
    .big {font-size: 12pt}
    .bigbold {font-size: 12pt; font-weight: bold}
    body {font-family: arial} 
    strong.title {font-size: 18pt; color: black}
CSS
    return $css;
}

sub getcxn_dbi_server {
    return &getcxn_dbi($odbc_server);
}

sub getcxn_dbi {
    my $cxnstring = shift;
    use DBI;
    my $dbh = DBI->connect("dbi:ODBC:$cxnstring") or
    &error("Couldn't connect to database", $DBI::errstr);
    $dbh->{PrintError} = 0;
    # $dbh->{AutoCommit} = 0;
    return $dbh;
}

sub addcomments {
    my $dbh;
    my $sql = q{insert into work..schema_comments(who, server, db, tbl
+, field, comment)
            values (?,?,?,?,?,?)};
    my $dbh_g = &getcxn_dbi_server;
    my $who = lc(remote_user);
    $who =~ s/.*\\(.*)/$1/; # whack off the domain
    foreach (param) {
    if (/(\w+)\.(\w+)\.(\w+)\.(\w*)/) {
        my $comment = param($_);
        if ($comment ne "") {
        my ($server, $database, $table, $field) = ($1, $2, $3, $4);
        if (!$dbh) {$dbh = &getcxn_dbi_server;}
        $dbh->do($sql, undef, $who, $server, $database, $table, $field
+, $comment);
        Delete($_);
        }
    }
    }
    Delete($submit);
}