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