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 naming => { column_accessors => 'preserve' }
  78 # also test POD for unique constraint
  79 $t->dump_test(
  80     classname => 'DBICTest::Schema::_preserve_column_accessors',
  81     test_db_class => 'make_dbictest_db_with_unique',
  82     options => { naming => { column_accessors => 'preserve' } },
  83     warnings => [
  84         qr/Dumping manual schema for DBICTest::Schema::_preserve_column_accessors to directory /,
  85         qr/Schema dump completed/,
  86     ],
  87     neg_regexes => {
  88         RouteChange => [
  89             qr/\baccessor\b/,
  90         ],
  91     },
  92     regexes => {
  93         Baz => [
  94             qr/\n\n=head1 UNIQUE CONSTRAINTS\n\n=head2 C<baz_num_unique>\n\n=over 4\n\n=item \* L<\/baz_num>\n\n=back\n\n=cut\n\n__PACKAGE__->add_unique_constraint\("baz_num_unique"\, \["baz_num"\]\);\n\n/,
  95         ],
  96     }
  97 );
  98
  99 $t->cleanup;
 100
 101 # test naming => { monikers => 'plural' }
 102 $t->dump_test(
 103     classname => 'DBICTest::Schema::_plural_monikers',
 104     options => { naming => { monikers => 'plural' } },
 105     warnings => [
 106         qr/Dumping manual schema for DBICTest::Schema::_plural_monikers to directory /,
 107         qr/Schema dump completed/,
 108     ],
 109     regexes => {
 110         Foos => [
 111             qr/\n=head1 NAME\n\nDBICTest::Schema::_plural_monikers::Foos\n\n=cut\n\n/,
 112         ],
 113         Bars => [
 114             qr/\n=head1 NAME\n\nDBICTest::Schema::_plural_monikers::Bars\n\n=cut\n\n/,
 115         ],
 116     },
 117 );
 118
 119 $t->cleanup;
 120
 121 # test naming => { monikers => 'singular' }
 122 $t->dump_test(
 123     classname => 'DBICTest::Schema::_singular_monikers',
 124     test_db_class => 'make_dbictest_db_plural_tables',
 125     options => { naming => { monikers => 'singular' } },
 126     warnings => [
 127         qr/Dumping manual schema for DBICTest::Schema::_singular_monikers to directory /,
 128         qr/Schema dump completed/,
 129     ],
 130     regexes => {
 131         Foo => [
 132             qr/\n=head1 NAME\n\nDBICTest::Schema::_singular_monikers::Foo\n\n=cut\n\n/,
 133         ],
 134         Bar => [
 135             qr/\n=head1 NAME\n\nDBICTest::Schema::_singular_monikers::Bar\n\n=cut\n\n/,
 136         ],
 137     },
 138 );
 139
 140 $t->cleanup;
 141
 142 # test naming => { monikers => 'preserve' }
 143 $t->dump_test(
 144     classname => 'DBICTest::Schema::_preserve_monikers',
 145     test_db_class => 'make_dbictest_db_plural_tables',
 146     options => { naming => { monikers => 'preserve' } },
 147     warnings => [
 148         qr/Dumping manual schema for DBICTest::Schema::_preserve_monikers to directory /,
 149         qr/Schema dump completed/,
 150     ],
 151     regexes => {
 152         Foos => [
 153             qr/\n=head1 NAME\n\nDBICTest::Schema::_preserve_monikers::Foos\n\n=cut\n\n/,
 154         ],
 155         Bars => [
 156             qr/\n=head1 NAME\n\nDBICTest::Schema::_preserve_monikers::Bars\n\n=cut\n\n/,
 157         ],
 158     },
 159 );
 160
 161 $t->cleanup;
 162
 163 # test out the POD
 164 $t->dump_test(
 165   classname => 'DBICTest::DumpMore::1',
 166   options => {
 167     custom_column_info => sub {
 168       my ($table, $col, $info) = @_;
 169       return +{ extra => { is_footext => 1 } } if $col eq 'footext';
 170     },
 171     result_base_class => 'My::ResultBaseClass',
 172     additional_classes => 'TestAdditional',
 173     additional_base_classes => 'TestAdditionalBase',
 174     left_base_classes => 'TestLeftBase',
 175     components => [ 'TestComponent', '+TestComponentFQN' ],
 176   },
 177   warnings => [
 178     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 179     qr/Schema dump completed/,
 180   ],
 181   regexes => {
 182     schema => [
 183       qr/package DBICTest::DumpMore::1;/,
 184       qr/->load_classes/,
 185     ],
 186     Foo => [
 187       qr/package DBICTest::DumpMore::1::Foo;/,
 188       qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\nuse strict;\nuse warnings;\n\n/,
 189       qr/\n=head1 BASE CLASS: L<My::ResultBaseClass>\n\n=cut\n\nuse base 'My::ResultBaseClass';\n\n/,
 190       qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item \* L<TestAdditional>\n\n=back\n\n=cut\n\n/,
 191       qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item \* L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
 192       qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item \* L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
 193       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/,
 194       qr/\n=head1 TABLE: C<foo>\n\n=cut\n\n__PACKAGE__->table\("foo"\);\n\n/,
 195       qr/\n=head1 ACCESSORS\n\n/,
 196       qr/\n=head2 fooid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
 197       qr/\n=head2 footext\n\n  data_type: 'text'\n  default_value: 'footext'\n  extra: {is_footext => 1}\n  is_nullable: 1\n\n/,
 198       qr/\n=head1 PRIMARY KEY\n\n=over 4\n\n=item \* L<\/fooid>\n\n=back\n\n=cut\n\n__PACKAGE__->set_primary_key\("fooid"\);\n/,
 199       qr/\n=head1 RELATIONS\n\n/,
 200       qr/\n=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
 201       qr/1;\n$/,
 202     ],
 203     Bar => [
 204       qr/package DBICTest::DumpMore::1::Bar;/,
 205       qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\nuse strict;\nuse warnings;\n\n/,
 206       qr/\n=head1 BASE CLASS: L<My::ResultBaseClass>\n\n=cut\n\nuse base 'My::ResultBaseClass';\n\n/,
 207       qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item \* L<TestAdditional>\n\n=back\n\n=cut\n\n/,
 208       qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item \* L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
 209       qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item \* L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
 210       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/,
 211       qr/\n=head1 TABLE: C<bar>\n\n=cut\n\n__PACKAGE__->table\("bar"\);\n\n/,
 212       qr/\n=head1 ACCESSORS\n\n/,
 213       qr/\n=head2 barid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
 214       qr/\n=head2 fooref\n\n  data_type: 'integer'\n  is_foreign_key: 1\n  is_nullable: 1\n\n/,
 215       qr/\n=head1 PRIMARY KEY\n\n=over 4\n\n=item \* L<\/barid>\n\n=back\n\n=cut\n\n__PACKAGE__->set_primary_key\("barid"\);\n/,
 216       qr/\n=head1 RELATIONS\n\n/,
 217       qr/\n=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
 218       qr/\n1;\n$/,
 219     ],
 220   },
 221 );
 222
 223 $t->append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
 224
 225
 226 $t->dump_test(
 227   classname => 'DBICTest::DumpMore::1',
 228   warnings => [
 229     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 230     qr/Schema dump completed/,
 231   ],
 232   regexes => {
 233     schema => [
 234       qr/package DBICTest::DumpMore::1;/,
 235       qr/->load_classes/,
 236     ],
 237     Foo => [
 238       qr/package DBICTest::DumpMore::1::Foo;/,
 239       qr/->set_primary_key/,
 240       qr/1;\n# XXX This is my custom content XXX/,
 241     ],
 242     Bar => [
 243       qr/package DBICTest::DumpMore::1::Bar;/,
 244       qr/->set_primary_key/,
 245       qr/1;\n$/,
 246     ],
 247   },
 248 );
 249
 250
 251 $t->dump_test(
 252   classname => 'DBICTest::DumpMore::1',
 253   options => {
 254     really_erase_my_files => 1
 255   },
 256   warnings => [
 257     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 258     qr/Deleting existing file /,
 259     qr/Deleting existing file /,
 260     qr/Deleting existing file /,
 261     qr/Schema dump completed/,
 262   ],
 263   regexes => {
 264     schema => [
 265       qr/package DBICTest::DumpMore::1;/,
 266       qr/->load_classes/,
 267     ],
 268     Foo => [
 269       qr/package DBICTest::DumpMore::1::Foo;/,
 270       qr/->set_primary_key/,
 271       qr/1;\n$/,
 272     ],
 273     Bar => [
 274       qr/package DBICTest::DumpMore::1::Bar;/,
 275       qr/->set_primary_key/,
 276       qr/1;\n$/,
 277     ],
 278   },
 279   neg_regexes => {
 280     Foo => [
 281       qr/# XXX This is my custom content XXX/,
 282     ],
 283   },
 284 );
 285
 286
 287 $t->cleanup;
 288
 289 # test namespaces
 290 $t->dump_test(
 291   classname => 'DBICTest::DumpMore::1',
 292   options => {
 293     use_namespaces => 1,
 294     generate_pod => 0
 295   },
 296   warnings => [
 297     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 298     qr/Schema dump completed/,
 299   ],
 300   neg_regexes => {
 301     'Result/Foo' => [
 302       qr/^=/m,
 303     ],
 304   },
 305 );
 306
 307
 308 $t->dump_test(
 309   classname => 'DBICTest::DumpMore::1',
 310   options => {
 311     db_schema => 'foo_schema',
 312     qualify_objects => 1,
 313     use_namespaces => 1
 314   },
 315   warnings => [
 316     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 317     qr/Schema dump completed/,
 318   ],
 319   regexes => {
 320     'Result/Foo' => [
 321       qr/^\Q__PACKAGE__->table("foo_schema.foo");\E/m,
 322       # the has_many relname should not have the schema in it!
 323       qr/^__PACKAGE__->has_many\(\n  "bars"/m,
 324     ],
 325   },
 326 );
 327
 328 $t->dump_test(
 329   classname => 'DBICTest::DumpMore::1',
 330   options => {
 331     use_namespaces => 1
 332   },
 333   warnings => [
 334     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 335     qr/Schema dump completed/,
 336   ],
 337   regexes => {
 338     schema => [
 339       qr/package DBICTest::DumpMore::1;/,
 340       qr/->load_namespaces/,
 341     ],
 342     'Result/Foo' => [
 343       qr/package DBICTest::DumpMore::1::Result::Foo;/,
 344       qr/->set_primary_key/,
 345       qr/1;\n$/,
 346     ],
 347     'Result/Bar' => [
 348       qr/package DBICTest::DumpMore::1::Result::Bar;/,
 349       qr/->set_primary_key/,
 350       qr/1;\n$/,
 351     ],
 352   },
 353 );
 354
 355
 356 $t->dump_test(
 357   classname => 'DBICTest::DumpMore::1',
 358   options => {
 359     use_namespaces => 1,
 360     result_namespace => 'Res',
 361     resultset_namespace => 'RSet',
 362     default_resultset_class => 'RSetBase',
 363   },
 364   warnings => [
 365     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 366     qr/Schema dump completed/,
 367   ],
 368   regexes => {
 369     schema => [
 370       qr/package DBICTest::DumpMore::1;/,
 371       qr/->load_namespaces/,
 372       qr/result_namespace => "Res"/,
 373       qr/resultset_namespace => "RSet"/,
 374       qr/default_resultset_class => "RSetBase"/,
 375     ],
 376     'Res/Foo' => [
 377       qr/package DBICTest::DumpMore::1::Res::Foo;/,
 378       qr/->set_primary_key/,
 379       qr/1;\n$/,
 380     ],
 381     'Res/Bar' => [
 382       qr/package DBICTest::DumpMore::1::Res::Bar;/,
 383       qr/->set_primary_key/,
 384       qr/1;\n$/,
 385     ],
 386   },
 387 );
 388
 389
 390 $t->dump_test(
 391   classname => 'DBICTest::DumpMore::1',
 392   options => {
 393     use_namespaces => 1,
 394     result_namespace => '+DBICTest::DumpMore::1::Res',
 395     resultset_namespace => 'RSet',
 396     default_resultset_class => 'RSetBase',
 397     result_base_class => 'My::ResultBaseClass',
 398     schema_base_class => 'My::SchemaBaseClass',
 399   },
 400   warnings => [
 401     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 402     qr/Schema dump completed/,
 403   ],
 404   regexes => {
 405     schema => [
 406       qr/package DBICTest::DumpMore::1;/,
 407       qr/->load_namespaces/,
 408       qr/result_namespace => "\+DBICTest::DumpMore::1::Res"/,
 409       qr/resultset_namespace => "RSet"/,
 410       qr/default_resultset_class => "RSetBase"/,
 411       qr/use base 'My::SchemaBaseClass'/,
 412     ],
 413     'Res/Foo' => [
 414       qr/package DBICTest::DumpMore::1::Res::Foo;/,
 415       qr/use base 'My::ResultBaseClass'/,
 416       qr/->set_primary_key/,
 417       qr/1;\n$/,
 418     ],
 419     'Res/Bar' => [
 420       qr/package DBICTest::DumpMore::1::Res::Bar;/,
 421       qr/use base 'My::ResultBaseClass'/,
 422       qr/->set_primary_key/,
 423       qr/1;\n$/,
 424     ],
 425   },
 426 );
 427
 428
 429 $t->dump_test(
 430   classname => 'DBICTest::DumpMore::1',
 431   options => {
 432     use_namespaces    => 1,
 433     result_base_class => 'My::MissingResultBaseClass',
 434   },
 435   error => qr/My::MissingResultBaseClass.*is not installed/,
 436 );
 437
 438 # test quote_char in connect_info for dbicdump
 439 $t->dump_test(
 440   classname => 'DBICTest::DumpMore::1',
 441   extra_connect_info => [
 442     '',
 443     '',
 444     { quote_char => '"' },
 445   ],
 446   warnings => [
 447     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 448     qr/Schema dump completed/,
 449   ],
 450 );
 451
 452 done_testing;
 453 # vim:et sts=4 sw=4 tw=0: