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     result_base_class => 'My::ResultBaseClass',
  86     additional_classes => 'TestAdditional',
  87     additional_base_classes => 'TestAdditionalBase',
  88     left_base_classes => 'TestLeftBase',
  89     components => [ 'TestComponent', '+TestComponentFQN' ],
  90   },
  91   warnings => [
  92     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
  93     qr/Schema dump completed/,
  94   ],
  95   regexes => {
  96     schema => [
  97       qr/package DBICTest::DumpMore::1;/,
  98       qr/->load_classes/,
  99     ],
 100     Foo => [
 101       qr/package DBICTest::DumpMore::1::Foo;/,
 102       qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
 103       qr/\n=head1 BASE CLASS: L<My::ResultBaseClass>\n\n=cut\n\n/,
 104       qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item \* L<TestAdditional>\n\n=back\n\n=cut\n\n/,
 105       qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item \* L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
 106       qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item \* L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
 107       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/,
 108       qr/\n=head1 ACCESSORS\n\n/,
 109       qr/\n=head2 fooid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
 110       qr/\n=head2 footext\n\n  data_type: 'text'\n  default_value: 'footext'\n  extra: {is_footext => 1}\n  is_nullable: 1\n\n/,
 111       qr/->set_primary_key/,
 112       qr/\n=head1 RELATIONS\n\n/,
 113       qr/\n=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
 114       qr/1;\n$/,
 115     ],
 116     Bar => [
 117       qr/package DBICTest::DumpMore::1::Bar;/,
 118       qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
 119       qr/\n=head1 BASE CLASS: L<My::ResultBaseClass>\n\n=cut\n\n/,
 120       qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item \* L<TestAdditional>\n\n=back\n\n=cut\n\n/,
 121       qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item \* L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
 122       qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item \* L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
 123       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/,
 124       qr/\n=head1 ACCESSORS\n\n/,
 125       qr/\n=head2 barid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
 126       qr/\n=head2 fooref\n\n  data_type: 'integer'\n  is_foreign_key: 1\n  is_nullable: 1\n\n/,
 127       qr/->set_primary_key/,
 128       qr/\n=head1 RELATIONS\n\n/,
 129       qr/\n=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
 130       qr/\n1;\n$/,
 131     ],
 132   },
 133 );
 134
 135
 136 $t->append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
 137
 138
 139 $t->dump_test(
 140   classname => 'DBICTest::DumpMore::1',
 141   warnings => [
 142     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 143     qr/Schema dump completed/,
 144   ],
 145   regexes => {
 146     schema => [
 147       qr/package DBICTest::DumpMore::1;/,
 148       qr/->load_classes/,
 149     ],
 150     Foo => [
 151       qr/package DBICTest::DumpMore::1::Foo;/,
 152       qr/->set_primary_key/,
 153       qr/1;\n# XXX This is my custom content XXX/,
 154     ],
 155     Bar => [
 156       qr/package DBICTest::DumpMore::1::Bar;/,
 157       qr/->set_primary_key/,
 158       qr/1;\n$/,
 159     ],
 160   },
 161 );
 162
 163
 164 $t->dump_test(
 165   classname => 'DBICTest::DumpMore::1',
 166   options => {
 167     really_erase_my_files => 1
 168   },
 169   warnings => [
 170     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 171     qr/Deleting existing file /,
 172     qr/Deleting existing file /,
 173     qr/Deleting existing file /,
 174     qr/Schema dump completed/,
 175   ],
 176   regexes => {
 177     schema => [
 178       qr/package DBICTest::DumpMore::1;/,
 179       qr/->load_classes/,
 180     ],
 181     Foo => [
 182       qr/package DBICTest::DumpMore::1::Foo;/,
 183       qr/->set_primary_key/,
 184       qr/1;\n$/,
 185     ],
 186     Bar => [
 187       qr/package DBICTest::DumpMore::1::Bar;/,
 188       qr/->set_primary_key/,
 189       qr/1;\n$/,
 190     ],
 191   },
 192   neg_regexes => {
 193     Foo => [
 194       qr/# XXX This is my custom content XXX/,
 195     ],
 196   },
 197 );
 198
 199
 200 $t->cleanup;
 201
 202 # test namespaces
 203 $t->dump_test(
 204   classname => 'DBICTest::DumpMore::1',
 205   options => {
 206     use_namespaces => 1,
 207     generate_pod => 0
 208   },
 209   warnings => [
 210     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 211     qr/Schema dump completed/,
 212   ],
 213   neg_regexes => {
 214     'Result/Foo' => [
 215       qr/^=/m,
 216     ],
 217   },
 218 );
 219
 220
 221 $t->dump_test(
 222   classname => 'DBICTest::DumpMore::1',
 223   options => {
 224     db_schema => 'foo_schema',
 225     qualify_objects => 1,
 226     use_namespaces => 1
 227   },
 228   warnings => [
 229     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 230     qr/Schema dump completed/,
 231   ],
 232   regexes => {
 233     'Result/Foo' => [
 234       qr/^\Q__PACKAGE__->table("foo_schema.foo");\E/m,
 235       # the has_many relname should not have the schema in it!
 236       qr/^__PACKAGE__->has_many\(\n  "bars"/m,
 237     ],
 238   },
 239 );
 240
 241 $t->dump_test(
 242   classname => 'DBICTest::DumpMore::1',
 243   options => {
 244     use_namespaces => 1
 245   },
 246   warnings => [
 247     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 248     qr/Schema dump completed/,
 249   ],
 250   regexes => {
 251     schema => [
 252       qr/package DBICTest::DumpMore::1;/,
 253       qr/->load_namespaces/,
 254     ],
 255     'Result/Foo' => [
 256       qr/package DBICTest::DumpMore::1::Result::Foo;/,
 257       qr/->set_primary_key/,
 258       qr/1;\n$/,
 259     ],
 260     'Result/Bar' => [
 261       qr/package DBICTest::DumpMore::1::Result::Bar;/,
 262       qr/->set_primary_key/,
 263       qr/1;\n$/,
 264     ],
 265   },
 266 );
 267
 268
 269 $t->dump_test(
 270   classname => 'DBICTest::DumpMore::1',
 271   options => {
 272     use_namespaces => 1,
 273     result_namespace => 'Res',
 274     resultset_namespace => 'RSet',
 275     default_resultset_class => 'RSetBase',
 276   },
 277   warnings => [
 278     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 279     qr/Schema dump completed/,
 280   ],
 281   regexes => {
 282     schema => [
 283       qr/package DBICTest::DumpMore::1;/,
 284       qr/->load_namespaces/,
 285       qr/result_namespace => 'Res'/,
 286       qr/resultset_namespace => 'RSet'/,
 287       qr/default_resultset_class => 'RSetBase'/,
 288     ],
 289     'Res/Foo' => [
 290       qr/package DBICTest::DumpMore::1::Res::Foo;/,
 291       qr/->set_primary_key/,
 292       qr/1;\n$/,
 293     ],
 294     'Res/Bar' => [
 295       qr/package DBICTest::DumpMore::1::Res::Bar;/,
 296       qr/->set_primary_key/,
 297       qr/1;\n$/,
 298     ],
 299   },
 300 );
 301
 302
 303 $t->dump_test(
 304   classname => 'DBICTest::DumpMore::1',
 305   options => {
 306     use_namespaces => 1,
 307     result_namespace => '+DBICTest::DumpMore::1::Res',
 308     resultset_namespace => 'RSet',
 309     default_resultset_class => 'RSetBase',
 310     result_base_class => 'My::ResultBaseClass',
 311     schema_base_class => 'My::SchemaBaseClass',
 312   },
 313   warnings => [
 314     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 315     qr/Schema dump completed/,
 316   ],
 317   regexes => {
 318     schema => [
 319       qr/package DBICTest::DumpMore::1;/,
 320       qr/->load_namespaces/,
 321       qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/,
 322       qr/resultset_namespace => 'RSet'/,
 323       qr/default_resultset_class => 'RSetBase'/,
 324       qr/use base 'My::SchemaBaseClass'/,
 325     ],
 326     'Res/Foo' => [
 327       qr/package DBICTest::DumpMore::1::Res::Foo;/,
 328       qr/use base 'My::ResultBaseClass'/,
 329       qr/->set_primary_key/,
 330       qr/1;\n$/,
 331     ],
 332     'Res/Bar' => [
 333       qr/package DBICTest::DumpMore::1::Res::Bar;/,
 334       qr/use base 'My::ResultBaseClass'/,
 335       qr/->set_primary_key/,
 336       qr/1;\n$/,
 337     ],
 338   },
 339 );
 340
 341
 342 $t->dump_test(
 343   classname => 'DBICTest::DumpMore::1',
 344   options => {
 345     use_namespaces    => 1,
 346     result_base_class => 'My::MissingResultBaseClass',
 347   },
 348   error => qr/My::MissingResultBaseClass.*is not installed/,
 349 );
 350
 351 # test quote_char in connect_info for dbicdump
 352 $t->dump_test(
 353   classname => 'DBICTest::DumpMore::1',
 354   extra_connect_info => [
 355     '',
 356     '',
 357     { quote_char => '"' },
 358   ],
 359   warnings => [
 360     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 361     qr/Schema dump completed/,
 362   ],
 363 );
 364
 365 done_testing;