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.12',
  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       (scalar 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 # This is to be called by the author onbly (automatically in Makefile.PL)
 250 sub _gen_pod {
 251   my $class = shift;
 252   my $modfn = __PACKAGE__ . '.pm';
 253   $modfn =~ s/\:\:/\//g;
 254
 255   require DBIx::Class;
 256   my $distver = DBIx::Class->VERSION;
 257
 258   my @chunks = (
 259     <<"EOC",
 260 #########################################################################
 261 #####################  A U T O G E N E R A T E D ########################
 262 #########################################################################
 263 #
 264 # The contents of this POD file are auto-generated.  Any changes you make
 265 # will be lost. If you need to change the generated text edit _gen_pod()
 266 # at the end of $modfn
 267 #
 268 EOC
 269     '=head1 NAME',
 270     "$class - Optional module dependency specifications (for module authors)",
 271     '=head1 SYNOPSIS (EXPERIMENTAL)',
 272     <<EOS,
 273 B<THE USAGE SHOWN HERE IS EXPERIMENTAL>
 274
 275 Somewhere in your build-file (e.g. L<Module::Install>'s Makefile.PL):
 276
 277   ...
 278
 279   configure_requires 'DBIx::Class' => '$distver';
 280
 281   require $class;
 282
 283   my \$deploy_deps = $class->req_list_for ('deploy');
 284
 285   for (keys %\$deploy_deps) {
 286     requires \$_ => \$deploy_deps->{\$_};
 287   }
 288
 289   ...
 290
 291 Note that there are some caveats regarding C<configure_requires()>, more info
 292 can be found at L<Module::Install/configure_requires>
 293 EOS
 294     '=head1 DESCRIPTION',
 295     <<'EOD',
 296 Some of the less-frequently used features of L<DBIx::Class> have external
 297 module dependencies on their own. In order not to burden the average user
 298 with modules he will never use, these optional dependencies are not included
 299 in the base Makefile.PL. Instead an exception with a descriptive message is
 300 thrown when a specific feature is missing one or several modules required for
 301 its operation. This module is the central holding place for  the current list
 302 of such dependencies, for DBIx::Class core authors, and DBIx::Class extension
 303 authors alike.
 304 EOD
 305     '=head1 CURRENT REQUIREMENT GROUPS',
 306     <<'EOD',
 307 Dependencies are organized in C<groups> and each group can list one or more
 308 required modules, with an optional minimum version (or 0 for any version).
 309 The group name can be used in the
 310 EOD
 311   );
 312
 313   for my $group (sort keys %$reqs) {
 314     my $p = $reqs->{$group}{pod}
 315       or next;
 316
 317     my $modlist = $reqs->{$group}{req}
 318       or next;
 319
 320     next unless keys %$modlist;
 321
 322     push @chunks, (
 323       "=head2 $p->{title}",
 324       "$p->{desc}",
 325       '=over',
 326       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
 327       '=back',
 328       "Requirement group: B<$group>",
 329     );
 330   }
 331
 332   push @chunks, (
 333     '=head1 METHODS',
 334     '=head2 req_list_for',
 335     '=over',
 336     '=item Arguments: $group_name',
 337     '=item Returns: \%list_of_module_version_pairs',
 338     '=back',
 339     <<EOD,
 340 This method should be used by DBIx::Class extension authors, to determine the
 341 version of modules a specific feature requires in the B<current> version of
 342 DBIx::Class. See the L<SYNOPSIS|/SYNOPSIS (EXPERIMENTAL)> for a real-world
 343 example.
 344 EOD
 345
 346     '=head2 req_ok_for',
 347     '=over',
 348     '=item Arguments: $group_name',
 349     '=item Returns: 1|0',
 350     '=back',
 351     'Returns true or false depending on whether all modules required by C<$group_name> are present on the system and loadable',
 352
 353     '=head2 req_missing_for',
 354     '=over',
 355     '=item Arguments: $group_name',
 356     '=item Returns: $error_message_string',
 357     '=back',
 358     <<EOD,
 359 Returns a single line string suitable for inclusion in larger error messages.
 360 This method would normally be used by DBIx::Class core-module author, to
 361 indicate to the user that he needs to install specific modules before he will
 362 be able to use a specific feature.
 363
 364 For example if the requirements for C<replicated> are not available, the
 365 returned string would look like:
 366
 367  Moose >= 0.98, MooseX::Types >= 0.21, namespace::clean (see $class for details)
 368
 369 The author is expected to prepend the necessary text to this message before
 370 returning the actual error seen by the user.
 371 EOD
 372
 373     '=head2 req_errorlist_for',
 374     '=over',
 375     '=item Arguments: $group_name',
 376     '=item Returns: \%list_of_loaderrors_per_module',
 377     '=back',
 378     <<'EOD',
 379 Returns a hashref containing the actual errors that occured while attempting
 380 to load each module in the requirement group.
 381 EOD
 382     '=head1 AUTHOR',
 383     'See L<DBIx::Class/CONTRIBUTORS>.',
 384     '=head1 LICENSE',
 385     'You may distribute this code under the same terms as Perl itself',
 386   );
 387
 388   my $fn = __FILE__;
 389   $fn =~ s/\.pm$/\.pod/;
 390
 391   open (my $fh, '>', $fn) or croak "Unable to write to $fn: $!";
 392   print $fh join ("\n\n", @chunks);
 393   close ($fh);
 394 }
 395
 396 1;