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