Edit D:\app\Administrator\product\11.2.0\dbhome_1\sysman\admin\emdrep\bin\Component.pm

#################################################################################
#
# $Header: Component.pm 23-mar-2007.09:29:52 chyu Exp $
#
# Component.pm
#
# Copyright (c) 2003, 2007, Oracle. All rights reserved.  
#
#    NAME
#      Component.pm - <one-line expansion of the name>
#
#    DESCRIPTION
#      <short description of component this file declares/defines>
#
#    NOTES
#      <other useful comments, qualifications, etc.>
#
#    MODIFIED   (MM/DD/YYYY)
#       chyu       07/21/06 - adding the RELEASE_VERSION mechanism to the 
#                             process 
#       chyu       03/23/07 - Backport chyu_bug-5404537 from main
#       chyu       08/10/06 - adding the condition logic
#       chyu       12/19/05 - XbranchMerge chyu_bug-4733827 from main 
#       chyu       11/29/05 - adding the upgrade type constants, and a new 
#                             boolean function to determine whether or not 
#                             there is any upgrade scripts 
#       tthakur    08/08/05 - adding post_data_upgrade 
#       chyu       07/25/05 - 
#       gsbhatia   07/26/05 - Fix code reach for + case 
#       gsbhatia   07/23/05 - Modify warning comment 
#       ktlaw      07/22/05 - add isEqual and fix # issue 
#       gsbhatia   07/23/05 - Modify sqlHash. Add support basedir as namespace 
#       gsbhatia   07/23/05 - Add pre_data|schema_downgrade support 
#       gsbhatia   07/22/05 - Use/put getters/setters
#       gsbhatia   07/21/05 - Add pre_schema_upgrade and pre_data_upgrade support 
#       gsbhatia   07/19/05 - Refactor code
#       ktlaw      07/20/05 - fix recreate
#       gsbhatia   07/18/05 - Add support for bad headers. Add logging support
#       ktlaw      07/16/05 - fix method call on undefined value error 
#       gsbhatia   06/26/05 - New repmgr impl 
#       ktlaw      06/16/05 - fix regex to get only files that ends with sql 
#                             or plb 
#       ktlaw      06/14/05 - fix closure problem 
#       gsbhatia   04/06/05 - Use custom impl of trivial xml parser for component.xml instead of XML::Parser
#       gsbhatia   01/20/05 - minor fixes 
#       gsbhatia   01/18/05 - Fill skeleton code 
#       ktlaw      01/17/05 - 
#       ktlaw      01/14/05 - add comments 
#       ktlaw      01/13/05 - ktlaw_new_repmgr
#       ktlaw      01/10/05 - created
################################################################################

package Component;

use strict;
use lib "$ENV{'ADE_VIEW_ROOT'}/emcore/scripts/install";
use SQLFile;
use Directory;
use File::Basename;
use Logger;

my @CREATE_TYPES = ( 'types','tables','indexes', 'pkgdefs','funcs','procs','views','pkgbodys', 'init', 'triggers','type_bodys','synonyms'); 
my @RECREATE_TYPES = ('pkgdefs', 'funcs', 'procs', 'views', 'pkgbodys', 'triggers', 'type_bodys');
my @UPGRADE_TYPES = ( 'schema_upgrade', 'data_upgrade', 'pre_schema_upgrade', 'pre_data_upgrade', 'post_data_upgrade');
my %TYPE_ORDER ;
my $CONDITION_OPTIONAL = 1;
my $i = 0;

foreach my $h (@CREATE_TYPES)
{
  $TYPE_ORDER{$h} = $i++; 
}

sub getLogger{
  my $self = shift;
  return $self->{'logger'};
}

sub setLogger{
  my ($self, $v) = @_;
  $self->{'logger'} = $v;
}

sub getDep{
  my $self = shift;
  return $self->{'dep'};
}

sub setDep{
  my ($self, $v) = @_;
  $self->{'dep'} = $v;
}
 
