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