lib/DBIx/Class/Optional/Dependencies.pm

   1 package DBIx::Class::Optional::Dependencies;
   2
   3 use warnings;
   4 use strict;
   5
   6 use Carp;
   7
   8 # NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G)
   9 # This module is to be loaded by Makefile.PM on a pristine system
  10
  11 # POD is generated automatically by calling _gen_pod from the
  12 # Makefile.PL in $AUTHOR mode
  13
  14 my $json_any = {
  15   'JSON::Any'                     => '1.22',
  16 };
  17
  18 my $moose_basic = {
  19   'Moose'                         => '0.98',
  20   'MooseX::Types'                 => '0.21',
  21 };
  22
  23 my $replicated = {
  24   %$moose_basic,
  25   'Hash::Merge'                   => '0.12',
  26 };
  27
  28 my $admin_basic = {
  29   %$moose_basic,
  30   %$json_any,
  31   'MooseX::Types::Path::Class'    => '0.05',
  32   'MooseX::Types::JSON'           => '0.02',
  33   'namespace::autoclean'          => '0.09',
  34 };
  35
  36 my $datetime_basic = {
  37   'DateTime'                      => '0.55',
  38   'DateTime::Format::Strptime'    => '1.2',
  39 };
  40
  41 my $reqs = {
  42   dist => {
  43     #'Module::Install::Pod::Inherit' => '0.01',
  44   },
  45
  46   replicated => {
  47     req => $replicated,
  48     pod => {
  49       title => 'Storage::Replicated',
  50       desc => 'Modules required for L<DBIx::Class::Storage::DBI::Replicated>',
  51     },
  52   },
  53
  54   test_replicated => {
  55     req => {
  56       %$replicated,
  57       'Test::Moose'               => '0',
  58     },
  59   },
  60
  61
  62   admin => {
  63     req => {
  64       %$admin_basic,
  65     },
  66     pod => {
  67       title => 'DBIx::Class::Admin',
  68       desc => 'Modules required for the DBIx::Class administrative library',
  69     },
  70   },
  71
  72   admin_script => {
  73     req => {
  74       %$moose_basic,
  75       %$admin_basic,
  76       'Getopt::Long::Descriptive' => '0.081',
  77       'Text::CSV'                 => '1.16',
  78     },
  79     pod => {
  80       title => 'dbicadmin',
  81       desc => 'Modules required for the CLI DBIx::Class interface dbicadmin',
  82     },
  83   },
  84
  85   deploy => {
  86     req => {
  87       'SQL::Translator'           => '0.11006',
  88     },
  89     pod => {
  90       title => 'Storage::DBI::deploy()',
  91       desc => 'Modules required for L<DBIx::Class::Storage::DBI/deploy> and L<DBIx::Class::Storage::DBI/deploymen_statements>',
  92     },
  93   },
  94
  95   test_pod => {
  96     req => {
  97       'Test::Pod'                 => '1.41',
  98     },
  99   },
 100
 101   test_podcoverage => {
 102     req => {
 103       'Test::Pod::Coverage'       => '1.08',
 104       'Pod::Coverage'             => '0.20',
 105     },
 106   },
 107
 108   test_notabs => {
 109     req => {
 110       'Test::NoTabs'              => '0.9',
 111     },
 112   },
 113
 114   test_eol => {
 115     req => {
 116       'Test::EOL'                 => '0.6',
 117     },
 118   },
 119
 120   test_prettydebug => {
 121     req => $json_any,
 122   },
 123
 124   test_leaks => {
 125     req => {
 126       'Test::Memory::Cycle'       => '0',
 127       'Devel::Cycle'              => '1.10',
 128     },
 129   },
 130
 131   test_dt => {
 132     req => $datetime_basic,
 133   },
 134
 135   test_dt_sqlite => {
 136     req => {
 137       %$datetime_basic,
 138       # t/36datetime.t
 139       # t/60core.t
 140       'DateTime::Format::SQLite'  => '0',
 141     },
 142   },
 143
 144   test_dt_mysql => {
 145     req => {
 146       %$datetime_basic,
 147       # t/inflate/datetime_mysql.t
 148       # (doesn't need Mysql itself)
 149       'DateTime::Format::MySQL'   => '0',
 150     },
 151   },
 152
 153   test_dt_pg => {
 154     req => {
 155       %$datetime_basic,
 156       # t/inflate/datetime_pg.t
 157       # (doesn't need PG itself)
 158       'DateTime::Format::Pg'      => '0.16004',
 159     },
 160   },
 161
 162   test_cdbicompat => {
 163     req => {
 164       'DBIx::ContextualFetch'     => '0',
 165       'Class::DBI::Plugin::DeepAbstractSearch' => '0',
 166       'Class::Trigger'            => '0',
 167       'Time::Piece::MySQL'        => '0',
 168       'Clone'                     => '0',
 169       'Date::Simple'              => '3.03',
 170     },
 171   },
 172
 173   test_rdbms_pg => {
 174     req => {
 175       $ENV{DBICTEST_PG_DSN}
 176         ? (
 177           'Sys::SigAction'        => '0',
 178           'DBD::Pg'               => '2.009002',
 179         ) : ()
 180     },
 181   },
 182
 183   test_rdbms_mssql_odbc => {
 184     req => {
 185       $ENV{DBICTEST_MSSQL_ODBC_DSN}
 186         ? (
 187           'DBD::ODBC'             => '0',
 188         ) : ()
 189     },
 190   },
 191
 192   test_rdbms_mssql_sybase => {
 193     req => {
 194       $ENV{DBICTEST_MSSQL_DSN}
 195         ? (
 196           'DBD::Sybase'           => '0',
 197         ) : ()
 198     },
 199   },
 200
 201   test_rdbms_mysql => {
 202     req => {
 203       $ENV{DBICTEST_MYSQL_DSN}
 204         ? (
 205           'DBD::mysql'            => '0',
 206         ) : ()
 207     },
 208   },
 209
 210   test_rdbms_oracle => {
 211     req => {
 212       $ENV{DBICTEST_ORA_DSN}
 213         ? (
 214           'DateTime::Format::Oracle' => '0',
 215           'DBD::Oracle'              => '1.24',
 216         ) : ()
 217     },
 218   },
 219
 220   test_rdbms_ase => {
 221     req => {
 222       $ENV{DBICTEST_SYBASE_DSN}
 223         ? (
 224           'DateTime::Format::Sybase' => 0,
 225         ) : ()
 226     },
 227   },
 228
 229   test_rdbms_db2 => {
 230     req => {
 231       $ENV{DBICTEST_DB2_DSN}
 232         ? (
 233           'DBD::DB2' => 0,
 234         ) : ()
 235     },
 236   },
 237
 238 };
 239
 240
 241 sub req_list_for {
 242   my ($class, $group) = @_;
 243
 244   croak "req_list_for() expects a requirement group name"
 245     unless $group;
 246
 247   my $deps = $reqs->{$group}{req}
 248     or croak "Requirement group '$group' does not exist";
 249
 250   return { %$deps };
 251 }
 252
 253
 254 our %req_availability_cache;
 255 sub req_ok_for {
 256   my ($class, $group) = @_;
 257
 258   croak "req_ok_for() expects a requirement group name"
 259     unless $group;
 260
 261   return $class->_check_deps($group)->{status};
 262 }
 263
 264 sub req_missing_for {
 265   my ($class, $group) = @_;
 266
 267   croak "req_missing_for() expects a requirement group name"
 268     unless $group;
 269
 270   return $class->_check_deps($group)->{missing};
 271 }
 272
 273 sub req_errorlist_for {
 274   my ($class, $group) = @_;
 275
 276   croak "req_errorlist_for() expects a requirement group name"
 277     unless $group;
 278
 279   return $class->_check_deps($group)->{errorlist};
 280 }
 281
 282 sub _check_deps {
 283   my ($class, $group) = @_;
 284
 285   return $req_availability_cache{$group} ||= do {
 286
 287     my $deps = $class->req_list_for ($group);
 288
 289     my %errors;
 290     for my $mod (keys %$deps) {
 291       my $req_line = "require $mod;";
 292       if (my $ver = $deps->{$mod}) {
 293         $req_line .= "$mod->VERSION($ver);";
 294       }
 295
 296       eval $req_line;
 297
 298       $errors{$mod} = $@ if $@;
 299     }
 300
 301     my $res;
 302
 303     if (keys %errors) {
 304       my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
 305       $missing .= " (see $class for details)" if $reqs->{$group}{pod};
 306       $res = {
 307         status => 0,
 308         errorlist => \%errors,
 309         missing => $missing,
 310       };
 311     }
 312     else {
 313       $res = {
 314         status => 1,
 315         errorlist => {},
 316         missing => '',
 317       };
 318     }
 319
 320     $res;
 321   };
 322 }
 323
 324 sub req_group_list {
 325   return { map { $_ => { %{ $reqs->{$_}{req} || {} } } } (keys %$reqs) };
 326 }
 327
 328 # This is to be called by the author only (automatically in Makefile.PL)
 329 sub _gen_pod {
 330   my ($class, $distver) = @_;
 331
 332   my $modfn = __PACKAGE__ . '.pm';
 333   $modfn =~ s/\:\:/\//g;
 334
 335   my $podfn = __FILE__;
 336   $podfn =~ s/\.pm$/\.pod/;
 337
 338   $distver ||=
 339     eval { require DBIx::Class; DBIx::Class->VERSION; }
 340       ||
 341     die
 342 "\n\n---------------------------------------------------------------------\n" .
 343 'Unable to load core DBIx::Class module to determine current version, '.
 344 'possibly due to missing dependencies. Author-mode autodocumentation ' .
 345 "halted\n\n" . $@ .
 346 "\n\n---------------------------------------------------------------------\n"
 347   ;
 348
 349   my $sqltver = $class->req_list_for ('deploy')->{'SQL::Translator'}
 350     or die "Hrmm? No sqlt dep?";
 351
 352   my @chunks = (
 353     <<'EOC',
 354 #########################################################################
 355 #####################  A U T O G E N E R A T E D ########################
 356 #########################################################################
 357 #
 358 # The contents of this POD file are auto-generated.  Any changes you make
 359 # will be lost. If you need to change the generated text edit _gen_pod()
 360 # at the end of $modfn
 361 #
 362 EOC
 363     '=head1 NAME',
 364     "$class - Optional module dependency specifications (for module authors)",
 365     '=head1 SYNOPSIS',
 366     <<"EOS",
 367 Somewhere in your build-file (e.g. L<Module::Install>'s Makefile.PL):
 368
 369   ...
 370
 371   configure_requires 'DBIx::Class' => '$distver';
 372
 373   require $class;
 374
 375   my \$deploy_deps = $class->req_list_for ('deploy');
 376
 377   for (keys %\$deploy_deps) {
 378     requires \$_ => \$deploy_deps->{\$_};
 379   }
 380
 381   ...
 382
 383 Note that there are some caveats regarding C<configure_requires()>, more info
 384 can be found at L<Module::Install/configure_requires>
 385 EOS
 386     '=head1 DESCRIPTION',
 387     <<'EOD',
 388 Some of the less-frequently used features of L<DBIx::Class> have external
 389 module dependencies on their own. In order not to burden the average user
 390 with modules he will never use, these optional dependencies are not included
 391 in the base Makefile.PL. Instead an exception with a descriptive message is
 392 thrown when a specific feature is missing one or several modules required for
 393 its operation. This module is the central holding place for  the current list
 394 of such dependencies, for DBIx::Class core authors, and DBIx::Class extension
 395 authors alike.
 396 EOD
 397     '=head1 CURRENT REQUIREMENT GROUPS',
 398     <<'EOD',
 399 Dependencies are organized in C<groups> and each group can list one or more
 400 required modules, with an optional minimum version (or 0 for any version).
 401 The group name can be used in the
 402 EOD
 403   );
 404
 405   for my $group (sort keys %$reqs) {
 406     my $p = $reqs->{$group}{pod}
 407       or next;
 408
 409     my $modlist = $reqs->{$group}{req}
 410       or next;
 411
 412     next unless keys %$modlist;
 413
 414     push @chunks, (
 415       "=head2 $p->{title}",
 416       "$p->{desc}",
 417       '=over',
 418       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
 419       '=back',
 420       "Requirement group: B<$group>",
 421     );
 422   }
 423
 424   push @chunks, (
 425     '=head1 METHODS',
 426     '=head2 req_group_list',
 427     '=over',
 428     '=item Arguments: none',
 429     '=item Returns: \%list_of_requirement_groups',
 430     '=back',
 431     <<'EOD',
 432 This method should be used by DBIx::Class packagers, to get a hashref of all
 433 dependencies keyed by dependency group. Each key (group name) can be supplied
 434 to one of the group-specific methods below.
 435 EOD
 436
 437     '=head2 req_list_for',
 438     '=over',
 439     '=item Arguments: $group_name',
 440     '=item Returns: \%list_of_module_version_pairs',
 441     '=back',
 442     <<'EOD',
 443 This method should be used by DBIx::Class extension authors, to determine the
 444 version of modules a specific feature requires in the B<current> version of
 445 DBIx::Class. See the L</SYNOPSIS> for a real-world
 446 example.
 447 EOD
 448
 449     '=head2 req_ok_for',
 450     '=over',
 451     '=item Arguments: $group_name',
 452     '=item Returns: 1|0',
 453     '=back',
 454     <<'EOD',
 455 Returns true or false depending on whether all modules required by
 456 C<$group_name> are present on the system and loadable.
 457 EOD
 458
 459     '=head2 req_missing_for',
 460     '=over',
 461     '=item Arguments: $group_name',
 462     '=item Returns: $error_message_string',
 463     '=back',
 464     <<"EOD",
 465 Returns a single line string suitable for inclusion in larger error messages.
 466 This method would normally be used by DBIx::Class core-module author, to
 467 indicate to the user that he needs to install specific modules before he will
 468 be able to use a specific feature.
 469
 470 For example if some of the requirements for C<deploy> are not available,
 471 the returned string could look like:
 472
 473  SQL::Translator >= $sqltver (see $class for details)
 474
 475 The author is expected to prepend the necessary text to this message before
 476 returning the actual error seen by the user.
 477 EOD
 478
 479     '=head2 req_errorlist_for',
 480     '=over',
 481     '=item Arguments: $group_name',
 482     '=item Returns: \%list_of_loaderrors_per_module',
 483     '=back',
 484     <<'EOD',
 485 Returns a hashref containing the actual errors that occured while attempting
 486 to load each module in the requirement group.
 487 EOD
 488     '=head1 AUTHOR',
 489     'See L<DBIx::Class/CONTRIBUTORS>.',
 490     '=head1 LICENSE',
 491     'You may distribute this code under the same terms as Perl itself',
 492   );
 493
 494   open (my $fh, '>', $podfn) or croak "Unable to write to $podfn: $!";
 495   print $fh join ("\n\n", @chunks);
 496   close ($fh);
 497 }
 498
 499 1;