导出PL/SQL定义

#!/usr/bin/perl

#########################################################################################
# 用于查看或导出指定数据库模式下的PL/SQL代码创建SQL
# 2008-08029 16:42 刘洪天
# 使用方法：
#    perl export_plsql_sources.pl -i|-e|-v username/password@//ip/sid [exportfile]
#        -i 表示交互式操作指定的PL/SQL代码（脚本会要求你输入PL/SQL代码名称）；
#           当使用此选项执行此脚本时，可以指定[exportfile]参数，为保存导出的SQL脚本的文件名。
#           如果不指定[exportfile]参数，导出脚本将保存在sources.sql文件下（文件路径为当前目录）。
#        -e 表示导出创建本模式下的所有PL/SQL代码的SQL脚本；
#           当使用此选项执行此脚本时，可以指定[exportfile]参数，为保存导出的SQL脚本的文件名。
#           如果不指定[exportfile]参数，导出脚本将保存在sources.sql文件下（文件路径为当前目录）。
#        -v 表示查看创建本模式下的PL/SQL代码的SQL语句
#########################################################################################


use DBI;
use strict;

my $pl = @ARGV;
if($pl<2) {
    print "使用方式：perl export_plsql_sources.pl -i|-e|-v username/password@//ip/sid [exportfile]\n";
    print "其中：\n";
    print "\t-i表示查看或导出指定PL/SQL代码的SQL\n";
    print "\t-e表示导出创建本模式下的所有PL/SQL代码的SQL脚本\n";
    print "\t-v表示查看创建本模式下的PL/SQL代码的SQL语句\n\n";
    print "\t当使用-e或-i选项执行此脚本时，可以指定[exportfile]参数，为保存导出的SQL脚本的文件名。如果不指定，导出脚本将保存在sources.sql文件下（文件路径为当前目录）。\n";
    exit -1;
} elsif($ARGV[0] ne '-i' and $ARGV[0] ne '-e' and $ARGV[0] ne '-v') {
    print "选项错误，支持的选项：-i表示交互式处理PL/SQL代码；-e表示导出创建本模式下的所有PL/SQL代码的SQL脚本；-v表示查看创建本模式下的PL/SQL代码的SQL语句\n";
    exit -2;
}

my $option = $ARGV[0];
my $conn_str = $ARGV[1];

my $script = 'plsql_sources.sql';

my ($tmp1,$tmp2) = split '@',$conn_str;
my ($username,$password) = split '/',$tmp1;
my (undef,undef,$ip,$sid) = split '/',$tmp2;

print "username = $username\n";
print "password = $password\n";
print "ip = $ip\n";
print "sid = $sid\n\n";

my $dbstr = "dbi:Oracle:host=".$ip.";sid=".$sid;
my $conn = DBI->connect($dbstr,$username,$password) or die print "ERROR: $DBI::errstr\n";

if($option eq '-v') {
    my %sources;
    my $sql = "select name,type,text from user_source where type <> 'JAVA SOURCE' order by type,name,line";
    my $stmt = $conn->prepare($sql);
    $stmt->execute();
    while (my ($name,$type,$text) = $stmt->fetchrow_array()) {
        $sources{"$type\t$name"} .= $text;
    }
    foreach my $key (sort keys %sources) {
        my ($type,$name) = split "\t",$key;
        my $source_sql = "create or replace ".$sources{$key};
        print "$type\t$name :\n";
        $source_sql = pars_tail($source_sql);
        print "$source_sql\n";
        print "是否继续(Y/n)？";
        while(my $res = ) {
            chomp $res;
            if ( $res ne '') {
                if ( $res eq 'y' or $res eq 'Y' ) {
                    last;
                } elsif ( $res eq 'n' or $res eq 'N' ) {
                    $stmt->finish();
                    $conn->disconnect();
                    exit 0;
                }
            } else {
                last;
            }
            print "是否继续(Y/n)？";
        }
    }
    $stmt->finish();

} elsif($option eq '-e') {
    if(defined $ARGV[2]) {
        $script = $ARGV[2];
    }
    print "SQL脚本将以覆盖的方式输出到$script\n\n";
    open SCRIPT,">$script";
    my %sources;
    my $sql = "select name,type,text from user_source where type <> 'JAVA SOURCE' order by type,name,line";
    my $stmt = $conn->prepare($sql);
    $stmt->execute();
    while (my ($name,$type,$text) = $stmt->fetchrow_array()) {
        $sources{"$type\t$name"} .= $text;
    }
    foreach my $key (sort keys %sources) {
        my ($type,$name) = split "\t",$key;
        my $source_sql = "create or replace ".$sources{$key};
        print "正在导出PL/SQL代码：$key  ";
        print SCRIPT "--$type\t$name :\n";
        $source_sql = pars_tail($source_sql);
        print SCRIPT "$source_sql/\n\n";
        print "OK\n";
    }
    close SCRIPT;
    $stmt->finish();

} elsif($option eq '-i') {
    if(defined $ARGV[2]) {
        $script = $ARGV[2];
    }
    print "SQL脚本将以追加的方式输出到$script\n\n";
    open SCRIPT,">>$script";
    my %sources;
    my $sql = "select name,type,text from user_source where type <> 'JAVA SOURCE' and name like upper(?) order by type,name,line";
    my $stmt = $conn->prepare($sql);

    print "请输入PL/SQL代码名称（可以进行模糊匹配，退出请直接按回车）：";
    while (my $source_name_pattern = ) {
        chomp $source_name_pattern;
        exit 0 if $source_name_pattern eq '';
        $stmt->execute($source_name_pattern);
        while (my ($name,$type,$text) = $stmt->fetchrow_array()) {
            $sources{"$type\t$name"} .= $text;
        }
        foreach my $key (sort keys %sources) {
            my ($type,$name) = split "\t",$key;
            my $source_sql = "create or replace ".$sources{$key};
            print "$type\t$name :\n";
            #print "$source_sql;\n/\n\n";
            print "是否导出此PL/SQL代码(Y/n)？";
            while(my $res = ) {
                chomp $res;
                if ( $res ne '') {
                    if ( $res eq 'y' or $res eq 'Y' ) {
                        print "正在导出PL/SQL代码：$key  ";
                        print SCRIPT "--$type\t$name :\n";
                        $source_sql = pars_tail($source_sql);
                        print SCRIPT "$source_sql/\n\n";
                        print "OK\n";
                        last;
                    } elsif ( $res eq 'n' or $res eq 'N' ) {
                        last;
                    }
                } else {
                    print "正在导出PL/SQL代码：$key  ";
                    print SCRIPT "--$type\t$name :\n";
                    $source_sql = pars_tail($source_sql);
                    print SCRIPT "$source_sql/\n\n";
                    print "OK\n";
                    last;
                }
                print "是否导出此PL/SQL代码(Y/n)？";
            }
        }
        print "请输入PL/SQL代码名称（可以进行模糊匹配，退出请直接按回车）：";
    }
    close SCRIPT;
    $stmt->finish();

}


$conn->disconnect();

print "FINISHED!\n";
exit 0;


# 令字符串以 ";\n" 结尾
sub pars_tail() {
    my $src = shift;
    return "\n;\n" if ! defined $src;
    my $tail = substr($src,length($src)-1);
    if($tail eq "\n") {
        $src = substr($src,0,length($src)-1);
        $src = pars_tail($src);
    } else {
        if($tail eq ";") {
            $src .= "\n";
        } else {
            $src .= "\n;\n";
        }
    }
    return $src;
}