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.11006',
  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           'DBD::Oracle'              => '1.24',
 164         ) : ()
 165     },
 166   },
 167
 168   rdbms_ase => {
 169     req => {
 170       $ENV{DBICTEST_SYBASE_DSN}
 171         ? (
 172           'DateTime::Format::Sybase' => 0,
 173         ) : ()
 174     },
 175   },
 176
 177   rdbms_asa => {
 178     req => {
 179       (scalar grep { $ENV{$_} } (qw/DBICTEST_SYBASE_ASA_DSN DBICTEST_SYBASE_ASA_ODBC_DSN/) )
 180         ? (
 181           'DateTime::Format::Strptime' => 0,
 182         ) : ()
 183     },
 184   },
 185
 186   rdbms_db2 => {
 187     req => {
 188       $ENV{DBICTEST_DB2_DSN}
 189         ? (
 190           'DBD::DB2' => 0,
 191         ) : ()
 192     },
 193   },
 194
 195 };
 196
 197
 198 sub req_list_for {
 199   my ($class, $group) = @_;
 200
 201   croak "req_list_for() expects a requirement group name"
 202     unless $group;
 203
 204   my $deps = $reqs->{$group}{req}
 205     or croak "Requirement group '$group' does not exist";
 206
 207   return { %$deps };
 208 }
 209
 210
 211 our %req_availability_cache;
 212 sub req_ok_for {
 213   my ($class, $group) = @_;
 214
 215   croak "req_ok_for() expects a requirement group name"
 216     unless $group;
 217
 218   return $class->_check_deps($group)->{status};
 219 }
 220
 221 sub req_missing_for {
 222   my ($class, $group) = @_;
 223
 224   croak "req_missing_for() expects a requirement group name"
 225     unless $group;
 226
 227   return $class->_check_deps($group)->{missing};
 228 }
 229
 230 sub req_errorlist_for {
 231   my ($class, $group) = @_;
 232
 233   croak "req_errorlist_for() expects a requirement group name"
 234     unless $group;
 235
 236   return $class->_check_deps($group)->{errorlist};
 237 }
 238
 239 sub _check_deps {
 240   my ($class, $group) = @_;
 241
 242   return $req_availability_cache{$group} ||= do {
 243
 244     my $deps = $class->req_list_for ($group);
 245
 246     my %errors;
 247     for my $mod (keys %$deps) {
 248       my $req_line = "require $mod;";
 249       if (my $ver = $deps->{$mod}) {
 250         $req_line .= "$mod->VERSION($ver);";
 251       }
 252
 253       eval $req_line;
 254
 255       $errors{$mod} = $@ if $@;
 256     }
 257
 258     my $res;
 259
 260     if (keys %errors) {
 261       my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
 262       $missing .= " (see $class for details)" if $reqs->{$group}{pod};
 263       $res = {
 264         status => 0,
 265         errorlist => \%errors,
 266         missing => $missing,
 267       };
 268     }
 269     else {
 270       $res = {
 271         status => 1,
 272         errorlist => {},
 273         missing => '',
 274       };
 275     }
 276
 277     $res;
 278   };
 279 }
 280
 281 sub req_group_list {
 282   return { map { $_ => { %{ $reqs->{$_}{req} || {} } } } (keys %$reqs) };
 283 }
 284
 285 # This is to be called by the author only (automatically in Makefile.PL)
 286 sub _gen_pod {
 287
 288   my $class = shift;
 289   my $modfn = __PACKAGE__ . '.pm';
 290   $modfn =~ s/\:\:/\//g;
 291
 292   my $podfn = __FILE__;
 293   $podfn =~ s/\.pm$/\.pod/;
 294
 295   my $distver =
 296     eval { require DBIx::Class; DBIx::Class->VERSION; }
 297       ||
 298     do {
 299       warn
 300 "\n\n---------------------------------------------------------------------\n" .
 301 'Unable to load core DBIx::Class module to determine current version, '.
 302 'possibly due to missing dependencies. Author-mode autodocumentation ' .
 303 "halted\n\n" . $@ .
 304 "\n\n---------------------------------------------------------------------\n"
 305       ;
 306       '*UNKNOWN*';  # rv
 307     }
 308   ;
 309
 310   my $sqltver = $class->req_list_for ('deploy')->{'SQL::Translator'}
 311     or die "Hrmm? No sqlt dep?";
 312
 313   my @chunks = (
 314     <<'EOC',
 315 #########################################################################
 316 #####################  A U T O G E N E R A T E D ########################
 317 #########################################################################
 318 #
 319 # The contents of this POD file are auto-generated.  Any changes you make
 320 # will be lost. If you need to change the generated text edit _gen_pod()
 321 # at the end of $modfn
 322 #
 323 EOC
 324     '=head1 NAME',
 325     "$class - Optional module dependency specifications (for module authors)",
 326     '=head1 SYNOPSIS',
 327     <<"EOS",
 328 Somewhere in your build-file (e.g. L<Module::Install>'s Makefile.PL):
 329
 330   ...
 331
 332   configure_requires 'DBIx::Class' => '$distver';
 333
 334   require $class;
 335
 336   my \$deploy_deps = $class->req_list_for ('deploy');
 337
 338   for (keys %\$deploy_deps) {
 339     requires \$_ => \$deploy_deps->{\$_};
 340   }
 341
 342   ...
 343
 344 Note that there are some caveats regarding C<configure_requires()>, more info
 345 can be found at L<Module::Install/configure_requires>
 346 EOS
 347     '=head1 DESCRIPTION',
 348     <<'EOD',
 349 Some of the less-frequently used features of L<DBIx::Class> have external
 350 module dependencies on their own. In order not to burden the average user
 351 with modules he will never use, these optional dependencies are not included
 352 in the base Makefile.PL. Instead an exception with a descriptive message is
 353 thrown when a specific feature is missing one or several modules required for
 354 its operation. This module is the central holding place for  the current list
 355 of such dependencies, for DBIx::Class core authors, and DBIx::Class extension
 356 authors alike.
 357 EOD
 358     '=head1 CURRENT REQUIREMENT GROUPS',
 359     <<'EOD',
 360 Dependencies are organized in C<groups> and each group can list one or more
 361 required modules, with an optional minimum version (or 0 for any version).
 362 The group name can be used in the
 363 EOD
 364   );
 365
 366   for my $group (sort keys %$reqs) {
 367     my $p = $reqs->{$group}{pod}
 368       or next;
 369
 370     my $modlist = $reqs->{$group}{req}
 371       or next;
 372
 373     next unless keys %$modlist;
 374
 375     push @chunks, (
 376       "=head2 $p->{title}",
 377       "$p->{desc}",
 378       '=over',
 379       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
 380       '=back',
 381       "Requirement group: B<$group>",
 382     );
 383   }
 384
 385   push @chunks, (
 386     '=head1 METHODS',
 387     '=head2 req_group_list',
 388     '=over',
 389     '=item Arguments: none',
 390     '=item Returns: \%list_of_requirement_groups',
 391     '=back',
 392     <<'EOD',
 393 This method should be used by DBIx::Class packagers, to get a hashref of all
 394 dependencies keyed by dependency group. Each key (group name) can be supplied
 395 to one of the group-specific methods below.
 396 EOD
 397
 398     '=head2 req_list_for',
 399     '=over',
 400     '=item Arguments: $group_name',
 401     '=item Returns: \%list_of_module_version_pairs',
 402     '=back',
 403     <<'EOD',
 404 This method should be used by DBIx::Class extension authors, to determine the
 405 version of modules a specific feature requires in the B<current> version of
 406 DBIx::Class. See the L</SYNOPSIS> for a real-world
 407 example.
 408 EOD
 409
 410     '=head2 req_ok_for',
 411     '=over',
 412     '=item Arguments: $group_name',
 413     '=item Returns: 1|0',
 414     '=back',
 415     <<'EOD',
 416 Returns true or false depending on whether all modules required by
 417 C<$group_name> are present on the system and loadable.
 418 EOD
 419
 420     '=head2 req_missing_for',
 421     '=over',
 422     '=item Arguments: $group_name',
 423     '=item Returns: $error_message_string',
 424     '=back',
 425     <<"EOD",
 426 Returns a single line string suitable for inclusion in larger error messages.
 427 This method would normally be used by DBIx::Class core-module author, to
 428 indicate to the user that he needs to install specific modules before he will
 429 be able to use a specific feature.
 430
 431 For example if some of the requirements for C<deploy> are not available,
 432 the returned string could look like:
 433
 434  SQL::Translator >= $sqltver (see $class for details)
 435
 436 The author is expected to prepend the necessary text to this message before
 437 returning the actual error seen by the user.
 438 EOD
 439
 440     '=head2 req_errorlist_for',
 441     '=over',
 442     '=item Arguments: $group_name',
 443     '=item Returns: \%list_of_loaderrors_per_module',
 444     '=back',
 445     <<'EOD',
 446 Returns a hashref containing the actual errors that occured while attempting
 447 to load each module in the requirement group.
 448 EOD
 449     '=head1 AUTHOR',
 450     'See L<DBIx::Class/CONTRIBUTORS>.',
 451     '=head1 LICENSE',
 452     'You may distribute this code under the same terms as Perl itself',
 453   );
 454
 455   open (my $fh, '>', $podfn) or croak "Unable to write to $podfn: $!";
 456   print $fh join ("\n\n", @chunks);
 457   close ($fh);
 458 }
 459
 460 1;