sub getDependencies{
  my $self = shift;
  return $self->getDep;
}

sub setDependencies{
  my ($self, $v) = @_;
  $self->setDep($v);
}

sub getName{
  my $self = shift;
  return $self->{'name'};
}

sub setName{
  my ($self, $v) = @_;
  $self->{'name'} = $v;
}

sub getVer{
  my $self = shift;
  return $self->{'ver'};
}

sub setVer{
  my ($self, $v) = @_;
  $self->{'ver'} = $v;
}

sub getVersion{
  my $self = shift;
  return $self->getVer;
}

sub setVersion{
  my ($self, $v) = @_;
  if ($v eq "RELEASE_VERSION")
  {
    $v = $self->getReleaseVersion();
  }
  $self->setVer($v);
}

sub getSql{
  my $self = shift;
  return $self->{'sql'};
}

sub setSql{
  my ($self, $v) = @_;
  $self->{'sql'} = $v;
}

sub getSqlHash{
  my $self = shift;
  return $self->{'sqlHash'};
}

sub setSqlHash{
  my ($self, $v) = @_;
  $self->{'sqlHash'} = $v;
}

sub getComponentRoot{
  my $self = shift;
  return $self->{'componentRoot'};
}

sub setComponentRoot{
  my ($self, $v) = @_;
  $self->{'componentRoot'} = $v;
}

sub setCondition{
  my ($self, $key, $value) = @_;
  $self->{'condition'}{$key} = $value;
}

sub setOptionalCondition{
  my ($self, $key, $value) = @_;
  $self->{'optional_condition'}{$key} = $value;
}

sub getCondition{
  my ($self, $key) = @_;
  if (defined $self->{'condition'}) {
    return $self->{'condition'}{$key};
  }
  return undef;
}

sub getOptionalCondition{
  my ($self, $key) = @_;
  if (defined $self->{'optional_condition'}) {
    return $self->{'optional_condition'}{$key};
  }
  return undef;
}

sub mustHaveCondition{
  $CONDITION_OPTIONAL = 0;
}

sub conditionOptional{
  $CONDITION_OPTIONAL = 1;
}

sub setReleaseVersion{
  my ($self, $version) = @_;
  $self->{'release_version'} = $version;
}

sub getReleaseVersion{
  my $self = shift;
  return $self->{'release_version'};
}

sub new
{
  my ($pkg) = @_;
  my $self = {};
  bless $self, $pkg;
  bless $self, $pkg;
  $self->setDep({});
  $self->setSql([]);
  $self->setSqlHash({});
  $self->setLogger(Logger->new());    
  return $self;
}

sub log{
  my ($self, $msg) = @_;
  $self->getLogger->infoln("$msg");
}

sub init
{
  my $self = shift ;  
  my ($file) = @_ ;
  
  #set component root
  $self->setComponentRoot(dirname($file));

#parse component.xml and populate this object here.

#TODO: Parse using XML library. Commented for now. Remove once
  #TODO: decision as to whether XML::Parser will be available in OH
  #TODO: is made.
  #use XML::Parser;
  #$self->evalWithExpatParser($file);
  
  #TODO: Implements custom xml parsing. Remove if XML::Parser is used above
  #TODO: Warning. This doesn't catch any XML formatting errors.
  $self->evalWithCustomParser($file);

#return 1 if parse successful
  return 1 unless($@);
  
  #warn if parse failed. Then return 0
  $self->getLogger->warn("Error while parsing: $@");
  return 0;
}

sub evalWithExpatParser{
  my $self = shift;
  my ($file) = @_;
  #use Expat parsing
  eval{
    my $parser = new XML::Parser(Style => 'Tree');
    my $doc = $parser->parsefile($file);
    $self->setName($doc->[1][0]{'name'});                           
    $self->setVersion($doc->[1][0]{'version'});                     
    for (my $i=3; $i<=$#{$doc->[1]}; $i+=4){
      $self->addDependency($doc->[1][$i+1][0]{'name'}, $doc->[1][$i+1][0]{'version'});	    
    }
  };
}

