RE: stored procedure names

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

I have a Perl script that can address both your questions. I can't attach it
using this Web interface, but will do with a news reader that allows
attaching a file. But let me paste the code here (the format probably sucks).

Linchi

## Begin script

use strict;
use Data::Dumper;

my $server = 'YourServerName';

my $procDependRef;

my $msProcRef = getMSProcNames($server);
my $procRef = getProcNames($server);

#print Dumper($procRef);

for my $db (keys %$procRef)
{
for my $proc ( @{$procRef->{$db}} )
{
my $sql = qq/set nocount on; EXEC sp_helptext \'$proc\';/;
my $cmd = qq/osql.exe -S$server -E -d$db -n -h-1 -w5000 -Q\"$sql\"/;
my $script = `$cmd`;

$script =~ s/\/\*([^\/]|\/[^\*])*\*\///;
$script =~ s/\-\-.*$//mg;

# my $scriptRef = parseTSQL($script);

my ($proc_inside, $dependRef) = findExecProc($script);

if ($proc !~ /$proc_inside/i)
{
warn "***Error: The proc name does not match the name in
syscomments.";
}

#$procDependRef->{$db}->{$proc} = $dependRef;
# print "Database=$db, Proc=$proc\n";
for my $dep (@{$dependRef})
{
# print "\t\t$dep\n";
if ($dep =~ /^\s*[a-zA-Z]+\s*$/)
{
next unless (dbaInSet($dep, $procRef->{$db}));
}

if ($dep =~ /^\s*sp\_\w+\s*$/)
{
if (dbaInSet($dep, $msProcRef))
{
$dep = $server . '.master.dbo.' . $dep;
}
}

if ($dep !~ /\./)
{
$dep = $server . '.' . $db . '.dbo.' . $dep;
}
elsif ($dep =~ /^\s*(\w+)\.(\w+)\s*$/)
{
$dep = $server . '.' . $db . '.' . $dep;
}
elsif ($dep =~ /^\s*(\w+)\.\.(\w+)\s*$/)
{
$dep = $server . '.' . $1 . '.dbo.' . $2;
}
elsif ($dep =~ /^\s*(\w+\.\w+\.\w+)\s*$/)
{
$dep = $server . '.' . $dep;
}
elsif ($dep =~ /^\s*(\w+)\.(\w+)\.\.(\w+)\s*$/)
{
$dep = $1 . '.' . $2 . '.' . '.dbo.' . $3;
}
elsif ($dep =~ /^\s*(\w+\.\w+\.\w+\.\w+)\s*$/)
{
$dep = $dep;
}
else
{
warn "**Error: $dep is not in the expected format."
}
print "$server,$db,$server.$db.$proc,$dep\n";
}

undef $script;
}
}

#print Dumper($procDependRef);


#########################
sub getMSProcNames {
#########################
my $server = shift;

my @procs;

my $sql = q/set nocount on; select name from master..sysobjects where
type in ('P', 'X') and name like 'sp_%'/;
my $cmd = qq/osql.exe -S$server -E -n -h-1 -w1000 -Q\"$sql\"/;
my $procs = `$cmd`;

for my $proc (split /\n/, $procs)
{
$proc =~ s/^\s*//;
$proc =~ s/\s*$//;

$proc = join('.', split /\s+/, $proc);

push @procs, $proc;
}
return [@procs];
} # getMSProcNames()

#########################
sub getProcNames {
#########################
my $server = shift;

my $procRef;

my $sql = q/set nocount on; select @@version/;
my $cmd = qq/osql.exe -S$server -E -n -h-1 -w1000 -Q\"$sql\"/;
my $version = `$cmd`;

if ($version =~ /\W8\.\d+\.\d+/)
{
$version = 'SQL2000';
}

$sql = q/set nocount on; select name from master..sysdatabases where
name not in ('master', 'tempdb', 'model', 'msdb', 'pubs', 'AdventureWorks')/;
$cmd = qq/osql.exe -S$server -E -n -h-1 -w1000 -Q\"$sql\"/;

my $dbs = `$cmd`;

for my $db (split /\s+/, $dbs)
{
next if $db =~ /^\s*$/;

if ($version eq 'SQL2000')
{
$sql = q/set nocount on; select user_name(uid), name from
sysobjects where type ='P' and objectproperty(id, N'IsMSShipped') != 1/;
}
else
{
$sql = q/set nocount on; select schema_name(uid), name from
sysobjects where type ='P' and objectproperty(id, N'IsMSShipped') != 1/;
}

$cmd = qq/osql.exe -S$server -E -d$db -n -h-1 -w1000 -Q\"$sql\"/;
my $procs = `$cmd`;

for my $proc (split /\n/, $procs)
{
$proc =~ s/^\s*//;
$proc =~ s/\s*$//;

$proc = join('.', split /\s+/, $proc);

push @{$procRef->{$db}}, $proc;
}
}

return $procRef;
} # getProcNames()


