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