Putting 4.2.0 on top of 4.0.17
[usit-rt.git] / lib / RT / Test / Shredder.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
6 #                                          <sales@bestpractical.com>
7 #
8 # (Except where explicitly superseded by other copyright notices)
9 #
10 #
11 # LICENSE:
12 #
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
16 # from www.gnu.org.
17 #
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 # General Public License for more details.
22 #
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28 #
29 #
30 # CONTRIBUTION SUBMISSION POLICY:
31 #
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
37 #
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
46 #
47 # END BPS TAGGED BLOCK }}}
48
49 use strict;
50 use warnings;
51
52 package RT::Test::Shredder;
53 use base 'RT::Test';
54
55 require File::Copy;
56 require Cwd;
57
58 =head1 DESCRIPTION
59
60 RT::Shredder test suite utilities
61
62 =head1 TESTING
63
64 Since RT:Shredder 0.01_03 we have a test suite. You
65 can run tests and see if everything works as expected
66 before you try shredder on your actual data.
67 Tests also help in the development process.
68
69 The test suite uses SQLite databases to store data in individual files,
70 so you could sun tests on your production servers without risking
71 damage to your production data.
72
73 You'll want to run the test suite almost every time you install or update
74 the shredder distribution, especialy if you have local customizations of
75 the DB schema and/or RT code.
76
77 Tests are one thing you can write even if you don't know much perl,
78 but want to learn more about RT's internals. New tests are very welcome.
79
80 =head2 WRITING TESTS
81
82 The shredder distribution has several files to help write new tests.
83
84   t/shredder/utils.pl - this file, utilities
85   t/00skeleton.t - skeleteton .t file for new tests
86
87 All tests follow this algorithm:
88
89   require "t/shredder/utils.pl"; # plug in utilities
90   init_db(); # create new tmp RT DB and init RT API
91   # create RT data you want to be always in the RT DB
92   # ...
93   create_savepoint('mysp'); # create DB savepoint
94   # create data you want delete with shredder
95   # ...
96   # run shredder on the objects you've created
97   # ...
98   # check that shredder deletes things you want
99   # this command will compare savepoint DB with current
100   cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
101   # then you can create another object and delete it, then check again
102
103 Savepoints are named and you can create two or more savepoints.
104
105 =cut
106
107 sub import {
108     my $class = shift;
109     $class->SUPER::import(@_);
110     $class->export_to_level(1);
111 }
112
113 =head1 FUNCTIONS
114
115 =head2 RT CONFIG
116
117 =head3 rewrite_rtconfig
118
119 Call this sub after C<RT::LoadConfig>. It changes the RT config
120 options necessary to switch to a local SQLite database.
121
122 =cut
123
124 sub bootstrap_more_config {
125     my $self = shift;
126     my $config = shift;
127
128     print $config <<'END';
129 Set($DatabaseType       , 'SQLite');
130 Set($DatabaseHost       , 'localhost' );
131 Set($DatabaseRTHost     , 'localhost' );
132 Set($DatabasePort       , '' );
133 END
134
135     print $config "Set(\$DatabaseName, '". $self->db_name ."');\n";
136     return;
137 }
138
139 =head2 DATABASES
140
141 =head3 db_name
142
143 Returns the absolute file path to the current DB.
144 It is C<<RT::Test->temp_directory . 'main.db'>>.
145
146 =cut
147
148 sub db_name { return File::Spec->catfile((shift)->temp_directory, "main.db") }
149
150 =head3 connect_sqlite
151
152 Returns connected DBI DB handle.
153
154 Takes path to sqlite db.
155
156 =cut
157
158 sub connect_sqlite
159 {
160     my $self = shift;
161     return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
162 }
163
164 =head2 SHREDDER
165
166 =head3 shredder_new
167
168 Creates and returns a new RT::Shredder object.
169
170 =cut
171
172 sub shredder_new
173 {
174     my $self = shift;
175
176     require RT::Shredder;
177     my $obj = RT::Shredder->new;
178
179     my $file = File::Spec->catfile( $self->temp_directory, 'dump.XXXX.sql' );
180     $obj->AddDumpPlugin( Arguments => {
181         file_name    => $file,
182         from_storage => 0,
183     } );
184
185     return $obj;
186 }
187
188
189 =head2 SAVEPOINTS
190
191 =head3 savepoint_name
192
193 Returns the absolute path to the named savepoint DB file.
194 Takes one argument - savepoint name, by default C<sp>.
195
196 =cut
197
198 sub savepoint_name
199 {
200     my $self  = shift;
201     my $name = shift || 'default';
202     return File::Spec->catfile( $self->temp_directory, "sp.$name.db" );
203 }
204
205 =head3 create_savepoint
206
207 Creates savepoint DB from the current DB.
208 Takes name of the savepoint as argument.
209
210 =head3 restore_savepoint
211
212 Restores current DB to savepoint state.
213 Takes name of the savepoint as argument.
214
215 =cut
216
217 sub create_savepoint {
218     my $self = shift;
219     return $self->__cp_db( $self->db_name => $self->savepoint_name( shift ) );
220 }
221 sub restore_savepoint {
222     my $self = shift;
223     return $self->__cp_db( $self->savepoint_name( shift ) => $self->db_name );
224 }
225 sub __cp_db
226 {
227     my $self  = shift;
228     my( $orig, $dest ) = @_;
229     RT::Test::__disconnect_rt();
230     File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
231     RT::Test::__reconnect_rt();
232     return;
233 }
234
235
236 =head2 DUMPS
237
238 =head3 dump_sqlite
239
240 Returns DB dump as a complex hash structure:
241     {
242     TableName => {
243         #id => {
244             lc_field => 'value',
245         }
246     }
247     }
248
249 Takes named argument C<CleanDates>. If true, clean all date fields from
250 dump. True by default.
251
252 =cut
253
254 sub dump_sqlite
255 {
256     my $self = shift;
257     my $dbh = shift;
258     my %args = ( CleanDates => 1, @_ );
259
260     my $old_fhkn = $dbh->{'FetchHashKeyName'};
261     $dbh->{'FetchHashKeyName'} = 'NAME_lc';
262
263     my @tables = $RT::Handle->_TableNames( $dbh );
264
265     my $res = {};
266     foreach my $t( @tables ) {
267         next if lc($t) eq 'sessions';
268         $res->{$t} = $dbh->selectall_hashref(
269             "SELECT * FROM $t". $self->dump_sqlite_exceptions($t), 'id'
270         );
271         $self->clean_dates( $res->{$t} ) if $args{'CleanDates'};
272         die $DBI::err if $DBI::err;
273     }
274
275     $dbh->{'FetchHashKeyName'} = $old_fhkn;
276     return $res;
277 }
278
279 =head3 dump_sqlite_exceptions
280
281 If there are parts of the DB which can change from creating and deleting
282 a queue, skip them when doing the comparison.  One example is the global
283 queue cache attribute on RT::System which will be updated on Queue creation
284 and can't be rolled back by the shredder.  It may actually make sense for
285 Shredder to be updating this at some point in the future.
286
287 =cut
288
289 sub dump_sqlite_exceptions {
290     my $self = shift;
291     my $table = shift;
292
293     my $special_wheres = {
294         attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
295     };
296
297     return $special_wheres->{lc $table}||'';
298
299 }
300
301 =head3 dump_current_and_savepoint
302
303 Returns dump of the current DB and of the named savepoint.
304 Takes one argument - savepoint name.
305
306 =cut
307
308 sub dump_current_and_savepoint
309 {
310     my $self = shift;
311     my $orig = $self->savepoint_name( shift );
312     die "Couldn't find savepoint file" unless -f $orig && -r _;
313     my $odbh = $self->connect_sqlite( $orig );
314     return ( $self->dump_sqlite( $RT::Handle->dbh, @_ ), $self->dump_sqlite( $odbh, @_ ) );
315 }
316
317 =head3 dump_savepoint_and_current
318
319 Returns the same data as C<dump_current_and_savepoint> function,
320 but in reversed order.
321
322 =cut
323
324 sub dump_savepoint_and_current { return reverse (shift)->dump_current_and_savepoint(@_) }
325
326 sub clean_dates
327 {
328     my $self = shift;
329     my $h = shift;
330     my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
331     foreach my $id ( keys %{ $h } ) {
332         next unless $h->{ $id };
333         foreach ( keys %{ $h->{ $id } } ) {
334             delete $h->{$id}{$_} if $h->{$id}{$_} &&
335               $h->{$id}{$_} =~ /$date_re/;
336         }
337     }
338 }
339
340 1;