/usr/share/perl5/DBI/Test/DSN/Provider.pm is in libdbi-test-perl 0.001-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | package DBI::Test::DSN::Provider;
use strict;
use warnings;
use Module::Pluggable::Object ();
my $dsn_plugins;
sub dsn_plugins
{
defined $dsn_plugins and return @{$dsn_plugins};
my $finder = Module::Pluggable::Object->new(
search_path => ["DBI::Test"],
only => qr/DBI::Test::(?:\w+::)*DSN::Provider.*/,
require => 1,
inner => 0
);
my @plugs =
grep { $_->isa("DBI::Test::DSN::Provider::Base") and $_->can("get_dsn_creds") }
$finder->plugins();
$dsn_plugins = \@plugs;
return @$dsn_plugins;
}
sub get_dsn_creds
{
my ( $self, $test_case_ns, $default_creds ) = @_;
my @plugins = sort {
$b->relevance( $test_case_ns, $default_creds )
<=> $a->relevance( $test_case_ns, $default_creds )
} grep { $_->relevance( $test_case_ns, $default_creds ) > 0 } $self->dsn_plugins();
foreach my $plugin (@plugins)
{
# Hash::Merge->merge( ... )
my $dsn_creds = $plugin->get_dsn_creds( $test_case_ns, $default_creds );
$dsn_creds and return $dsn_creds;
}
$default_creds and return $default_creds;
return [ 'dbi:NullP:', undef, undef, { ReadOnly => 1 } ];
}
1;
=head1 NAME
DBI::Test::DSN::Provider - choose appropriate DSN
=head1 DESCRIPTION
=head1 AUTHOR
This module is a team-effort. The current team members are
H.Merijn Brand (Tux)
Jens Rehsack (Sno)
Peter Rabbitson (ribasushi)
=head1 COPYRIGHT AND LICENSE
Copyright (C)2013 - The DBI development team
You may distribute this module under the terms of either the GNU
General Public License or the Artistic License, as specified in
the Perl README file.
=cut
|