t/lib/DBICTest/Schema.pm

   1 package # hide from PAUSE
   2     DBICTest::Schema;
   3
   4 use strict;
   5 use warnings;
   6 no warnings 'qw';
   7
   8 use base 'DBIx::Class::Schema';
   9
  10 use DBICTest::Util qw/populate_weakregistry assert_empty_weakregistry/;
  11 use namespace::clean;
  12
  13 __PACKAGE__->mk_group_accessors(simple => 'custom_attr');
  14
  15 __PACKAGE__->load_classes(qw/
  16   Artist
  17   SequenceTest
  18   BindType
  19   Employee
  20   CD
  21   Genre
  22   Bookmark
  23   Link
  24   #dummy
  25   Track
  26   Tag
  27   Year2000CDs
  28   Year1999CDs
  29   CustomSql
  30   Money
  31   TimestampPrimaryKey
  32   /,
  33   { 'DBICTest::Schema' => [qw/
  34     LinerNotes
  35     Artwork
  36     Artwork_to_Artist
  37     Image
  38     Lyrics
  39     LyricVersion
  40     OneKey
  41     #dummy
  42     TwoKeys
  43     Serialized
  44   /]},
  45   (
  46     'FourKeys',
  47     'FourKeys_to_TwoKeys',
  48     '#dummy',
  49     'SelfRef',
  50     'ArtistUndirectedMap',
  51     'ArtistSourceName',
  52     'ArtistSubclass',
  53     'Producer',
  54     'CD_to_Producer',
  55     'Dummy',    # this is a real result class we remove in the hook below
  56   ),
  57   qw/SelfRefAlias TreeLike TwoKeyTreeLike Event EventTZ NoPrimaryKey/,
  58   qw/Collection CollectionObject TypedObject Owners BooksInLibrary/,
  59   qw/ForceForeign Encoded/,
  60 );
  61
  62 sub sqlt_deploy_hook {
  63   my ($self, $sqlt_schema) = @_;
  64
  65   $sqlt_schema->drop_table('dummy');
  66 }
  67
  68 my $weak_registry = {};
  69
  70 sub clone {
  71   my $self = shift->next::method(@_);
  72   populate_weakregistry ( $weak_registry, $self )
  73     if $INC{'Test/Builder.pm'};
  74   $self;
  75 }
  76
  77 sub connection {
  78   my $self = shift->next::method(@_);
  79
  80   if ($INC{'Test/Builder.pm'}) {
  81     populate_weakregistry ( $weak_registry, $self->storage );
  82
  83     my $cur_connect_call = $self->storage->on_connect_call;
  84
  85     $self->storage->on_connect_call([
  86       (ref $cur_connect_call eq 'ARRAY'
  87         ? @$cur_connect_call
  88         : ($cur_connect_call || ())
  89       ),
  90       [sub {
  91         populate_weakregistry( $weak_registry, shift->_dbh )
  92       }],
  93     ]);
  94   }
  95
  96   $self;
  97 }
  98
  99 END {
 100   assert_empty_weakregistry($weak_registry, 'quiet');
 101 }
 102
 103 1;