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   test_memcached => {
 239     req => {
 240       $ENV{DBICTEST_MEMCACHED}
 241         ? (
 242           'Cache::Memcached' => 0,
 243         ) : ()
 244     },
 245   },
 246
 247 };
 248
 249
 250 sub req_list_for {
 251   my ($class, $group) = @_;
 252
 253   croak "req_list_for() expects a requirement group name"
 254     unless $group;
 255
 256   my $deps = $reqs->{$group}{req}
 257     or croak "Requirement group '$group' does not exist";
 258
 259   return { %$deps };
 260 }
 261
 262
 263 our %req_availability_cache;
 264 sub req_ok_for {
 265   my ($class, $group) = @_;
 266
 267   croak "req_ok_for() expects a requirement group name"
 268     unless $group;
 269
 270   return $class->_check_deps($group)->{status};
 271 }
 272
 273 sub req_missing_for {
 274   my ($class, $group) = @_;
 275
 276   croak "req_missing_for() expects a requirement group name"
 277     unless $group;
 278
 279   return $class->_check_deps($group)->{missing};
 280 }
 281
 282 sub req_errorlist_for {
 283   my ($class, $group) = @_;
 284
 285   croak "req_errorlist_for() expects a requirement group name"
 286     unless $group;
 287
 288   return $class->_check_deps($group)->{errorlist};
 289 }
 290
 291 sub _check_deps {
 292   my ($class, $group) = @_;
 293
 294   return $req_availability_cache{$group} ||= do {
 295
 296     my $deps = $class->req_list_for ($group);
 297
 298     my %errors;
 299     for my $mod (keys %$deps) {
 300       my $req_line = "require $mod;";
 301       if (my $ver = $deps->{$mod}) {
 302         $req_line .= "$mod->VERSION($ver);";
 303       }
 304
 305       eval $req_line;
 306
 307       $errors{$mod} = $@ if $@;
 308     }
 309
 310     my $res;
 311
 312     if (keys %errors) {
 313       my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
 314       $missing .= " (see $class for details)" if $reqs->{$group}{pod};
 315       $res = {
 316         status => 0,
 317         errorlist => \%errors,
 318         missing => $missing,
 319       };
 320     }
 321     else {
 322       $res = {
 323         status => 1,
 324         errorlist => {},
 325         missing => '',
 326       };
 327     }
 328
 329     $res;
 330   };
 331 }
 332
 333 sub req_group_list {
 334   return { map { $_ => { %{ $reqs->{$_}{req} || {} } } } (keys %$reqs) };
 335 }
 336
 337 # This is to be called by the author only (automatically in Makefile.PL)
 338 sub _gen_pod {
 339   my ($class, $distver) = @_;
 340
 341   my $modfn = __PACKAGE__ . '.pm';
 342   $modfn =~ s/\:\:/\//g;
 343
 344   my $podfn = __FILE__;
 345   $podfn =~ s/\.pm$/\.pod/;
 346
 347   $distver ||=
 348     eval { require DBIx::Class; DBIx::Class->VERSION; }
 349       ||
 350     die
 351 "\n\n---------------------------------------------------------------------\n" .
 352 'Unable to load core DBIx::Class module to determine current version, '.
 353 'possibly due to missing dependencies. Author-mode autodocumentation ' .
 354 "halted\n\n" . $@ .
 355 "\n\n---------------------------------------------------------------------\n"
 356   ;
 357
 358   my $sqltver = $class->req_list_for ('deploy')->{'SQL::Translator'}
 359     or die "Hrmm? No sqlt dep?";
 360
 361   my @chunks = (
 362     <<'EOC',
 363 #########################################################################
 364 #####################  A U T O G E N E R A T E D ########################
 365 #########################################################################
 366 #
 367 # The contents of this POD file are auto-generated.  Any changes you make
 368 # will be lost. If you need to change the generated text edit _gen_pod()
 369 # at the end of $modfn
 370 #
 371 EOC
 372     '=head1 NAME',
 373     "$class - Optional module dependency specifications (for module authors)",
 374     '=head1 SYNOPSIS',
 375     <<"EOS",
 376 Somewhere in your build-file (e.g. L<Module::Install>'s Makefile.PL):
 377
 378   ...
 379
 380   configure_requires 'DBIx::Class' => '$distver';
 381
 382   require $class;
 383
 384   my \$deploy_deps = $class->req_list_for ('deploy');
 385
 386   for (keys %\$deploy_deps) {
 387     requires \$_ => \$deploy_deps->{\$_};
 388   }
 389
 390   ...
 391
 392 Note that there are some caveats regarding C<configure_requires()>, more info
 393 can be found at L<Module::Install/configure_requires>
 394 EOS
 395     '=head1 DESCRIPTION',
 396     <<'EOD',
 397 Some of the less-frequently used features of L<DBIx::Class> have external
 398 module dependencies on their own. In order not to burden the average user
 399 with modules he will never use, these optional dependencies are not included
 400 in the base Makefile.PL. Instead an exception with a descriptive message is
 401 thrown when a specific feature is missing one or several modules required for
 402 its operation. This module is the central holding place for  the current list
 403 of such dependencies, for DBIx::Class core authors, and DBIx::Class extension
 404 authors alike.
 405 EOD
 406     '=head1 CURRENT REQUIREMENT GROUPS',
 407     <<'EOD',
 408 Dependencies are organized in C<groups> and each group can list one or more
 409 required modules, with an optional minimum version (or 0 for any version).
 410 The group name can be used in the
 411 EOD
 412   );
 413
 414   for my $group (sort keys %$reqs) {
 415     my $p = $reqs->{$group}{pod}
 416       or next;
 417
 418     my $modlist = $reqs->{$group}{req}
 419       or next;
 420
 421     next unless keys %$modlist;
 422
 423     push @chunks, (
 424       "=head2 $p->{title}",
 425       "$p->{desc}",
 426       '=over',
 427       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
 428       '=back',
 429       "Requirement group: B<$group>",
 430     );
 431   }
 432
 433   push @chunks, (
 434     '=head1 METHODS',
 435     '=head2 req_group_list',
 436     '=over',
 437     '=item Arguments: none',
 438     '=item Returns: \%list_of_requirement_groups',
 439     '=back',
 440     <<'EOD',
 441 This method should be used by DBIx::Class packagers, to get a hashref of all
 442 dependencies keyed by dependency group. Each key (group name) can be supplied
 443 to one of the group-specific methods below.
 444 EOD
 445
 446     '=head2 req_list_for',
 447     '=over',
 448     '=item Arguments: $group_name',
 449     '=item Returns: \%list_of_module_version_pairs',
 450     '=back',
 451     <<'EOD',
 452 This method should be used by DBIx::Class extension authors, to determine the
 453 version of modules a specific feature requires in the B<current> version of
 454 DBIx::Class. See the L</SYNOPSIS> for a real-world
 455 example.
 456 EOD
 457
 458     '=head2 req_ok_for',
 459     '=over',
 460     '=item Arguments: $group_name',
 461     '=item Returns: 1|0',
 462     '=back',
 463     <<'EOD',
 464 Returns true or false depending on whether all modules required by
 465 C<$group_name> are present on the system and loadable.
 466 EOD
 467
 468     '=head2 req_missing_for',
 469     '=over',
 470     '=item Arguments: $group_name',
 471     '=item Returns: $error_message_string',
 472     '=back',
 473     <<"EOD",
 474 Returns a single line string suitable for inclusion in larger error messages.
 475 This method would normally be used by DBIx::Class core-module author, to
 476 indicate to the user that he needs to install specific modules before he will
 477 be able to use a specific feature.
 478
 479 For example if some of the requirements for C<deploy> are not available,
 480 the returned string could look like:
 481
 482  SQL::Translator >= $sqltver (see $class for details)
 483
 484 The author is expected to prepend the necessary text to this message before
 485 returning the actual error seen by the user.
 486 EOD
 487
 488     '=head2 req_errorlist_for',
 489     '=over',
 490     '=item Arguments: $group_name',
 491     '=item Returns: \%list_of_loaderrors_per_module',
 492     '=back',
 493     <<'EOD',
 494 Returns a hashref containing the actual errors that occured while attempting
 495 to load each module in the requirement group.
 496 EOD
 497     '=head1 AUTHOR',
 498     'See L<DBIx::Class/CONTRIBUTORS>.',
 499     '=head1 LICENSE',
 500     'You may distribute this code under the same terms as Perl itself',
 501   );
 502
 503   open (my $fh, '>', $podfn) or croak "Unable to write to $podfn: $!";
 504   print $fh join ("\n\n", @chunks);
 505   close ($fh);
 506 }
 507
 508 1;