1use strict; 2use warnings; 3 4use Test::More; 5use lib qw(t/lib); 6use DBICTest; 7 8{ 9 package DBICTest::ResultSource::OtherSource; 10 use strict; 11 use warnings; 12 use base qw/DBIx::Class::ResultSource::Table/; 13} 14 15plan tests => 4; 16 17my $schema = DBICTest->init_schema(); 18my $artist_source = $schema->source('Artist'); 19 20my $new_source = DBICTest::ResultSource::OtherSource->new({ 21 %$artist_source, 22 name => 'artist_preview', 23 _relationships => Storable::dclone( $artist_source->_relationships ), 24}); 25 26$new_source->add_column('other_col' => { data_type => 'integer', default_value => 1 }); 27 28my $warn = ''; 29local $SIG{__WARN__} = sub { $warn = shift }; 30 31{ 32 $schema->register_extra_source( 'artist->extra' => $new_source ); 33 34 my $source = $schema->source('DBICTest::Artist'); 35 is($source->source_name, 'Artist', 'original source still primary source'); 36} 37 38{ 39 my $source = $schema->source('DBICTest::Artist'); 40 $schema->register_source($source->source_name, $source); 41 is($warn, '', "re-registering an existing source under the same name causes no errors"); 42} 43 44{ 45 my $new_source_name = 'Artist->preview(artist_preview)'; 46 $schema->register_source( $new_source_name => $new_source ); 47 48 ok(($warn =~ /DBICTest::Artist already has a source, use register_extra_source for additional sources/), 'registering extra source causes errors'); 49 50 my $source = $schema->source('DBICTest::Artist'); 51 is($source->source_name, $new_source_name, 'original source still primary source'); 52} 53 541; 55