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   my $modfn = __PACKAGE__ . '.pm';
 220   $modfn =~ s/\:\:/\//g;
 221
 222   my @chunks = (
 223     <<"EOC",
 224 #########################################################################
 225 #####################  A U T O G E N E R A T E D ########################
 226 #########################################################################
 227 #
 228 # The contents of this POD file are auto-generated.  Any changes you make
 229 # will be lost. If you need to change the generated text edit _gen_pod()
 230 # at the end of $modfn
 231 #
 232 EOC
 233     '=head1 NAME',
 234     "$class - Optional module dependency specifications",
 235     '=head1 DESCRIPTION',
 236     <<'EOD',
 237 Some of the less-frequently used features of L<DBIx::Class> have external
 238 module dependencies on their own. In order not to burden the average user
 239 with modules he will never use, these optional dependencies are not included
 240 in the base Makefile.PL. Instead an exception with a descriptive message is
 241 thrown when a specific feature is missing one or several modules required for
 242 its operation. This module is the central holding place for  the current list
 243 of such dependencies.
 244 EOD
 245     '=head1 CURRENT REQUIREMENT GROUPS',
 246     <<'EOD',
 247 Dependencies are organized in C<groups> and each group can list one or more
 248 required modules, with an optional minimum version (or 0 for any version).
 249 The group name can be used in the
 250 EOD
 251   );
 252
 253   for my $group (sort keys %$reqs) {
 254     my $p = $reqs->{$group}{pod}
 255       or next;
 256
 257     my $modlist = $reqs->{$group}{req}
 258       or next;
 259
 260     next unless keys %$modlist;
 261
 262     push @chunks, (
 263       "=head2 $p->{title}",
 264       "$p->{desc}",
 265       '=over',
 266       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
 267       '=back',
 268       "Requirement group: B<$group>",
 269     );
 270   }
 271
 272   push @chunks, (
 273     '=head1 METHODS',
 274     '=head2 req_list_for',
 275     '=over',
 276     '=item Arguments: $group_name',
 277     '=item Returns: \%list_of_module_version_pairs',
 278     '=back',
 279     <<EOD,
 280 This method should be used by DBIx::Class extension authors, to determine the
 281 version of modules which a specific feature requires in the current version of
 282 DBIx::Class. For example if you write a module/extension that requires
 283 DBIx::Class and also requires the availability of
 284 L<DBIx::Class::Storage::DBI/deploy>, you can do the following in your
 285 C<Makefile.PL> or C<Build.PL>
 286
 287  require $class;
 288  my \$dep_list = $class->req_list_for ('deploy');
 289
 290 Which will give you a list of module/version pairs necessary for the particular
 291 feature to function with this version of DBIx::Class.
 292 EOD
 293
 294     '=head2 req_ok_for',
 295     '=over',
 296     '=item Arguments: $group_name',
 297     '=item Returns: 1|0',
 298     '=back',
 299     'Returns true or false depending on whether all modules required by C<$group_name> are present on the system and loadable',
 300
 301     '=head2 req_missing_for',
 302     '=over',
 303     '=item Arguments: $group_name',
 304     '=item Returns: $error_message_string',
 305     '=back',
 306     <<EOD,
 307 Returns a single line string suitable for inclusion in larger error messages.
 308 This method would normally be used by DBIx::Class core-module author, to
 309 indicate to the user that he needs to install specific modules before he will
 310 be able to use a specific feature.
 311
 312 For example if the requirements for C<replicated> are not available, the
 313 returned string would look like:
 314
 315  Moose >= 0.98, MooseX::Types >= 0.21, namespace::clean (see $class for details)
 316
 317 The author is expected to prepend the necessary text to this message before
 318 returning the actual error seen by the user.
 319 EOD
 320
 321     '=head2 req_errorlist_for',
 322     '=over',
 323     '=item Arguments: $group_name',
 324     '=item Returns: \%list_of_loaderrors_per_module',
 325     '=back',
 326     <<'EOD',
 327 Returns a hashref containing the actual errors that occured while attempting
 328 to load each module in the requirement group.
 329 EOD
 330     '=head1 AUTHOR',
 331     'See L<DBIx::Class/CONTRIBUTORS>.',
 332     '=head1 LICENSE',
 333     'You may distribute this code under the same terms as Perl itself',
 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;