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   regexes => {
  17     Foo => [
  18       qr/package DBICTest::Schema::_no_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/
  19     ],
  20   },
  21 );
  22
  23 # test skipping external content
  24 $t->dump_test(
  25   classname => 'DBICTest::Schema::_skip_load_external',
  26   options => {
  27     skip_load_external => 1,
  28   },
  29   neg_regexes => {
  30     Foo => [
  31       qr/package DBICTest::Schema::_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/
  32     ],
  33   },
  34 );
  35
  36 $t->cleanup;
  37 # test config_file
  38 {
  39   my $config_file = File::Temp->new (UNLINK => 1);
  40
  41   print $config_file "{ skip_relationships => 1 }\n";
  42   close $config_file;
  43
  44   $t->dump_test(
  45     classname => 'DBICTest::Schema::_config_file',
  46     options => { config_file => "$config_file" },
  47     neg_regexes => {
  48       Foo => [
  49         qr/has_many/,
  50       ],
  51     },
  52   );
  53 }
  54
  55 # proper exception
  56 $t->dump_test(
  57   classname => 'DBICTest::Schema::_clashing_monikers',
  58   test_db_class => 'make_dbictest_db_clashing_monikers',
  59   error => qr/tables (?:"bar", "bars"|"bars", "bar") reduced to the same source moniker 'Bar'/,
  60 );
  61
  62
  63 $t->cleanup;
  64
  65 # test naming => { column_accessors => 'preserve' }
  66 # also test POD for unique constraint
  67 $t->dump_test(
  68     classname => 'DBICTest::Schema::_preserve_column_accessors',
  69     test_db_class => 'make_dbictest_db_with_unique',
  70     options => { naming => { column_accessors => 'preserve' } },
  71     neg_regexes => {
  72         RouteChange => [
  73             qr/\baccessor\b/,
  74         ],
  75     },
  76     regexes => {
  77         Baz => [
  78             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/,
  79         ],
  80     }
  81 );
  82
  83 $t->cleanup;
  84
  85 # test that rels are sorted
  86 $t->dump_test(
  87     classname => 'DBICTest::Schema::_sorted_rels',
  88     test_db_class => 'make_dbictest_db_with_unique',
  89     regexes => {
  90         Baz => [
  91             qr/->might_have\(\n  "quux".*->belongs_to\(\n  "station_visited"/s,
  92         ],
  93     }
  94 );
  95
  96 $t->cleanup;
  97
  98 $t->dump_test(
  99     classname => 'DBICTest::Schema::_sorted_uniqs',
 100     test_db_class => 'make_dbictest_db_multi_unique',
 101     regexes => {
 102         Bar => [
 103             qr/->add_unique_constraint\("uniq1_unique".*->add_unique_constraint\("uniq2_unique"/s,
 104         ],
 105     },
 106 );
 107
 108 $t->cleanup;
 109
 110 # test naming => { monikers => 'plural' }
 111 $t->dump_test(
 112     classname => 'DBICTest::Schema::_plural_monikers',
 113     options => { naming => { monikers => 'plural' } },
 114     regexes => {
 115         Foos => [
 116             qr/\n=head1 NAME\n\nDBICTest::Schema::_plural_monikers::Foos\n\n=cut\n\n/,
 117         ],
 118         Bars => [
 119             qr/\n=head1 NAME\n\nDBICTest::Schema::_plural_monikers::Bars\n\n=cut\n\n/,
 120         ],
 121     },
 122 );
 123
 124 $t->cleanup;
 125
 126 # test naming => { monikers => 'singular' }
 127 $t->dump_test(
 128     classname => 'DBICTest::Schema::_singular_monikers',
 129     test_db_class => 'make_dbictest_db_plural_tables',
 130     options => { naming => { monikers => 'singular' } },
 131     regexes => {
 132         Foo => [
 133             qr/\n=head1 NAME\n\nDBICTest::Schema::_singular_monikers::Foo\n\n=cut\n\n/,
 134         ],
 135         Bar => [
 136             qr/\n=head1 NAME\n\nDBICTest::Schema::_singular_monikers::Bar\n\n=cut\n\n/,
 137         ],
 138     },
 139 );
 140
 141 $t->cleanup;
 142
 143 # test naming => { monikers => 'preserve' }
 144 $t->dump_test(
 145     classname => 'DBICTest::Schema::_preserve_monikers',
 146     test_db_class => 'make_dbictest_db_plural_tables',
 147     options => { naming => { monikers => 'preserve' } },
 148     regexes => {
 149         Foos => [
 150             qr/\n=head1 NAME\n\nDBICTest::Schema::_preserve_monikers::Foos\n\n=cut\n\n/,
 151         ],
 152         Bars => [
 153             qr/\n=head1 NAME\n\nDBICTest::Schema::_preserve_monikers::Bars\n\n=cut\n\n/,
 154         ],
 155     },
 156 );
 157
 158 $t->cleanup;
 159
 160 # test out the POD
 161 $t->dump_test(
 162   classname => 'DBICTest::DumpMore::1',
 163   options => {
 164     custom_column_info => sub {
 165       my ($table, $col, $info) = @_;
 166       return +{ extra => { is_footext => 1 } } if $col eq 'footext';
 167     },
 168     result_base_class => 'My::ResultBaseClass',
 169     additional_classes => 'TestAdditional',
 170     additional_base_classes => 'TestAdditionalBase',
 171     left_base_classes => 'TestLeftBase',
 172     components => [ 'TestComponent', '+TestComponentFQN' ],
 173   },
 174   regexes => {
 175     schema => [
 176       qr/package DBICTest::DumpMore::1;/,
 177       qr/->load_classes/,
 178     ],
 179     Foo => [
 180       qr/package DBICTest::DumpMore::1::Foo;/,
 181       qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\nuse strict;\nuse warnings;\n\n/,
 182       qr/\n=head1 BASE CLASS: L<My::ResultBaseClass>\n\n=cut\n\nuse base 'My::ResultBaseClass';\n\n/,
 183       qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item \* L<TestAdditional>\n\n=back\n\n=cut\n\n/,
 184       qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item \* L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
 185       qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item \* L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
 186       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/,
 187       qr/\n=head1 TABLE: C<foo>\n\n=cut\n\n__PACKAGE__->table\("foo"\);\n\n/,
 188       qr/\n=head1 ACCESSORS\n\n/,
 189       qr/\n=head2 fooid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
 190       qr/\n=head2 footext\n\n  data_type: 'text'\n  default_value: 'footext'\n  extra: {is_footext => 1}\n  is_nullable: 1\n\n/,
 191       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/,
 192       qr/\n=head1 RELATIONS\n\n/,
 193       qr/\n=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
 194       qr/1;\n$/,
 195     ],
 196     Bar => [
 197       qr/package DBICTest::DumpMore::1::Bar;/,
 198       qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\nuse strict;\nuse warnings;\n\n/,
 199       qr/\n=head1 BASE CLASS: L<My::ResultBaseClass>\n\n=cut\n\nuse base 'My::ResultBaseClass';\n\n/,
 200       qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item \* L<TestAdditional>\n\n=back\n\n=cut\n\n/,
 201       qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item \* L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
 202       qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item \* L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
 203       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/,
 204       qr/\n=head1 TABLE: C<bar>\n\n=cut\n\n__PACKAGE__->table\("bar"\);\n\n/,
 205       qr/\n=head1 ACCESSORS\n\n/,
 206       qr/\n=head2 barid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
 207       qr/\n=head2 fooref\n\n  data_type: 'integer'\n  is_foreign_key: 1\n  is_nullable: 1\n\n/,
 208       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/,
 209       qr/\n=head1 RELATIONS\n\n/,
 210       qr/\n=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
 211       qr/\n1;\n$/,
 212     ],
 213   },
 214 );
 215
 216 $t->append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
 217
 218
 219 $t->dump_test(
 220   classname => 'DBICTest::DumpMore::1',
 221   regexes => {
 222     schema => [
 223       qr/package DBICTest::DumpMore::1;/,
 224       qr/->load_classes/,
 225     ],
 226     Foo => [
 227       qr/package DBICTest::DumpMore::1::Foo;/,
 228       qr/->set_primary_key/,
 229       qr/1;\n# XXX This is my custom content XXX/,
 230     ],
 231     Bar => [
 232       qr/package DBICTest::DumpMore::1::Bar;/,
 233       qr/->set_primary_key/,
 234       qr/1;\n$/,
 235     ],
 236   },
 237 );
 238
 239
 240 $t->dump_test(
 241   classname => 'DBICTest::DumpMore::1',
 242   options => {
 243     really_erase_my_files => 1
 244   },
 245   regexes => {
 246     schema => [
 247       qr/package DBICTest::DumpMore::1;/,
 248       qr/->load_classes/,
 249     ],
 250     Foo => [
 251       qr/package DBICTest::DumpMore::1::Foo;/,
 252       qr/->set_primary_key/,
 253       qr/1;\n$/,
 254     ],
 255     Bar => [
 256       qr/package DBICTest::DumpMore::1::Bar;/,
 257       qr/->set_primary_key/,
 258       qr/1;\n$/,
 259     ],
 260   },
 261   neg_regexes => {
 262     Foo => [
 263       qr/# XXX This is my custom content XXX/,
 264     ],
 265   },
 266 );
 267
 268
 269 $t->cleanup;
 270
 271 # test namespaces
 272 $t->dump_test(
 273   classname => 'DBICTest::DumpMore::1',
 274   options => {
 275     use_namespaces => 1,
 276     generate_pod => 0
 277   },
 278   neg_regexes => {
 279     'Result/Foo' => [
 280       qr/^=/m,
 281     ],
 282   },
 283 );
 284
 285
 286 $t->dump_test(
 287   classname => 'DBICTest::DumpMore::1',
 288   options => {
 289     db_schema => 'foo_schema',
 290     qualify_objects => 1,
 291     use_namespaces => 1
 292   },
 293   warnings => [
 294     qr/^db_schema is not supported on SQLite/,
 295   ],
 296   regexes => {
 297     'Result/Foo' => [
 298       qr/^\Q__PACKAGE__->table("foo_schema.foo");\E/m,
 299       # the has_many relname should not have the schema in it!
 300       qr/^__PACKAGE__->has_many\(\n  "bars"/m,
 301     ],
 302   },
 303 );
 304
 305 # test moniker_parts
 306 $t->dump_test(
 307   classname => 'DBICTest::DumpMore::1',
 308   options => {
 309     db_schema => 'my_schema',
 310     moniker_parts => ['_schema', 'name'],
 311     qualify_objects => 1,
 312     use_namespaces => 1,
 313   },
 314   warnings => [
 315     qr/^db_schema is not supported on SQLite/,
 316   ],
 317   regexes => {
 318     'Result/MySchemaFoo' => [
 319       qr/^\Q__PACKAGE__->table("my_schema.foo");\E/m,
 320       # the has_many relname should not have the schema in it!
 321       qr/^__PACKAGE__->has_many\(\n  "bars"/m,
 322     ],
 323   },
 324 );
 325
 326 $t->dump_test(
 327   classname => 'DBICTest::DumpMore::1',
 328   options => {
 329     use_namespaces => 1
 330   },
 331   regexes => {
 332     schema => [
 333       qr/package DBICTest::DumpMore::1;/,
 334       qr/->load_namespaces/,
 335     ],
 336     'Result/Foo' => [
 337       qr/package DBICTest::DumpMore::1::Result::Foo;/,
 338       qr/->set_primary_key/,
 339       qr/1;\n$/,
 340     ],
 341     'Result/Bar' => [
 342       qr/package DBICTest::DumpMore::1::Result::Bar;/,
 343       qr/->set_primary_key/,
 344       qr/1;\n$/,
 345     ],
 346   },
 347 );
 348
 349
 350 $t->dump_test(
 351   classname => 'DBICTest::DumpMore::1',
 352   options => {
 353     use_namespaces => 1,
 354     result_namespace => 'Res',
 355     resultset_namespace => 'RSet',
 356     default_resultset_class => 'RSetBase',
 357   },
 358   regexes => {
 359     schema => [
 360       qr/package DBICTest::DumpMore::1;/,
 361       qr/->load_namespaces/,
 362       qr/result_namespace => "Res"/,
 363       qr/resultset_namespace => "RSet"/,
 364       qr/default_resultset_class => "RSetBase"/,
 365     ],
 366     'Res/Foo' => [
 367       qr/package DBICTest::DumpMore::1::Res::Foo;/,
 368       qr/->set_primary_key/,
 369       qr/1;\n$/,
 370     ],
 371     'Res/Bar' => [
 372       qr/package DBICTest::DumpMore::1::Res::Bar;/,
 373       qr/->set_primary_key/,
 374       qr/1;\n$/,
 375     ],
 376   },
 377 );
 378
 379
 380 $t->dump_test(
 381   classname => 'DBICTest::DumpMore::1',
 382   options => {
 383     use_namespaces => 1,
 384     result_namespace => '+DBICTest::DumpMore::1::Res',
 385     resultset_namespace => 'RSet',
 386     default_resultset_class => 'RSetBase',
 387     result_base_class => 'My::ResultBaseClass',
 388     schema_base_class => 'My::SchemaBaseClass',
 389   },
 390   regexes => {
 391     schema => [
 392       qr/package DBICTest::DumpMore::1;/,
 393       qr/->load_namespaces/,
 394       qr/result_namespace => "\+DBICTest::DumpMore::1::Res"/,
 395       qr/resultset_namespace => "RSet"/,
 396       qr/default_resultset_class => "RSetBase"/,
 397       qr/use base 'My::SchemaBaseClass'/,
 398     ],
 399     'Res/Foo' => [
 400       qr/package DBICTest::DumpMore::1::Res::Foo;/,
 401       qr/use base 'My::ResultBaseClass'/,
 402       qr/->set_primary_key/,
 403       qr/1;\n$/,
 404     ],
 405     'Res/Bar' => [
 406       qr/package DBICTest::DumpMore::1::Res::Bar;/,
 407       qr/use base 'My::ResultBaseClass'/,
 408       qr/->set_primary_key/,
 409       qr/1;\n$/,
 410     ],
 411   },
 412 );
 413
 414 $t->dump_test(
 415   classname => 'DBICTest::DumpMore::1',
 416   options => {
 417     use_namespaces    => 1,
 418     result_base_class => 'My::MissingResultBaseClass',
 419   },
 420   error => qr/My::MissingResultBaseClass.*is not installed/,
 421 );
 422
 423 # test quote_char in connect_info for dbicdump
 424 $t->dump_test(
 425   classname => 'DBICTest::DumpMore::1',
 426   extra_connect_info => [
 427     '',
 428     '',
 429     { quote_char => '"' },
 430   ],
 431 );
 432
 433 done_testing;
 434 # vim:et sts=4 sw=4 tw=0: