t/23dumpmore.t

   1 use warnings;
   2 use strict;
   3
   4 use File::Temp ();
   5 use Test::More;
   6
   7 use lib qw(t/lib);
   8 use dbixcsl_dumper_tests;
   9 my $t = 'dbixcsl_dumper_tests';
  10
  11 $t->cleanup;
  12
  13 # test loading external content
  14 $t->dump_test(
  15   classname => 'DBICTest::Schema::_no_skip_load_external',
  16   warnings => [
  17     qr/Dumping manual schema for DBICTest::Schema::_no_skip_load_external to directory /,
  18     qr/Schema dump completed/,
  19   ],
  20   regexes => {
  21     Foo => [
  22       qr/package DBICTest::Schema::_no_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/
  23     ],
  24   },
  25 );
  26
  27 # test skipping external content
  28 $t->dump_test(
  29   classname => 'DBICTest::Schema::_skip_load_external',
  30   options => {
  31     skip_load_external => 1
  32   },
  33   warnings => [
  34     qr/Dumping manual schema for DBICTest::Schema::_skip_load_external to directory /,
  35     qr/Schema dump completed/,
  36   ],
  37   neg_regexes => {
  38     Foo => [
  39       qr/package DBICTest::Schema::_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/
  40     ],
  41   },
  42 );
  43
  44 $t->cleanup;
  45 # test config_file
  46 {
  47   my $config_file = File::Temp->new (UNLINK => 1);
  48
  49   print $config_file "{ skip_relationships => 1 }\n";
  50   close $config_file;
  51
  52   $t->dump_test(
  53     classname => 'DBICTest::Schema::_config_file',
  54     options => { config_file => "$config_file" },
  55     warnings => [
  56       qr/Dumping manual schema for DBICTest::Schema::_config_file to directory /,
  57       qr/Schema dump completed/,
  58     ],
  59     neg_regexes => {
  60       Foo => [
  61         qr/has_many/,
  62       ],
  63     },
  64   );
  65 }
  66
  67 # proper exception
  68 $t->dump_test(
  69   classname => 'DBICTest::Schema::_clashing_monikers',
  70   test_db_class => 'make_dbictest_db_clashing_monikers',
  71   error => qr/tables 'bar', 'bars' reduced to the same source moniker 'Bar'/,
  72 );
  73
  74
  75 $t->cleanup;
  76
  77 # test out the POD
  78 $t->dump_test(
  79   classname => 'DBICTest::DumpMore::1',
  80   options => {
  81     custom_column_info => sub {
  82       my ($table, $col, $info) = @_;
  83       return +{ extra => { is_footext => 1 } } if $col eq 'footext';
  84     },
  85     additional_classes => 'TestAdditional',
  86     additional_base_classes => 'TestAdditionalBase',
  87     left_base_classes => 'TestLeftBase',
  88     components => [ 'TestComponent', '+TestComponentFQN' ],
  89   },
  90   warnings => [
  91     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
  92     qr/Schema dump completed/,
  93   ],
  94   regexes => {
  95     schema => [
  96       qr/package DBICTest::DumpMore::1;/,
  97       qr/->load_classes/,
  98     ],
  99     Foo => [
 100       qr/package DBICTest::DumpMore::1::Foo;/,
 101       qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
 102       qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item L<TestAdditional>\n\n=back\n\n=cut\n\n/,
 103       qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
 104       qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
 105       qr/\n=head1 COMPONENTS LOADED\n\n=over 4\n\n=item L<DBIx::Class::TestComponent>\n\n=item L<TestComponentFQN>\n\n=back\n\n=cut\n\n/,
 106       qr/\n=head1 ACCESSORS\n\n/,
 107       qr/\n=head2 fooid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
 108       qr/\n=head2 footext\n\n  data_type: 'text'\n  default_value: 'footext'\n  extra: {is_footext => 1}\n  is_nullable: 1\n\n/,
 109       qr/->set_primary_key/,
 110       qr/\n=head1 RELATIONS\n\n/,
 111       qr/\n=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
 112       qr/1;\n$/,
 113     ],
 114     Bar => [
 115       qr/package DBICTest::DumpMore::1::Bar;/,
 116       qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
 117       qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item L<TestAdditional>\n\n=back\n\n=cut\n\n/,
 118       qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
 119       qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
 120       qr/\n=head1 COMPONENTS LOADED\n\n=over 4\n\n=item L<DBIx::Class::TestComponent>\n\n=item L<TestComponentFQN>\n\n=back\n\n=cut\n\n/,
 121       qr/\n=head1 ACCESSORS\n\n/,
 122       qr/\n=head2 barid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
 123       qr/\n=head2 fooref\n\n  data_type: 'integer'\n  is_foreign_key: 1\n  is_nullable: 1\n\n/,
 124       qr/->set_primary_key/,
 125       qr/\n=head1 RELATIONS\n\n/,
 126       qr/\n=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
 127       qr/\n1;\n$/,
 128     ],
 129   },
 130 );
 131
 132
 133 $t->append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
 134
 135
 136 $t->dump_test(
 137   classname => 'DBICTest::DumpMore::1',
 138   warnings => [
 139     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 140     qr/Schema dump completed/,
 141   ],
 142   regexes => {
 143     schema => [
 144       qr/package DBICTest::DumpMore::1;/,
 145       qr/->load_classes/,
 146     ],
 147     Foo => [
 148       qr/package DBICTest::DumpMore::1::Foo;/,
 149       qr/->set_primary_key/,
 150       qr/1;\n# XXX This is my custom content XXX/,
 151     ],
 152     Bar => [
 153       qr/package DBICTest::DumpMore::1::Bar;/,
 154       qr/->set_primary_key/,
 155       qr/1;\n$/,
 156     ],
 157   },
 158 );
 159
 160
 161 $t->dump_test(
 162   classname => 'DBICTest::DumpMore::1',
 163   options => {
 164     really_erase_my_files => 1
 165   },
 166   warnings => [
 167     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 168     qr/Deleting existing file /,
 169     qr/Deleting existing file /,
 170     qr/Deleting existing file /,
 171     qr/Schema dump completed/,
 172   ],
 173   regexes => {
 174     schema => [
 175       qr/package DBICTest::DumpMore::1;/,
 176       qr/->load_classes/,
 177     ],
 178     Foo => [
 179       qr/package DBICTest::DumpMore::1::Foo;/,
 180       qr/->set_primary_key/,
 181       qr/1;\n$/,
 182     ],
 183     Bar => [
 184       qr/package DBICTest::DumpMore::1::Bar;/,
 185       qr/->set_primary_key/,
 186       qr/1;\n$/,
 187     ],
 188   },
 189   neg_regexes => {
 190     Foo => [
 191       qr/# XXX This is my custom content XXX/,
 192     ],
 193   },
 194 );
 195
 196
 197 $t->cleanup;
 198
 199 # test namespaces
 200 $t->dump_test(
 201   classname => 'DBICTest::DumpMore::1',
 202   options => {
 203     use_namespaces => 1,
 204     generate_pod => 0
 205   },
 206   warnings => [
 207     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 208     qr/Schema dump completed/,
 209   ],
 210   neg_regexes => {
 211     'Result/Foo' => [
 212       qr/^=/m,
 213     ],
 214   },
 215 );
 216
 217
 218 $t->dump_test(
 219   classname => 'DBICTest::DumpMore::1',
 220   options => {
 221     db_schema => 'foo_schema',
 222     qualify_objects => 1,
 223     use_namespaces => 1
 224   },
 225   warnings => [
 226     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 227     qr/Schema dump completed/,
 228   ],
 229   regexes => {
 230     'Result/Foo' => [
 231       qr/^\Q__PACKAGE__->table("foo_schema.foo");\E/m,
 232       # the has_many relname should not have the schema in it!
 233       qr/^__PACKAGE__->has_many\(\n  "bars"/m,
 234     ],
 235   },
 236 );
 237
 238 $t->dump_test(
 239   classname => 'DBICTest::DumpMore::1',
 240   options => {
 241     use_namespaces => 1
 242   },
 243   warnings => [
 244     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 245     qr/Schema dump completed/,
 246   ],
 247   regexes => {
 248     schema => [
 249       qr/package DBICTest::DumpMore::1;/,
 250       qr/->load_namespaces/,
 251     ],
 252     'Result/Foo' => [
 253       qr/package DBICTest::DumpMore::1::Result::Foo;/,
 254       qr/->set_primary_key/,
 255       qr/1;\n$/,
 256     ],
 257     'Result/Bar' => [
 258       qr/package DBICTest::DumpMore::1::Result::Bar;/,
 259       qr/->set_primary_key/,
 260       qr/1;\n$/,
 261     ],
 262   },
 263 );
 264
 265
 266 $t->dump_test(
 267   classname => 'DBICTest::DumpMore::1',
 268   options => {
 269     use_namespaces => 1,
 270     result_namespace => 'Res',
 271     resultset_namespace => 'RSet',
 272     default_resultset_class => 'RSetBase',
 273   },
 274   warnings => [
 275     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 276     qr/Schema dump completed/,
 277   ],
 278   regexes => {
 279     schema => [
 280       qr/package DBICTest::DumpMore::1;/,
 281       qr/->load_namespaces/,
 282       qr/result_namespace => 'Res'/,
 283       qr/resultset_namespace => 'RSet'/,
 284       qr/default_resultset_class => 'RSetBase'/,
 285     ],
 286     'Res/Foo' => [
 287       qr/package DBICTest::DumpMore::1::Res::Foo;/,
 288       qr/->set_primary_key/,
 289       qr/1;\n$/,
 290     ],
 291     'Res/Bar' => [
 292       qr/package DBICTest::DumpMore::1::Res::Bar;/,
 293       qr/->set_primary_key/,
 294       qr/1;\n$/,
 295     ],
 296   },
 297 );
 298
 299
 300 $t->dump_test(
 301   classname => 'DBICTest::DumpMore::1',
 302   options => {
 303     use_namespaces => 1,
 304     result_namespace => '+DBICTest::DumpMore::1::Res',
 305     resultset_namespace => 'RSet',
 306     default_resultset_class => 'RSetBase',
 307     result_base_class => 'My::ResultBaseClass',
 308     schema_base_class => 'My::SchemaBaseClass',
 309   },
 310   warnings => [
 311     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 312     qr/Schema dump completed/,
 313   ],
 314   regexes => {
 315     schema => [
 316       qr/package DBICTest::DumpMore::1;/,
 317       qr/->load_namespaces/,
 318       qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/,
 319       qr/resultset_namespace => 'RSet'/,
 320       qr/default_resultset_class => 'RSetBase'/,
 321       qr/use base 'My::SchemaBaseClass'/,
 322     ],
 323     'Res/Foo' => [
 324       qr/package DBICTest::DumpMore::1::Res::Foo;/,
 325       qr/use base 'My::ResultBaseClass'/,
 326       qr/->set_primary_key/,
 327       qr/1;\n$/,
 328     ],
 329     'Res/Bar' => [
 330       qr/package DBICTest::DumpMore::1::Res::Bar;/,
 331       qr/use base 'My::ResultBaseClass'/,
 332       qr/->set_primary_key/,
 333       qr/1;\n$/,
 334     ],
 335   },
 336 );
 337
 338
 339 $t->dump_test(
 340   classname => 'DBICTest::DumpMore::1',
 341   options => {
 342     use_namespaces    => 1,
 343     result_base_class => 'My::MissingResultBaseClass',
 344   },
 345   error => qr/My::MissingResultBaseClass.*is not installed/,
 346 );
 347
 348 # test quote_char in connect_info for dbicdump
 349 $t->dump_test(
 350   classname => 'DBICTest::DumpMore::1',
 351   extra_connect_info => [
 352     '',
 353     '',
 354     { quote_char => '"' },
 355   ],
 356   warnings => [
 357     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 358     qr/Schema dump completed/,
 359   ],
 360 );
 361
 362 done_testing;