这几天Perl的Template-Toolkit技术实现了自动生成程序的功能，跟大家共享！

项目背景我就不说了，因为这涉及公司机密，大家帮忙看看，这段代码还有改进的余地吗？这段时间请教了大家不少问题，在这里谢过了！把这段代码跟大家分享，以求共同改进！

#! /usr/bin/perl use strict; use File::Basename; # 该包用于取得程序的执行路径 use DBI; use DBD::Oracle qw(:ora_types); use Template; my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(); my $create_date; my $path_name; # 保存程序的执行路径 my $paragraph_name; my ($key, $value); my %dsn; my %owner; my %templatecfg; my ($source_table, $target_table, $rpt_month, $dept_id, $template_init, $template_refresh); my @map; my %importcfg; my $config; # 该变量保存Template引擎的配置参数 my $dbh; my $statement; my $sth; my $map_var; my $map_length; my $i; my ($column_name, $data_type, $data_length, $data_precision, $data_scale, $isnull, $pkey); my $tf_data_type; my $offset; my $last_data_length; my $fieldnumber; my @source_list; my @transform_list; my @target_list; my $template; my $vars; $year += 1900; $mon++; $mon  = sprintf("%02d", $mon); $mday = sprintf("%02d", $mday); $hour = sprintf("%02d", $hour); $min  = sprintf("%02d", $min); $sec  = sprintf("%02d", $sec); $create_date = $mon.'/'.$mday.'/'.$year.' '.$hour.':'.$min.':'.$sec;

