Mercurial > pub > Impl
view Lib/Deployment/Batch/CDBIUpdate.pm @ 125:a4b0a819bbda
Small fixes in IMPL::DOM::Schema
author | wizard |
---|---|
date | Thu, 10 Jun 2010 17:43:51 +0400 |
parents | 16ada169ca75 |
children | 76515373dac0 |
line wrap: on
line source
use strict; package Deployment::Batch::CDBIUpdate; use Common; use base qw(Deployment::Batch::Generic); use DBI; use Schema::DataSource; use Schema::DataSource::CDBIBuilder; BEGIN { DeclareProperty DataSchemaFile => ACCESS_READ; DeclareProperty DataSourceDir => ACCESS_READ; DeclareProperty DSNamespace => ACCESS_READ; DeclareProperty DBConnection => ACCESS_READ; DeclareProperty DBTraitsClass => ACCESS_READ; DeclareProperty SchemaPrev => ACCESS_READ; } sub CTOR { my ($this,%args) = @_; $this->{$DataSchemaFile} = $args{'Source'} or die new Exception('A data shema file is required'); $this->{$DataSourceDir} = $args{'Output'} or die new Exception('A directory for a data source is required'); $this->{$DSNamespace} = $args{'Namespace'} || 'DataSource'; $this->{$DBTraitsClass} = $args{'DBTraits'} or die new Exception('A DBTraitsClass is required'); (my $modname = $args{'DBTraits'}.'.pm') =~ s/::/\//g; $this->Log("Loading DBTraits '$modname'"); require $modname; } sub Run { my ($this) = @_; $this->{$DBConnection} = $this->Context->{Connection}; my $prefix = $this->{$DSNamespace}.'::'; my $schemaDS = new Schema::DataSource(DataSourceBuilder => new Schema::DataSource::CDBIBuilder); $schemaDS->BuildSchema($this->{$DataSchemaFile}); my $schemaDB = $schemaDS->DataSourceBuilder->BuildDBSchema(); (my $fname = $this->{$DataSourceDir}.$this->{$DSNamespace}.'.pm') =~ s/::/\//g; # we are in the immediate mode, so the file will be backupped immediatelly; $this->Log("Backup $fname"); Deployment::Batch->Backup( File => $fname ); $this->Log("Write the datasource '$this->{$DSNamespace}' to '$this->{$DataSourceDir}'"); $schemaDS->DataSourceBuilder->WriteModules($fname,$prefix); if ($this->{$DBConnection}) { $this->Log("Update the database '$this->{$DBConnection}[0]'"); $this->{$SchemaPrev} = $this->UpdateDBToSchema($schemaDB); } $schemaDB->Dispose; } sub Rollback { my ($this) = @_; if ($this->{$SchemaPrev}) { $this->Log("Rallback the DB schema"); $this->UpdateDBToSchema($this->{$SchemaPrev})->Dispose; $this->{$SchemaPrev}->Dispose; delete $this->{$SchemaPrev}; } } sub UpdateDBToSchema { my ($this,$schemaDB) = @_; my $dbh = DBI->connect(@{$this->{$DBConnection}}) or die new Exception('Failed to connect to the database',@{$this->{$DBConnection}}); my $SchemaSource; if (UNIVERSAL::can($this->{$DBTraitsClass},'GetMetaTable')) { $SchemaSource = new Deployment::CDBI::SQLSchemeSource (MetaTable => $this->{$DBTraitsClass}->GetMetaTable($dbh)); } else { die new Exception("Can't get a meta table",$this->{$DBTraitsClass}); } my $schemaDBOld = $SchemaSource->ReadSchema($schemaDB->Name); my $updater = $this->{$DBTraitsClass}->new(SrcSchema => $schemaDBOld, DstSchema => $schemaDB); $updater->UpdateSchema(); $dbh->do($_) or die new Exception('Failed to execute the sql statement', $_) foreach $updater->Handler->Sql; $SchemaSource->SaveSchema($schemaDB); return $schemaDBOld; } sub DESTROY { my $this = shift; $this->{$SchemaPrev}->Dispose if $this->{$SchemaPrev}; } package Deployment::CDBI::SQLSchemeSource; use Common; use Data::Dumper; use MIME::Base64; use Storable qw(nstore_fd fd_retrieve); our @ISA = qw(Object); BEGIN { DeclareProperty MetaTable => ACCESS_NONE; } sub ReadSchema { my ($this,$name) = @_; my $schema = decode_base64($this->{$MetaTable}->ReadProperty("db_schema_$name")); if ($schema) { open my $hvar,"<",\$schema or die new Exception("Failed to create a handle to the variable"); return fd_retrieve($hvar); } else { return new Schema::DB(Name => $name, Version => 0); } } sub SaveSchema { my ($this,$schema) = @_; my $name = $schema->Name; my $data = ""; { open my $hvar,">",\$data or die new Exception("Failed to create a handle to the variable"); nstore_fd($schema,$hvar); } $this->{$MetaTable}->SetProperty("db_schema_$name",encode_base64($data)); } 1;