ftp.nice.ch/pub/next/unix/database/sybperl.1.0.N.b.tar.gz#/sybperl/t/sbex.pl

This is sbex.pl in view mode; [Download] [Up]

#!../sybperl


@nul = ('not null','null');
@sysdb = ('master', 'model', 'tempdb');

require "../lib/sybperl.pl";
require "../lib/sybdb.ph";

print "Sybperl version $SybperlVer\n\n";

print "This script tests some of sybperl's functions, and prints out\n";
print "description of the databases that are defined in your Sybase\n";
print "dataserver.\n\n";


$dbproc = &dblogin("sa");	# Login to sybase
&dbmsghandle ("message_handler"); # Some user defined error handlers
&dberrhandle ("error_handler");

$dbproc2 = &dbopen;		# Get a second dbprocess, so that we can select from several
                                # chanels simultaneously. We could code things so that this
				# feature is unnecessary, but it's good to exercise it.

				# First, find out what databases exist:
&dbcmd($dbproc, "select name from sysdatabases order by crdate\n");
&dbsqlexec($dbproc);
&dbresults($dbproc);

database: while((@db = &dbnextrow($dbproc)))
{
    foreach $nm (@sysdb)
    {
	if($db[0] =~ /$nm/)
	{
	    print "'$db[0]' is a system database\n";
	    next database;
	}
    }
    print "Finding user tables in user database $db[0]...";

    &dbcmd($dbproc2, "select o.name, u.name, o.id\n"); # 
    &dbcmd($dbproc2, "from $db[0].dbo.sysobjects o, $db[0].dbo.sysusers u\n");
    &dbcmd($dbproc2, "where o.type = 'U' and u.uid = o.uid\n");
    &dbcmd($dbproc2, "order by o.name\n");

    &dbsqlexec($dbproc2);
    &dbresults($dbproc2);

    while((@dat = &dbnextrow($dbproc2)))
    {
	$tab = join('@', @dat);	# Save the information
	push(@tables, $tab);	# for later use...
    }
    print "Done.\n";

    print "Finding user defined datatypes in database $db[0]...\n";

    &dbcmd($dbproc2, "select s.length,substring(s.name,1,30),substring(st.name,1,30)\n");
    &dbcmd($dbproc2, "from $db[0].dbo.systypes s, $db[0].dbo.systypes st\n");
    &dbcmd($dbproc2, "where  st.type = s.type\n");
    &dbcmd($dbproc2, "and s.usertype > 100 and st.usertype < 100 and st.usertype != 18\n");
    &dbsqlexec($dbproc2);
    &dbresults($dbproc2);

    while((@dat = &dbnextrow($dbproc2)))
    {
	print "sp_addtype $dat[1],";
	if ($dat[2] =~ /char|binary/)
	{
	    print "'$dat[2]($dat[0])'";
	}
	else
	{
	    print "$dat[2]";
	}
	print "\n";

    }
    print "Done.\n";

    print "Now we find the table definition for each user table\nin database $db[0]...\n";

    foreach $ln (@tables)		# For each line in the list
    {
	@tab = split('@',$ln);

	&dbcmd($dbproc2, "select Column_name = c.name, \n");
	&dbcmd($dbproc2, "       Type = t.name, \n");
	&dbcmd($dbproc2, "       Length = c.length, \n");
	&dbcmd($dbproc2, "       Nulls = convert(bit, (c.status & 8))\n");
	&dbcmd($dbproc2, "from   $db[0].dbo.syscolumns c, $db[0].dbo.systypes t\n");
	&dbcmd($dbproc2, "where  c.id = $tab[2]\n");
	&dbcmd($dbproc2, "and    c.usertype *= t.usertype\n");
	
	&dbsqlexec($dbproc2);
	&dbresults($dbproc2);

	print "\nTABLE $db[0].$tab[1].$tab[0]\n ("; 
	$first = 1;
	while((@field = &dbnextrow($dbproc2)))
	{
	    print ",\n" if !$first;		# add a , and a \n if not first field in table
        
	    print "\t$field[0] \t$field[1]";
	    print "($field[2])" if $field[1] =~ /char|bin/;
	    print " $nul[$field[3]]";

	    $first = 0 if $first;
	}
	print " )\n";

# now get the indexes...
#
	print "\nIndexes on $db[0].$tab[0].$tab[1]...\n\n";
	&dbuse($dbproc2, $db[0]);
	&dbcmd($dbproc2, "sp_helpindex '$tab[1].$tab[0]'\n");

	&dbsqlexec($dbproc2);
	&dbresults($dbproc2);

	while((@field = &dbnextrow($dbproc2)))
	{
	    print "unique " if $field[1] =~ /unique/;
	    print "clustered " if $field[1] =~ /^clust/;
	    print "index $field[0]\n";
	    @col = split(/,/,$field[2]);
	    print "on $db[0].$tab[1].$tab[0] (";
	    $first = 1;
	    foreach $ln1 (@col)
	    {
		print ", " if !$first;
		$first = 0;
		print "$ln1";
	    }
	    print ")\n";
	}
	print "\nDone.\n";
    }
    &dbuse($dbproc2, "master");
    @tables = ();
}

&dbexit;


# Message and error handlers.

sub message_handler
{
    local ($db, $message, $state, $severity, $text, $server, $procedure, $line)
	= @_;

    if ($severity > 0)
    {
	print ("Sybase message ", $message, ", Severity ", $severity,
	       ", state ", $state);
	print ("\nServer `", $server, "'") if defined ($server);
	print ("\nProcedure `", $procedure, "'") if defined ($procedure);
	print ("\nLine ", $line) if defined ($line);
	print ("\n    ", $text, "\n\n");

# &dbstrcpy returns the command buffer.

	local ($lineno) = 1;	# 
	foreach $row (split (/\n/, &dbstrcpy ($db)))
	{
	    print (sprintf ("%5d", $lineno ++), "> ", $row, "\n");
	}
    }
    elsif ($message == 0)
    {
	print ($text, "\n");
    }
    
    0;
}

sub error_handler {
    # Check the error code to see if we should report this.
    if ($_[2] != &SYBESMSG) {
	local ($db, $severity, $error, $os_error, $error_msg, $os_error_msg)
	    = @_;
	print ("Sybase error: ", $error_msg, "\n");
	print ("OS Error: ", $os_error_msg, "\n") if defined ($os_error_msg);
    }

    &INT_CANCEL;
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.