1package DBIEngineTest; 2use 5.010; 3use strict; 4use warnings; 5use utf8; 6use Try::Tiny; 7use Test::More; 8use Test::Exception; 9use Time::HiRes qw(sleep); 10use Path::Class 0.33 qw(file dir); 11use Digest::SHA qw(sha1_hex); 12use Locale::TextDomain qw(App-Sqitch); 13use File::Temp 'tempdir'; 14 15# Just die on warnings. 16use Carp; BEGIN { $SIG{__WARN__} = \&Carp::confess } 17 18sub run { 19 my ( $self, %p ) = @_; 20 21 my $class = $p{class}; 22 my @sqitch_params = @{ $p{sqitch_params} || [] }; 23 my $user1_name = 'Marge Simpson'; 24 my $user1_email = 'marge@example.com'; 25 my $mock_sqitch = Test::MockModule->new('App::Sqitch'); 26 27 # Mock script hashes using lines from the README. 28 my $mock_change = Test::MockModule->new('App::Sqitch::Plan::Change'); 29 my @lines = grep { $_ } file('README.md')->slurp( 30 chomp => 1, 31 iomode => '<:encoding(UTF-8)' 32 ); 33 # Each change should retain its own hash. 34 my $orig_deploy_hash; 35 $mock_change->mock(_deploy_hash => sub { 36 my $self = shift; 37 $self->$orig_deploy_hash || sha1_hex shift @lines; 38 }); 39 $orig_deploy_hash = $mock_change->original('_deploy_hash'); 40 41 can_ok $class, qw( 42 initialized 43 initialize 44 run_file 45 run_handle 46 log_deploy_change 47 log_fail_change 48 log_revert_change 49 earliest_change_id 50 latest_change_id 51 is_deployed_tag 52 is_deployed_change 53 change_id_for 54 change_id_for_depend 55 name_for_change_id 56 change_offset_from_id 57 change_id_offset_from_id 58 load_change 59 ); 60 61 subtest 'live database' => sub { 62 my $sqitch = App::Sqitch->new( 63 @sqitch_params, 64 user_name => $user1_name, 65 user_email => $user1_email, 66 ); 67 my $target = App::Sqitch::Target->new( 68 sqitch => $sqitch, 69 @{ $p{target_params} || [] }, 70 ); 71 my $engine = $class->new( 72 sqitch => $sqitch, 73 target => $target, 74 @{ $p{engine_params} || [] }, 75 ); 76 if (my $code = $p{skip_unless}) { 77 try { 78 $code->( $engine ) || die 'NO'; 79 } catch { 80 plan skip_all => sprintf( 81 'Unable to live-test %s engine: %s', 82 $class->name, 83 eval { $_->message } || $_ 84 ); 85 }; 86 } 87 88 ok $engine, 'Engine instantiated'; 89 90 ok !$engine->initialized, 'Database should not yet be initialized'; 91 OLDREG: { 92 my $mock_file = Test::MockModule->new('Path::Class::File'); 93 my $dir = file(__FILE__)->dir->subdir('upgradable_registries'); 94 $mock_file->mock( dir => sub { $dir } ); 95 ok $engine->initialize, 'Initialize the database'; 96 }; 97 ok $engine->initialized, 'Database should now be initialized'; 98 ok !$engine->needs_upgrade, 'Registry should not need upgrading'; 99 my $get_releases = sub { 100 my $releases = $engine->dbh->selectall_arrayref(q{ 101 SELECT version, installer_name, installer_email 102 FROM releases 103 ORDER BY version 104 }); 105 $_->[0] = sprintf '%.1f', $_->[0] for @{ $releases }; 106 return $releases; 107 }; 108 is_deeply $get_releases->(), [ 109 [$engine->registry_release + 0, $sqitch->user_name, $sqitch->user_email] 110 ], 'The release should be registered'; 111 112 # Let's make sure upgrades work. 113 $engine->dbh->do('DROP TABLE releases'); 114 ok $engine->needs_upgrade, 'Registry should need upgrading'; 115 MOCKINFO: { 116 my $sqitch_mocker = Test::MockModule->new(ref $sqitch); 117 my @args; 118 $sqitch_mocker->mock(info => sub { shift; push @args => @_ }); 119 ok $engine->upgrade_registry, 'Upgrade the registry'; 120 is_deeply \@args, [' * ' . __x( 121 'From {old} to {new}', 122 old => 0, 123 new => '1.0', 124 ), ' * ' . __x( 125 'From {old} to {new}', 126 old => '1.0', 127 new => '1.1', 128 )], 'Should have info output for upgrade'; 129 } 130 ok !$engine->needs_upgrade, 'Registry should no longer need upgrading'; 131 is_deeply $get_releases->(), [ 132 [ '1.0', $sqitch->user_name, $sqitch->user_email ], 133 [ '1.1', $sqitch->user_name, $sqitch->user_email ], 134 ], 'The release should be registered again'; 135 136 # Try it with a different Sqitch DB. 137 $target = App::Sqitch::Target->new( 138 sqitch => $sqitch, 139 @{ $p{alt_target_params} || [] }, 140 ); 141 ok $engine = $class->new( 142 sqitch => $sqitch, 143 target => $target, 144 @{ $p{alt_engine_params} || [] }, 145 ), 'Create engine with alternate params'; 146 147 is $engine->earliest_change_id, undef, 'No init, earliest change'; 148 is $engine->latest_change_id, undef, 'No init, no latest change'; 149 150 ok !$engine->initialized, 'Database should no longer seem initialized'; 151 ok $engine->initialize, 'Initialize the database again'; 152 ok $engine->initialized, 'Database should be initialized again'; 153 ok !$engine->needs_upgrade, 'Registry should not need upgrading'; 154 155 is $engine->earliest_change_id, undef, 'Still no earlist change'; 156 is $engine->latest_change_id, undef, 'Still no latest changes'; 157 158 # Make sure a second attempt to initialize dies. 159 throws_ok { $engine->initialize } 'App::Sqitch::X', 160 'Should die on existing schema'; 161 is $@->ident, 'engine', 'Mode should be "engine"'; 162 is $@->message, $p{init_error}, 163 'And it should show the proper schema in the error message'; 164 165 throws_ok { $engine->dbh->do('INSERT blah INTO __bar_____') } 'App::Sqitch::X', 166 'Database error should be converted to Sqitch exception'; 167 is $@->ident, $DBI::state, 'Ident should be SQL error state'; 168 like $@->message, $p{engine_err_regex}, 'The message should be from the engine'; 169 like $@->previous_exception, qr/DBD::[^:]+::db do failed: /, 170 'The DBI error should be in preview_exception'; 171 172 is $engine->current_state, undef, 'Current state should be undef'; 173 is_deeply all( $engine->current_changes ), [], 'Should have no current changes'; 174 is_deeply all( $engine->current_tags ), [], 'Should have no current tags'; 175 is_deeply all( $engine->search_events ), [], 'Should have no events'; 176 177 ########################################################################## 178 # Test the database connection, if appropriate. 179 if (my $code = $p{test_dbh}) { 180 $code->($engine->dbh); 181 } 182 183 ########################################################################## 184 # Test register_project(). 185 can_ok $engine, 'register_project'; 186 can_ok $engine, 'registered_projects'; 187 188 is_deeply [ $engine->registered_projects ], [], 189 'Should have no registered projects'; 190 191 ok $engine->register_project, 'Register the project'; 192 is_deeply [ $engine->registered_projects ], ['engine'], 193 'Should have one registered project, "engine"'; 194 is_deeply $engine->dbh->selectall_arrayref( 195 'SELECT project, uri, creator_name, creator_email FROM projects' 196 ), [['engine', undef, $sqitch->user_name, $sqitch->user_email]], 197 'The project should be registered'; 198 199 # Try to register it again. 200 ok $engine->register_project, 'Register the project again'; 201 is_deeply [ $engine->registered_projects ], ['engine'], 202 'Should still have one registered project, "engine"'; 203 is_deeply $engine->dbh->selectall_arrayref( 204 'SELECT project, uri, creator_name, creator_email FROM projects' 205 ), [['engine', undef, $sqitch->user_name, $sqitch->user_email]], 206 'The project should still be registered only once'; 207 208 # Register a different project name. 209 MOCKPROJECT: { 210 my $plan_mocker = Test::MockModule->new(ref $target->plan ); 211 $plan_mocker->mock(project => 'groovy'); 212 $plan_mocker->mock(uri => 'http://example.com/'); 213 ok $engine->register_project, 'Register a second project'; 214 } 215 216 is_deeply [ $engine->registered_projects ], ['engine', 'groovy'], 217 'Should have both registered projects'; 218 is_deeply $engine->dbh->selectall_arrayref( 219 'SELECT project, uri, creator_name, creator_email FROM projects ORDER BY created_at' 220 ), [ 221 ['engine', undef, $sqitch->user_name, $sqitch->user_email], 222 ['groovy', 'http://example.com/', $sqitch->user_name, $sqitch->user_email], 223 ], 'Both projects should now be registered'; 224 225 # Try to register with a different URI. 226 MOCKURI: { 227 my $plan_mocker = Test::MockModule->new(ref $target->plan ); 228 my $plan_proj = 'engine'; 229 my $plan_uri = 'http://example.net/'; 230 $plan_mocker->mock(project => sub { $plan_proj }); 231 $plan_mocker->mock(uri => sub { $plan_uri }); 232 throws_ok { $engine->register_project } 'App::Sqitch::X', 233 'Should get an error for defined URI vs NULL registered URI'; 234 is $@->ident, 'engine', 'Defined URI error ident should be "engine"'; 235 is $@->message, __x( 236 'Cannot register "{project}" with URI {uri}: already exists with NULL URI', 237 project => 'engine', 238 uri => $plan_uri, 239 ), 'Defined URI error message should be correct'; 240 241 # Try it when the registered URI is NULL. 242 $plan_proj = 'groovy'; 243 throws_ok { $engine->register_project } 'App::Sqitch::X', 244 'Should get an error for different URIs'; 245 is $@->ident, 'engine', 'Different URI error ident should be "engine"'; 246 is $@->message, __x( 247 'Cannot register "{project}" with URI {uri}: already exists with URI {reg_uri}', 248 project => 'groovy', 249 uri => $plan_uri, 250 reg_uri => 'http://example.com/', 251 ), 'Different URI error message should be correct'; 252 253 # Try with a NULL project URI. 254 $plan_uri = undef; 255 throws_ok { $engine->register_project } 'App::Sqitch::X', 256 'Should get an error for NULL plan URI'; 257 is $@->ident, 'engine', 'NULL plan URI error ident should be "engine"'; 258 is $@->message, __x( 259 'Cannot register "{project}" without URI: already exists with URI {uri}', 260 project => 'groovy', 261 uri => 'http://example.com/', 262 ), 'NULL plan uri error message should be correct'; 263 264 # It should succeed when the name and URI are the same. 265 $plan_uri = 'http://example.com/'; 266 ok $engine->register_project, 'Register "groovy" again'; 267 is_deeply [ $engine->registered_projects ], ['engine', 'groovy'], 268 'Should still have two registered projects'; 269 is_deeply $engine->dbh->selectall_arrayref( 270 'SELECT project, uri, creator_name, creator_email FROM projects ORDER BY created_at' 271 ), [ 272 ['engine', undef, $sqitch->user_name, $sqitch->user_email], 273 ['groovy', 'http://example.com/', $sqitch->user_name, $sqitch->user_email], 274 ], 'Both projects should still be registered'; 275 276 # Now try the same URI but a different name. 277 $plan_proj = 'bob'; 278 throws_ok { $engine->register_project } 'App::Sqitch::X', 279 'Should get error for an project with the URI'; 280 is $@->ident, 'engine', 'Existing URI error ident should be "engine"'; 281 is $@->message, __x( 282 'Cannot register "{project}" with URI {uri}: project "{reg_proj}" already using that URI', 283 project => $plan_proj, 284 uri => $plan_uri, 285 reg_proj => 'groovy', 286 ), 'Exising URI error message should be correct'; 287 } 288 289 ###################################################################### 290 # Test log_deploy_change(). 291 my $plan = $target->plan; 292 my $change = $plan->change_at(0); 293 my ($tag) = $change->tags; 294 is $change->name, 'users', 'Should have "users" change'; 295 ok !$engine->is_deployed_change($change), 'The change should not be deployed'; 296 is_deeply [$engine->are_deployed_changes($change)], [], 297 'The change should not be deployed'; 298 299 ok $engine->log_deploy_change($change), 'Deploy "users" change'; 300 ok $engine->is_deployed_change($change), 'The change should now be deployed'; 301 is_deeply [$engine->are_deployed_changes($change)], [$change->id], 302 'The change should now be deployed'; 303 304 is $engine->earliest_change_id, $change->id, 'Should get users ID for earliest change ID'; 305 is $engine->earliest_change_id(1), undef, 'Should get no change offset 1 from earliest'; 306 is $engine->latest_change_id, $change->id, 'Should get users ID for latest change ID'; 307 is $engine->latest_change_id(1), undef, 'Should get no change offset 1 from latest'; 308 309 is_deeply all_changes($engine), [[ 310 $change->id, 'users', 'engine', 'User roles', $sqitch->user_name, $sqitch->user_email, 311 $change->planner_name, $change->planner_email, 312 ]],'A record should have been inserted into the changes table'; 313 is_deeply get_dependencies($engine, $change->id), [], 'Should have no dependencies'; 314 is_deeply [ $engine->changes_requiring_change($change) ], [], 315 'Change should not be required'; 316 317 318 my @event_data = ([ 319 'deploy', 320 $change->id, 321 'users', 322 'engine', 323 'User roles', 324 $engine->_log_requires_param($change), 325 $engine->_log_conflicts_param($change), 326 $engine->_log_tags_param($change), 327 $sqitch->user_name, 328 $sqitch->user_email, 329 $change->planner_name, 330 $change->planner_email 331 ]); 332 333 is_deeply all_events($engine), \@event_data, 334 'A record should have been inserted into the events table'; 335 336 is_deeply all_tags($engine), [[ 337 $tag->id, 338 '@alpha', 339 $change->id, 340 'engine', 341 'Good to go!', 342 $sqitch->user_name, 343 $sqitch->user_email, 344 $tag->planner_name, 345 $tag->planner_email, 346 ]], 'The tag should have been logged'; 347 348 is $engine->name_for_change_id($change->id), 'users@alpha', 349 'name_for_change_id() should return the change name with tag'; 350 351 ok my $state = $engine->current_state, 'Get the current state'; 352 isa_ok my $dt = delete $state->{committed_at}, 'App::Sqitch::DateTime', 353 'committed_at value'; 354 is $dt->time_zone->name, 'UTC', 'committed_at TZ should be UTC'; 355 is_deeply $state, { 356 project => 'engine', 357 change_id => $change->id, 358 script_hash => $change->script_hash, 359 change => 'users', 360 note => 'User roles', 361 committer_name => $sqitch->user_name, 362 committer_email => $sqitch->user_email, 363 tags => ['@alpha'], 364 planner_name => $change->planner_name, 365 planner_email => $change->planner_email, 366 planned_at => $change->timestamp, 367 }, 'The rest of the state should look right'; 368 is_deeply all( $engine->current_changes ), [{ 369 change_id => $change->id, 370 script_hash => $change->script_hash, 371 change => 'users', 372 committer_name => $sqitch->user_name, 373 committer_email => $sqitch->user_email, 374 committed_at => $dt, 375 planner_name => $change->planner_name, 376 planner_email => $change->planner_email, 377 planned_at => $change->timestamp, 378 }], 'Should have one current change'; 379 is_deeply all( $engine->current_tags('nonesuch') ), [], 380 'Should have no current chnages for nonexistent project'; 381 is_deeply all( $engine->current_tags ), [{ 382 tag_id => $tag->id, 383 tag => '@alpha', 384 committed_at => dt_for_tag( $engine, $tag->id ), 385 committer_name => $sqitch->user_name, 386 committer_email => $sqitch->user_email, 387 planner_name => $tag->planner_name, 388 planner_email => $tag->planner_email, 389 planned_at => $tag->timestamp, 390 }], 'Should have one current tags'; 391 is_deeply all( $engine->current_tags('nonesuch') ), [], 392 'Should have no current tags for nonexistent project'; 393 my @events = ({ 394 event => 'deploy', 395 project => 'engine', 396 change_id => $change->id, 397 change => 'users', 398 note => 'User roles', 399 requires => $engine->_log_requires_param($change), 400 conflicts => $engine->_log_conflicts_param($change), 401 tags => $engine->_log_tags_param($change), 402 committer_name => $sqitch->user_name, 403 committer_email => $sqitch->user_email, 404 committed_at => dt_for_event($engine, 0), 405 planned_at => $change->timestamp, 406 planner_name => $change->planner_name, 407 planner_email => $change->planner_email, 408 }); 409 is_deeply all( $engine->search_events ), \@events, 'Should have one event'; 410 411 ###################################################################### 412 # Test log_new_tags(). 413 ok $engine->log_new_tags($change), 'Log new tags for "users" change'; 414 is_deeply all_tags($engine), [[ 415 $tag->id, 416 '@alpha', 417 $change->id, 418 'engine', 419 'Good to go!', 420 $sqitch->user_name, 421 $sqitch->user_email, 422 $tag->planner_name, 423 $tag->planner_email, 424 ]], 'The tag should be the same'; 425 426 # Delete that tag. 427 $engine->dbh->do('DELETE FROM tags'); 428 is_deeply all_tags($engine), [], 'Should now have no tags'; 429 430 # Put it back. 431 ok $engine->log_new_tags($change), 'Log new tags for "users" change again'; 432 is_deeply all_tags($engine), [[ 433 $tag->id, 434 '@alpha', 435 $change->id, 436 'engine', 437 'Good to go!', 438 $sqitch->user_name, 439 $sqitch->user_email, 440 $tag->planner_name, 441 $tag->planner_email, 442 ]], 'The tag should be back'; 443 444 ###################################################################### 445 # Test log_revert_change(). First shift existing event dates. 446 ok $engine->log_revert_change($change), 'Revert "users" change'; 447 ok !$engine->is_deployed_change($change), 'The change should no longer be deployed'; 448 is_deeply [$engine->are_deployed_changes($change)], [], 449 'The change should no longer be deployed'; 450 451 is $engine->earliest_change_id, undef, 'Should get undef for earliest change'; 452 is $engine->latest_change_id, undef, 'Should get undef for latest change'; 453 454 is_deeply all_changes($engine), [], 455 'The record should have been deleted from the changes table'; 456 is_deeply all_tags($engine), [], 'And the tag record should have been removed'; 457 is_deeply get_dependencies($engine, $change->id), [], 'Should still have no dependencies'; 458 is_deeply [ $engine->changes_requiring_change($change) ], [], 459 'Change should not be required'; 460 461 push @event_data, [ 462 'revert', 463 $change->id, 464 'users', 465 'engine', 466 'User roles', 467 $engine->_log_requires_param($change), 468 $engine->_log_conflicts_param($change), 469 $engine->_log_tags_param($change), 470 $sqitch->user_name, 471 $sqitch->user_email, 472 $change->planner_name, 473 $change->planner_email 474 ]; 475 476 is_deeply all_events($engine), \@event_data, 477 'The revert event should have been logged'; 478 479 is $engine->name_for_change_id($change->id), undef, 480 'name_for_change_id() should no longer return the change name'; 481 is $engine->current_state, undef, 'Current state should be undef again'; 482 is_deeply all( $engine->current_changes ), [], 483 'Should again have no current changes'; 484 is_deeply all( $engine->current_tags ), [], 'Should again have no current tags'; 485 486 unshift @events => { 487 event => 'revert', 488 project => 'engine', 489 change_id => $change->id, 490 change => 'users', 491 note => 'User roles', 492 requires => $engine->_log_requires_param($change), 493 conflicts => $engine->_log_conflicts_param($change), 494 tags => $engine->_log_tags_param($change), 495 committer_name => $sqitch->user_name, 496 committer_email => $sqitch->user_email, 497 committed_at => dt_for_event($engine, 1), 498 planned_at => $change->timestamp, 499 planner_name => $change->planner_name, 500 planner_email => $change->planner_email, 501 }; 502 is_deeply all( $engine->search_events ), \@events, 'Should have two events'; 503 504 ###################################################################### 505 # Test log_fail_change(). 506 ok $engine->log_fail_change($change), 'Fail "users" change'; 507 ok !$engine->is_deployed_change($change), 'The change still should not be deployed'; 508 is_deeply [$engine->are_deployed_changes($change)], [], 509 'The change still should not be deployed'; 510 is $engine->earliest_change_id, undef, 'Should still get undef for earliest change'; 511 is $engine->latest_change_id, undef, 'Should still get undef for latest change'; 512 is_deeply all_changes($engine), [], 'Still should have not changes table record'; 513 is_deeply all_tags($engine), [], 'Should still have no tag records'; 514 is_deeply get_dependencies($engine, $change->id), [], 'Should still have no dependencies'; 515 is_deeply [ $engine->changes_requiring_change($change) ], [], 516 'Change should not be required'; 517 518 push @event_data, [ 519 'fail', 520 $change->id, 521 'users', 522 'engine', 523 'User roles', 524 $engine->_log_requires_param($change), 525 $engine->_log_conflicts_param($change), 526 $engine->_log_tags_param($change), 527 $sqitch->user_name, 528 $sqitch->user_email, 529 $change->planner_name, 530 $change->planner_email 531 ]; 532 533 is_deeply all_events($engine), \@event_data, 'The fail event should have been logged'; 534 is $engine->current_state, undef, 'Current state should still be undef'; 535 is_deeply all( $engine->current_changes ), [], 'Should still have no current changes'; 536 is_deeply all( $engine->current_tags ), [], 'Should still have no current tags'; 537 538 unshift @events => { 539 event => 'fail', 540 project => 'engine', 541 change_id => $change->id, 542 change => 'users', 543 note => 'User roles', 544 requires => $engine->_log_requires_param($change), 545 conflicts => $engine->_log_conflicts_param($change), 546 tags => $engine->_log_tags_param($change), 547 committer_name => $sqitch->user_name, 548 committer_email => $sqitch->user_email, 549 committed_at => dt_for_event($engine, 2), 550 planned_at => $change->timestamp, 551 planner_name => $change->planner_name, 552 planner_email => $change->planner_email, 553 }; 554 is_deeply all( $engine->search_events ), \@events, 'Should have 3 events'; 555 556 # From here on in, use a different committer. 557 my $user2_name = 'Homer Simpson'; 558 my $user2_email = 'homer@example.com'; 559 $mock_sqitch->mock( user_name => $user2_name ); 560 $mock_sqitch->mock( user_email => $user2_email ); 561 562 ###################################################################### 563 # Test a change with dependencies. 564 ok $engine->log_deploy_change($change), 'Deploy the change again'; 565 ok $engine->is_deployed_tag($tag), 'The tag again should be deployed'; 566 is $engine->earliest_change_id, $change->id, 'Should again get users ID for earliest change ID'; 567 is $engine->earliest_change_id(1), undef, 'Should still get no change offset 1 from earliest'; 568 is $engine->latest_change_id, $change->id, 'Should again get users ID for latest change ID'; 569 is $engine->latest_change_id(1), undef, 'Should still get no change offset 1 from latest'; 570 571 ok my $change2 = $plan->change_at(1), 'Get the second change'; 572 is_deeply [sort $engine->are_deployed_changes($change, $change2)], [$change->id], 573 'Only the first change should be deployed'; 574 my ($req) = $change2->requires; 575 ok $req->resolved_id($change->id), 'Set resolved ID in required depend'; 576 # Send this change back in time. 577 $engine->dbh->do( 578 'UPDATE changes SET committed_at = ?', 579 undef, '2013-03-30 00:47:47', 580 ); 581 ok $engine->log_deploy_change($change2), 'Deploy second change'; 582 is $engine->earliest_change_id, $change->id, 'Should still get users ID for earliest change ID'; 583 is $engine->earliest_change_id(1), $change2->id, 584 'Should get "widgets" offset 1 from earliest'; 585 is $engine->earliest_change_id(2), undef, 'Should get no change offset 2 from earliest'; 586 is $engine->latest_change_id, $change2->id, 'Should get "widgets" ID for latest change ID'; 587 is $engine->latest_change_id(1), $change->id, 588 'Should get "user" offset 1 from earliest'; 589 is $engine->latest_change_id(2), undef, 'Should get no change offset 2 from latest'; 590 591 is_deeply all_changes($engine), [ 592 [ 593 $change->id, 594 'users', 595 'engine', 596 'User roles', 597 $user2_name, 598 $user2_email, 599 $change->planner_name, 600 $change->planner_email, 601 ], 602 [ 603 $change2->id, 604 'widgets', 605 'engine', 606 'All in', 607 $user2_name, 608 $user2_email, 609 $change2->planner_name, 610 $change2->planner_email, 611 ], 612 ], 'Should have both changes and requires/conflcits deployed'; 613 is_deeply [sort $engine->are_deployed_changes($change, $change2)], 614 [sort $change->id, $change2->id], 615 'Both changes should be deployed'; 616 is_deeply get_dependencies($engine, $change->id), [], 617 'Should still have no dependencies for "users"'; 618 is_deeply get_dependencies($engine, $change2->id), [ 619 [ 620 $change2->id, 621 'conflict', 622 'dr_evil', 623 undef, 624 ], 625 [ 626 $change2->id, 627 'require', 628 'users', 629 $change->id, 630 ], 631 ], 'Should have both dependencies for "widgets"'; 632 633 is_deeply [ $engine->changes_requiring_change($change) ], [{ 634 project => 'engine', 635 change_id => $change2->id, 636 change => 'widgets', 637 asof_tag => undef, 638 }], 'Change "users" should be required by "widgets"'; 639 is_deeply [ $engine->changes_requiring_change($change2) ], [], 640 'Change "widgets" should not be required'; 641 642 push @event_data, [ 643 'deploy', 644 $change->id, 645 'users', 646 'engine', 647 'User roles', 648 $engine->_log_requires_param($change), 649 $engine->_log_conflicts_param($change), 650 $engine->_log_tags_param($change), 651 $user2_name, 652 $user2_email, 653 $change->planner_name, 654 $change->planner_email, 655 ], [ 656 'deploy', 657 $change2->id, 658 'widgets', 659 'engine', 660 'All in', 661 $engine->_log_requires_param($change2), 662 $engine->_log_conflicts_param($change2), 663 $engine->_log_tags_param($change2), 664 $user2_name, 665 $user2_email, 666 $change2->planner_name, 667 $change2->planner_email, 668 ]; 669 is_deeply all_events($engine), \@event_data, 670 'The new change deploy should have been logged'; 671 672 is $engine->name_for_change_id($change2->id), 'widgets', 673 'name_for_change_id() should return just the change name'; 674 675 ok $state = $engine->current_state, 'Get the current state again'; 676 isa_ok $dt = delete $state->{committed_at}, 'App::Sqitch::DateTime', 677 'committed_at value'; 678 is $dt->time_zone->name, 'UTC', 'committed_at TZ should be UTC'; 679 is_deeply $state, { 680 project => 'engine', 681 change_id => $change2->id, 682 script_hash => $change2->script_hash, 683 change => 'widgets', 684 note => 'All in', 685 committer_name => $user2_name, 686 committer_email => $user2_email, 687 planner_name => $change2->planner_name, 688 planner_email => $change2->planner_email, 689 planned_at => $change2->timestamp, 690 tags => [], 691 }, 'The state should reference new change'; 692 693 my @current_changes = ( 694 { 695 change_id => $change2->id, 696 script_hash => $change2->script_hash, 697 change => 'widgets', 698 committer_name => $user2_name, 699 committer_email => $user2_email, 700 committed_at => dt_for_change( $engine, $change2->id ), 701 planner_name => $change2->planner_name, 702 planner_email => $change2->planner_email, 703 planned_at => $change2->timestamp, 704 }, 705 { 706 change_id => $change->id, 707 script_hash => $change->script_hash, 708 change => 'users', 709 committer_name => $user2_name, 710 committer_email => $user2_email, 711 committed_at => dt_for_change( $engine, $change->id ), 712 planner_name => $change->planner_name, 713 planner_email => $change->planner_email, 714 planned_at => $change->timestamp, 715 }, 716 ); 717 718 is_deeply all( $engine->current_changes ), \@current_changes, 719 'Should have two current changes in reverse chronological order'; 720 721 my @current_tags = ( 722 { 723 tag_id => $tag->id, 724 tag => '@alpha', 725 committer_name => $user2_name, 726 committer_email => $user2_email, 727 committed_at => dt_for_tag( $engine, $tag->id ), 728 planner_name => $tag->planner_name, 729 planner_email => $tag->planner_email, 730 planned_at => $tag->timestamp, 731 }, 732 ); 733 is_deeply all( $engine->current_tags ), \@current_tags, 734 'Should again have one current tags'; 735 736 unshift @events => { 737 event => 'deploy', 738 project => 'engine', 739 change_id => $change2->id, 740 change => 'widgets', 741 note => 'All in', 742 requires => $engine->_log_requires_param($change2), 743 conflicts => $engine->_log_conflicts_param($change2), 744 tags => $engine->_log_tags_param($change2), 745 committer_name => $user2_name, 746 committer_email => $user2_email, 747 committed_at => dt_for_event($engine, 4), 748 planner_name => $change2->planner_name, 749 planner_email => $change2->planner_email, 750 planned_at => $change2->timestamp, 751 }, { 752 event => 'deploy', 753 project => 'engine', 754 change_id => $change->id, 755 change => 'users', 756 note => 'User roles', 757 requires => $engine->_log_requires_param($change), 758 conflicts => $engine->_log_conflicts_param($change), 759 tags => $engine->_log_tags_param($change), 760 committer_name => $user2_name, 761 committer_email => $user2_email, 762 committed_at => dt_for_event($engine, 3), 763 planner_name => $change->planner_name, 764 planner_email => $change->planner_email, 765 planned_at => $change->timestamp, 766 }; 767 is_deeply all( $engine->search_events ), \@events, 'Should have 5 events'; 768 769 ###################################################################### 770 # Test deployed_changes(), deployed_changes_since(), load_change, and 771 # change_offset_from_id(), and change_id_offset_from_id() 772 can_ok $engine, qw( 773 deployed_changes 774 deployed_changes_since 775 load_change 776 change_offset_from_id 777 change_id_offset_from_id 778 ); 779 my $change_hash = { 780 id => $change->id, 781 name => $change->name, 782 project => $change->project, 783 note => $change->note, 784 timestamp => $change->timestamp, 785 planner_name => $change->planner_name, 786 planner_email => $change->planner_email, 787 tags => ['@alpha'], 788 }; 789 my $change2_hash = { 790 id => $change2->id, 791 name => $change2->name, 792 project => $change2->project, 793 note => $change2->note, 794 timestamp => $change2->timestamp, 795 planner_name => $change2->planner_name, 796 planner_email => $change2->planner_email, 797 tags => [], 798 }; 799 800 is_deeply [$engine->deployed_changes], [$change_hash, $change2_hash], 801 'Should have two deployed changes'; 802 is_deeply [$engine->deployed_changes_since($change)], [$change2_hash], 803 'Should find one deployed since the first one'; 804 is_deeply [$engine->deployed_changes_since($change2)], [], 805 'Should find none deployed since the second one'; 806 807 is_deeply $engine->load_change($change->id), $change_hash, 808 'Should load change 1'; 809 is_deeply $engine->load_change($change2->id), $change2_hash, 810 'Should load change 2'; 811 is_deeply $engine->load_change('whatever'), undef, 812 'load() should return undef for uknown change ID'; 813 814 is_deeply $engine->change_offset_from_id($change->id, undef), $change_hash, 815 'Should load change with no offset'; 816 is_deeply $engine->change_offset_from_id($change2->id, 0), $change2_hash, 817 'Should load change with offset 0'; 818 819 is_deeply $engine->change_id_offset_from_id($change->id, undef), $change->id, 820 'Should get change ID with no offset'; 821 is_deeply $engine->change_id_offset_from_id($change2->id, 0), $change2->id, 822 'Should get change ID with offset 0'; 823 824 # Now try some offsets. 825 is_deeply $engine->change_offset_from_id($change->id, 1), $change2_hash, 826 'Should find change with offset 1'; 827 is_deeply $engine->change_offset_from_id($change2->id, -1), $change_hash, 828 'Should find change with offset -1'; 829 is_deeply $engine->change_offset_from_id($change->id, 2), undef, 830 'Should find undef change with offset 2'; 831 832 is_deeply $engine->change_id_offset_from_id($change->id, 1), $change2->id, 833 'Should find change ID with offset 1'; 834 is_deeply $engine->change_id_offset_from_id($change2->id, -1), $change->id, 835 'Should find change ID with offset -1'; 836 is_deeply $engine->change_id_offset_from_id($change->id, 2), undef, 837 'Should find undef change ID with offset 2'; 838 839 # Revert change 2. 840 ok $engine->log_revert_change($change2), 'Revert "widgets"'; 841 is_deeply [$engine->deployed_changes], [$change_hash], 842 'Should now have one deployed change ID'; 843 is_deeply [$engine->deployed_changes_since($change)], [], 844 'Should find none deployed since that one'; 845 846 # Add another one. 847 ok $engine->log_deploy_change($change2), 'Log another change'; 848 is_deeply [$engine->deployed_changes], [$change_hash, $change2_hash], 849 'Should have both deployed change IDs'; 850 is_deeply [$engine->deployed_changes_since($change)], [$change2_hash], 851 'Should find only the second after the first'; 852 is_deeply [$engine->deployed_changes_since($change2)], [], 853 'Should find none after the second'; 854 855 ok $state = $engine->current_state, 'Get the current state once more'; 856 isa_ok $dt = delete $state->{committed_at}, 'App::Sqitch::DateTime', 857 'committed_at value'; 858 is $dt->time_zone->name, 'UTC', 'committed_at TZ should be UTC'; 859 is_deeply $state, { 860 project => 'engine', 861 change_id => $change2->id, 862 script_hash => $change2->script_hash, 863 change => 'widgets', 864 note => 'All in', 865 committer_name => $sqitch->user_name, 866 committer_email => $sqitch->user_email, 867 tags => [], 868 planner_name => $change2->planner_name, 869 planner_email => $change2->planner_email, 870 planned_at => $change2->timestamp, 871 }, 'The new state should reference latest change'; 872 873 # These were reverted and re-deployed, so might have new timestamps. 874 $current_changes[0]->{committed_at} = dt_for_change( $engine, $change2->id ); 875 $current_changes[1]->{committed_at} = dt_for_change( $engine, $change->id ); 876 is_deeply all( $engine->current_changes ), \@current_changes, 877 'Should still have two current changes in reverse chronological order'; 878 is_deeply all( $engine->current_tags ), \@current_tags, 879 'Should still have one current tags'; 880 881 unshift @events => { 882 event => 'deploy', 883 project => 'engine', 884 change_id => $change2->id, 885 change => 'widgets', 886 note => 'All in', 887 requires => $engine->_log_requires_param($change2), 888 conflicts => $engine->_log_conflicts_param($change2), 889 tags => $engine->_log_tags_param($change2), 890 committer_name => $user2_name, 891 committer_email => $user2_email, 892 committed_at => dt_for_event($engine, 6), 893 planner_name => $change2->planner_name, 894 planner_email => $change2->planner_email, 895 planned_at => $change2->timestamp, 896 }, { 897 event => 'revert', 898 project => 'engine', 899 change_id => $change2->id, 900 change => 'widgets', 901 note => 'All in', 902 requires => $engine->_log_requires_param($change2), 903 conflicts => $engine->_log_conflicts_param($change2), 904 tags => $engine->_log_tags_param($change2), 905 committer_name => $user2_name, 906 committer_email => $user2_email, 907 committed_at => dt_for_event($engine, 5), 908 planner_name => $change2->planner_name, 909 planner_email => $change2->planner_email, 910 planned_at => $change2->timestamp, 911 }; 912 is_deeply all( $engine->search_events ), \@events, 'Should have 7 events'; 913 914 ###################################################################### 915 # Deploy the new changes with two tags. 916 $plan->add( name => 'fred', note => 'Hello Fred' ); 917 $plan->add( name => 'barney', note => 'Hello Barney' ); 918 $plan->tag( name => 'beta', note => 'Note beta' ); 919 $plan->tag( name => 'gamma', note => 'Note gamma' ); 920 ok my $fred = $plan->get('fred'), 'Get the "fred" change'; 921 ok $engine->log_deploy_change($fred), 'Deploy "fred"'; 922 sleep 0.1; # Give SQLite a little time to tick microseconds. 923 ok my $barney = $plan->get('barney'), 'Get the "barney" change'; 924 ok $engine->log_deploy_change($barney), 'Deploy "barney"'; 925 926 is $engine->earliest_change_id, $change->id, 'Earliest change should sill be "users"'; 927 is $engine->earliest_change_id(1), $change2->id, 928 'Should still get "widgets" offset 1 from earliest'; 929 is $engine->earliest_change_id(2), $fred->id, 930 'Should get "fred" offset 2 from earliest'; 931 is $engine->earliest_change_id(3), $barney->id, 932 'Should get "barney" offset 3 from earliest'; 933 934 is $engine->latest_change_id, $barney->id, 'Latest change should be "barney"'; 935 is $engine->latest_change_id(1), $fred->id, 'Should get "fred" offset 1 from latest'; 936 is $engine->latest_change_id(2), $change2->id, 'Should get "widgets" offset 2 from latest'; 937 is $engine->latest_change_id(3), $change->id, 'Should get "users" offset 3 from latest'; 938 939 $state = $engine->current_state; 940 # MySQL's group_concat() does not by default sort by row order, alas. 941 $state->{tags} = [ sort @{ $state->{tags} } ] 942 if $class eq 'App::Sqitch::Engine::mysql'; 943 is_deeply $state, { 944 project => 'engine', 945 change_id => $barney->id, 946 script_hash => $barney->script_hash, 947 change => 'barney', 948 note => 'Hello Barney', 949 committer_name => $sqitch->user_name, 950 committer_email => $sqitch->user_email, 951 committed_at => dt_for_change( $engine,$barney->id), 952 tags => [qw(@beta @gamma)], 953 planner_name => $barney->planner_name, 954 planner_email => $barney->planner_email, 955 planned_at => $barney->timestamp, 956 }, 'Barney should be in the current state'; 957 958 unshift @current_changes => { 959 change_id => $barney->id, 960 script_hash => $barney->script_hash, 961 change => 'barney', 962 committer_name => $user2_name, 963 committer_email => $user2_email, 964 committed_at => dt_for_change( $engine, $barney->id ), 965 planner_name => $barney->planner_name, 966 planner_email => $barney->planner_email, 967 planned_at => $barney->timestamp, 968 }, { 969 change_id => $fred->id, 970 script_hash => $fred->script_hash, 971 change => 'fred', 972 committer_name => $user2_name, 973 committer_email => $user2_email, 974 committed_at => dt_for_change( $engine, $fred->id ), 975 planner_name => $fred->planner_name, 976 planner_email => $fred->planner_email, 977 planned_at => $fred->timestamp, 978 }; 979 980 is_deeply all( $engine->current_changes ), \@current_changes, 981 'Should have all four current changes in reverse chron order'; 982 983 my ($beta, $gamma) = $barney->tags; 984 if (my $format = $p{add_second_format}) { 985 my $set = sprintf $format, 'committed_at'; 986 $engine->dbh->do( 987 "UPDATE tags SET committed_at = $set WHERE tag = '\@gamma'" 988 ); 989 } 990 unshift @current_tags => { 991 tag_id => $gamma->id, 992 tag => '@gamma', 993 committer_name => $user2_name, 994 committer_email => $user2_email, 995 committed_at => dt_for_tag( $engine, $gamma->id ), 996 planner_name => $gamma->planner_name, 997 planner_email => $gamma->planner_email, 998 planned_at => $gamma->timestamp, 999 }, { 1000 tag_id => $beta->id, 1001 tag => '@beta', 1002 committer_name => $user2_name, 1003 committer_email => $user2_email, 1004 committed_at => dt_for_tag( $engine, $beta->id ), 1005 planner_name => $beta->planner_name, 1006 planner_email => $beta->planner_email, 1007 planned_at => $beta->timestamp, 1008 }; 1009 1010 is_deeply all( $engine->current_tags ), \@current_tags, 1011 'Should now have three current tags in reverse chron order'; 1012 1013 unshift @events => { 1014 event => 'deploy', 1015 project => 'engine', 1016 change_id => $barney->id, 1017 change => 'barney', 1018 note => 'Hello Barney', 1019 requires => $engine->_log_requires_param($barney), 1020 conflicts => $engine->_log_conflicts_param($barney), 1021 tags => $engine->_log_tags_param($barney), 1022 committer_name => $user2_name, 1023 committer_email => $user2_email, 1024 committed_at => dt_for_event($engine, 8), 1025 planner_name => $barney->planner_name, 1026 planner_email => $barney->planner_email, 1027 planned_at => $barney->timestamp, 1028 }, { 1029 event => 'deploy', 1030 project => 'engine', 1031 change_id => $fred->id, 1032 change => 'fred', 1033 note => 'Hello Fred', 1034 requires => $engine->_log_requires_param($fred), 1035 conflicts => $engine->_log_conflicts_param($fred), 1036 tags => $engine->_log_tags_param($fred), 1037 committer_name => $user2_name, 1038 committer_email => $user2_email, 1039 committed_at => dt_for_event($engine, 7), 1040 planner_name => $fred->planner_name, 1041 planner_email => $fred->planner_email, 1042 planned_at => $fred->timestamp, 1043 }; 1044 is_deeply all( $engine->search_events ), \@events, 'Should have 9 events'; 1045 1046 ###################################################################### 1047 # Test search_events() parameters. 1048 is_deeply all( $engine->search_events(limit => 2) ), [ @events[0..1] ], 1049 'The limit param to search_events should work'; 1050 1051 is_deeply all( $engine->search_events(offset => 4) ), [ @events[4..$#events] ], 1052 'The offset param to search_events should work'; 1053 1054 is_deeply all( $engine->search_events(limit => 3, offset => 4) ), [ @events[4..6] ], 1055 'The limit and offset params to search_events should work together'; 1056 1057 is_deeply all( $engine->search_events( direction => 'DESC' ) ), \@events, 1058 'Should work to set direction "DESC" in search_events'; 1059 is_deeply all( $engine->search_events( direction => 'desc' ) ), \@events, 1060 'Should work to set direction "desc" in search_events'; 1061 is_deeply all( $engine->search_events( direction => 'descending' ) ), \@events, 1062 'Should work to set direction "descending" in search_events'; 1063 1064 is_deeply all( $engine->search_events( direction => 'ASC' ) ), 1065 [ reverse @events ], 1066 'Should work to set direction "ASC" in search_events'; 1067 is_deeply all( $engine->search_events( direction => 'asc' ) ), 1068 [ reverse @events ], 1069 'Should work to set direction "asc" in search_events'; 1070 is_deeply all( $engine->search_events( direction => 'ascending' ) ), 1071 [ reverse @events ], 1072 'Should work to set direction "ascending" in search_events'; 1073 throws_ok { $engine->search_events( direction => 'foo' ) } 'App::Sqitch::X', 1074 'Should catch exception for invalid search direction'; 1075 is $@->ident, 'DEV', 'Search direction error ident should be "DEV"'; 1076 is $@->message, 'Search direction must be either "ASC" or "DESC"', 1077 'Search direction error message should be correct'; 1078 1079 is_deeply all( $engine->search_events( committer => 'Simpson$' ) ), \@events, 1080 'The committer param to search_events should work'; 1081 is_deeply all( $engine->search_events( committer => "^Homer" ) ), 1082 [ @events[0..5] ], 1083 'The committer param to search_events should work as a regex'; 1084 is_deeply all( $engine->search_events( committer => 'Simpsonized$' ) ), [], 1085 qq{Committer regex should fail to match with "Simpsonized\$"}; 1086 1087 is_deeply all( $engine->search_events( change => 'users' ) ), 1088 [ @events[5..$#events] ], 1089 'The change param to search_events should work with "users"'; 1090 is_deeply all( $engine->search_events( change => 'widgets' ) ), 1091 [ @events[2..4] ], 1092 'The change param to search_events should work with "widgets"'; 1093 is_deeply all( $engine->search_events( change => 'fred' ) ), 1094 [ $events[1] ], 1095 'The change param to search_events should work with "fred"'; 1096 is_deeply all( $engine->search_events( change => 'fre$' ) ), [], 1097 'The change param to search_events should return nothing for "fre$"'; 1098 is_deeply all( $engine->search_events( change => '(er|re)' ) ), 1099 [@events[1, 5..8]], 1100 'The change param to search_events should return match "(er|re)"'; 1101 1102 is_deeply all( $engine->search_events( event => [qw(deploy)] ) ), 1103 [ grep { $_->{event} eq 'deploy' } @events ], 1104 'The event param should work with "deploy"'; 1105 is_deeply all( $engine->search_events( event => [qw(revert)] ) ), 1106 [ grep { $_->{event} eq 'revert' } @events ], 1107 'The event param should work with "revert"'; 1108 is_deeply all( $engine->search_events( event => [qw(fail)] ) ), 1109 [ grep { $_->{event} eq 'fail' } @events ], 1110 'The event param should work with "fail"'; 1111 is_deeply all( $engine->search_events( event => [qw(revert fail)] ) ), 1112 [ grep { $_->{event} ne 'deploy' } @events ], 1113 'The event param should work with "revert" and "fail"'; 1114 is_deeply all( $engine->search_events( event => [qw(deploy revert fail)] ) ), 1115 \@events, 1116 'The event param should work with "deploy", "revert", and "fail"'; 1117 is_deeply all( $engine->search_events( event => ['foo'] ) ), [], 1118 'The event param should return nothing for "foo"'; 1119 1120 # Add an external project event. 1121 ok my $ext_plan = App::Sqitch::Plan->new( 1122 sqitch => $sqitch, 1123 target => $target, 1124 project => 'groovy', 1125 ), 'Create external plan'; 1126 ok my $ext_change = $ext_plan->add( 1127 plan => $ext_plan, 1128 name => 'crazyman', 1129 note => 'Crazy, right?', 1130 ), "Create external change"; 1131 1132 # Because we're gonna use a regular expression on events.project to 1133 # get events from multiple projects, we need to make sure that we get 1134 # things in the proper order, such as on MySQL 5.5, where there is no 1135 # datetime precision. So pretend we're about to insert another 1136 # "engine" project record to get the MySQL engine to wait out a clock 1137 # second tick before inserting our "groovy" change. This is purely so 1138 # we get things back in the proper order for the `project => 'g'` test 1139 # below. In reality it shouldn't matter much. 1140 $engine->_prepare_to_log(events => $barney); 1141 1142 ok $engine->log_deploy_change($ext_change), 'Log the external change'; 1143 my $ext_event = { 1144 event => 'deploy', 1145 project => 'groovy', 1146 change_id => $ext_change->id, 1147 change => $ext_change->name, 1148 note => $ext_change->note, 1149 requires => $engine->_log_requires_param($ext_change), 1150 conflicts => $engine->_log_conflicts_param($ext_change), 1151 tags => $engine->_log_tags_param($ext_change), 1152 committer_name => $user2_name, 1153 committer_email => $user2_email, 1154 committed_at => dt_for_event($engine, 9), 1155 planner_name => $user2_name, 1156 planner_email => $user2_email, 1157 planned_at => $ext_change->timestamp, 1158 }; 1159 is_deeply all( $engine->search_events( project => '^engine$' ) ), \@events, 1160 'The project param to search_events should work'; 1161 is_deeply all( $engine->search_events( project => '^groovy$' ) ), [$ext_event], 1162 'The project param to search_events should work with external project'; 1163 is_deeply all( $engine->search_events( project => 'g' ) ), [$ext_event, @events], 1164 'The project param to search_events should match across projects'; 1165 is_deeply all( $engine->search_events( project => 'nonexistent' ) ), [], 1166 qq{Project regex should fail to match with "nonexistent"}; 1167 1168 # Make sure we do not see these changes where we should not. 1169 ok !grep( { $_ eq $ext_change->id } $engine->deployed_changes), 1170 'deployed_changes should not include external change'; 1171 ok !grep( { $_ eq $ext_change->id } $engine->deployed_changes_since($change)), 1172 'deployed_changes_since should not include external change'; 1173 1174 is $engine->earliest_change_id, $change->id, 1175 'Earliest change should sill be "users"'; 1176 isnt $engine->latest_change_id, $ext_change->id, 1177 'Latest change ID should not be from external project'; 1178 1179 throws_ok { $engine->search_events(foo => 1) } 'App::Sqitch::X', 1180 'Should catch exception for invalid search param'; 1181 is $@->ident, 'DEV', 'Invalid search param error ident should be "DEV"'; 1182 is $@->message, 'Invalid parameters passed to search_events(): foo', 1183 'Invalid search param error message should be correct'; 1184 1185 throws_ok { $engine->search_events(foo => 1, bar => 2) } 'App::Sqitch::X', 1186 'Should catch exception for invalid search params'; 1187 is $@->ident, 'DEV', 'Invalid search params error ident should be "DEV"'; 1188 is $@->message, 'Invalid parameters passed to search_events(): bar, foo', 1189 'Invalid search params error message should be correct'; 1190 1191 ###################################################################### 1192 # Now that we have a change from an externa project, get its state. 1193 ok $state = $engine->current_state('groovy'), 'Get the "groovy" state'; 1194 isa_ok $dt = delete $state->{committed_at}, 'App::Sqitch::DateTime', 1195 'groofy committed_at value'; 1196 is $dt->time_zone->name, 'UTC', 'groovy committed_at TZ should be UTC'; 1197 is_deeply $state, { 1198 project => 'groovy', 1199 change_id => $ext_change->id, 1200 script_hash => $ext_change->script_hash, 1201 change => $ext_change->name, 1202 note => $ext_change->note, 1203 committer_name => $sqitch->user_name, 1204 committer_email => $sqitch->user_email, 1205 tags => [], 1206 planner_name => $ext_change->planner_name, 1207 planner_email => $ext_change->planner_email, 1208 planned_at => $ext_change->timestamp, 1209 }, 'The rest of the state should look right'; 1210 1211 ###################################################################### 1212 # Test change_id_for(). 1213 for my $spec ( 1214 [ 1215 'change_id only', 1216 { change_id => $change->id }, 1217 $change->id, 1218 ], 1219 [ 1220 'change only', 1221 { change => $change->name }, 1222 $change->id, 1223 ], 1224 [ 1225 'change + tag', 1226 { change => $change->name, tag => 'alpha' }, 1227 $change->id, 1228 ], 1229 [ 1230 'change@HEAD', 1231 { change => $change->name, tag => 'HEAD' }, 1232 $change->id, 1233 ], 1234 [ 1235 'tag only', 1236 { tag => 'alpha' }, 1237 $change->id, 1238 ], 1239 [ 1240 'ROOT', 1241 { tag => 'ROOT' }, 1242 $change->id, 1243 ], 1244 [ 1245 'FIRST', 1246 { tag => 'FIRST' }, 1247 $change->id, 1248 ], 1249 [ 1250 'HEAD', 1251 { tag => 'HEAD' }, 1252 $barney->id, 1253 ], 1254 [ 1255 'LAST', 1256 { tag => 'LAST' }, 1257 $barney->id, 1258 ], 1259 [ 1260 'project:ROOT', 1261 { tag => 'ROOT', project => 'groovy' }, 1262 $ext_change->id, 1263 ], 1264 [ 1265 'project:HEAD', 1266 { tag => 'HEAD', project => 'groovy' }, 1267 $ext_change->id, 1268 ], 1269 ) { 1270 my ( $desc, $params, $exp_id ) = @{ $spec }; 1271 is $engine->change_id_for(%{ $params }), $exp_id, "Should find id for $desc"; 1272 } 1273 1274 for my $spec ( 1275 [ 1276 'unkonwn id', 1277 { change_id => 'whatever' }, 1278 ], 1279 [ 1280 'unkonwn change', 1281 { change => 'whatever' }, 1282 ], 1283 [ 1284 'unkonwn tag', 1285 { tag => 'whatever' }, 1286 ], 1287 [ 1288 'change + unkonwn tag', 1289 { change => $change->name, tag => 'whatever' }, 1290 ], 1291 [ 1292 'change@ROOT', 1293 { change => $change->name, tag => 'ROOT' }, 1294 ], 1295 [ 1296 'change + different project', 1297 { change => $change->name, project => 'whatever' }, 1298 ], 1299 [ 1300 'tag + different project', 1301 { tag => 'alpha', project => 'whatever' }, 1302 ], 1303 ) { 1304 my ( $desc, $params ) = @{ $spec }; 1305 is $engine->change_id_for(%{ $params }), undef, "Should find nothing for $desc"; 1306 } 1307 1308 ###################################################################### 1309 # Test change_id_for_depend(). 1310 my $id = '4f1e83f409f5f533eeef9d16b8a59e2c0aa91cc1'; 1311 my $i; 1312 1313 for my $spec ( 1314 [ 1315 'id only', 1316 { id => $id }, 1317 { id => $id }, 1318 ], 1319 [ 1320 'change + tag', 1321 { change => 'bart', tag => 'epsilon' }, 1322 { name => 'bart' } 1323 ], 1324 [ 1325 'change only', 1326 { change => 'lisa' }, 1327 { name => 'lisa' }, 1328 ], 1329 [ 1330 'tag only', 1331 { tag => 'sigma' }, 1332 { name => 'maggie' }, 1333 ], 1334 ) { 1335 my ( $desc, $dep_params, $chg_params ) = @{ $spec }; 1336 1337 # Test as an internal dependency. 1338 INTERNAL: { 1339 ok my $change = $plan->add( 1340 name => 'foo' . ++$i, 1341 %{$chg_params}, 1342 ), "Create internal $desc change"; 1343 1344 # Tag it if necessary. 1345 if (my $tag = $dep_params->{tag}) { 1346 ok $plan->tag(name => $tag), "Add tag internal \@$tag"; 1347 } 1348 1349 # Should start with unsatisfied dependency. 1350 ok my $dep = App::Sqitch::Plan::Depend->new( 1351 plan => $plan, 1352 project => $plan->project, 1353 %{ $dep_params }, 1354 ), "Create internal $desc dependency"; 1355 is $engine->change_id_for_depend($dep), undef, 1356 "Internal $desc depencency should not be satisfied"; 1357 1358 # Once deployed, dependency should be satisfied. 1359 ok $engine->log_deploy_change($change), 1360 "Log internal $desc change deployment"; 1361 is $engine->change_id_for_depend($dep), $change->id, 1362 "Internal $desc depencency should now be satisfied"; 1363 1364 # Revert it and try again. 1365 sleep 0.1; # Give SQLite a little time to tick microseconds. 1366 ok $engine->log_revert_change($change), 1367 "Log internal $desc change reversion"; 1368 is $engine->change_id_for_depend($dep), undef, 1369 "Internal $desc depencency should again be unsatisfied"; 1370 } 1371 1372 # Now test as an external dependency. 1373 EXTERNAL: { 1374 # Make sure we have unique IDs. 1375 $_->{id} = 'dcb10d16276c9be8956274740d9f332bd71344ed' 1376 for grep { $_->{id} } $dep_params, $chg_params; 1377 1378 # Make Change and Tag return registered external project "groovy". 1379 $dep_params->{project} = 'groovy'; 1380 my $line_mocker = Test::MockModule->new('App::Sqitch::Plan::Line'); 1381 $line_mocker->mock(project => $dep_params->{project}); 1382 1383 ok my $change = App::Sqitch::Plan::Change->new( 1384 plan => $plan, 1385 name => 'foo' . ++$i, 1386 %{$chg_params}, 1387 ), "Create external $desc change"; 1388 1389 # Tag it if necessary. 1390 if (my $tag = $dep_params->{tag}) { 1391 ok $change->add_tag(App::Sqitch::Plan::Tag->new( 1392 plan => $plan, 1393 change => $change, 1394 name => $tag, 1395 ) ), "Add tag external \@$tag"; 1396 } 1397 1398 # Should start with unsatisfied dependency. 1399 ok my $dep = App::Sqitch::Plan::Depend->new( 1400 plan => $plan, 1401 project => $plan->project, 1402 %{ $dep_params }, 1403 ), "Create external $desc dependency"; 1404 is $engine->change_id_for_depend($dep), undef, 1405 "External $desc depencency should not be satisfied"; 1406 1407 # Once deployed, dependency should be satisfied. 1408 ok $engine->log_deploy_change($change), 1409 "Log external $desc change deployment"; 1410 1411 is $engine->change_id_for_depend($dep), $change->id, 1412 "External $desc depencency should now be satisfied"; 1413 1414 # Revert it and try again. 1415 sleep 0.1; # Give SQLite a little time to tick microseconds. 1416 ok $engine->log_revert_change($change), 1417 "Log external $desc change reversion"; 1418 is $engine->change_id_for_depend($dep), undef, 1419 "External $desc depencency should again be unsatisfied"; 1420 } 1421 } 1422 1423 ok my $ext_change2 = App::Sqitch::Plan::Change->new( 1424 plan => $ext_plan, 1425 name => 'outside_in', 1426 ), "Create another external change"; 1427 ok $ext_change2->add_tag( my $ext_tag = App::Sqitch::Plan::Tag->new( 1428 plan => $plan, 1429 change => $ext_change2, 1430 name => 'meta', 1431 ) ), 'Add tag external "meta"'; 1432 1433 ok $engine->log_deploy_change($ext_change2), 'Log the external change with tag'; 1434 1435 # Make sure name_for_change_id() works properly. 1436 ok $engine->dbh->do(q{DELETE FROM tags WHERE project = 'engine'}), 1437 'Delete the engine project tags'; 1438 is $engine->name_for_change_id($change2->id), 'widgets', 1439 'name_for_change_id() should return "widgets" for its ID'; 1440 is $engine->name_for_change_id($ext_change2->id), 'outside_in@meta', 1441 'name_for_change_id() should return "outside_in@meta" for its ID'; 1442 1443 # Make sure current_changes and current_tags are project-scoped. 1444 is_deeply all( $engine->current_changes ), \@current_changes, 1445 'Should have only the "engine" changes from current_changes'; 1446 is_deeply all( $engine->current_changes('groovy') ), [ 1447 { 1448 change_id => $ext_change2->id, 1449 script_hash => $ext_change2->script_hash, 1450 change => $ext_change2->name, 1451 committer_name => $user2_name, 1452 committer_email => $user2_email, 1453 committed_at => dt_for_change( $engine, $ext_change2->id ), 1454 planner_name => $ext_change2->planner_name, 1455 planner_email => $ext_change2->planner_email, 1456 planned_at => $ext_change2->timestamp, 1457 }, { 1458 change_id => $ext_change->id, 1459 script_hash => $ext_change->script_hash, 1460 change => $ext_change->name, 1461 committer_name => $user2_name, 1462 committer_email => $user2_email, 1463 committed_at => dt_for_change( $engine, $ext_change->id ), 1464 planner_name => $ext_change->planner_name, 1465 planner_email => $ext_change->planner_email, 1466 planned_at => $ext_change->timestamp, 1467 } 1468 ], 'Should get only requestd project changes from current_changes'; 1469 is_deeply all( $engine->current_tags ), [], 1470 'Should no longer have "engine" project tags'; 1471 is_deeply all( $engine->current_tags('groovy') ), [{ 1472 tag_id => $ext_tag->id, 1473 tag => '@meta', 1474 committer_name => $user2_name, 1475 committer_email => $user2_email, 1476 committed_at => dt_for_tag( $engine, $ext_tag->id ), 1477 planner_name => $ext_tag->planner_name, 1478 planner_email => $ext_tag->planner_email, 1479 planned_at => $ext_tag->timestamp, 1480 }], 'Should get groovy tags from current_chages()'; 1481 1482 ###################################################################### 1483 # Test changes with multiple and cross-project dependencies. 1484 ok my $hyper = $plan->add( 1485 name => 'hypercritical', 1486 requires => ['engine:fred', 'groovy:crazyman'], 1487 ), 'Create change "hypercritial" in current plan'; 1488 $_->resolved_id( $engine->change_id_for_depend($_) ) for $hyper->requires; 1489 ok $engine->log_deploy_change($hyper), 'Log change "hyper"'; 1490 1491 is_deeply [ $engine->changes_requiring_change($hyper) ], [], 1492 'No changes should require "hypercritical"'; 1493 is_deeply [ $engine->changes_requiring_change($fred) ], [{ 1494 project => 'engine', 1495 change_id => $hyper->id, 1496 change => $hyper->name, 1497 asof_tag => undef, 1498 }], 'Change "hypercritical" should require "fred"'; 1499 1500 is_deeply [ $engine->changes_requiring_change($ext_change) ], [{ 1501 project => 'engine', 1502 change_id => $hyper->id, 1503 change => $hyper->name, 1504 asof_tag => undef, 1505 }], 'Change "hypercritical" should require "groovy:crazyman"'; 1506 1507 # Add another change with more depencencies. 1508 ok my $ext_change3 = App::Sqitch::Plan::Change->new( 1509 plan => $ext_plan, 1510 name => 'elsewise', 1511 requires => [ 1512 App::Sqitch::Plan::Depend->new( 1513 plan => $ext_plan, 1514 project => 'engine', 1515 change => 'fred', 1516 ), 1517 App::Sqitch::Plan::Depend->new( 1518 plan => $ext_plan, 1519 change => 'crazyman', 1520 ), 1521 ] 1522 ), "Create a third external change"; 1523 $_->resolved_id( $engine->change_id_for_depend($_) ) for $ext_change3->requires; 1524 ok $engine->log_deploy_change($ext_change3), 'Log change "elsewise"'; 1525 1526 is_deeply [ 1527 sort { $b->{change} cmp $a->{change} } 1528 $engine->changes_requiring_change($fred) 1529 ], [ 1530 { 1531 project => 'engine', 1532 change_id => $hyper->id, 1533 change => $hyper->name, 1534 asof_tag => undef, 1535 }, 1536 { 1537 project => 'groovy', 1538 change_id => $ext_change3->id, 1539 change => $ext_change3->name, 1540 asof_tag => undef, 1541 }, 1542 ], 'Change "fred" should be required by changes in two projects'; 1543 1544 is_deeply [ 1545 sort { $b->{change} cmp $a->{change} } 1546 $engine->changes_requiring_change($ext_change) 1547 ], [ 1548 { 1549 project => 'engine', 1550 change_id => $hyper->id, 1551 change => $hyper->name, 1552 asof_tag => undef, 1553 }, 1554 { 1555 project => 'groovy', 1556 change_id => $ext_change3->id, 1557 change => $ext_change3->name, 1558 asof_tag => undef, 1559 }, 1560 ], 'Change "groovy:crazyman" should be required by changes in two projects'; 1561 1562 ###################################################################### 1563 # Test begin_work() and finish_work(). 1564 can_ok $engine, qw(begin_work finish_work); 1565 my $mock_dbh = Test::MockModule->new(ref $engine->dbh, no_auto => 1); 1566 my $txn; 1567 $mock_dbh->mock(begin_work => sub { $txn = 1 }); 1568 $mock_dbh->mock(commit => sub { $txn = 0 }); 1569 $mock_dbh->mock(rollback => sub { $txn = -1 }); 1570 my @do; 1571 $mock_dbh->mock(do => sub { 1572 shift; 1573 @do = @_; 1574 }); 1575 ok $engine->begin_work, 'Begin work'; 1576 is $txn, 1, 'Should have started a transaction'; 1577 ok $engine->finish_work, 'Finish work'; 1578 is $txn, 0, 'Should have committed a transaction'; 1579 ok $engine->begin_work, 'Begin work again'; 1580 is $txn, 1, 'Should have started another transaction'; 1581 ok $engine->rollback_work, 'Rollback work'; 1582 is $txn, -1, 'Should have rolled back a transaction'; 1583 $mock_dbh->unmock('do'); 1584 1585 ###################################################################### 1586 if ($class eq 'App::Sqitch::Engine::pg') { 1587 # Test _update_ids by old ID; required only for pg, which was the 1588 # only engine that existed at the time. 1589 my @proj_changes = ($change, $change2, $fred, $barney, $hyper); 1590 my @all_changes = ($change, $change2, $fred, $barney, $ext_change, $ext_change2, $hyper, $ext_change3); 1591 my @proj_tags = ($change->tags, $beta, $gamma); 1592 my @all_tags = (@proj_tags, $ext_tag); 1593 1594 # Let's just revert and re-deploy them all. 1595 ok $engine->log_revert_change($_), 1596 'Revert "' . $_->name . '" change' for reverse @all_changes; 1597 ok $engine->log_deploy_change($_), 1598 'Deploy "' . $_->name . '" change' for @all_changes; 1599 1600 my $upd_change = $engine->dbh->prepare( 1601 'UPDATE changes SET change_id = ? WHERE change_id = ?' 1602 ); 1603 my $upd_tag = $engine->dbh->prepare( 1604 'UPDATE tags SET tag_id = ? WHERE tag_id = ?' 1605 ); 1606 1607 for my $change (@proj_changes) { 1608 $upd_change->execute($change->old_id, $change->id); 1609 } 1610 for my $tag (@proj_tags) { 1611 $upd_tag->execute($tag->old_id, $tag->id); 1612 } 1613 1614 # Mock Engine to silence the info notice. 1615 my $mock_engine = Test::MockModule->new('App::Sqitch::Engine'); 1616 $mock_engine->mock(plan => $plan); 1617 $mock_engine->mock(_update_ids => sub { shift }); 1618 1619 is $engine->_update_ids, 10, 'Update IDs by old ID should return 10'; 1620 1621 # All of the current project changes should be updated. 1622 is_deeply [ map { [@{$_}[0,1]] } @{ all_changes($engine) }], 1623 [ map { [ $_->id, $_->name ] } @all_changes ], 1624 'All of the change IDs should have been updated'; 1625 1626 # All of the current project tags should be updated. 1627 is_deeply [ map { [@{$_}[0,1]] } @{ all_tags($engine) }], 1628 [ map { [ $_->id, $_->format_name ] } @all_tags ], 1629 'All of the tag IDs should have been updated'; 1630 1631 # Now reset them so they have to be found by name. 1632 $i = 0; 1633 for my $change (@proj_changes) { 1634 $upd_change->execute($change->old_id . $i++, $change->id); 1635 } 1636 for my $tag (@proj_tags) { 1637 $upd_tag->execute($tag->old_id . $i++, $tag->id); 1638 } 1639 1640 is $engine->_update_ids, 10, 'Update IDs by name should also return 10'; 1641 1642 # All of the current project changes should be updated. 1643 is_deeply [ map { [@{$_}[0,1]] } @{ all_changes($engine) }], 1644 [ map { [ $_->id, $_->name ] } @all_changes ], 1645 'All of the change IDs should have been updated by name'; 1646 1647 # All of the current project tags should be updated. 1648 is_deeply [ map { [@{$_}[0,1]] } @{ all_tags($engine) }], 1649 [ map { [ $_->id, $_->format_name ] } @all_tags ], 1650 'All of the tag IDs should have been updated by name'; 1651 } 1652 1653 ###################################################################### 1654 # Add a reworked change. 1655 ok my $rev_change = $plan->rework( name => 'users' ), 'Rework change "users"'; 1656 my $deploy_file = $rev_change->deploy_file; 1657 my $tmp_dir = dir( tempdir CLEANUP => 1 ); 1658 $deploy_file->copy_to($tmp_dir); 1659 my $fh = $deploy_file->opena or die "Cannot open $deploy_file: $!\n"; 1660 try { 1661 say $fh '-- Append line to reworked script so it gets a new SHA-1 hash'; 1662 close $fh; 1663 $_->resolved_id( $engine->change_id_for_depend($_) ) for $rev_change->requires; 1664 ok $engine->log_deploy_change($rev_change), 'Deploy the reworked change'; 1665 } finally { 1666 # Restore the reworked script. 1667 $tmp_dir->file( $deploy_file->basename )->copy_to($deploy_file); 1668 }; 1669 1670 # Make sure that change_id_for() is okay with the dupe. 1671 is $engine->change_id_for( change => 'users'), $change->id, 1672 'change_id_for() should find the earliest change ID'; 1673 1674 ###################################################################### 1675 # Tag and Rework the change again. 1676 ok $plan->tag(name => 'theta'), 'Tag the plan "theta"'; 1677 ok $engine->log_new_tags($rev_change), 'Log new tag'; 1678 1679 ok my $rev_change2 = $plan->rework( name => 'users' ), 1680 'Rework change "users" again'; 1681 $fh = $deploy_file->opena or die "Cannot open $deploy_file: $!\n"; 1682 try { 1683 say $fh '-- Append another line to reworked script for a new SHA-1 hash'; 1684 close $fh; 1685 $_->resolved_id( $engine->change_id_for_depend($_) ) for $rev_change2->requires; 1686 ok $engine->log_deploy_change($rev_change2), 'Deploy the reworked change'; 1687 } finally { 1688 # Restore the reworked script. 1689 $tmp_dir->file( $deploy_file->basename )->copy_to($deploy_file); 1690 }; 1691 1692 # make sure that change_id_for is still good with things. 1693 for my $spec ( 1694 [ 1695 'first instance of change', 1696 { change => 'users' }, 1697 $change->id, 1698 ], 1699 [ 1700 'HEAD instance of change', 1701 { change => 'users', tag => 'HEAD' }, 1702 $rev_change2->id, 1703 ], 1704 [ 1705 'second instance of change by tag', 1706 { change => 'users', tag => 'theta' }, 1707 $rev_change->id, 1708 ], 1709 ) { 1710 my ( $desc, $params, $exp_id ) = @{ $spec }; 1711 is $engine->change_id_for(%{ $params }), $exp_id, "Should find id for $desc"; 1712 } 1713 1714 # Unmock everything and call it a day. 1715 $mock_dbh->unmock_all; 1716 $mock_sqitch->unmock_all; 1717 1718 ###################################################################### 1719 # Let's make sure script_hash upgrades work. 1720 $engine->dbh->do('UPDATE changes SET script_hash = change_id'); 1721 ok $engine->_update_script_hashes, 'Update script hashes'; 1722 1723 # Make sure they were updated properly. 1724 my $sth = $engine->dbh->prepare( 1725 'SELECT change_id, script_hash FROM changes WHERE project = ?', 1726 ); 1727 $sth->execute($plan->project); 1728 while (my $row = $sth->fetch) { 1729 my $change = $plan->get($row->[0]); 1730 is $row->[1], $change->script_hash, 1731 'Should have updated script hash for ' . $change->name; 1732 } 1733 1734 # Make sure no other projects were updated. 1735 $sth = $engine->dbh->prepare( 1736 'SELECT change_id, script_hash FROM changes WHERE project <> ?', 1737 ); 1738 $sth->execute($plan->project); 1739 while (my $row = $sth->fetch) { 1740 is $row->[1], $row->[0], 1741 'Change ID and script hash should be ' . substr $row->[0], 0, 6; 1742 } 1743 1744 ###################################################################### 1745 # All done. 1746 done_testing; 1747 }; 1748} 1749 1750sub dt_for_change { 1751 my $engine = shift; 1752 my $col = sprintf $engine->_ts2char_format, 'committed_at'; 1753 my $dtfunc = $engine->can('_dt'); 1754 $dtfunc->($engine->dbh->selectcol_arrayref( 1755 "SELECT $col FROM changes WHERE change_id = ?", 1756 undef, shift 1757 )->[0]); 1758} 1759 1760sub dt_for_tag { 1761 my $engine = shift; 1762 my $col = sprintf $engine->_ts2char_format, 'committed_at'; 1763 my $dtfunc = $engine->can('_dt'); 1764 $dtfunc->($engine->dbh->selectcol_arrayref( 1765 "SELECT $col FROM tags WHERE tag_id = ?", 1766 undef, shift 1767 )->[0]); 1768} 1769 1770sub all { 1771 my $iter = shift; 1772 my @res; 1773 while (my $row = $iter->()) { 1774 push @res => $row; 1775 } 1776 return \@res; 1777} 1778 1779sub dt_for_event { 1780 my ($engine, $offset) = @_; 1781 my $col = sprintf $engine->_ts2char_format, 'committed_at'; 1782 my $dtfunc = $engine->can('_dt'); 1783 my $dbh = $engine->dbh; 1784 return $dtfunc->($engine->dbh->selectcol_arrayref(qq{ 1785 SELECT ts FROM ( 1786 SELECT ts, rownum AS rnum FROM ( 1787 SELECT $col AS ts 1788 FROM events 1789 ORDER BY committed_at ASC 1790 ) 1791 ) WHERE rnum = ? 1792 }, undef, $offset + 1)->[0]) if $dbh->{Driver}->{Name} eq 'Oracle'; 1793 return $dtfunc->($engine->dbh->selectcol_arrayref( 1794 "SELECT FIRST 1 SKIP $offset $col FROM events ORDER BY committed_at ASC", 1795 )->[0]) if $dbh->{Driver}->{Name} eq 'Firebird'; 1796 return $dtfunc->($engine->dbh->selectcol_arrayref( 1797 "SELECT $col FROM events ORDER BY committed_at ASC LIMIT 1 OFFSET $offset", 1798 )->[0]); 1799} 1800 1801sub all_changes { 1802 shift->dbh->selectall_arrayref(q{ 1803 SELECT change_id, c.change, project, note, committer_name, committer_email, 1804 planner_name, planner_email 1805 FROM changes c 1806 ORDER BY committed_at 1807 }); 1808} 1809 1810sub all_tags { 1811 shift->dbh->selectall_arrayref(q{ 1812 SELECT tag_id, tag, change_id, project, note, 1813 committer_name, committer_email, planner_name, planner_email 1814 FROM tags 1815 ORDER BY committed_at 1816 }); 1817} 1818 1819sub all_events { 1820 shift->dbh->selectall_arrayref(q{ 1821 SELECT event, change_id, e.change, project, note, requires, conflicts, tags, 1822 committer_name, committer_email, planner_name, planner_email 1823 FROM events e 1824 ORDER BY committed_at 1825 }); 1826} 1827 1828sub get_dependencies { 1829 shift->dbh->selectall_arrayref(q{ 1830 SELECT change_id, type, dependency, dependency_id 1831 FROM dependencies 1832 WHERE change_id = ? 1833 ORDER BY dependency 1834 }, undef, shift); 1835} 1836 18371; 1838