Commit | Line | Data |
69cc9910 |
1 | package DBIx::Class::Version::Table; |
2 | use base 'DBIx::Class'; |
3 | use strict; |
4 | use warnings; |
5 | |
6 | __PACKAGE__->load_components(qw/ Core/); |
7 | __PACKAGE__->table('SchemaVersions'); |
8 | |
9 | __PACKAGE__->add_columns |
10 | ( 'Version' => { |
11 | 'data_type' => 'VARCHAR', |
12 | 'is_auto_increment' => 0, |
13 | 'default_value' => undef, |
14 | 'is_foreign_key' => 0, |
15 | 'name' => 'Version', |
16 | 'is_nullable' => 0, |
17 | 'size' => '10' |
18 | }, |
19 | 'Installed' => { |
20 | 'data_type' => 'VARCHAR', |
21 | 'is_auto_increment' => 0, |
22 | 'default_value' => undef, |
23 | 'is_foreign_key' => 0, |
24 | 'name' => 'Installed', |
25 | 'is_nullable' => 0, |
26 | 'size' => '20' |
27 | }, |
28 | ); |
29 | __PACKAGE__->set_primary_key('Version'); |
30 | |
31 | package DBIx::Class::Version; |
32 | use base 'DBIx::Class::Schema'; |
33 | use strict; |
34 | use warnings; |
35 | |
36 | __PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table'); |
37 | |
38 | |
39 | # --------------------------------------------------------------------------- |
40 | package DBIx::Class::Versioning; |
41 | |
42 | use strict; |
43 | use warnings; |
44 | use base 'DBIx::Class'; |
45 | use POSIX 'strftime'; |
46 | use Data::Dumper; |
47 | # use DBIx::Class::Version; |
48 | |
49 | __PACKAGE__->mk_classdata('_filedata'); |
50 | __PACKAGE__->mk_classdata('upgrade_directory'); |
51 | |
52 | sub on_connect |
53 | { |
54 | my ($self) = @_; |
55 | print "on_connect\n"; |
56 | my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); |
57 | my $vtable = $vschema->resultset('Table'); |
58 | my $pversion; |
59 | if(!$self->exists($vtable)) |
60 | { |
61 | print "deploying.. \n"; |
62 | $vschema->storage->debug(1); |
63 | print "Debugging is: ", $vschema->storage->debug, "\n"; |
64 | $vschema->deploy(); |
65 | $pversion = 0; |
66 | } |
67 | else |
68 | { |
69 | $pversion = $vtable->search(undef, |
70 | { select => [ |
71 | 'Version', |
72 | { 'max' => 'Installed' }, |
73 | ], |
74 | group_by => [ 'Version' ], |
75 | })->first; |
76 | $pversion = $pversion->Version if($pversion); |
77 | } |
78 | if($pversion eq $self->VERSION) |
79 | { |
80 | print "This version is already installed\n"; |
81 | return 1; |
82 | } |
83 | |
84 | |
85 | $vtable->create({ Version => $self->VERSION, |
86 | Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) |
87 | }); |
88 | |
89 | if(!$pversion) |
90 | { |
91 | print "No previous version found, skipping upgrade\n"; |
92 | return 1; |
93 | } |
94 | |
95 | my $file = $self->ddl_filename($self->upgrade_directory, |
96 | $self->storage->sqlt_type, |
97 | $self->VERSION |
98 | ); |
99 | $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e; |
100 | if(!-f $file) |
101 | { |
102 | warn "Upgrade not possible, no upgrade file found ($file)\n"; |
103 | return; |
104 | } |
105 | print "Found Upgrade file: $file\n"; |
106 | my $fh; |
107 | open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)"); |
108 | my @data = split(/;\n/, join('', <$fh>)); |
109 | close($fh); |
110 | @data = grep { $_ && $_ !~ /^-- / } @data; |
111 | @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data; |
112 | print "Commands: ", join("\n", @data), "\n"; |
113 | $self->_filedata(\@data); |
114 | |
115 | $self->backup(); |
116 | $self->upgrade(); |
117 | |
118 | # X Create version table if not exists? |
119 | # Make backup |
120 | # Run create statements |
121 | # Run post-create callback |
122 | # Run alter/drop statement |
123 | # Run post-alter callback |
124 | } |
125 | |
126 | sub exists |
127 | { |
128 | my ($self, $rs) = @_; |
129 | |
130 | eval { |
131 | $rs->search({ 1, 0 })->count; |
132 | }; |
133 | |
134 | return 0 if $@; |
135 | |
136 | return 1; |
137 | } |
138 | |
139 | sub backup |
140 | { |
141 | my ($self) = @_; |
142 | } |
143 | |
144 | sub upgrade |
145 | { |
146 | my ($self) = @_; |
147 | |
148 | ## overridable sub, per default just run all the commands. |
149 | |
150 | $self->run_upgrade(qr/create/i); |
151 | $self->run_upgrade(qr/alter table .*? add/i); |
152 | $self->run_upgrade(qr/alter table .*? (?!drop)/i); |
153 | $self->run_upgrade(qr/alter table .*? drop/i); |
154 | $self->run_upgrade(qr/drop/i); |
155 | $self->run_upgrade(qr//i); |
156 | } |
157 | |
158 | |
159 | sub run_upgrade |
160 | { |
161 | my ($self, $stm) = @_; |
162 | print "Reg: $stm\n"; |
163 | my @statements = grep { $_ =~ $stm } @{$self->_filedata}; |
164 | # print "Statements: ", join("\n", @statements), "\n"; |
165 | $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]); |
166 | |
167 | for (@statements) |
168 | { |
169 | $self->storage->debugfh->print("$_\n") if $self->storage->debug; |
170 | print "Running \n>>$_<<\n"; |
171 | $self->storage->dbh->do($_) or warn "SQL was:\n $_"; |
172 | } |
173 | |
174 | return 1; |
175 | } |