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