##################################
sub parseTSQL {
##################################
my($script) = shift;

use Parse::RecDescent;

# $::RD_TRACE = 0;
$::RD_HINT = 0;

my $Grammar=<<'EOGRAMMAR';

{ my $cnt;
my $sqlRef = {
code => ''
};
}

program : <skip:''> part(s) /\Z/ { $sqlRef }

part : comment
| TSQL_code
| string
| double_identifier
| bracket_identifier

comment : ansi_comment
{ $sqlRef->{code} .= ' ';
}

| delimited_comment
{ $sqlRef->{code} .= ' ';
}

ansi_comment : m{ (--[^\n]*)\n }x
{ $item[1] }

delimited_comment : simple_comment
{ $item[1] }
| nested_comment
{ $item[1] }


simple_comment : comment_opener comment_closer
{ $item[1] . $item[2] }
| comment_opener pure_comment(s) comment_closer
{ $item[1] . join('', @{$item[2]}) .
$item[3] }

nested_comment : comment_opener raw_comment(s) comment_closer
{ $item[1] . join('', @{$item[2]}) .
$item[3] }

raw_comment : pure_comment(?) delimited_comment pure_comment(?)
{ join('', @{$item[1]}) . $item[2] .
join('', @{$item[3]}) }

comment_opener : m{ /\* }x
{ $item[1] }

comment_closer : m{ \*/ }x
{ $item[1] }

pure_comment : m{ (?: [^*/]+ # no * or /
| \*(?!/) # if *, then not
followed by /
| \/(?!\*) # if /, then not
followed by *
)+
}x
{ $item[1] }


TSQL_code : m{([^\"/\'\-\[]+ # one or more non-delimiters
( # then (optionally)...
/[^*] # a potential, but not actual,
comment delimiter
| # or
-[^\-]
)? #
)+ # all repeated once or more
}x
{ $sqlRef->{code} .= $item[1] }

string : m{\'(([^\'] | (\'\'))*)\'}x
{
$sqlRef->{code} .= $item[1];
}

double_identifier : m{\"
(([^\"] | (\"\"))+)
\"
}x
{
$sqlRef->{code} .= $item[1];
}

bracket_identifier : m{\[
([^\[\]]+)
\]
}x

{
$sqlRef->{code} .= $item[1];
}

EOGRAMMAR

my $parser = new Parse::RecDescent $Grammar or die "***Error: invalid
TSQL grammar.";
$parser->program($script) or die "***Error: malformed TSQL script.";
} # parseTSQL

##################################
sub findExecProc {
##################################
my ($batch) = @_;
my $db;
my $proc;
my @depends;

if ($batch =~
/\bcreate\s+(?:proc|procedure)\s+((\[)?\w+(\])?\.(\[)?\w+(\])?|(\[)?\w+(\])?)/i) {
$proc = $1;

while ($batch =~ /\b(?:exec|execute)\s+
(?:\@\w+\s*=\s*)?

(
(\[)?\w+(\])?\.(\[)?\w+(\])?\.(\[)?\w*(\])?\.(\[)?\w+(\])?
| (\[)?\w+(\])?\.(\[)?\w*(\])?\.(\[)?\w+(\])?
| (\[)?\w+(\])?\.(\[)?\w+(\])?
| (\[)?\w+(\])?
)
/igx
)
{
push @depends, $1;
}
}

my $ref;
for my $depend (@depends)
{
$depend =~ s/\[//g;
$depend =~ s/\]//g;
$ref->{$depend} = 1;
}
($proc, [keys %$ref]);
} # findExecProc

#####################
sub dbaInSet {
#####################
my($element, $setRef) = @_;
$element = quotemeta($element);
grep(/^$element$/, @$setRef);
} # dbaInSet



## end script



"JB" wrote:

This is a two part question having to do the SP names. ( SQLServer 2000)
1) SPs have two names, the name that apprears in the list of SPs(In e.g.
Enterprise Manager) and the name in the CREATE PROCEDURE text. SQL Server is
quite happy allow these names to be different until either the text is edited
or the SP is executed. So question 1 is, "Is there a system SP that can be
used to find all the SPs in a database for which the names don't match?"
This issues comes up when I rename several SPs and then forget to fix up all
the name in the CREATE PROCUDURE text.

2) The second question is whether or not there is a procedure that can be
used to search all the SPs in the database for EXECUTE statements that are
pointing to invalid SP names. SQL Server implements deferred name resolution
during editing which is good but it would also be useful to be able to turn
this off now and then to find errors before execution. User functions insist
on names being valid during editing which means a little more bother with
editing but saves time during testing.
--
JB
.

Relevant Pages

  • Re: SMTP OnArrival Transport Event Sink
    ... have the script extract the sender list, ... fine when it runs on a windows 2003 server with the smtp service enabled. ... Sub IEventIsCacheable_IsCacheable ...
    (microsoft.public.exchange.development)
  • Re: how to go from VB in a page to ASP in another page and come back
    ... > but if i understand your code, the value from ASP is put outside the SUB. ... script, meaning it is executed in the browser, not the server. ... if you have this in a client event ...
    (microsoft.public.inetserver.asp.general)
  • Re: load testing
    ... I use a Perl script. ... - server is the name or IP address of the machine you want to stresstest ... sub send_msgs_in_file{ ... stresstest.pl server sender recipient filename nprocs ...
    (comp.mail.sendmail)
  • Purge Old Files
    ... it does not work on XP or windows 2003 server. ... here a copy of the script file in .vbs ... Sub Main ...
    (microsoft.public.windows.server.scripting)
  • Re: Same Internal Server Error from last two days
    ... I am trying to run a Hello World Perl Script in Apache 2.2. ... But its constantly giving me Internal Server Error.The script ... # have to place corresponding `LoadModule' lines at this location so the ...
    (perl.beginners)