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