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 $reqs = {
  15   dist => {
  16     #'Module::Install::Pod::Inherit' => '0.01',
  17   },
  18
  19   replicated => {
  20     req => {
  21       'Moose'                     => '0.98',
  22       'MooseX::Types'             => '0.21',
  23       'namespace::clean'          => '0.11',
  24       'Hash::Merge'               => '0.11',
  25     },
  26     pod => {
  27       title => 'Storage::Replicated',
  28       desc => 'Modules required for L<DBIx::Class::Storage::DBI::Replicated>',
  29     },
  30   },
  31
  32   admin => {
  33   },
  34
  35   deploy => {
  36     req => {
  37       'SQL::Translator'           => '0.11002',
  38     },
  39     pod => {
  40       title => 'Storage::DBI::deploy()',
  41       desc => 'Modules required for L<DBIx::Class::Storage::DBI/deploy> and L<DBIx::Class::Storage::DBI/deploymen_statements>',
  42     },
  43   },
  44
  45   author => {
  46     req => {
  47       'Test::Pod'                 => '1.26',
  48       'Test::Pod::Coverage'       => '1.08',
  49       'Pod::Coverage'             => '0.20',
  50       #'Test::NoTabs'              => '0.9',
  51       #'Test::EOL'                 => '0.6',
  52     },
  53   },
  54
  55   core => {
  56     req => {
  57       # t/52cycle.t
  58       'Test::Memory::Cycle'       => '0',
  59       'Devel::Cycle'              => '1.10',
  60
  61       # t/36datetime.t
  62       # t/60core.t
  63       'DateTime::Format::SQLite'  => '0',
  64
  65       # t/96_is_deteministic_value.t
  66       'DateTime::Format::Strptime'=> '0',
  67     },
  68   },
  69
  70   cdbicompat => {
  71     req => {
  72       'DBIx::ContextualFetch'     => '0',
  73       'Class::DBI::Plugin::DeepAbstractSearch' => '0',
  74       'Class::Trigger'            => '0',
  75       'Time::Piece::MySQL'        => '0',
  76       'Clone'                     => '0',
  77       'Date::Simple'              => '3.03',
  78     },
  79   },
  80
  81   rdbms_pg => {
  82     req => {
  83       $ENV{DBICTEST_PG_DSN}
  84         ? (
  85           'Sys::SigAction'        => '0',
  86           'DBD::Pg'               => '2.009002',
  87           'DateTime::Format::Pg'  => '0',
  88         ) : ()
  89     },
  90   },
  91
  92   rdbms_mysql => {
  93     req => {
  94       $ENV{DBICTEST_MYSQL_DSN}
  95         ? (
  96           'DateTime::Format::MySQL' => '0',
  97           'DBD::mysql'              => '0',
  98         ) : ()
  99     },
 100   },
 101
 102   rdbms_oracle => {
 103     req => {
 104       $ENV{DBICTEST_ORA_DSN}
 105         ? (
 106           'DateTime::Format::Oracle' => '0',
 107         ) : ()
 108     },
 109   },
 110
 111   rdbms_ase => {
 112     req => {
 113       $ENV{DBICTEST_SYBASE_DSN}
 114         ? (
 115           'DateTime::Format::Sybase' => 0,
 116         ) : ()
 117     },
 118   },
 119
 120   rdbms_asa => {
 121     req => {
 122       grep $_, @ENV{qw/DBICTEST_SYBASE_ASA_DSN DBICTEST_SYBASE_ASA_ODBC_DSN/}
 123         ? (
 124           'DateTime::Format::Strptime' => 0,
 125         ) : ()
 126     },
 127   },
 128 };
 129
 130
 131 sub _all_optional_requirements {
 132   return { map { %{ $reqs->{$_}{req} || {} } } (keys %$reqs) };
 133 }
 134
 135 sub req_list_for {
 136   my ($class, $group) = @_;
 137
 138   croak "req_list_for() expects a requirement group name"
 139     unless $group;
 140
 141   my $deps = $reqs->{$group}{req}
 142     or croak "Requirement group '$group' does not exist";
 143
 144   return { %$deps };
 145 }
 146
 147
 148 our %req_availability_cache;
 149 sub req_ok_for {
 150   my ($class, $group) = @_;
 151
 152   croak "req_ok_for() expects a requirement group name"
 153     unless $group;
 154
 155   $class->_check_deps ($group) unless $req_availability_cache{$group};
 156
 157   return $req_availability_cache{$group}{status};
 158 }
 159
 160 sub req_missing_for {
 161   my ($class, $group) = @_;
 162
 163   croak "req_missing_for() expects a requirement group name"
 164     unless $group;
 165
 166   $class->_check_deps ($group) unless $req_availability_cache{$group};
 167
 168   return $req_availability_cache{$group}{missing};
 169 }
 170
 171 sub req_errorlist_for {
 172   my ($class, $group) = @_;
 173
 174   croak "req_errorlist_for() expects a requirement group name"
 175     unless $group;
 176
 177   $class->_check_deps ($group) unless $req_availability_cache{$group};
 178
 179   return $req_availability_cache{$group}{errorlist};
 180 }
 181
 182 sub _check_deps {
 183   my ($class, $group) = @_;
 184
 185   my $deps = $class->req_list_for ($group);
 186
 187   my %errors;
 188   for my $mod (keys %$deps) {
 189     if (my $ver = $deps->{$mod}) {
 190       eval "use $mod $ver ()";
 191     }
 192     else {
 193       eval "require $mod";
 194     }
 195
 196     $errors{$mod} = $@ if $@;
 197   }
 198
 199   if (keys %errors) {
 200     my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
 201     $missing .= " (see $class for details)" if $reqs->{$group}{pod};
 202     $req_availability_cache{$group} = {
 203       status => 0,
 204       errorlist => { %errors },
 205       missing => $missing,
 206     };
 207   }
 208   else {
 209     $req_availability_cache{$group} = {
 210       status => 1,
 211       errorlist => {},
 212       missing => '',
 213     };
 214   }
 215 }
 216
 217 sub _gen_pod {
 218   my $class = shift;
 219
 220   my @chunks = (
 221     '=head1 NAME',
 222     "$class - Optional module dependency specifications",
 223     '=head1 DESCRIPTION',
 224     <<'EOD',
 225 Some of the less-frequently used features of L<DBIx::Class> have external
 226 module dependencies on their own. In order not to burden the average user
 227 with modules he will never use, these optional dependencies are not included
 228 in the base Makefile.PL. Instead an exception with a descriptive message is
 229 thrown when a specific feature is missing one or several modules required for
 230 its operation. This module is the central holding place for  the current list
 231 of such dependencies.
 232 EOD
 233     '=head1 CURRENT REQUIREMENT GROUPS',
 234     <<'EOD',
 235 Dependencies are organized in C<groups> and each group can list one or more
 236 required modules, with an optional minimum version (or 0 for any version).
 237 The group name can be used in the
 238 EOD
 239   );
 240
 241   for my $group (sort keys %$reqs) {
 242     my $p = $reqs->{$group}{pod}
 243       or next;
 244
 245     my $modlist = $reqs->{$group}{req}
 246       or next;
 247
 248     next unless keys %$modlist;
 249
 250     push @chunks, (
 251       "=head2 $p->{title}",
 252       "$p->{desc}",
 253       '=over',
 254       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
 255       '=back',
 256       "Requirement group: B<$group>",
 257     );
 258   }
 259
 260   push @chunks, (
 261     '=head1 METHODS',
 262     '=head2 req_list_for',
 263     '=over',
 264     '=item Arguments: $group_name',
 265     '=item Returns: \%list_of_module_version_pairs',
 266     '=back',
 267     <<EOD,
 268 This method should be used by DBIx::Class extension authors, to determine the
 269 version of modules which a specific feature requires in the current version of
 270 DBIx::Class. For example if you write a module/extension that requires
 271 DBIx::Class and also requires the availability of
 272 L<DBIx::Class::Storage::DBI/deploy>, you can do the following in your
 273 C<Makefile.PL> or C<Build.PL>
 274
 275  require $class;
 276  my \$dep_list = $class->req_list_for ('deploy');
 277
 278 Which will give you a list of module/version pairs necessary for the particular
 279 feature to function with this version of DBIx::Class.
 280 EOD
 281
 282     '=head2 req_ok_for',
 283     '=over',
 284     '=item Arguments: $group_name',
 285     '=item Returns: 1|0',
 286     '=back',
 287     'Returns true or false depending on whether all modules required by $group_name are present on the system and loadable',
 288
 289     '=head2 req_missing_for',
 290     '=over',
 291     '=item Arguments: $group_name',
 292     '=item Returns: $error_message_string',
 293     '=back',
 294     <<EOD,
 295 Returns a single line string suitable for inclusion in larger error messages.
 296 This method would normally be used by DBIx::Class core-module author, to
 297 indicate to the user that he needs to install specific modules before he will
 298 be able to use a specific feature.
 299
 300 For example if the requirements for C<replicated> are not available, the
 301 returned string would look like:
 302
 303  Moose >= 0.98, MooseX::Types >= 0.21, namespace::clean (see $class for details)
 304
 305 The author is expected to prepend the necessary text to this message before
 306 returning the actual error seen by the user.
 307 EOD
 308
 309     '=head2 req_errorlist_for',
 310     '=over',
 311     '=item Arguments: $group_name',
 312     '=item Returns: \%list_of_loaderrors_per_module',
 313     '=back',
 314     <<'EOD',
 315 Returns a hashref containing the actual errors that occured while attempting
 316 to load each module in the requirement group.
 317 EOD
 318
 319   );
 320
 321   my $fn = __FILE__;
 322   $fn =~ s/\.pm$/\.pod/;
 323
 324   open (my $fh, '>', $fn) or croak "Unable to write to $fn: $!";
 325   print $fh join ("\n\n", @chunks);
 326   close ($fh);
 327 }
 328
 329 1;