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