|
49
|
1 use strict;
|
|
|
2 package Deployment::Batch::CDBIUpdate;
|
|
|
3 use Common;
|
|
165
|
4 use parent qw(Deployment::Batch::Generic);
|
|
49
|
5
|
|
|
6 use DBI;
|
|
|
7 use Schema::DataSource;
|
|
|
8 use Schema::DataSource::CDBIBuilder;
|
|
|
9
|
|
|
10
|
|
|
11 BEGIN {
|
|
|
12 DeclareProperty DataSchemaFile => ACCESS_READ;
|
|
|
13 DeclareProperty DataSourceDir => ACCESS_READ;
|
|
|
14 DeclareProperty DSNamespace => ACCESS_READ;
|
|
|
15 DeclareProperty DBConnection => ACCESS_READ;
|
|
|
16 DeclareProperty DBTraitsClass => ACCESS_READ;
|
|
|
17 DeclareProperty SchemaPrev => ACCESS_READ;
|
|
|
18 }
|
|
|
19
|
|
|
20 sub CTOR {
|
|
|
21 my ($this,%args) = @_;
|
|
|
22
|
|
|
23 $this->{$DataSchemaFile} = $args{'Source'} or die new Exception('A data shema file is required');
|
|
|
24 $this->{$DataSourceDir} = $args{'Output'} or die new Exception('A directory for a data source is required');
|
|
|
25 $this->{$DSNamespace} = $args{'Namespace'} || 'DataSource';
|
|
|
26 $this->{$DBTraitsClass} = $args{'DBTraits'} or die new Exception('A DBTraitsClass is required');
|
|
|
27
|
|
|
28 (my $modname = $args{'DBTraits'}.'.pm') =~ s/::/\//g;
|
|
|
29 $this->Log("Loading DBTraits '$modname'");
|
|
|
30 require $modname;
|
|
|
31 }
|
|
|
32
|
|
|
33 sub Run {
|
|
|
34 my ($this) = @_;
|
|
|
35
|
|
|
36 $this->{$DBConnection} = $this->Context->{Connection};
|
|
|
37
|
|
|
38 my $prefix = $this->{$DSNamespace}.'::';
|
|
|
39
|
|
|
40 my $schemaDS = new Schema::DataSource(DataSourceBuilder => new Schema::DataSource::CDBIBuilder);
|
|
|
41 $schemaDS->BuildSchema($this->{$DataSchemaFile});
|
|
|
42
|
|
|
43 my $schemaDB = $schemaDS->DataSourceBuilder->BuildDBSchema();
|
|
|
44 (my $fname = $this->{$DataSourceDir}.$this->{$DSNamespace}.'.pm') =~ s/::/\//g;
|
|
|
45
|
|
|
46 # we are in the immediate mode, so the file will be backupped immediatelly;
|
|
|
47 $this->Log("Backup $fname");
|
|
|
48 Deployment::Batch->Backup( File => $fname );
|
|
|
49
|
|
|
50 $this->Log("Write the datasource '$this->{$DSNamespace}' to '$this->{$DataSourceDir}'");
|
|
|
51 $schemaDS->DataSourceBuilder->WriteModules($fname,$prefix);
|
|
|
52
|
|
|
53 if ($this->{$DBConnection}) {
|
|
|
54 $this->Log("Update the database '$this->{$DBConnection}[0]'");
|
|
|
55
|
|
|
56 $this->{$SchemaPrev} = $this->UpdateDBToSchema($schemaDB);
|
|
|
57
|
|
|
58 }
|
|
|
59 $schemaDB->Dispose;
|
|
|
60 }
|
|
|
61
|
|
|
62 sub Rollback {
|
|
|
63 my ($this) = @_;
|
|
|
64
|
|
|
65 if ($this->{$SchemaPrev}) {
|
|
|
66 $this->Log("Rallback the DB schema");
|
|
|
67 $this->UpdateDBToSchema($this->{$SchemaPrev})->Dispose;
|
|
|
68 $this->{$SchemaPrev}->Dispose;
|
|
|
69 delete $this->{$SchemaPrev};
|
|
|
70 }
|
|
|
71
|
|
|
72 }
|
|
|
73
|
|
|
74 sub UpdateDBToSchema {
|
|
|
75 my ($this,$schemaDB) = @_;
|
|
|
76 my $dbh = DBI->connect(@{$this->{$DBConnection}}) or die new Exception('Failed to connect to the database',@{$this->{$DBConnection}});
|
|
|
77 my $SchemaSource;
|
|
|
78
|
|
|
79 if (UNIVERSAL::can($this->{$DBTraitsClass},'GetMetaTable')) {
|
|
|
80 $SchemaSource = new Deployment::CDBI::SQLSchemeSource (MetaTable => $this->{$DBTraitsClass}->GetMetaTable($dbh));
|
|
|
81 } else {
|
|
|
82 die new Exception("Can't get a meta table",$this->{$DBTraitsClass});
|
|
|
83 }
|
|
|
84
|
|
|
85 my $schemaDBOld = $SchemaSource->ReadSchema($schemaDB->Name);
|
|
|
86
|
|
|
87 my $updater = $this->{$DBTraitsClass}->new(SrcSchema => $schemaDBOld, DstSchema => $schemaDB);
|
|
|
88 $updater->UpdateSchema();
|
|
|
89
|
|
|
90 $dbh->do($_) or die new Exception('Failed to execute the sql statement', $_) foreach $updater->Handler->Sql;
|
|
|
91
|
|
|
92 $SchemaSource->SaveSchema($schemaDB);
|
|
|
93 return $schemaDBOld;
|
|
|
94 }
|
|
|
95
|
|
|
96 sub DESTROY {
|
|
|
97 my $this = shift;
|
|
|
98
|
|
|
99 $this->{$SchemaPrev}->Dispose if $this->{$SchemaPrev};
|
|
|
100 }
|
|
|
101
|
|
|
102 package Deployment::CDBI::SQLSchemeSource;
|
|
|
103 use Common;
|
|
|
104 use Data::Dumper;
|
|
|
105 use MIME::Base64;
|
|
|
106 use Storable qw(nstore_fd fd_retrieve);
|
|
|
107 our @ISA = qw(Object);
|
|
|
108
|
|
|
109 BEGIN {
|
|
|
110 DeclareProperty MetaTable => ACCESS_NONE;
|
|
|
111 }
|
|
|
112
|
|
|
113 sub ReadSchema {
|
|
|
114 my ($this,$name) = @_;
|
|
|
115
|
|
|
116 my $schema = decode_base64($this->{$MetaTable}->ReadProperty("db_schema_$name"));
|
|
|
117 if ($schema) {
|
|
|
118 open my $hvar,"<",\$schema or die new Exception("Failed to create a handle to the variable");
|
|
|
119 return fd_retrieve($hvar);
|
|
|
120 } else {
|
|
|
121 return new Schema::DB(Name => $name, Version => 0);
|
|
|
122 }
|
|
|
123 }
|
|
|
124
|
|
|
125 sub SaveSchema {
|
|
|
126 my ($this,$schema) = @_;
|
|
|
127
|
|
|
128 my $name = $schema->Name;
|
|
|
129
|
|
|
130 my $data = "";
|
|
|
131 {
|
|
|
132 open my $hvar,">",\$data or die new Exception("Failed to create a handle to the variable");
|
|
|
133 nstore_fd($schema,$hvar);
|
|
|
134 }
|
|
|
135
|
|
|
136 $this->{$MetaTable}->SetProperty("db_schema_$name",encode_base64($data));
|
|
|
137 }
|
|
|
138
|
|
|
139 1;
|
