DBA Tips Archive for Oracle

  

Oracle Programming with Tcl & Oratcl

by Jeff Hunter, Sr. Database Administrator

Overview

Oratcl is an extension to Tool Command Language (Tcl) that provides access to a Oracle Database server. Oratcl adds additional Tcl commands that login to an Oracle Server, pass SQL code, read results, etc. Oratcl was inspired by similar tools written for Perl (sybperl, oraperl) but was written from scratch instead of borrowing on the work of either Perl extension. Oratcl features:

Download Tck, TK & Oratcl

To start, you need to download a copy of Tcl, Tk and Oratcl. Make sure to download the latest version of Tcl (tk8.3.2.tar.gz) and Tk (tk8.3.2.tar.gz).

Program Download Version Release Date
Tcl Developer Xchange
tk8.3.2.tar.gz & tk8.3.2.tar.gz		 View
Download Tck and Tk		 8.3.2 August 9, 2000
oratcl301.tar.gz Download 3.01 ?

Installation Overview

Place the files tk8.3.2.tar.gz, tk8.3.2.tar.gz and oratcl301.tar.gz together in a temporary directory. You will need to install all products in the following order:
  1. Tcl
  2. Tk
  3. Oratcl
Install Tcl 

     % cd /tmp
     % gunzip tcl8.3.2.tar.gz
     % tar xvf tcl8.3.2.tar
     % cd tcl8.3.2/unix
     % ./configure --enable-gcc --exec_prefix /usr/local
     % make
     % su  # "make install" must be run as 'root'
     % make install
     % ln -s /usr/local/bin/tclsh8.3 /usr/local/bin/tclsh

WARNING: Do not delete the Tcl 8.3.2 Tree! This will be needed to install both Tk and Oratcl.

Install Tk 

     % cd /tmp
     % gunzip tk8.3.2.tar.gz
     % tar xvf tk8.3.2.tar
     % cd tk8.3.2/unix
     % ./configure --enable-gcc --exec_prefix /usr/local
     % make
     % su  # "make install" must be run as 'root'
     % make install
     % ln -s /usr/local/bin/wish8.3 /usr/local/bin/wish

Install Oratcl 

     % cd /tmp
     % gunzip oratcl301.tar.gz
     % tar xvf oratcl301.tar
     % cd oratcl-3-0-1-branch
     % ./configure --enable-gcc --exec-prefix=/usr/local
     % make
     % su  # make install must be run as 'root'
     % make install

Now Delete All Source Trees 

     % cd /tmp
     % rm -rf tcl8.3.2 tk8.3.2 oratcl-3-0-1-branch

Testing Oratcl

Below is a simple script that can be used to test your new Oratcl installation. Save the file test_oratcl.tcl on the UNIX server and change the mode of the file to 755. (i.e. chmod 755 test_oratcl.tcl). Then run test_oratcl.tcl giving the Database Name to connect as the only parameter: 
     % chmod 755 test_oratcl.tcl
     % test_oratcl.tcl ERPDB
     % ERPDB SYSTEM
     % ERPDB
     % SYSTEM

   Sample Oratcl Script. test_oratcl.tcl 
#!/usr/local/bin/tclsh

# ------------------------
# FILE   : test_oratcl.tcl
# AUTHOR : Jeff Hunter
# ------------------------

package require Oratcl

global oramsg

set find_db_version { select instance, user from v$thread }

set DB $argv

if {[string length $DB] == 0} {
  puts "Need to enter a DB name as the first argument..."
  exit
}

set idpass "system/manager@$DB"

set lda [oralogon $idpass]
set cur1 [oraopen $lda]

orasql $cur1 $find_db_version

set db_version [orafetch $cur1]

set col1 [lindex $db_version 0]
set col2 [lindex $db_version 1]

puts $db_version
puts $col1
puts $col2

oraclose $cur1
oralogoff $lda

exit

Web Programming with Oratcl

The following scripts will provide an overview of how to utilize Oratcl in a web environment. Your CGI script will need to "source" the two libraries: cgi-lib.tcl and fore-lib.tcl.

   Tcl CGI Routines. cgi-lib.tcl 
#!/usr/local/bin/tclsh

# +--------------------------------------------------------------------------+
# | File         : cgi-lib.tcl                                               |
# | Purpose      : The following script provides many subroutines that can   |
# |                be used to read HTML Forms.                               |
# +--------------------------------------------------------------------------+