sub evalWithCustomParser{
  my $self = shift;
  my ($file) = @_;
  
  #use custom parsing
  eval{
    open(FD, $file) or die "can't open $file";
    while (<FD>){
      if (/\s*<\s*component\s+name\s*=\s*(?:"(.*?)"|'(.*?)')\s+version\s*=\s*(?:"(.*?)"|'(.*?)')/){
        $self->setName((defined($1))?$1:$2);
        $self->setVersion((defined ($3))?$3:$4);
      }elsif (/\s*<\s*depends\s+name\s*=\s*(?:"(.*?)"|'(.*?)')\s+version\s*=\s*(?:"(.*?)"|'(.*?)')/){
        my $name = (defined ($1))?$1:$2;
        my $ver = (defined ($3))?$3:$4;
        if ($ver eq "RELEASE_VERSION")
        {
          $ver = $self->getReleaseVersion();
        }
        $self->addDependency($name, $ver);    
      }
    }
    close(FD);
  }
}

sub addDependency
{
  my $self = shift ;  
  my ($name,$ver) = @_;
  $self->getDep->{$name} = $ver ;
}

# return a list of SQLFiles that matches a list of types
sub getSQLFilesByTypes
{
  my $self = shift ;  
  my @list = @_ ;

my %map ;
  foreach my $h (@list)
  {
    $map{$h} = 1 ;
  }  
  my @ret ;
  foreach my $h (@{$self->getSql})
  {
    if(defined $map{$h->getType})
    {
      my $satisfiedConditions = 1;
      if ($h->hasConditions() eq 1) {
        for my $key ($h->getConditionKeys)
        {
          $self->getLogger->traceln('cond:'.$key.':'.$h->getCondition($key));
          if (defined $self->getCondition($key)) {
            if (uc $h->getCondition($key) ne uc $self->getCondition($key)) {
              $satisfiedConditions = 0;
            }
          } else {
            if (!defined $self->getOptionalCondition($key)) {
              $satisfiedConditions = 0;
            }
          }
          $self->getLogger->traceln('cond2:'.$satisfiedConditions);
          if (defined $self->getOptionalCondition($key)) {
            if (defined $h->getCondition($key)) {
                  if (uc $h->getCondition($key) ne uc $self->getOptionalCondition($key)) {
                        $satisfiedConditions = 0;
                      }
                }
          }
          $self->getLogger->traceln('cond3:'.$satisfiedConditions);
        }
      }
      if ($CONDITION_OPTIONAL == 0) {
        if ($h->hasConditions() eq 0) {
          $satisfiedConditions = 0;
        }
      }
      $self->getLogger->traceln($h->getPath.':'.$satisfiedConditions);
      if ($satisfiedConditions eq 1) {
        push(@ret, $h);
      }
    }
  }  
  return @ret ;
}

sub list
{
  my $self = shift ;  
  sub printFile
  {
    (my $file) = @_;
    my $sql = SQLFile->new();
    $sql->setLogger($self->getLogger);
    $sql->init($file);
    $sql->dumpObject if($sql->getIsValid);
  }
  my $d = new Directory;
  $d->setPath($self->getComponentRoot);
  $d->find(\&printFile,'true','\.(plb|sql)$');        
}

