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