# TclX replacements:
proc read_file {fname} {
    set f [open $fname]
    set r [read $f]
    close $f
    set r
}
proc cequal {s1 s2} {
    expr {[string compare $s1 $s2]==0}
}

#
# UnCgi Translation hack, in Tcl, v1.5 5/1995 by L@demailly.com
# this version should be updated to newer, using subst and taking
# care of ::
proc uncgi {buf} {
    # ncsa httpd (at least) \ quotes some chars, including \ so :
    regsub -all {\\(.)} $buf {\1} buf ;
    regsub -all {\\} $buf {\\\\} buf ;
    regsub -all { }  $buf {\ } buf ;
    regsub -all {\+} $buf {\ } buf ;
    regsub -all {\$} $buf {\$} buf ;
    regsub -all \n   $buf {\n} buf ;
    regsub -all {;}  $buf {\;} buf ;
    regsub -all {\[} $buf {\[} buf ;
    regsub -all \" $buf \\\" buf ;
    # the next one can probably be skipped as the first char is prolly not
    # an \{, but, hey who knows... lets be safe...
    regsub  ^\{ $buf \\\{ buf ;
    # I think everything has been escaped, now the real work :
    regsub -all -nocase {%([a-fA-F0-9][a-fA-F0-9])} $buf {[format %c 0x\1]} buf
    # And now lets replace all those escaped back, along with excuting of
    # the format :
    eval return \"$buf\"
    # now everything is in buf, but translated, nice trick no ?
}

#
# text -> html + auto link of urls
#
proc escape {str {auto 1}} {
    regsub -all {&} $str {\&} str;
    regsub -all {<} $str {\<} str;
    regsub -all {>} $str {\>} str;
    regsub -all {"} $str {\"} str;
    regsub -all "\[\t\r\n\]\[ \t\r\n\]*" $str { } str;
    if {$auto} {
        regsub -all {(http|ftp|gopher)://([^& ,;)|]+)} $str {<a href="\0">\0</a>} str;
    }
    return $str;
}

# returns in the 'cgi' array all the parameters sent to the script
# through 'message' (each array cell is a list (ie if only one value
# is expected through 'test' variable, use [lindex $cgi(test) 0] to get it.
proc parse_cgi_message {message} {
    global cgi;
    foreach pair [split $message &] {
        set plst [split $pair =];
        set name [uncgi [lindex $plst 0]];
        set val  [uncgi [lindex $plst 1]];
        lappend cgi($name) $val;
    }
}

# process form values, accept only post method
set message "";
if {[info exist env(REQUEST_METHOD)] && [string compare $env(REQUEST_METHOD) "POST"]==0} {
  set message [read stdin $env(CONTENT_LENGTH)];
}

if {[info exist env(REQUEST_METHOD)] && [string compare $env(REQUEST_METHOD) "GET"]==0} {
  set message $env(QUERY_STRING);
}

set cgi() ""
parse_cgi_message $message;

   Misc TCL Web Routines. fore-lib.tcl 
#!/usr/local/bin/tclsh

# +--------------------------------------------------------------------------+
# | File         : fore-lib.tcl                                              |
# | Programmer   : Jeff Hunter                                               |
# | Date         : 29-SEP-2000                                               |
# | Purpose      : The following script provides many subroutines that will  |
# |                be common to many Web TCL application. It also contains   |
# |                any global variables.                                     |
# +--------------------------------------------------------------------------+

proc printHeader {} {
  puts "Content-type: text/html\n\n"
}

proc endHTML {} {
  puts "</BODY></HTML>"
}

proc startHTML {title} {
  puts "<HTML><BODY><Style>A.noLinkBlackT { color:#000000; text-decoration: none; }</Style>"
  puts "<FONT SIZE=\"4\"><img src=\"../config/logo_small.gif\"> "
  puts "<B>$title</B>"
  puts "<HR SIZE=\"3\" NOSHADE></FONT>"
  puts "<P><BR>"
}

   Example Tcl CGI Program. TCL_test1.cgi 
#!/usr/local/bin/tclsh

source ../lib/cgi-lib.tcl
source ../lib/fore-lib.tcl
package require Oratcl
set env(ORACLE_HOME) /u01/app/oracle/product/8.1.7

printHeader
startHTML "TCL / Oracle Test"

if {[info exist cgi(submitA)]} {
  set submitA [lindex $cgi(submitA) 0]
  set userid   [lindex $cgi(userid) 0]
  set password [lindex $cgi(password) 0]
  set dbname [lindex $cgi(dbname) 0]
} else {
  set submitA ""
}

if {$submitA == "Submit"} {

  set ora_constr $userid/$password@$dbname

  set logon [oralogon $ora_constr]
  set cursor [oraopen $logon]
  orasql $cursor "select instance, user, TO_CHAR(sysdate, 'DD-MON-YYYY HH24:MI:SS') from v\$thread"

  set results [orafetch $cursor]

  set p_instance [lindex $results 0]
  set p_user [lindex $results 1]
  set p_sysdate [lindex $results 2]

  oraclose $cursor
  oralogoff $logon

  puts "<CENTER><TABLE BGCOLOR=\"#C0C0C0\" BORDER=\"0\" CELLPADDING=\"3\" CELLSPACING=\"1\">"
  puts "<TR>"
  puts "<TD COLSPAN=\"2\" BGCOLOR=\"#1d5387\" ALIGN=\"center\" WIDTH=\"500\">"
  puts "<FONT SIZE=+1 FACE=\"ARIAL\" COLOR=#FFFFFF>Tcl / Oracle Database Logon Results</FONT>"
  puts "</TD></TR>"
  puts "<TR><TD><B>Instance</B></TD><TD>$p_instance</TD></TR>"
  puts "<TR><TD><B>User</B></TD><TD>$p_user</TD></TR>"
  puts "<TR><TD><B>Sysdate</B></TD><TD>$p_sysdate</TD></TR>"
  puts "</TABLE></CENTER>"

} else {

  puts "<FORM method=\"POST\">"
  puts "<CENTER><TABLE BGCOLOR=\"#C0C0C0\" BORDER=\"0\" CELLPADDING=\"3\" CELLSPACING=\"1\">"
  puts "<TR>"
  puts "<TD COLSPAN=\"2\" BGCOLOR=\"#1d5387\" ALIGN=\"center\" WIDTH=\"500\">"
  puts "<FONT SIZE=+1 FACE=\"ARIAL\" COLOR=#FFFFFF>Tcl / Oracle Database Logon Test</FONT>"
  puts "</TD>"
  puts "</TR>"
  puts "<TR>"
  puts "<TD>"
  puts "<B>User ID</B></TD>"
  puts "<TD><INPUT TYPE=\"text\" NAME=\"userid\" SIZE=\"30\" VALUE=\"SYSTEM\">"
  puts "</TD>"
  puts "</TR>"
  puts "<TR><TD>"
  puts "<B>Password</B></TD><TD><INPUT TYPE=\"password\" NAME=\"password\" SIZE=\"30\">"
  puts "</TD></TR>"
  puts "<TR><TD>"
  puts "<B>Database</B></TD><TD><INPUT TYPE=\"text\" NAME=\"dbname\" SIZE=\"30\" VALUE=\"DBADB\">"
  puts "</TD></TR>"
  puts "<TR>"
  puts "<TD COLSPAN=2 ALIGN=center>"
  puts "<INPUT TYPE=\"submit\" NAME=\"submitA\" VALUE=\"Submit\">"
  puts "<INPUT TYPE=\"reset\" VALUE=\"Reset Values\">"
  puts "</TD></TR>"
  puts "</TABLE></CENTER></FORM>"
}


endHTML


Copyright (c) 1998-2013 Jeffrey M. Hunter. All rights reserved.

All articles, scripts and material located at the Internet address of http://www.idevelopment.info is the copyright of Jeffrey M. Hunter and is protected under copyright laws of the United States. This document may not be hosted on any other site without my express, prior, written permission. Application to host any of the material elsewhere can be made by contacting me at jhunter@idevelopment.info.

I have made every effort and taken great care in making sure that the material included on my web site is technically accurate, but I disclaim any and all responsibility for any loss, damage or destruction of data or any other property which may arise from relying on it. I will in no case be liable for any monetary damages arising from such loss, damage or destruction.

Last modified on
Thursday, 18-Nov-2010 18:09:20 EST
Page Count: 14303