Mercurial > pub > Impl
comparison Lib/Deployment/CDBI.pm @ 0:03e58a454b20
Создан репозитарий
| author | Sergey |
|---|---|
| date | Tue, 14 Jul 2009 12:54:37 +0400 |
| parents | |
| children | 16ada169ca75 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:03e58a454b20 |
|---|---|
| 1 use strict; | |
| 2 package Deployment::CDBI; | |
| 3 use Common; | |
| 4 use DBI; | |
| 5 use Schema::DataSource; | |
| 6 use Schema::DataSource::CDBIBuilder; | |
| 7 | |
| 8 our @ISA = qw(Object); | |
| 9 | |
| 10 BEGIN { | |
| 11 DeclareProperty DataSchemaFile => ACCESS_READ; | |
| 12 DeclareProperty DataSourceDir => ACCESS_READ; | |
| 13 DeclareProperty DSNamespace => ACCESS_READ; | |
| 14 DeclareProperty DBConnection => ACCESS_READ; | |
| 15 DeclareProperty DBTraitsClass => ACCESS_READ; | |
| 16 } | |
| 17 | |
| 18 sub CTOR { | |
| 19 my ($this,%args) = @_; | |
| 20 | |
| 21 $this->{$DataSchemaFile} = $args{'DataSchemaFile'} or die new Exception('A data shema file is required'); | |
| 22 $this->{$DataSourceDir} = $args{'DataSourceDir'} or die new Exception('A directory for a data source is required'); | |
| 23 $this->{$DSNamespace} = $args{'DSNamespace'} || 'DataSource'; | |
| 24 $this->{$DBTraitsClass} = $args{'DBTraitsClass'} or die new Exception('A DBTraitsClass is required'); | |
| 25 $this->{$DBConnection} = $args{'DBConnection'}; | |
| 26 } | |
| 27 | |
| 28 sub Update { | |
| 29 my ($this) = @_; | |
| 30 | |
| 31 my $prefix = $this->{$DSNamespace}.'::'; | |
| 32 | |
| 33 my $schemaDS = new Schema::DataSource(DataSourceBuilder => new Schema::DataSource::CDBIBuilder); | |
| 34 $schemaDS->BuildSchema($this->{$DataSchemaFile}); | |
| 35 | |
| 36 my $schemaDB = $schemaDS->DataSourceBuilder->BuildDBSchema(); | |
| 37 (my $fname = $this->{$DSNamespace} ) =~ s/::/\//g; | |
| 38 $schemaDS->DataSourceBuilder->WriteModules($this->{$DataSourceDir}.$fname.'.pm',$prefix); | |
| 39 | |
| 40 if ($this->{$DBConnection}) { | |
| 41 | |
| 42 my $dbh = DBI->connect(@{$this->{$DBConnection}}) or die new Exception('Failed to connect to the database',@{$this->{$DBConnection}}); | |
| 43 my $SchemaSource; | |
| 44 if (UNIVERSAL::can($this->{$DBTraitsClass},'GetMetaTable')) { | |
| 45 $SchemaSource = new Deployment::CDBI::SQLSchemeSource (MetaTable => $this->{$DBTraitsClass}->GetMetaTable($dbh)); | |
| 46 } else { | |
| 47 die new Exception("Can't get meta table"); | |
| 48 } | |
| 49 | |
| 50 my $schemaDBOld = $SchemaSource->ReadSchema($schemaDB->Name); | |
| 51 | |
| 52 my $updater = $this->{$DBTraitsClass}->new(SrcSchema => $schemaDBOld, DstSchema => $schemaDB); | |
| 53 $updater->UpdateSchema(); | |
| 54 | |
| 55 $dbh->do($_) or die new Exception('Failed to execute the sql statement', $_) foreach $updater->Handler->Sql; | |
| 56 | |
| 57 $SchemaSource->SaveSchema($schemaDB); | |
| 58 | |
| 59 $schemaDBOld->Dispose; | |
| 60 } | |
| 61 $schemaDB->Dispose; | |
| 62 } | |
| 63 | |
| 64 package Deployment::CDBI::SQLSchemeSource; | |
| 65 use Common; | |
| 66 use Data::Dumper; | |
| 67 use MIME::Base64; | |
| 68 use Storable qw(nstore_fd fd_retrieve); | |
| 69 our @ISA = qw(Object); | |
| 70 | |
| 71 BEGIN { | |
| 72 DeclareProperty MetaTable => ACCESS_NONE; | |
| 73 } | |
| 74 | |
| 75 sub ReadSchema { | |
| 76 my ($this,$name) = @_; | |
| 77 | |
| 78 my $schema = decode_base64($this->{$MetaTable}->ReadProperty("db_schema_$name")); | |
| 79 if ($schema) { | |
| 80 open my $hvar,"<",\$schema or die new Exception("Failed to create a handle to the variable"); | |
| 81 return fd_retrieve($hvar); | |
| 82 } else { | |
| 83 return new Schema::DB(Name => $name, Version => 0); | |
| 84 } | |
| 85 } | |
| 86 | |
| 87 sub SaveSchema { | |
| 88 my ($this,$schema) = @_; | |
| 89 | |
| 90 my $name = $schema->Name; | |
| 91 | |
| 92 my $data; | |
| 93 { | |
| 94 open my $hvar,">",\$data or die new Exception("Failed to create a handle to the variable"); | |
| 95 nstore_fd($schema,$hvar); | |
| 96 } | |
| 97 | |
| 98 $this->{$MetaTable}->SetProperty("db_schema_$name",encode_base64($data)); | |
| 99 } | |
| 100 | |
| 101 1; |
