PEPPLER.ORG
Michael Peppler
Sybase Consulting
Menu
Home
Sybase on Linux
Install Guide for Sybase on Linux
General Sybase Resources
General Perl Resources
Freeware
Sybperl
Sybase::Simple
DBD::Sybase
BCP Tool
Bug Tracker
Mailing List Archive
Downloads Directory
FAQs
Sybase on Linux FAQ
Sybperl FAQ
Personal
Michael Peppler's resume

sybperl-l Archive

Up    Prev    Next    

From: Michael Peppler <mpeppler at MBAY dot NET>
Subject: Re: Looking for CGI/Sybperl examples?
Date: Feb 13 1998 4:59PM

#!/usr/local/bin/perl

#	@(#)Show.cgi	1.2	06/11/97
#
#	Show.cgi - display the text of triggers, stored procs, views,
#		   and defaults in html format.
#
#	Copyright (c) 1997, Michael Peppler
#		All rights reserved.
#



use strict;
use Sybase::DBlib;
use SybWWW;

use CGI;

my $query = new CGI;

print $query->header;
print $query->start_html(-title => "Show a Sybase Object");

my $server   = $query->param('server');
my $database = $query->param('database');

my $state = $query->param('__state__') || 0;

if(!$database) {
    error("Please supply the database parameter.

"); } my $dbh = new Sybase::DBlib "sa", undef, $server; ($dbh->dbuse($database) == SUCCEED) || error("The database $database deosn't exist"); SWITCH_STATE: while(1) { ($state == 0) && do { my($values, $labels) = getObjects(); print "

Show a Sybase objects definition:

\n"; print "

Please select an object:

\n"; print $query->start_form; print $query->scrolling_list(-name=>'object', '-values'=>$values, -labels=>$labels, -size=>10); $query->param(-name=>'__state__', '-values'=>1); print $query->hidden(-name=>'__state__'); print $query->hidden(-name=>'database'); print $query->hidden(-name=>'server'); print $query->submit; print $query->end_form; last SWITCH_STATE; }; ($state == 1) && do { print "

Show a Sybase object's definition:

\n"; my $objId = $query->param('object'); my $html = getText($objId); print $html; last SWITCH_STATE; }; } print $query->end_html; exit(0); sub getObjects { $dbh->dbcmd(" select distinct 'obj' = o.name, 'user' = u.name, o.id, o.type from dbo.sysobjects o, dbo.sysusers u, dbo.sysprocedures p where u.uid = o.uid and o.id = p.id and p.status & 4096 != 4096 order by o.name "); $dbh->dbsqlexec; $dbh->dbresults; my %dat; my @values; my %labels; my $value; while(%dat = $dbh->dbnextrow(TRUE)) { $value = "$dat{id} - $dat{type}"; push(@values, $value); $labels{$value} = "$dat{user}.$dat{obj}"; } (\@values, \%labels); } sub getText { my $objId = shift; $objId =~ s/[\D\-\s]+$//; $dbh->dbcmd ("select text from dbo.syscomments where id = $objId"); $dbh->dbsqlexec; $dbh->dbresults; my $html = ''; my $text; while(($text) = $dbh->dbnextrow) { $html .= $text; } TsqlToHtml($html); } sub TsqlToHtml { my $html = shift; $html =~ s/\n/
\n/g; $html =~ s/\b(as|begin|between|declare|delete|drop|else|end|exec|exists|go|if|insert|procedure|return|set|update|values|from|select|where|and|or|create|order by)\b/$1<\/b>/ig; $html =~ s/\b(tinyint|smallint|int|char|varchar|datetime|smalldatetime|money|smallmoney|numeric|decimal|text|binary|varbinary|image)\b/$1<\/i>/gi; $html =~ s/\t/\ \ \ \ /g; $html =~ s/ /\ /sg; $html; } sub error { print "

Error!

\n"; print @_; print $query->end_html; exit(0); }