sub createParseAndAdd
{
  my $self = shift;
  return sub 
  {
    my $file = shift;
    if($file !~ /\#/)
    {
      my $sql = SQLFile->new();
      $sql->setLogger($self->getLogger);
      $sql->setComponentRoot($self->getComponentRoot);
      #Initialize the SQL object
      #Most sql file relatived logic happens here
      #For instance, parsing the sql file and populating the 
      #SQLFile object
      $sql->init($file);
      if($sql->getIsValid)
      {
  	my $key = $sql->getPathRelativeToBasedir;
        my $basedir = $sql->getBasedir;
        #Initialize hash of hash
        #Create a hash of basedir namespace
        $self->getSqlHash->{qq($basedir)}={} if (!defined $self->getSqlHash->{qq($basedir)});
  	$self->getSqlHash->{qq($basedir)}->{qq($key)}=$sql;
  	push(@{$self->getSql}, $sql);
      }
    }
  }
}

sub parse
{
  my $self = shift;  
  #Initialize the array of valid SQLs
  $self->setSql([]);
  my $d = new Directory;
  $d->setPath($self->getComponentRoot);
  $d->find(createParseAndAdd($self),'true','\.(plb|sql)$'); 
  #All the valid SQL files have been loaded into their object model
  #Now, for each valid sql, set the Augmented Functional Unit
  #(For position based sorting)
  $self->log("\n\n");
  $self->log("********** Start header analysis ****************");
  for my $sql (@{$self->getSql}){
    $self->setAFU($sql);  
  }
  $self->log("********** End header analysis ****************");
  $self->log("\n\n");

#Dump sql object model for debuggin purpose. This represent the processed 
  #SQL objects ready for sorting
  $self->log("\n\n");
  $self->log("The following dump is meant for debugging purposes");
  $self->log("********** Start SQL objects dump ****************");
  for my $sql (@{$self->getSql}){
    $self->log("\n\n");
    $self->log("Dumping object model for: ${\$sql->getPath}");
    $sql->dumpObject;
  }
  $self->log("********** End SQL objects dump ****************");

}

sub setAFU{
  my $self = shift;
  my $sql = shift;
  #Return if afu for the sql has already been set.
  #This might have occured if the sql has already been processed during
  #the recursive call
  return if ($sql->getAfuProcessed);
  #Mark SQL as processed (for AFU)
  $sql->setAfuProcessed(1);
  $self->log("Analyzing header for: ${\$sql->getPath}");
  my $header = $sql->getHeader;
  $self->log("\tHeader: $header");
  if (defined $sql->getPos){
    my $pos = $sql->getPos;
    if ($pos =~ /(.*)(\+|\-)/){
      my ($prev, $sign) = ($1, $2);
      #The case when we have more than just + or -
      if($prev ne ''){
        my $basedir = $sql->getBasedir;
	my $prevSQL = $self->getSqlHash->{qq($basedir)}->{qq($prev)};
	#Sign was prefixed to some string
	#Does this string represent a valid SQL?
	#Or is it a typo? Check ofor it.
      	if (!defined $prevSQL){
   	  $self->log(qq(\tWARNING: Bad pos attribute in repmgr header.));
   	  $self->log(qq(\tWARNING: Either there is a non-existent file: "$prev" in position attribute: "$pos"));
   	  $self->log(qq(\tWARNING: OR there is a bad repmgr header/no repmgr header in file: "$prev"));
          $self->log(qq(\tWARNING: "${\$sql->getPath}" will be treated as if having no position attribute));
	  return;
        }
 	#OK, pos attribute contains an SQL which does exist. So load it
	#and process its afu. Because current SQL's afu will depend on
	#prev SQL's afu
        $self->setAFU($prevSQL);
        $sql->setAfuDir($prevSQL->getAfuDir);
	#Now, modify current SQL's afu based on the sign
      	if ($sign eq '+'){
          $sql->setAfuName($self->getMinMaxStr($prevSQL->getAfuName));
      	}else{
          $sql->setAfuName($self->getMaxMinStr($prevSQL->getAfuName));
      	}
      }
      #So, the pos attribute just cotains + or -
      #This is the trivial case, so set this SQL's afu appropriately
      else{
      	if ($sign eq '-'){
          $sql->setAfuDir([]);
          $sql->setAfuName(qq(@));
          $sql->setAfuExt(qq());
          return;
	}
        #Create an array which is guaranteed to lose during array comparison
        my @arr = (qq({));
        $sql->setAfuDir(\@arr);
        $sql->setAfuName(qq({));
        $sql->setAfuExt(qq());
      }
    }
  }
}

sub getMinMaxStr{
  my ($self, $str) = @_;
  return $str.qq(@);
}

sub getMaxMinStr{
  my ($self, $str) = @_;
  my $temp='';
  $temp=substr($str, 0, -1) if(length($str)>1);
  return $temp.chr(ord(substr($str, -1))-1).qq({);
}

sub printOrderedScripts{
  my ($self, $type, $sqlRef) = @_;
  my @sqls = @$sqlRef;
  $self->log("\n\n");
  $self->log("***** Start Final order for $type scripts in component: ${\$self->getName} *****");
  foreach my $sql (@sqls){
    $self->log(qq(${\$sql->getBasedir}/${\$sql->getPathRelativeToBasedir}));
  }
  $self->log("***** End Final order for $type scripts in component: ${\$self->getName} *****");
  $self->log("\n\n");
}

sub create
{
  my $self = shift ;  
  my ($session) = @_ ;
  my @sqls = sort sqlCmp $self->getSQLFilesByTypes(@CREATE_TYPES);
  $self->printOrderedScripts("create", \@sqls);
  $session->executeScripts(\@sqls);
}

sub post_create
{
  my $self = shift ;  
  my ($session) = @_ ;
  my @sqls = sort sqlCmp $self->getSQLFilesByTypes('post_creation');
  $self->printOrderedScripts("post_create", \@sqls);
  $session->executeScripts(\@sqls);
}

sub outofbox
{
  my $self = shift ;  
  my ($session) = @_ ;
  my @sqls = sort sqlCmp $self->getSQLFilesByTypes('out_of_box');
  $self->printOrderedScripts("outofbox", \@sqls);
  $session->executeScripts(\@sqls);
}

sub recreate
{
  my $self = shift ;  
  my ($session,$fromVersion) = @_ ;
  my @sqls = sort sqlCmp $self->getSQLFilesByTypes(@RECREATE_TYPES);
  $self->printOrderedScripts("recreate", \@sqls);
  $session->executeScripts(\@sqls);
}

sub schema_upgrade
{
  my $self = shift ;  
  my ($session,$fromVersion) = @_ ;
  my @schema = $self->getSQLFilesByTypes('schema_upgrade');
  $self->executeUpgrade($session,\@schema,$fromVersion,"schema_upgrade");
}

sub data_upgrade
{
  my $self = shift ;  
  my ($session,$fromVersion) = @_ ;
  my @data = $self->getSQLFilesByTypes('data_upgrade');
  $self->executeUpgrade($session,\@data,$fromVersion, "data_upgrade");
}

sub pre_schema_upgrade
{
  my ($self, $session, $fromVersion) = @_ ;
  my @data = $self->getSQLFilesByTypes('pre_schema_upgrade');
  $self->executeUpgrade($session,\@data,$fromVersion, "pre_schema_upgrade");
}

sub pre_data_upgrade
{
  my ($self, $session, $fromVersion) = @_ ;
  my @data = $self->getSQLFilesByTypes('pre_data_upgrade');
  $self->executeUpgrade($session,\@data,$fromVersion, "pre_data_upgrade");
}

sub pre_schema_downgrade
{
  my ($self, $session, $fromVersion) = @_ ;
  my @data = $self->getSQLFilesByTypes('pre_schema_downgrade');
  $self->executeUpgrade($session,\@data,$fromVersion, "pre_schema_downgrade");
}

sub pre_data_downgrade
{
  my ($self, $session, $fromVersion) = @_ ;
  my @data = $self->getSQLFilesByTypes('pre_data_downgrade');
  $self->executeUpgrade($session,\@data,$fromVersion, "pre_data_downgrade");
}

sub post_data_upgrade
{
  #post_data_upgrade is version neutral
  my ($self, $session) = @_ ;
  my @sqls = $self->getSQLFilesByTypes('post_data_upgrade');
  my @sorted = sort upgradeCmp @sqls; 
  $session->executeScripts(\@sorted);
  $self->printOrderedScripts("post_data_upgrade: ", \@sorted);
  
}

sub has_upgrade_scripts
{
  my ($self, $session) = @_ ;
  my @sqls = $self->getSQLFilesByTypes(@UPGRADE_TYPES);
  if (scalar @sqls > 0){
    return 1;
  }
  return 0; 
}

sub executeUpgrade
{
  my $self = shift ;  
  my ($session, $list, $from, $upgradeType) = @_ ;
  my %table;
  #first builds a table of version to file sets.
  foreach my $h (@$list)
  {
    my $ver = $self->canonicalizeVer($h->getVersion);
    $self->log("Canonicalizing: version ${\$h->getVersion} in file: ${\$h->getPath} to: version $ver"); 
    if(!defined $table{$ver})
    {
      $table{$ver} = () ;
    }
    push(@{$table{$ver}},$h);
  }
  #now sort all versions
  my @versions = sort verCmp keys %table;
  my @debugSQLs = ();
  #execute scripts that are greater than the from version
  foreach my $h (@versions)
  { 
    if(&verCmp($from,$h) < 0)
    {
      my $sqls = $table{$h};
      my @sorted = sort upgradeCmp @$sqls; 
      $session->executeScripts(\@sorted);
      push(@debugSQLs, @sorted);      
    }
  }
  $self->printOrderedScripts("$upgradeType (from version: $from)", \@debugSQLs);
}

sub canonicalizeVer{
  my ($self, $ver) = @_;
  my @x = split(/\./, $ver);
  my @y = reverse @x;
  foreach my $num (@y){
    last if ($self->atoi($num));
    pop @x; 
  }
  my $str = '';
  foreach my  $v (@x){
    $str.=$v.qq(\.);
  }
  return substr($str, 0, -1);
}

sub atoi {
  my ($self, $val) = @_;
  my $n=0;
  foreach my $d (split(//, $val)) {
    $n = $n*10 + $d;
  }
  return $n;
}

# Comparator functions
sub verCmp($$)
{
  my ($a,$b) = @_;
  my @x = split(/\./,$a);
  my @y = split(/\./,$b);
  my $n = @x ;
  my $m = @y ;
  my $i;
  if($n > $m)
  {
    for($i=0;$i<$n-$m;$i++)
    {
      push(@y,0);
    }
  }elsif($m > $n)
  {
    for($i=0;$i<$m-$n;$i++)
    {
      push(@x,0);
    }
  }
  $n = @x;
  return &arrayCmp(\@x, \@y);
}

sub arrayCmp{
  my ($a, $b) = @_;
  my $i = 0;
  while ($i<=$#$a && $i<=$#$b){
    if ($$a[$i] eq $$b[$i++]){next;}
     return $$a[--$i] cmp $$b[$i];
  }
  return $#$a-$i <=> $#$b-$i;
}

sub sqlCmp
{
  $TYPE_ORDER{$a->getType} <=> $TYPE_ORDER{$b->getType} 
  or
  $a->getSeq <=> $b->getSeq 
  or
  arrayCmp($a->getAfuDir, $b->getAfuDir)
  or 
  $a->getAfuName cmp $b->getAfuName
  or 
  $a->getAfuExt cmp $b->getAfuExt
}

sub upgradeCmp
{
  $a->getSeq <=> $b->getSeq 
  or
  arrayCmp($a->getAfuDir, $b->getAfuDir)
  or 
  $a->getAfuName cmp $b->getAfuName
  or 
  $a->getAfuExt cmp $b->getAfuExt 
}

sub isEqual()
{
  my $self = shift ;  
  my ($ver) = @_ ;
  my $ret = verCmp($self->getVersion(),$ver);
  return $ret == 0 ; 
}

Ms-Dos/Windows Unix Write backup

jsp File Browser version 1.2 by www.vonloesch.de