view Lib/Deployment/CDBI.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 03e58a454b20
children 16ada169ca75
line wrap: on
line source

use strict;
package Deployment::CDBI;
use Common;
use DBI;
use Schema::DataSource;
use Schema::DataSource::CDBIBuilder;

our @ISA = qw(Object);

BEGIN {
    DeclareProperty DataSchemaFile => ACCESS_READ;
    DeclareProperty DataSourceDir => ACCESS_READ;
    DeclareProperty DSNamespace => ACCESS_READ;
    DeclareProperty DBConnection => ACCESS_READ;
    DeclareProperty DBTraitsClass => ACCESS_READ;
}

sub CTOR {
    my ($this,%args) = @_;
    
    $this->{$DataSchemaFile} = $args{'DataSchemaFile'} or die new Exception('A data shema file is required');
    $this->{$DataSourceDir} = $args{'DataSourceDir'} or die new Exception('A directory for a data source is required');
    $this->{$DSNamespace} = $args{'DSNamespace'} || 'DataSource';
    $this->{$DBTraitsClass} = $args{'DBTraitsClass'} or die new Exception('A DBTraitsClass is required');
    $this->{$DBConnection} = $args{'DBConnection'};
}

sub Update {
    my ($this) = @_;
    
    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->{$DSNamespace} ) =~ s/::/\//g;
    $schemaDS->DataSourceBuilder->WriteModules($this->{$DataSourceDir}.$fname.'.pm',$prefix);
    
    if ($this->{$DBConnection}) {
        
        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 meta table");
        }
        
        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);
        
        $schemaDBOld->Dispose;
    }
    $schemaDB->Dispose;
}

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;