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