#!/usr/local/bin/perl ############################################################################# # Generic SQL access to Database # output can either be HTML table (or) XML # Written by: Sam Sultan ############################################################################# use CGI "param"; use DBI; $DBdriv = 'mysql'; $DBname = param('db'); $DBuser = param('user'); $DBpswd = param('pswd'); $DBhost = param('host'); $DBport = param('port'); $sql = param('sql'); $output = param('output'); $output = 'HTML' if (! $output); # if not supplied use HTML $output = uc($output); # convert to upper case if ($output eq 'HTML') { #if HTML output print "Content-type: text/html \n\n"; print " SQL Access - Sam Sultan ©

Database Results

"; } if ($output eq 'XML' or $output eq 'XSLT') { #if XML or XSLT output print "Content-type: text/xml \n\n"; print " \n"; if ($output eq 'XSLT') { #if XSLT, add an XSLT stylesheet print " \n"; } print " \n"; } if ($DBdriv eq 'Oracle') { $ENV{'ORACLE_HOME'} = "/opt/oracle8i/OraHome1"; $ENV{'LD_RUN_PATH'} = "/opt/oracle8i/OraHome1/lib"; } $dbh = ($DBhost eq '' && $DBport eq '') ? DBI->connect("DBI:$DBdriv:$DBname","$DBuser","$DBpswd") : DBI->connect("DBI:$DBdriv:$DBname:$DBhost:$DBport","$DBuser","$DBpswd"); if (!defined($dbh)) { if ($output eq 'HTML') { print "
Cannot open database connection -
$DBI::errstr"; print "
"; } if ($output eq 'XML' or $output eq 'XSLT') { print "Cannot open database connection - $DBI::errstr \n"; print ""; } exit; } $sql =~ s/--/-- /g; #add a space if there is none $stmts = 'select|desc|show|explain|#|--|\/\*'; #select,desc,...,comments ($sql =~ /^\s*($stmts)/i) #Is this a select,... ? &select() #Yes- call select subroutine : &update(); #No - call update subroutine $dbh->disconnect(); if ($output eq 'HTML') { print " \n"; print " \n"; print " \n"; } if ($output eq 'XML' or $output eq 'XSLT') { print " \n"; } exit(0); ##################### SELECT subroutine #################################### sub select { $cursor = $dbh->prepare($sql); if (!defined($cursor)) { if ($output eq 'HTML') { print "Cannot prepare statement:
$sql
$DBI::errstr \n"; } if ($output eq 'XML' or $output eq 'XSLT') { print "Cannot prepare statement: $sql - $DBI::errstr \n"; } return; } $rc = $cursor->execute(); if (!defined($rc)) { if ($output eq 'HTML') { print "Cannot execute statement:
$sql
$DBI::errstr \n"; } if ($output eq 'XML' or $output eq 'XSLT') { print "Cannot execute statement: $sql - $DBI::errstr \n"; } return; } $nameref = $cursor->{'NAME'}; # get ref to column headers @column_names = @$nameref; # load into array if ($output eq 'HTML') { # print heading print ""; foreach $column_name (@column_names) { # loop thru column_names print "$column_name"; # print column headings } print " \n"; } $rows=0; while( @columns = $cursor->fetchrow_array() ) { if ($output eq 'HTML') { print ""; for ($i=0; $i<@columns; $i++) { #loop thru all columns $column = $columns[$i]; $column =~ s/\n/
/g; #chamge all \n to
print " $column   "; } print " \n"; } if ($output eq 'XML' or $output eq 'XSLT') { print " \n"; for ($i=0; $i<@columns; $i++) { #loop thru all columns $column_name = $column_names[$i]; $column_name =~ s/\W/_/g; #change non-alpha to _ $column = $columns[$i]; print " <$column_name>$column \n"; } print " \n"; } $rows++; } if ($output eq 'HTML') { print " $rows rows returned \n"; } } ##################### UPDATE subroutine #################################### sub update { $rc = $dbh->do($sql); if (!defined($rc)) { if ($output eq 'HTML') { print "Cannot execute statement:
$sql
$DBI::errstr \n"; } if ($output eq 'XML' or $output eq 'XSLT') { print "Cannot execute statement: $sql - $DBI::errstr \n"; } return; } if ($output eq 'HTML') { ($rc == 0) ? print "Update Performed Successfully \n" : print "Update is Successful - $rc rows effected\n"; } if ($output eq 'XML' or $output eq 'XSLT') { ($rc == 0) ? print "Update Performed Successfully \n" : print "Update is Successful - $rc rows effected \n"; } } ########### NO LONGER CALLED ################################################ sub show { if ($sql =~ /(database.*)/i) { #Is this "show databases"? @names = $dbh->func('_ListDBs'); print "databases \n"; for ($i=0; $i<@names; $i++) { print "$names[$i] \n "; } } if ($sql =~ /(table.*)/i) { #Is this "show tables"? @names = $dbh->tables(); print "tables \n"; for ($i=0; $i<@names; $i++) { print "$names[$i] \n "; } } if ($sql =~ /(column.?)(\s+from\s+)(\w+)/i #Is this "show columns"? or $sql =~ /(desc)(\s+)(\w+)/i) { # or "desc columns"? $request = $1; #Grab which type of request from the match above $table = $3; #Grab the table name $buf = $dbh->prepare("select * from $table limit 1"); $rc = $buf->execute(); $nameref = $buf->{'NAME'}; @names = @$nameref; $typeref = $buf->{'TYPE'}; @types = @$typeref; $lgthref = $buf->{'PRECISION'}; @lengths = @$lgthref; $scleref = $buf->{'SCALE'}; @scales = @$scleref; $nullref = $buf->{'NULLABLE'}; @nulls = @$nullref; $buf->finish(); %descT = (1=>char,2=>numeric,3=>decimal,4=>integer,5=>smallint,6=>float, 7=>real,8=>double,9=>date,10=>time,11=>timestamp,12=>varchar, -1=>longvarchar,-2=>binary,-3=>varbinary,-4=>longvarbinary, -5=>bigint,-6=>tinyint,-7=>bit,-8=>wchar,-9=>wvchar, -10=>wlgvchar); %descN = (0=>'no',1=>'yes',2=>'unknown',''=>'no'); print " $table $request type "; print " length decimal nulls? \n"; for ($i=0; $i<@names; $i++) { print "$names[$i]$descT{$types[$i]} "; print " $lengths[$i]$scales[$i]$descN{$nulls[$i]}\n"; } } } ############################################################################