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