my $pathname=dirname($0); open(FH, $pathname.'\config.ini')     or die "ERROR: Cannot open config file: $!";      while(<FH>) {   chomp();   next if(($_ =~ /^\s*$/) || ($_ =~ /^#/));  # 跳过空行和注释行   $_ =~ s/#.*//;      if(/^\s*\[\s*DSN\s*\]\s*$/i)   {       $paragraph_name = 'DSN';       next;   }   elsif(/^\s*\[\s*OWNER\s*\]\s*$/i)   {     $paragraph_name = 'OWNER';     next;   }   elsif(/^\s*\[\s*TEMPLATECFG\s*\]\s*$/i)   {     $paragraph_name = 'TEMPLATECFG';     next;   }   elsif(/^\s*\[\s*MAP\s*\]\s*$/i)   {     $paragraph_name = 'MAP';     next;   }   elsif(/^\s*\[\s*IMPORTCFG\s*\]\s*$/i)   {     $paragraph_name = 'IMPORTCFG';     next;   }      if($paragraph_name eq 'DSN')   {     ($key, $value) = $_ =~ /^\s*(\w+)\s*=\s*(\w+)\s*$/;     $dsn{uc("$key")} = "$value";   }   elsif($paragraph_name eq 'OWNER')   {     ($key, $value) = $_ =~ /^\s*(\w+)\s*=\s*(\w+)\s*$/;     $owner{uc("$key")} = "$value";   }   elsif($paragraph_name eq 'TEMPLATECFG')   {

($key, $value) = $_ =~ /^\s*(\w+)\s*=\s*(\S+)\s*$/;     $templatecfg{uc("$key")} = "$value";   }   elsif($paragraph_name eq 'MAP')   {     ($source_table, $target_table, $rpt_month, $dept_id, $template_init, $template_refresh) = $_ =~     /^\s*(\w+)\s*(\w+)\s*(\w+)\s*(\w+)\s*(\S+)\s*(\S+)\s*$/;     push(@map, {SOURCE_TABLE     => "$source_table",                 TARGET_TABLE     => "$target_table",                 RPT_MONTH        => "$rpt_month",                 DEPT_ID          => "$dept_id",                 TEMPLATE_INIT    => "$template_init",                 TEMPLATE_REFRESH => "$template_refresh",                });   }   elsif($paragraph_name eq 'IMPORTCFG')   {     ($key, $value) = $_ =~ /^\s*(\w+)\s*=\s*(\S+)\s*$/;     $importcfg{uc("$key")} = "$value";   } } close(FH); $config = { INCLUDE_PATH => $templatecfg{'INCLUDE_PATH'},             OUTPUT_PATH  => $templatecfg{'OUTPUT_PATH'},             RE_CHOMP    => 1,           }; $dbh=DBI->connect("dbi:Oracledsn{'DATASOURCE'}", "$dsn{'USERNAME'}", "$dsn{'PASSWORD'}"); $dbh->do("alter session set NLS_DATE_FORMAT='YYYY-MM-DD'"); $map_length = @map; $i = 0; while($map_length) {   $map_var = $map[$i];   $map_length--;   $i++;      $statement = qq{select a.column_name,                          a.data_type,                          a.data_length,                          a.data_precision,                          a.data_scale,                          decode(a.nullable, 'Y', 'NULL', 'N', 'NOTNULL') isnull,                          decode(b.constraint_type, 'P', 'PRIMARY KEY', NULL, 'NOT A KEY') pkey                   from all_tab_columns a,                                         (select aa.constraint_type,

bb.column_name                                          from all_constraints aa, all_cons_columns bb                                          where aa.owner = bb.owner                                            and aa.constraint_name = bb.constraint_name                                            and aa.owner = '$owner{SOURCE_OWNER}'                                            and aa.constraint_type = 'P'                                            and bb.table_name = '$map_var->{SOURCE_TABLE}') b                   where a.table_name = '$map_var->{SOURCE_TABLE}'                     and a.owner = '$owner{SOURCE_OWNER}'                     and a.column_name = b.column_name(+)                   order by a.column_id};                      $sth=$dbh->prepare($statement);   $sth->execute();      $offset = 0;   $last_data_length = 0;   $fieldnumber = 0;   while(($column_name, $data_type, $data_length, $data_precision, $data_scale, $isnull, $pkey) = $sth->fetchrow())   {     if($data_type eq 'NUMBER')     {         if(("$data_precision" eq "") && ("$data_scale" eq ""))         {           $data_type = 'number';           $data_length = '15';           $data_precision = '15';           $data_scale = '0';                      $tf_data_type = 'double';       }       else       {           $data_type = 'number(p,s)';           if(!$data_precision)           {             $data_length = '38';             $data_precision = '38';           }           else           {             $data_length = $data_precision;           }                      $tf_data_type = 'decimal';       }     }     else     {

光一大堆代码，连说明都没有，谁知道你这是干啥的？

if(($data_type eq 'CHAR') || ($data_type eq 'VARCHAR2'))
      {
        $data_precision = $data_length;
        $data_scale = '0';
        
        $tf_data_type = 'string';
      }
      else
      {
        $data_length = '19';
        $data_precision = '19';
        $data_scale = '0';
        
        $tf_data_type = 'date/time';
      }
      $data_type = lc($data_type);
    }
   
    $offset += $last_data_length;
    $last_data_length = $data_length;
    $fieldnumber++;
   
    push(@source_list, {DATATYPE       => "$data_type",
                        FIELDNUMBER    => "$fieldnumber",
                        KEYTYPE        => "$pkey",
                        LENGTH         => "$data_length",
                        NAME           => "$column_name",
                        NULLABLE       => "$isnull",
                        OFFSET         => "$offset",
                        PHYSICALLENGTH => "$data_length",
                        PHYSICALOFFSET => "$offset",
                        PRECISION      => "$data_precision",
                        SCALE          => "$data_scale",
                       });
  
   
   
    push(@transform_list, {DATATYPE    => "$tf_data_type",
                           NAME        => "$column_name",
                           PRECISION   => "$data_precision",
                           SCALE       => "$data_scale",
                          });
  }
   
   
  $statement = qq{select a.column_name,
                         a.data_type,
                         a.data_length,
                         a.data_precision,
                         a.data_scale,
                         decode(a.nullable, 'Y', 'NULL', 'N', 'NOTNULL') isnull,
                         decode(b.constraint_type, 'P', 'PRIMARY KEY', NULL, 'NOT A KEY') pkey
                  from all_tab_columns a,
                                        (select aa.constraint_type,
                                                bb.column_name
                                         from all_constraints aa, all_cons_columns bb
                                         where aa.owner = bb.owner
                                           and aa.constraint_name = bb.constraint_name
                                           and aa.owner = '$owner{TARGET_OWNER}'
                                           and aa.constraint_type = 'P'
                                           and bb.table_name = '$map_var->{TARGET_TABLE}') b
                  where a.table_name = '$map_var->{TARGET_TABLE}'
                    and a.owner = 'owner{TARGET_OWNER}'
                    and a.column_name = b.column_name(+)
                  order by a.column_id};
                  
  $sth=$dbh->prepare($statement);
  $sth->execute();
  
  $fieldnumber = 0;
  while(($column_name, $data_type, $data_length, $data_precision, $data_scale, $isnull, $pkey) = $sth->fetchrow())
  {
    if($data_type eq 'NUMBER')
    {
            if(("$data_precision" eq "") && ("$data_scale" eq ""))
            {
              $data_type = 'number';
              $data_precision = '15';
              $data_scale = '0';
      }
      else
      {
              $data_type = 'number(p,s)';
              if(!$data_precision)
              {
                $data_precision = '38';
              }
              else
              {
                $data_length = $data_precision;
              }
             
              $tf_data_type = 'decimal';
      }
    }
    else
    {
      
      if(($data_type eq 'CHAR') || ($data_type eq 'VARCHAR2'))
      {
        $data_precision = $data_length;
        $data_scale = '0';
      }
      else
      {
        $data_precision = '19';
        $data_scale = '0';
      }
      $data_type = lc($data_type);
    }
   
    $fieldnumber++;
  
    push(@target_list, {DATATYPE       => "$data_type",
                        FIELDNUMBER    => "$fieldnumber",
                        KEYTYPE        => "$pkey",
                        NAME           => "$column_name",
                        NULLABLE       => "$isnull",
                        PRECISION      => "$data_precision",
                        SCALE          => "$data_scale",
                       });
  }
  
  $template = Template->new($config);
  $vars = {
   source_table   => $map_var->{'SOURCE_TABLE'},
   target_table   => $map_var->{'TARGET_TABLE'},
   rpt_month      => $map_var->{'RPT_MONTH'},
   dept_id        => $map_var->{'DEPT_ID'},
   create_date    => $create_date,
   source_list    => \@source_list,
   target_list    => \@target_list,
   transform_list => \@transform_list,
   };
      
  $template->process("$map_var->{'TEMPLATE_INIT'}",
                   $vars,
                   'wf_'.lc($map_var->{'TARGET_TABLE'}).'_init.xml')
                   || die $template->error();
  $template->process("$map_var->{'TEMPLATE_REFRESH'}",
                   $vars,
                   'wf_'.lc($map_var->{'TARGET_TABLE'}).'_refresh.xml')
                   || die $template->error();
                  
}
print "\nInformatica对象脚本（*.xml文件）生成结束!\n\n";

$sth->finish;
$dbh->disconnect
      || die $DBI::errstr;

####生成Informatica的XML脚本结束####

####开始导入Informatica的XML脚本####

if($ARGV[0] eq '-i')
{
  my $control_vars;
  my $bat_vars;
  
  $config = { INCLUDE_PATH => "$pathname",
              OUTPUT_PATH  => "$pathname",
              PRE_CHOMP    => 1,
            };
            
  $control_vars = {
    SOURCEFOLDERNAME     => $importcfg{'SOURCEFOLDERNAME'},
    SOURCEREPOSITORYNAME => $importcfg{'SOURCEREPOSITORYNAME'},
    TARGETFOLDERNAME     => $importcfg{'TARGETFOLDERNAME'},
    TARGETREPOSITORYNAME => $importcfg{'TARGETREPOSITORYNAME'},
  };
  
  $bat_vars = {
    ROOT                   => $importcfg{'ROOT'},
    INFA_DOMAINS_FILE      => $importcfg{'INFA_DOMAINS_FILE'},
    REPOSITORY_NAME        => $importcfg{'TARGETREPOSITORYNAME'},
    GATEWAY_HOST           => $importcfg{'GATEWAY_HOST'},
    GATEWAY_PORT           => $importcfg{'GATEWAY_PORT'},
    USERNAME               => $importcfg{'USERNAME'},
    PASSWORD               => $importcfg{'PASSWORD'},
    GENERATED_SCRIPTS_PATH => $templatecfg{'OUTPUT_PATH'},
    CONTROL_FILE_PATH      => $pathname,
    IMPORTLOG_FILE_PATH    => $importcfg{'IMPORTLOG_FILE_PATH'},
    MAP_LIST               => \@map,
  };
  
  $template = Template->new($config);

  $template->process("control.tt2",
                   $control_vars,
                   'control.xml')
                   || die $template->error();
  $template->process("import.tt2",
                   $bat_vars,
                   'import.bat')
                   || die $template->error();
                  
  print "\n导入Informatica对象脚本（import.bat文件）生成结束!\n\n";
   
   

}
elsif(($ARGV[0] ne '-i') && (defined $ARGV[0]))
{
  print "无效的导入参数，导入时输入-i参数\n";
}

目标：自动生成程序
就是用程序生成程序

看不懂。

..生成什么程序？
根据什么生成？
输入输出大家都不知道..

这是商业项目，具体内容不便透漏，请原谅，代码太多了，一次贴不上，帮忙分析分析语法吧，有没有可以改进的地方