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