view Lib/Deployment/CDBI.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children
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;