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