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