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