view Lib/Deployment/CDBI.pm @ 134:44977efed303

Significant performance optimizations Fixed recursion problems due converting objects to JSON Added cache support for the templates Added discovery feature for the web methods
author wizard
date Mon, 21 Jun 2010 02:39:53 +0400
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;