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