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); }
In reply to MS SQL7 schema, with metadata by nop
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |