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; |