This file is indexed.

/usr/share/perl5/Test/Database/Handle.pm is in libtest-database-perl 1.113-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
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
package Test::Database::Handle;
$Test::Database::Handle::VERSION = '1.113';
use strict;
use warnings;
use Carp;
use DBI;

# basic accessors
for my $attr (qw( dbd dsn username password name driver )) {
    no strict 'refs';
    *{$attr} = sub { return $_[0]{$attr} };
}

sub new {
    my ( $class, %args ) = @_;

    exists $args{$_} or croak "$_ argument required"
       for qw( dsn );

    my ( $scheme, $driver, $attr_string, $attr_hash, $driver_dsn )
        = DBI->parse_dsn( $args{dsn} );

    # fix args
    %args = (
        %args,
        dbd => $driver,
    );

    # try to provide a Test::Database::Driver object
    if ( !exists $args{driver} ) {
        eval {
            $args{driver} = "Test::Database::Driver::$driver"->new(
                driver_dsn => $args{dsn},
                username   => $args{username},
                password   => $args{password},
            );
        };
    }

    return bless { %args }, $class;
}

sub connection_info { return @{ $_[0] }{qw( dsn username password )} }

sub dbh {
    my ( $self, $attr ) = @_;
    return $self->{dbh} ||= DBI->connect( $self->connection_info(), $attr );
}

'IDENTITY';

__END__

=head1 NAME

Test::Database::Handle - A class for Test::Database handles

=head1 SYNOPSIS

    use Test::Database;

    my $handle = Test::Database->handle(@requests);
    my $dbh    = $handle->dbh();

=head1 DESCRIPTION

Test::Database::Handle is a very simple class for encapsulating the
information about a test database handle.

Test::Database::Handle objects are used within a test script to
obtain the necessary information about a test database handle.
Handles are obtained through the C<< Test::Database->handles() >>
or C<< Test::Database->handle() >> methods.

=head1 METHODS

Test::Database::Handle provides the following methods:

=head2 new

Return a new Test::Database::Handle with the given parameters
(C<dsn>, C<username>, C<password>).

The only mandatory argument is C<dsn>.

=head1 ACCESSORS

The following accessors are available.

=head2 dsn

Return the Data Source Name.

=head2 username

Return the connection username. Defaults to C<undef>.

=head2 password

Return the connection password. Defaults to C<undef>.

=head2 connection_info

Return the connection information triplet (C<dsn>, C<username>, C<password>).

    my ( $dsn, $username, $password ) = $handle->connection_info;

=head2 dbh

    my $dbh = $handle->dbh;
    my $dbh = $handle->dbh( $attr );

Return the DBI database handle obtained when connecting with the
connection triplet returned by C<connection_info()>.

The optional parameter C<$attr> is a reference to a hash of connection
attributes, passed directly to DBI's C<connect()> method.

=head2 name

Return the database name attached to the handle.

=head2 dbd

Return the DBI driver name, as computed from the C<dsn>.

=head2 driver

Return the L<Test::Database::Driver> object attached to the handle.

=head1 AUTHOR

Philippe Bruhat (BooK), C<< <book@cpan.org> >>

=head1 COPYRIGHT

Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved.

=head1 LICENSE

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut