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