This file is indexed.

/usr/share/perl5/Test/Database/Handle.pm is in libtest-database-perl 1.11-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
145
146
package Test::Database::Handle;
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 = (
        username => '',
        password => '',
        %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

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

C<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

C<Test::Database::Handle> provides the following methods:

=over 4

=item new( %args )

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

The only mandatory argument is C<dsn>.

=back

The following accessors are available.

=over 4

=item dsn()

Return the Data Source Name.

=item username()

Return the connection username.

=item password()

Return the connection password.

=item connection_info()

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

=item 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.

=item name()

Return the database name attached to the handle.

=item dbd()

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

=item driver()

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

=back

=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