lib/DBIx/Class/Schema/Loader/Optional/Dependencies.pm

   1 package DBIx::Class::Schema::Loader::Optional::Dependencies;
   2
   3 use warnings;
   4 use strict;
   5
   6 use Carp;
   7
   8 # Stolen from DBIx::Class
   9
  10 # NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G)
  11 # This module is to be loaded by Makefile.PM on a pristine system
  12
  13 # POD is generated automatically by calling _gen_pod from the
  14 # Makefile.PL in $AUTHOR mode
  15
  16 my $reqs = {
  17     dist => {
  18         #'Module::Install::Pod::Inherit' => '0.01',
  19     },
  20
  21     use_moose => {
  22         req => {
  23             'Moose' => '1.12',
  24             'MooseX::NonMoose' => '0.25',
  25             'namespace::autoclean' => '0.09',
  26             'MooseX::MarkAsMethods' => '0.13',
  27         },
  28         pod => {
  29             title => 'use_moose',
  30             desc  => 'Modules required for the use_moose option',
  31         },
  32     },
  33
  34     dbicdump_config => {
  35         req => {
  36             'Config::Any' => '0',
  37         },
  38         pod => {
  39             title => 'dbicdump config file',
  40             desc  => 'Modules required for using a config file with dbicdump',
  41         },
  42     },
  43
  44     test_dbicdump_config => {
  45         req => {
  46             'Config::Any'     => '0',
  47             'Config::General' => '0',
  48         },
  49         pod => {
  50             title => 'dbicdump config file testing',
  51             desc  => 'Modules required for using testing using a config file with dbicdump',
  52         },
  53     },
  54
  55     test_pod => {
  56         req => {
  57             'Test::Pod'   => '1.14',
  58             'Pod::Simple' => '3.22',
  59         },
  60         pod => {
  61             title => 'POD testing',
  62             desc  => 'Modules required for testing POD in this distribution',
  63         },
  64     },
  65 };
  66
  67 sub req_list_for {
  68   my ($class, $group) = @_;
  69
  70   croak "req_list_for() expects a requirement group name"
  71     unless $group;
  72
  73   my $deps = $reqs->{$group}{req}
  74     or croak "Requirement group '$group' does not exist";
  75
  76   return { %$deps };
  77 }
  78
  79
  80 our %req_availability_cache;
  81 sub req_ok_for {
  82   my ($class, $group) = @_;
  83
  84   croak "req_ok_for() expects a requirement group name"
  85     unless $group;
  86
  87   $class->_check_deps ($group) unless $req_availability_cache{$group};
  88
  89   return $req_availability_cache{$group}{status};
  90 }
  91
  92 sub req_missing_for {
  93   my ($class, $group) = @_;
  94
  95   croak "req_missing_for() expects a requirement group name"
  96     unless $group;
  97
  98   $class->_check_deps ($group) unless $req_availability_cache{$group};
  99
 100   return $req_availability_cache{$group}{missing};
 101 }
 102
 103 sub req_errorlist_for {
 104   my ($class, $group) = @_;
 105
 106   croak "req_errorlist_for() expects a requirement group name"
 107     unless $group;
 108
 109   $class->_check_deps ($group) unless $req_availability_cache{$group};
 110
 111   return $req_availability_cache{$group}{errorlist};
 112 }
 113
 114 sub _check_deps {
 115   my ($class, $group) = @_;
 116
 117   my $deps = $class->req_list_for ($group);
 118
 119   my %errors;
 120   for my $mod (keys %$deps) {
 121     if (my $ver = $deps->{$mod}) {
 122       eval "use $mod $ver ()";
 123     }
 124     else {
 125       eval "require $mod";
 126     }
 127
 128     $errors{$mod} = $@ if $@;
 129   }
 130
 131   if (keys %errors) {
 132     my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
 133     $missing .= " (see $class for details)" if $reqs->{$group}{pod};
 134     $req_availability_cache{$group} = {
 135       status => 0,
 136       errorlist => { %errors },
 137       missing => $missing,
 138     };
 139   }
 140   else {
 141     $req_availability_cache{$group} = {
 142       status => 1,
 143       errorlist => {},
 144       missing => '',
 145     };
 146   }
 147 }
 148
 149 sub req_group_list {
 150   return { map { $_ => { %{ $reqs->{$_}{req} || {} } } } (keys %$reqs) };
 151 }
 152
 153 # This is to be called by the author only (automatically in Makefile.PL)
 154 sub _gen_pod {
 155
 156   my $class = shift;
 157   my $modfn = __PACKAGE__ . '.pm';
 158   $modfn =~ s/\:\:/\//g;
 159
 160   my $podfn = __FILE__;
 161   $podfn =~ s/\.pm$/\.pod/;
 162
 163   my $distver =
 164     eval { require DBIx::Class::Schema::Loader; DBIx::Class::Schema::Loader->VERSION; }
 165       ||
 166     do {
 167       warn
 168 "\n\n---------------------------------------------------------------------\n" .
 169 'Unable to load the DBIx::Class::Schema::Loader module to determine current ' .
 170 'version, possibly due to missing dependencies. Author-mode autodocumentation ' .
 171 "halted\n\n" . $@ .
 172 "\n\n---------------------------------------------------------------------\n"
 173       ;
 174       '*UNKNOWN*';  # rv
 175     }
 176   ;
 177
 178   my @chunks = (
 179     <<"EOC",
 180 #########################################################################
 181 #####################  A U T O G E N E R A T E D ########################
 182 #########################################################################
 183 #
 184 # The contents of this POD file are auto-generated.  Any changes you make
 185 # will be lost. If you need to change the generated text edit _gen_pod()
 186 # at the end of $modfn
 187 #
 188 EOC
 189     '=head1 NAME',
 190     "$class - Optional module dependency specifications (for module authors)",
 191     '=head1 SYNOPSIS',
 192     <<EOS,
 193 Somewhere in your build-file (e.g. L<Module::Install>'s Makefile.PL):
 194
 195   ...
 196
 197   configure_requires 'DBIx::Class::Schema::Loader' => '$distver';
 198
 199   require $class;
 200
 201   my \$use_moose_deps = $class->req_list_for ('use_moose');
 202
 203   for (keys %\$use_moose_deps) {
 204     requires \$_ => \$use_moose_deps->{\$_};
 205   }
 206
 207   ...
 208
 209 Note that there are some caveats regarding C<configure_requires()>, more info
 210 can be found at L<Module::Install/configure_requires>
 211 EOS
 212     '=head1 DESCRIPTION',
 213     <<'EOD',
 214 Some of the features of L<DBIx::Class::Schema::Loader> have external
 215 module dependencies on their own. In order not to burden the average user
 216 with modules he will never use, these optional dependencies are not included
 217 in the base Makefile.PL. Instead an exception with a descriptive message is
 218 thrown when a specific feature is missing one or several modules required for
 219 its operation. This module is the central holding place for  the current list
 220 of such dependencies.
 221 EOD
 222     '=head1 CURRENT REQUIREMENT GROUPS',
 223     <<'EOD',
 224 Dependencies are organized in C<groups> and each group can list one or more
 225 required modules, with an optional minimum version (or 0 for any version).
 226 EOD
 227   );
 228
 229   for my $group (sort keys %$reqs) {
 230     my $p = $reqs->{$group}{pod}
 231       or next;
 232
 233     my $modlist = $reqs->{$group}{req}
 234       or next;
 235
 236     next unless keys %$modlist;
 237
 238     push @chunks, (
 239       "=head2 $p->{title}",
 240       "$p->{desc}",
 241       '=over',
 242       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
 243       '=back',
 244       "Requirement group: B<$group>",
 245     );
 246   }
 247
 248   push @chunks, (
 249     '=head1 METHODS',
 250     '=head2 req_group_list',
 251     '=over',
 252     '=item Arguments: $none',
 253     '=item Returns: \%list_of_requirement_groups',
 254     '=back',
 255     <<EOD,
 256 This method should be used by DBIx::Class packagers, to get a hashref of all
 257 dependencies keyed by dependency group. Each key (group name) can be supplied
 258 to one of the group-specific methods below.
 259 EOD
 260
 261     '=head2 req_list_for',
 262     '=over',
 263     '=item Arguments: $group_name',
 264     '=item Returns: \%list_of_module_version_pairs',
 265     '=back',
 266     <<EOD,
 267 This method should be used by DBIx::Class extension authors, to determine the
 268 version of modules a specific feature requires in the B<current> version of
 269 L<DBIx::Class::Schema::Loader>. See the L</SYNOPSIS> for a real-world
 270 example.
 271 EOD
 272
 273     '=head2 req_ok_for',
 274     '=over',
 275     '=item Arguments: $group_name',
 276     '=item Returns: 1|0',
 277     '=back',
 278     'Returns true or false depending on whether all modules required by C<$group_name> are present on the system and loadable',
 279
 280     '=head2 req_missing_for',
 281     '=over',
 282     '=item Arguments: $group_name',
 283     '=item Returns: $error_message_string',
 284     '=back',
 285     <<EOD,
 286 Returns a single line string suitable for inclusion in larger error messages.
 287 This method would normally be used by L<DBIx::Class::Schema::Loader>
 288 maintainers, to indicate to the user that he needs to install specific modules
 289 before he will be able to use a specific feature.
 290
 291 For example if some of the requirements for C<use_moose> are not available,
 292 the returned string could look like:
 293
 294  Moose >= 0 (see use_moose for details)
 295
 296 The author is expected to prepend the necessary text to this message before
 297 returning the actual error seen by the user.
 298 EOD
 299
 300     '=head2 req_errorlist_for',
 301     '=over',
 302     '=item Arguments: $group_name',
 303     '=item Returns: \%list_of_loaderrors_per_module',
 304     '=back',
 305     <<'EOD',
 306 Returns a hashref containing the actual errors that occurred while attempting
 307 to load each module in the requirement group.
 308 EOD
 309     '=head1 AUTHOR',
 310     'See L<DBIx::Class/CONTRIBUTORS>.',
 311     '=head1 LICENSE',
 312     'You may distribute this code under the same terms as Perl itself',
 313   );
 314
 315   open (my $fh, '>', $podfn) or croak "Unable to write to $podfn: $!";
 316   print $fh join ("\n\n", @chunks);
 317   close ($fh);
 318 }
 319
 320 1;