[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Optional / Dependencies.pm

package DBIx::Class::Optional::Dependencies;

use warnings;
use strict;

use Carp;

# NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G)
# This module is to be loaded by Makefile.PM on a pristine system

# POD is generated automatically by calling _gen_pod from the
# Makefile.PL in $AUTHOR mode

my $reqs = {
  dist => {
    #'Module::Install::Pod::Inherit' => '0.01',
  },

  replicated => {
    req => {
      'Moose'                     => '0.98',
      'MooseX::Types'             => '0.21',
      'namespace::clean'          => '0.11',
      'Hash::Merge'               => '0.11',
    },
    pod => {
      title => 'Storage::Replicated',
      desc => 'Modules required for L<DBIx::Class::Storage::DBI::Replicated>',
    },
  },

  admin => {
  },

  deploy => {
    req => {
      'SQL::Translator'           => '0.11002',
    },
    pod => {
      title => 'Storage::DBI::deploy()',
      desc => 'Modules required for L<DBIx::Class::Storage::DBI/deploy> and L<DBIx::Class::Storage::DBI/deploymen_statements>',
    },
  },

  author => {
    req => {
      'Test::Pod'                 => '1.26',
      'Test::Pod::Coverage'       => '1.08',
      'Pod::Coverage'             => '0.20',
      #'Test::NoTabs'              => '0.9',
      #'Test::EOL'                 => '0.6',
    },
  },

  core => {
    req => {
      # t/52cycle.t
      'Test::Memory::Cycle'       => '0',
      'Devel::Cycle'              => '1.10',

      # t/36datetime.t
      # t/60core.t
      'DateTime::Format::SQLite'  => '0',

      # t/96_is_deteministic_value.t
      'DateTime::Format::Strptime'=> '0',
    },
  },

  cdbicompat => {
    req => {
      'DBIx::ContextualFetch'     => '0',
      'Class::DBI::Plugin::DeepAbstractSearch' => '0',
      'Class::Trigger'            => '0',
      'Time::Piece::MySQL'        => '0',
      'Clone'                     => '0',
      'Date::Simple'              => '3.03',
    },
  },

  rdbms_pg => {
    req => {
      $ENV{DBICTEST_PG_DSN}
        ? (
          'Sys::SigAction'        => '0',
          'DBD::Pg'               => '2.009002',
          'DateTime::Format::Pg'  => '0',
        ) : ()
    },
  },

  rdbms_mysql => {
    req => {
      $ENV{DBICTEST_MYSQL_DSN}
        ? (
          'DateTime::Format::MySQL' => '0',
          'DBD::mysql'              => '0',
        ) : ()
    },
  },

  rdbms_oracle => {
    req => {
      $ENV{DBICTEST_ORA_DSN}
        ? (
          'DateTime::Format::Oracle' => '0',
        ) : ()
    },
  },

  rdbms_ase => {
    req => {
      $ENV{DBICTEST_SYBASE_DSN}
        ? (
          'DateTime::Format::Sybase' => 0,
        ) : ()
    },
  },

  rdbms_asa => {
    req => {
      grep $_, @ENV{qw/DBICTEST_SYBASE_ASA_DSN DBICTEST_SYBASE_ASA_ODBC_DSN/}
        ? (
          'DateTime::Format::Strptime' => 0,
        ) : ()
    },
  },
};


sub _all_optional_requirements {
  return { map { %{ $reqs->{$_}{req} || {} } } (keys %$reqs) };
}

sub req_list_for {
  my ($class, $group) = @_;

  croak "req_list_for() expects a requirement group name"
    unless $group;

  my $deps = $reqs->{$group}{req}
    or croak "Requirement group '$group' does not exist";

  return { %$deps };
}


our %req_availability_cache;
sub req_ok_for {
  my ($class, $group) = @_;

  croak "req_ok_for() expects a requirement group name"
    unless $group;

  $class->_check_deps ($group) unless $req_availability_cache{$group};

  return $req_availability_cache{$group}{status};
}

sub req_missing_for {
  my ($class, $group) = @_;

  croak "req_missing_for() expects a requirement group name"
    unless $group;

  $class->_check_deps ($group) unless $req_availability_cache{$group};

  return $req_availability_cache{$group}{missing};
}

sub req_errorlist_for {
  my ($class, $group) = @_;

  croak "req_errorlist_for() expects a requirement group name"
    unless $group;

  $class->_check_deps ($group) unless $req_availability_cache{$group};

  return $req_availability_cache{$group}{errorlist};
}

sub _check_deps {
  my ($class, $group) = @_;

  my $deps = $class->req_list_for ($group);

  my %errors;
  for my $mod (keys %$deps) {
    if (my $ver = $deps->{$mod}) {
      eval "use $mod $ver ()";
    }
    else {
      eval "require $mod";
    }

    $errors{$mod} = $@ if $@;
  }

  if (keys %errors) {
    my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
    $missing .= " (see $class for details)" if $reqs->{$group}{pod};
    $req_availability_cache{$group} = {
      status => 0,
      errorlist => { %errors },
      missing => $missing,
    };
  }
  else {
    $req_availability_cache{$group} = {
      status => 1,
      errorlist => {},
      missing => '',
    };
  }
}

sub _gen_pod {
  my $class = shift;
  my $modfn = __PACKAGE__ . '.pm';
  $modfn =~ s/\:\:/\//g;

  my @chunks = (
    <<"EOC",
#########################################################################
#####################  A U T O G E N E R A T E D ########################
#########################################################################
#
# The contents of this POD file are auto-generated.  Any changes you make
# will be lost. If you need to change the generated text edit _gen_pod()
# at the end of $modfn
#
EOC
    '=head1 NAME',
    "$class - Optional module dependency specifications",
    '=head1 DESCRIPTION',
    <<'EOD',
Some of the less-frequently used features of L<DBIx::Class> have external
module dependencies on their own. In order not to burden the average user
with modules he will never use, these optional dependencies are not included
in the base Makefile.PL. Instead an exception with a descriptive message is
thrown when a specific feature is missing one or several modules required for
its operation. This module is the central holding place for  the current list
of such dependencies.
EOD
    '=head1 CURRENT REQUIREMENT GROUPS',
    <<'EOD',
Dependencies are organized in C<groups> and each group can list one or more
required modules, with an optional minimum version (or 0 for any version).
The group name can be used in the 
EOD
  );

  for my $group (sort keys %$reqs) {
    my $p = $reqs->{$group}{pod}
      or next;

    my $modlist = $reqs->{$group}{req}
      or next;

    next unless keys %$modlist;

    push @chunks, (
      "=head2 $p->{title}",
      "$p->{desc}",
      '=over',
      ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
      '=back',
      "Requirement group: B<$group>",
    );
  }

  push @chunks, (
    '=head1 METHODS',
    '=head2 req_list_for',
    '=over',
    '=item Arguments: $group_name',
    '=item Returns: \%list_of_module_version_pairs',
    '=back',
    <<EOD,
This method should be used by DBIx::Class extension authors, to determine the
version of modules which a specific feature requires in the current version of
DBIx::Class. For example if you write a module/extension that requires
DBIx::Class and also requires the availability of
L<DBIx::Class::Storage::DBI/deploy>, you can do the following in your
C<Makefile.PL> or C<Build.PL>

 require $class;
 my \$dep_list = $class->req_list_for ('deploy');

Which will give you a list of module/version pairs necessary for the particular
feature to function with this version of DBIx::Class.
EOD

    '=head2 req_ok_for',
    '=over',
    '=item Arguments: $group_name',
    '=item Returns: 1|0',
    '=back',
    'Returns true or false depending on whether all modules required by C<$group_name> are present on the system and loadable',

    '=head2 req_missing_for',
    '=over',
    '=item Arguments: $group_name',
    '=item Returns: $error_message_string',
    '=back',
    <<EOD,
Returns a single line string suitable for inclusion in larger error messages.
This method would normally be used by DBIx::Class core-module author, to
indicate to the user that he needs to install specific modules before he will
be able to use a specific feature.

For example if the requirements for C<replicated> are not available, the
returned string would look like:

 Moose >= 0.98, MooseX::Types >= 0.21, namespace::clean (see $class for details)

The author is expected to prepend the necessary text to this message before
returning the actual error seen by the user.
EOD

    '=head2 req_errorlist_for',
    '=over',
    '=item Arguments: $group_name',
    '=item Returns: \%list_of_loaderrors_per_module',
    '=back',
    <<'EOD',
Returns a hashref containing the actual errors that occured while attempting
to load each module in the requirement group.
EOD

  );

  my $fn = __FILE__;
  $fn =~ s/\.pm$/\.pod/;

  open (my $fh, '>', $fn) or croak "Unable to write to $fn: $!";
  print $fh join ("\n\n", @chunks);
  close ($fh);
}

1;
Commit	Line	Data
8057ed01	1	package DBIx::Class::Optional::Dependencies;
	2
	3	use warnings;
	4	use strict;
	5
fb39747c	6	use Carp;
	7
	8	# NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G)
8057ed01	9	# This module is to be loaded by Makefile.PM on a pristine system
8057ed01	10
f6b26571	11	# POD is generated automatically by calling _gen_pod from the
	12	# Makefile.PL in $AUTHOR mode
	13
8057ed01	14	my $reqs = {
	15	dist => {
	16	#'Module::Install::Pod::Inherit' => '0.01',
	17	},
	18
	19	replicated => {
f6b26571	20	req => {
	21	'Moose' => '0.98',
	22	'MooseX::Types' => '0.21',
	23	'namespace::clean' => '0.11',
	24	'Hash::Merge' => '0.11',
	25	},
	26	pod => {
	27	title => 'Storage::Replicated',
	28	desc => 'Modules required for L<DBIx::Class::Storage::DBI::Replicated>',
	29	},
8057ed01	30	},
	31
	32	admin => {
	33	},
	34
	35	deploy => {
f6b26571	36	req => {
	37	'SQL::Translator' => '0.11002',
	38	},
	39	pod => {
	40	title => 'Storage::DBI::deploy()',
	41	desc => 'Modules required for L<DBIx::Class::Storage::DBI/deploy> and L<DBIx::Class::Storage::DBI/deploymen_statements>',
	42	},
8057ed01	43	},
	44
	45	author => {
f6b26571	46	req => {
	47	'Test::Pod' => '1.26',
	48	'Test::Pod::Coverage' => '1.08',
	49	'Pod::Coverage' => '0.20',
	50	#'Test::NoTabs' => '0.9',
	51	#'Test::EOL' => '0.6',
	52	},
8057ed01	53	},
	54
	55	core => {
f6b26571	56	req => {
	57	# t/52cycle.t
	58	'Test::Memory::Cycle' => '0',
	59	'Devel::Cycle' => '1.10',
	60
	61	# t/36datetime.t
	62	# t/60core.t
	63	'DateTime::Format::SQLite' => '0',
	64
	65	# t/96_is_deteministic_value.t
	66	'DateTime::Format::Strptime'=> '0',
	67	},
8057ed01	68	},
	69
	70	cdbicompat => {
f6b26571	71	req => {
	72	'DBIx::ContextualFetch' => '0',
	73	'Class::DBI::Plugin::DeepAbstractSearch' => '0',
	74	'Class::Trigger' => '0',
	75	'Time::Piece::MySQL' => '0',
	76	'Clone' => '0',
	77	'Date::Simple' => '3.03',
	78	},
8057ed01	79	},
	80
	81	rdbms_pg => {
f6b26571	82	req => {
	83	$ENV{DBICTEST_PG_DSN}
	84	? (
	85	'Sys::SigAction' => '0',
	86	'DBD::Pg' => '2.009002',
	87	'DateTime::Format::Pg' => '0',
	88	) : ()
	89	},
8057ed01	90	},
	91
	92	rdbms_mysql => {
f6b26571	93	req => {
	94	$ENV{DBICTEST_MYSQL_DSN}
	95	? (
	96	'DateTime::Format::MySQL' => '0',
	97	'DBD::mysql' => '0',
	98	) : ()
	99	},
8057ed01	100	},
	101
	102	rdbms_oracle => {
f6b26571	103	req => {
	104	$ENV{DBICTEST_ORA_DSN}
	105	? (
	106	'DateTime::Format::Oracle' => '0',
	107	) : ()
	108	},
8057ed01	109	},
	110
	111	rdbms_ase => {
f6b26571	112	req => {
	113	$ENV{DBICTEST_SYBASE_DSN}
	114	? (
	115	'DateTime::Format::Sybase' => 0,
	116	) : ()
	117	},
8057ed01	118	},
	119
	120	rdbms_asa => {
f6b26571	121	req => {
	122	grep $_, @ENV{qw/DBICTEST_SYBASE_ASA_DSN DBICTEST_SYBASE_ASA_ODBC_DSN/}
	123	? (
	124	'DateTime::Format::Strptime' => 0,
	125	) : ()
	126	},
8057ed01	127	},
	128	};
	129
f6b26571	130
0d4740b3	131	sub _all_optional_requirements {
f6b26571	132	return { map { %{ $reqs->{$_}{req} \|\| {} } } (keys %$reqs) };
8057ed01	133	}
8057ed01	134
fb39747c	135	sub req_list_for {
	136	my ($class, $group) = @_;
	137
f6b26571	138	croak "req_list_for() expects a requirement group name"
fb39747c	139	unless $group;
fb39747c	140
f6b26571	141	my $deps = $reqs->{$group}{req}
f6b26571	142	or croak "Requirement group '$group' does not exist";
fb39747c	143
	144	return { %$deps };
	145	}
	146
	147
	148	our %req_availability_cache;
	149	sub req_ok_for {
	150	my ($class, $group) = @_;
	151
	152	croak "req_ok_for() expects a requirement group name"
	153	unless $group;
	154
	155	$class->_check_deps ($group) unless $req_availability_cache{$group};
	156
	157	return $req_availability_cache{$group}{status};
	158	}
	159
	160	sub req_missing_for {
	161	my ($class, $group) = @_;
	162
	163	croak "req_missing_for() expects a requirement group name"
	164	unless $group;
	165
	166	$class->_check_deps ($group) unless $req_availability_cache{$group};
	167
	168	return $req_availability_cache{$group}{missing};
	169	}
	170
	171	sub req_errorlist_for {
	172	my ($class, $group) = @_;
	173
	174	croak "req_errorlist_for() expects a requirement group name"
	175	unless $group;
	176
	177	$class->_check_deps ($group) unless $req_availability_cache{$group};
	178
	179	return $req_availability_cache{$group}{errorlist};
	180	}
	181
	182	sub _check_deps {
	183	my ($class, $group) = @_;
	184
f6b26571	185	my $deps = $class->req_list_for ($group);
fb39747c	186
	187	my %errors;
	188	for my $mod (keys %$deps) {
	189	if (my $ver = $deps->{$mod}) {
	190	eval "use $mod $ver ()";
	191	}
	192	else {
	193	eval "require $mod";
	194	}
	195
	196	$errors{$mod} = $@ if $@;
	197	}
	198
	199	if (keys %errors) {
f6b26571	200	my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
f6b26571	201	$missing .= " (see $class for details)" if $reqs->{$group}{pod};
fb39747c	202	$req_availability_cache{$group} = {
	203	status => 0,
	204	errorlist => { %errors },
f6b26571	205	missing => $missing,
fb39747c	206	};
	207	}
	208	else {
	209	$req_availability_cache{$group} = {
	210	status => 1,
	211	errorlist => {},
	212	missing => '',
	213	};
	214	}
	215	}
	216
f6b26571	217	sub _gen_pod {
f6b26571	218	my $class = shift;
af4ac504	219	my $modfn = __PACKAGE__ . '.pm';
af4ac504	220	$modfn =~ s/\:\:/\//g;
f6b26571	221
f6b26571	222	my @chunks = (
af4ac504	223	<<"EOC",
	224	#########################################################################
	225	##################### A U T O G E N E R A T E D ########################
	226	#########################################################################
	227	#
	228	# The contents of this POD file are auto-generated. Any changes you make
	229	# will be lost. If you need to change the generated text edit _gen_pod()
	230	# at the end of $modfn
	231	#
	232	EOC
f6b26571	233	'=head1 NAME',
	234	"$class - Optional module dependency specifications",
	235	'=head1 DESCRIPTION',
	236	<<'EOD',
	237	Some of the less-frequently used features of L<DBIx::Class> have external
	238	module dependencies on their own. In order not to burden the average user
	239	with modules he will never use, these optional dependencies are not included
	240	in the base Makefile.PL. Instead an exception with a descriptive message is
	241	thrown when a specific feature is missing one or several modules required for
	242	its operation. This module is the central holding place for the current list
	243	of such dependencies.
	244	EOD
	245	'=head1 CURRENT REQUIREMENT GROUPS',
	246	<<'EOD',
	247	Dependencies are organized in C<groups> and each group can list one or more
	248	required modules, with an optional minimum version (or 0 for any version).
	249	The group name can be used in the
	250	EOD
	251	);
	252
	253	for my $group (sort keys %$reqs) {
	254	my $p = $reqs->{$group}{pod}
	255	or next;
	256
	257	my $modlist = $reqs->{$group}{req}
	258	or next;
	259
	260	next unless keys %$modlist;
	261
	262	push @chunks, (
	263	"=head2 $p->{title}",
	264	"$p->{desc}",
	265	'=over',
	266	( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
	267	'=back',
	268	"Requirement group: B<$group>",
	269	);
	270	}
	271
	272	push @chunks, (
	273	'=head1 METHODS',
	274	'=head2 req_list_for',
	275	'=over',
	276	'=item Arguments: $group_name',
	277	'=item Returns: \%list_of_module_version_pairs',
	278	'=back',
	279	<<EOD,
	280	This method should be used by DBIx::Class extension authors, to determine the
	281	version of modules which a specific feature requires in the current version of
	282	DBIx::Class. For example if you write a module/extension that requires
	283	DBIx::Class and also requires the availability of
	284	L<DBIx::Class::Storage::DBI/deploy>, you can do the following in your
	285	C<Makefile.PL> or C<Build.PL>
	286
	287	require $class;
	288	my \$dep_list = $class->req_list_for ('deploy');
	289
	290	Which will give you a list of module/version pairs necessary for the particular
	291	feature to function with this version of DBIx::Class.
	292	EOD
	293
	294	'=head2 req_ok_for',
	295	'=over',
	296	'=item Arguments: $group_name',
297	'=item Returns: 1\|0',
298	'=back',
af4ac504	299	'Returns true or false depending on whether all modules required by C<$group_name> are present on the system and loadable',
f6b26571	300
	301	'=head2 req_missing_for',
	302	'=over',
	303	'=item Arguments: $group_name',
	304	'=item Returns: $error_message_string',
	305	'=back',
	306	<<EOD,
	307	Returns a single line string suitable for inclusion in larger error messages.
	308	This method would normally be used by DBIx::Class core-module author, to
	309	indicate to the user that he needs to install specific modules before he will
	310	be able to use a specific feature.
	311
	312	For example if the requirements for C<replicated> are not available, the
	313	returned string would look like:
	314
	315	Moose >= 0.98, MooseX::Types >= 0.21, namespace::clean (see $class for details)
	316
	317	The author is expected to prepend the necessary text to this message before
	318	returning the actual error seen by the user.
	319	EOD
	320
	321	'=head2 req_errorlist_for',
	322	'=over',
	323	'=item Arguments: $group_name',
	324	'=item Returns: \%list_of_loaderrors_per_module',
	325	'=back',
	326	<<'EOD',
	327	Returns a hashref containing the actual errors that occured while attempting
	328	to load each module in the requirement group.
	329	EOD
	330
	331	);
	332
	333	my $fn = __FILE__;
	334	$fn =~ s/\.pm$/\.pod/;
	335
	336	open (my $fh, '>', $fn) or croak "Unable to write to $fn: $!";
	337	print $fh join ("\n\n", @chunks);
	338	close ($fh);
	339	}
	340
8057ed01	341	1;