#!/usr/local/bin/perl #============ EXTERNAL LIBRARIES use DBI; #============ EXPORTED ENVIRONMENT VARIABLES if (! (defined $ENV{"ORACLE_HOME"} and (defined $ENV{"ORACLE_SID"} or defined $ENV{"TWO_TASK"}))) { &Usage; exit ; } $ENV{"TWO_TASK"} = $ENV{"ORACLE_SID"} unless (defined $ENV{"TWO_TASK"}) ; $ENV{"ORACLE_SID"} = $ENV{"TWO_TASK"} unless (defined $ENV{"ORACLE_SID"}) ; if (defined($ENV{'LD_LIBRARY_PATH'})) { $LD_LIBRARY_PATH_DFLT = $ENV{'LD_LIBRARY_PATH'}; $LD_LIBRARY_PATH = "$ORACLE_HOME/lib:$LD_LIBRARY_PATH_DFLT:/usr/ucblib"; } else { $LD_LIBRARY_PATH_DFLT = ""; $LD_LIBRARY_PATH = "$ORACLE_HOME/lib:/usr/ucblib"; } $ORACLE_PATH = "$ORACLE_HOME/bin"; $ENV{"LD_LIBRARY_PATH"} = $LD_LIBRARY_PATH; $ENV{"PATH"} .= ":$ORACLE_PATH"; #==================== MAIN PROGRAM ====================# $|=1; $arg0 = $ARGV[0] ; $arg1 = $ARGV[1] ; $arg2 = $ARGV[2] ; $arg3 = $ARGV[3] ; $arg4 = $ARGV[4] ; $arg5 = $ARGV[5] ; $arg6 = $ARGV[6] ; if (length($arg0) == 0 || length($arg1) == 0 || length($arg2) == 0) { &Usage ; } else { ($ORACLE_USER, $ORACLE_PASSWORD) = split(/\//, $arg0) ; if ($arg1 eq "-create") { &tabledefs_create($arg2) ; } elsif ($arg1 eq "-drop") { &tabledefs_drop($arg2) ; } elsif ($arg1 eq "-recreate") { &tabledefs_drop($arg2) ; &tabledefs_create($arg2) ; } elsif ($arg1 eq "-insert" && length($arg3) != 0) { &tablerows_insert($arg2, $arg3) ; } elsif ($arg1 eq "-select" && $arg3 eq "-from" && length($arg4) != 0) { if ($arg5 ne "") { if ($arg5 ne "-where") { die ("use '-where' to specify where_clause\n") ; } if ($arg6 eq "") { die ("? '-where' specified without where_clause\n") ; } } &tablerows_select($arg2,$arg4,$arg6) ; } elsif ($arg1 eq "-read") { &tabledefs_read($arg2) ; &tabledefs_print ; } elsif ($arg1 eq "-write") { &tabledefs_read($arg2) ; &tabledefs_write ; } else { &Usage; } } exit ; #==================== DIAGNOSTICS ====================# sub Usage { print STDOUT ("Usage\n") ; print STDOUT ("\t$0 user/password -create table.def\n") ; print STDOUT ("\t$0 user/password -drop table.def\n") ; print STDOUT ("\t$0 user/password -recreate table.def\n") ; print STDOUT ("\t$0 user/password -insert TABLE_NAME table.dat\n") ; print STDOUT ("\t$0 user/password -select \"column_list\" -from TABLE_NAME\n") ; print STDOUT ("\t$0 user/password -select \"column_list\" -from TABLE_NAME -where \"where_clause\"\n") ; print STDOUT ("where\n") ; print STDOUT ("\tuser/password : oracle user, password delimited by '/'\n") ; print STDOUT ("\t-create : create the tables listed in table.def\n") ; print STDOUT ("\t see below for description of table.def\n") ; print STDOUT ("\t-drop : drop the tables listed in table.def\n") ; print STDOUT ("\t-recreate : drop and create the tables listed in table.def\n") ; print STDOUT ("\t-insert : insert data in table.dat into TABLE_NAME\n") ; print STDOUT ("\t see below for description of table.dat\n") ; print STDOUT ("\t-select : extract data from TABLE_NAME.\n") ; print STDOUT ("\t \"column_list\" is one or more comma-separated\n") ; print STDOUT ("\t column names from TABLE_NAME. use \"*\" for all.\n") ; print STDOUT ("\t -where is an optional argument to -select. provide\n") ; print STDOUT ("\t a valid sql where-clause\n") ; print STDOUT ("Environment Variables\n") ; print STDOUT ("\tORACLE_HOME - required\n"); print STDOUT ("\tORACLE_SID or TWO_TASK - required\n"); print STDOUT ("Files\n") ; print STDOUT ("\ttable.def -- a user-named file or path/file. Contains descriptions of\n") ; print STDOUT ("\t one or more tables in ascii text. Description must begin with\n") ; print STDOUT ("\t identifier 'TABLE' and follow SQL protocols. Example:\n") ; print STDOUT ("\t\tTABLE MIRAGE_USER ( \n") ; print STDOUT ("\t\t username VARCHAR2(64),\n") ; print STDOUT ("\t\t sessionnum NUMBER,\n") ; print STDOUT ("\t\t sessiontime DATE\n") ; print STDOUT ("\t\t )\n") ; print STDOUT ("\t\tTABLE MIRAGE_PROJECT ( \n") ; print STDOUT ("\t\t project VARCHAR2(64),\n") ; print STDOUT ("\t\t username VARCHAR2(64),\n") ; print STDOUT ("\t\t data LONG\n") ; print STDOUT ("\t\t )\n") ; print STDOUT ("\t The '(' and ')' characters delimiting the column definitions\n") ; print STDOUT ("\t of a table must be surrounded by whitespace. No other\n") ; print STDOUT ("\t parentheses may be surrounded by whitespace (e.g., in types).\n") ; print STDOUT ("\t Commas cannot be prefixed by whitespace. When specifying\n") ; print STDOUT ("\t the precision and scale of type, do not embed whitespace.\n") ; print STDOUT ("\t If the data type LONG is found, it is assummed that inserts\n") ; print STDOUT ("\t for that column will be performed from files named in table.dat.\n") ; print STDOUT ("\t Tip: Use -proto argument of catalog_info.pl to generate table.def.\n") ; print STDOUT ("\ttable.dat -- a user-named file or path/file. Contains tab-delimited\n") ; print STDOUT ("\t data for a named table described in table.def. If the data\n") ; print STDOUT ("\t type LONG is found, it is assummed that a file name or path is\n") ; print STDOUT ("\t is used to represent the data. Example data for MIRAGE_PROJECT :\n") ; print STDOUT ("\t\tWestern Shores Fred Bassett f00293.dat\n") ; print STDOUT ("\t\tKamaloops Creek Marty Owens f10728.dat\n") ; print STDOUT ("\t\tGold Beach Marty Owens f10729.dat\n") ; return; } #============ sub dispenv { print STDOUT ("\n") ; print STDOUT ("Environment Variables\n") ; print STDOUT ("\n") ; my $key ; foreach $key (keys %ENV) { print STDOUT ("$key = $ENV{$key}\n") ; } return; } #==================== FUNCTIONS ====================# sub file_inhale { my ($infile) = @_ ; (-e $infile) || die ("Can't find $infile\n") ; open(FP, "<$infile") || die ("Can't open $infile\n") ; (-z FP) && die ("$infile is empty.\n") ; my $filesize = -s $infile ; my $bytesread = read(FP, $contents, $filesize) ; while ($bytesread < $filesize) { my $remainder = $filesize - $bytesread ; $bytesread += read(FP, $contents, $remainder, $bytesread) ; } close (FP) ; return $contents ; } #============ sub tabledefs_read { my ($infile) = @_ ; my @token = &tabledefs_tokens(&upperwhiteout( &file_inhale($infile) )) ; my @tableloc ; my $tablecount = 0 ; for (my $i=0; $i<@token; $i++) { if ($token[$i] eq "TABLE") { my $j = $i + 1 ; if ($j == @token) { die ("'TABLE' declaration with no body at end of $infile\n") ; } $tableloc[$tablecount] = $j ; $tablecount++ ; } } if ($tablecount == 0) { die ("? no 'TABLE' identifiers found in $infile\n") ; }; $tableloc[$tablecount] = @token + 1; for (my $i=0; $i<$tablecount; $i++) { my $loc = $tableloc[$i] ; my $name = $token[$loc] ; my $openparen = $loc + 1 ; my $closeparen = $tableloc[$i+1] - 2 ; if ($token[$openparen] ne "(") { die ("table name $name must be followed by ' ( ' in $infile\n") ; } if ($token[$closeparen] ne ")") { die ("table definition for $name must be completed by ' ) ' in $infile\n") ; } if ((($closeparen - $openparen) % 2) != 1) { die ("column defs for table $name in $infile must occur in \"name type\" pairs\n") ; } my $firstdef = $openparen + 1 ; my $columndef = "$token[$firstdef];$token[$firstdef+1]" ; for (my $j=($firstdef+2); $j<$closeparen; $j+=2) { $columndef .= "\0" ; $columndef .= "$token[$j];$token[$j+1]" ; } $TableDef{$name} = $columndef ; } return ; } #============ sub tabledefs_tokens { my ($contents) = @_ ; # assumes upperwhiteout $contents =~ s/, /;/g; $contents =~ s/ /;/g; $contents =~ s/LONG;RAW/LONG RAW/g; $contents =~ s/DOUBLE;PRECISION/DOUBLE PRECISION/g; $contents =~ s/;UNIQUE/ UNIQUE/g; my @token = split(/;/, $contents) ; return @token ; } #============ sub tabledefs_print { foreach $tablename (keys %TableDef) { print STDOUT ("$tablename\n") ; my @table_column = &tabledefs_column($tablename) ; for (my $c=0; $c<@table_column; $c++) { my ($colname, $coltype) = split(/;/, $table_column[$c]) ; printf STDOUT ("\t%-32s%s\n", $colname, $coltype) ; } } return ; } #============ sub tabledefs_write { foreach $tablename (keys %TableDef) { print STDOUT tabledefs_proto($tablename) ; } return ; } #============ sub tabledefs_create { my ($infile) = @_ ; &tabledefs_read($infile) ; my $dbh = DBI->connect("dbi:Oracle:", $ORACLE_USER, $ORACLE_PASSWORD, { RaiseError=>1, AutoCommit=>0}) ; foreach $tablename (keys %TableDef) { my $proto = tabledefs_proto($tablename) ; my $sth = $dbh->prepare("CREATE $proto") ; $sth->execute; } $dbh->commit; $dbh->disconnect; return; } #============ sub tabledefs_drop { my ($infile) = @_ ; &tabledefs_read($infile) ; my $dbh = DBI->connect("dbi:Oracle:", $ORACLE_USER, $ORACLE_PASSWORD, { RaiseError=>1, AutoCommit=>0}) ; foreach $tablename (keys %TableDef) { my $sth = $dbh->prepare("DROP TABLE $tablename") ; $sth->execute; } $dbh->commit; $dbh->disconnect; return; } #============ sub tabledefs_proto { my ($tablename) = @_ ; my @table_column = &tabledefs_column($tablename) ; my $proto = "TABLE $tablename (\n" ; my $c ; my $colname ; my $coltype ; for ($c=0; $c<@table_column-1; $c++) { ($colname, $coltype) = split(/;/, $table_column[$c]) ; $proto .= sprintf("\t%-32s%s,\n", $colname, $coltype) ; } $c = @table_column - 1 ; ($colname, $coltype) = split(/;/, $table_column[$c]) ; $proto .= sprintf("\t%-32s%s\n", $colname, $coltype) ; $proto .= "\t)\n" ; return $proto ; } #============ sub tabledefs_types { my ($tablename) = @_ ; my @table_column = &tabledefs_column($tablename) ; my $cname ; my @columntype ; for (my $c=0; $c<@table_column; $c++) { ($cname, $columntype[$c]) = split(/;/, $table_column[$c], 2) ; } return @columntype ; } #============ sub tabledefs_column { my ($tablename) = @_ ; my @table_column = split(/\0/, $TableDef{$tablename}) ; if (@table_column == 0) { die ("Can't find columns of table $tablename\n") ; } return @table_column ; } #============ sub tablerows_insert { my ($tablename, $datfile) = @_ ; (-e $datfile) || die ("Can't find $datfile\n") ; $tablename =~ tr/a-z/A-Z/; my @columndef = &columndefs_inquire($tablename) ; my @columnname = &columndefs_names(@columndef) ; my @columntype = &columndefs_typenames(@columndef) ; my @fileflag = &columndefs_longflags(@columntype) ; my $c ; my $getfiles = (1 == 0) ; for ($c=0; $c<@fileflag; $c++) { if ($fileflag[$c]) { $getfiles = $fileflag[$c] ; last ; } } my $query = &mkquery_insert($tablename, @columnname) ; my $dbh = DBI->connect("dbi:Oracle:", $ORACLE_USER, $ORACLE_PASSWORD, { RaiseError=>1, AutoCommit=>0}) ; my $sth = $dbh->prepare($query) ; open(FH, $datfile) || die ("Can't open $datfile\n") ; while () { chop ; my @bv = split /\t/ ; if ($getfiles) { for ($c=0; $c<@fileflag; $c++) { $bv[$c] = file_inhale($bv[$c]) if ($fileflag[$c]) ; } } $sth->execute(@bv) ; } close(FH) ; $dbh->commit ; $dbh->disconnect ; return ; } #============ sub mkquery_insert { my ($tname, @cname) = @_ ; my $query = "insert into $tname ($cname[0]" ; for (my $c=1; $c<@cname; $c++) { $query .= ", $cname[$c]" ; } $query .= ") values (?" ; for (my $c=1; $c<@cname; $c++) { $query .= ", ?" ; } $query .= ")" ; return $query ; } #============ sub mkquery_select { my ($tname, $wclause, @cname) = @_ ; my $query = "select $cname[0]" ; for (my $c=1; $c<@cname; $c++) { $query .= ", $cname[$c]" ; } $query .= " from $tname" ; if ($wclause ne "") { $query .= " where $wclause" ; } return $query ; } #============ sub columndefs_inquire { my ($tablearg) = @_ ; my ($part1, $part2) = split(/\./, $tablearg, 2) ; my $tablename ; my $owner ; if (! defined $part2) { $tablename = $part1 ; $owner = $part2 ; } else { $owner = $part1 ; $tablename = $part2 ; } my $query = "select COLUMN_NAME, DATA_TYPE, DATA_LENGTH, DATA_PRECISION, DATA_SCALE from all_tab_columns where all_tab_columns.TABLE_NAME = '$tablename'" ; $query .= " and all_tab_columns.OWNER = '$owner'" if (defined $owner) ; my @columndef = &fetchquery_2result($query) ; return @columndef ; } #============ sub columndefs_names { my (@columndef) = @_ ; my @columnname ; my $ctype ; for (my $c=0; $c<@columndef; $c++) { ($columnname[$c], $ctype) = split(/\0/, $columndef[$c], 2) ; } return @columnname ; } #============ sub columndefs_listnames { my ($clist, @columndef) = @_ ; $clist = upperwhiteout($clist) ; $clist =~ s/, /;/g; my @columnlist = split(/;/, $clist) ; my @columnname ; my $cname ; my $ctype ; for (my $d=0; $d<@columnlist; $d++) { $columnname[$d] = "" ; for (my $c=0; $c<@columndef; $c++) { ($cname, $ctype) = split(/\0/, $columndef[$c], 2) ; if ($cname eq $columnlist[$d]) { $columnname[$d] = $cname ; last ; } } if ($columnname[$d] eq "") { die ("Can't find column $columnlist[$d]\n") ; } } return @columnname ; } #============ sub columndefs_typenames { my (@columndef) = @_ ; my $cname ; my @typename ; my $csize ; for (my $c=0; $c<@columndef; $c++) { ($cname, $typename[$c], $csize) = split(/\0/, $columndef[$c], 3) ; } return @typename ; } #============ sub columndefs_longflags { my (@tname) = @_ ; my @cflag ; for (my $c=0; $c<@tname; $c++) { $cflag[$c] = ($tname[$c] eq "LONG" || $tname[$c] eq "LONG RAW") ; } return @cflag ; } #============ sub tablerows_select { my ($clist, $tablename, $wclause) = @_ ; $tablename =~ tr/a-z/A-Z/; my @columndef = &columndefs_inquire($tablename) ; my @columnname ; my @columntype ; if ($clist eq "*") { @columnname = &columndefs_names(@columndef) ; @columntype = &columndefs_typenames(@columndef) ; } else { @columnname = &columndefs_listnames($clist, @columndef) ; my @tablenames = &columndefs_names(@columndef) ; my @tabletypes = &columndefs_typenames(@columndef) ; for (my $d=0; $d<@columnname; $d++) { for (my $c=0; $c<@tabletypes; $c++) { if ($columnname[$d] eq $tablenames[$c]) { $columntype[$d] = $tabletypes[$c] ; last ; } } } } my @longflag = &columndefs_longflags(@columntype) ; my $c ; my $longexists = (1 == 0) ; my $lcol ; for ($c=0; $c<@longflag; $c++) { if ($longflag[$c]) { $longexists = $longflag[$c] ; $lcol = $c ; last ; # only one long is permitted per row } } my @bv = @columnname ; # initialize bv to proper size my @bref ; for ($c=0; $c<@bv; $c++) { $bref[$c] = \$bv[$c] ; } my $query = &mkquery_select($tablename, $wclause, @columnname) ; my $dbh = DBI->connect("dbi:Oracle:", $ORACLE_USER, $ORACLE_PASSWORD, { RaiseError=>1, AutoCommit=>0, LongTruncOk=>1}) ; my $sth = $dbh->prepare($query) ; $sth->bind_columns(undef, @bref); $sth->execute(); while ($sth->fetch) { if ($longexists) { # get long data my $offset = length($bv[$lcol]); my $frag ; while (1) { $frag = $sth->blob_read($lcol,$offset,80) ; last unless defined $frag ; my $ll = length($frag) ; last unless $ll ; $bv[$lcol] .= $frag ; $offset += $ll ; } # print mix (if any) of long ($lcol) and non-long data if ($lcol > 0) { print STDOUT $bv[$0] ; for (my $t=1; $t<$lcol; $t++) { print STDOUT ("\t$bv[$t]") ; } print STDOUT ("\n") ; } print STDOUT $bv[$lcol] ; if ($lcol < @bv - 1) { print STDOUT $bv[$lcol+1] ; for (my $t=lcol+1; $t<@bv; $t++) { print STDOUT ("\t$bv[$t]") ; } print STDOUT ("\n") ; } } else { print STDOUT ("$bv[$0]") ; for (my $t=1; $t<@bv; $t++) { print STDOUT ("\t$bv[$t]") ; } print STDOUT ("\n") ; } } $sth->finish; $dbh->disconnect; return; } #============ sub whiteout { my ($text) = @_ ; $text =~ s/[\n]{1,}/ /mg; $text =~ s/^[ \t]{1,}//g; $text =~ s/[ \t]{1,}$//g; $text =~ s/[ \t]{1,}/ /g; return $text ; } #============ sub upperwhiteout { my ($text) = @_ ; $text =~ s/[\n]{1,}/ /mg; $text =~ s/^[ \t]{1,}//g; $text =~ s/[ \t]{1,}$//g; $text =~ s/[ \t]{1,}/ /g; $text =~ tr/a-z/A-Z/; return $text ; } #============ sub fetchquery_2result { my ($query) = @_ ; my $dbh = DBI->connect("dbi:Oracle:", $ORACLE_USER, $ORACLE_PASSWORD, { RaiseError=>1, AutoCommit=>0}) ; my $sth = $dbh->prepare($query) ; $sth->execute; my $result ; @result = ""; my $count = 0; while (my @row_ary = $sth->fetchrow_array) { $result[$count] = $row_ary[$0]; for (my $k=1; $k<@row_ary; $k++) { $result[$count] .= "\0"; $result[$count] .= $row_ary[$k]; } $count++; } $sth->finish; $dbh->disconnect; if (length($result[0]) == 0) { return ; } else { return @result ; } } #============ sub columndefs_dat2proto { my ($columndat) = @_ ; my ($colname, $coltype, $collen, $colprec, $colscale) = split(/\0/, $columndat) ; my $range ; if ($colprec ne "") { if ($colscale ne "" && $colscale != 0) { $range = "($colprec,$colscale)" ; } else { $range = "($colprec)" ; } } elsif ($coltype eq "CHAR" || $coltype eq "VARCHAR" || $coltype eq "VARCHAR2" || $coltype eq "RAW" ) { if ($collen ne "" && $collen != 0) { $range = "($collen)" ; } else { $range = "" ; } } else { $range = "" ; } $coltype .= $range ; return ($colname, $coltype) ; }