| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package DBIx::Password; |
|
2
|
1
|
|
|
1
|
|
962
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
40
|
|
|
3
|
1
|
|
|
1
|
|
8647
|
use DBI(); |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
@DBIx::Password::ISA = qw ( DBI::db ); |
|
6
|
|
|
|
|
|
|
($DBIx::Password::VERSION) = ' $Revision: 1.9 $ ' =~ /\$Revision:\s+([^\s]+)/; |
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
my $virtual1 = {}; |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my %driver_cache; |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub connect { |
|
14
|
|
|
|
|
|
|
my ($class, $user, $options) = @_; |
|
15
|
|
|
|
|
|
|
return undef unless $virtual1->{$user}; |
|
16
|
|
|
|
|
|
|
my $self; |
|
17
|
|
|
|
|
|
|
my $virtual = $virtual1->{$user}; |
|
18
|
|
|
|
|
|
|
return undef unless $virtual; |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
$self = DBI->connect($virtual->{connect} |
|
21
|
|
|
|
|
|
|
, $virtual->{'username'} |
|
22
|
|
|
|
|
|
|
, $virtual->{'password'} |
|
23
|
|
|
|
|
|
|
, $virtual->{'attributes'} |
|
24
|
|
|
|
|
|
|
); |
|
25
|
|
|
|
|
|
|
return undef unless $self; |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
bless $self, $class; |
|
28
|
|
|
|
|
|
|
$driver_cache{$self} = $user; |
|
29
|
|
|
|
|
|
|
return $self; |
|
30
|
|
|
|
|
|
|
} |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub connect_cached { |
|
33
|
|
|
|
|
|
|
my ($class, $user, $options) = @_; |
|
34
|
|
|
|
|
|
|
return undef unless $virtual1->{$user}; |
|
35
|
|
|
|
|
|
|
my $self; |
|
36
|
|
|
|
|
|
|
my $virtual = $virtual1->{$user}; |
|
37
|
|
|
|
|
|
|
return undef unless $virtual; |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
$self = DBI->connect_cached($virtual->{connect} |
|
40
|
|
|
|
|
|
|
, $virtual->{'username'} |
|
41
|
|
|
|
|
|
|
, $virtual->{'password'} |
|
42
|
|
|
|
|
|
|
, $virtual->{'attributes'} |
|
43
|
|
|
|
|
|
|
); |
|
44
|
|
|
|
|
|
|
return undef unless $self; |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
bless $self, $class; |
|
47
|
|
|
|
|
|
|
$driver_cache{$self} = $user; |
|
48
|
|
|
|
|
|
|
return $self; |
|
49
|
|
|
|
|
|
|
} |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub getDriver { |
|
52
|
|
|
|
|
|
|
my ($self) = @_; |
|
53
|
|
|
|
|
|
|
unless(ref $self) { |
|
54
|
|
|
|
|
|
|
for my $key (keys %$virtual1) { |
|
55
|
|
|
|
|
|
|
return $virtual1->{$key}->{'driver'} if $self eq $key; |
|
56
|
|
|
|
|
|
|
} |
|
57
|
|
|
|
|
|
|
} else { |
|
58
|
|
|
|
|
|
|
my $user = $driver_cache{$self}; |
|
59
|
|
|
|
|
|
|
return $virtual1->{$user}{'driver'}; |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
} |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub checkVirtualUser { |
|
64
|
|
|
|
|
|
|
my ($user) = @_; |
|
65
|
|
|
|
|
|
|
return $virtual1->{$user} ? 1 : 0; |
|
66
|
|
|
|
|
|
|
} |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub getVirtualUser { |
|
69
|
|
|
|
|
|
|
my ($user) = @_; |
|
70
|
|
|
|
|
|
|
return $virtual1->{$user} || undef; |
|
71
|
|
|
|
|
|
|
} |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub DESTROY { |
|
74
|
|
|
|
|
|
|
my ($self) = @_; |
|
75
|
|
|
|
|
|
|
$self->SUPER::DESTROY; |
|
76
|
|
|
|
|
|
|
} |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
1; |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 NAME |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
DBIx::Password - Allows you to create a global password file for DB passwords |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
use DBIx::Password; |
|
87
|
|
|
|
|
|
|
my $dbh = DBIx::Password->connect($user); |
|
88
|
|
|
|
|
|
|
my $dbh = DBIx::Password->connect_cached($user); |
|
89
|
|
|
|
|
|
|
$dbh->getDriver; |
|
90
|
|
|
|
|
|
|
DBIx::Password::getDriver($user); |
|
91
|
|
|
|
|
|
|
DBIx::Password::checkVirtualUser($user); |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
94
|
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Don't you hate keeping track of database passwords and such throughout |
|
96
|
|
|
|
|
|
|
your scripts? How about the problem of changing those passwords |
|
97
|
|
|
|
|
|
|
on a mass scale? This module is one possible solution. When you |
|
98
|
|
|
|
|
|
|
go to build this module it will ask you to create virtual users. |
|
99
|
|
|
|
|
|
|
For each user you need to specify the database module to use, |
|
100
|
|
|
|
|
|
|
the database connect string, the username and the password. You |
|
101
|
|
|
|
|
|
|
will be prompted to give a name to this virtual user. |
|
102
|
|
|
|
|
|
|
You can add as many as you like. |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
I would recommend that if you are only using this with |
|
105
|
|
|
|
|
|
|
web applications that you change the final permissions on this |
|
106
|
|
|
|
|
|
|
package after it is installed in site_perl such that only |
|
107
|
|
|
|
|
|
|
the webserver can read it. |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
A method called getDriver has been added so that you |
|
110
|
|
|
|
|
|
|
can determine what driver is being used (handy for |
|
111
|
|
|
|
|
|
|
working out database indepence issues). |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
If you want to find out if the virtual user is valid, |
|
114
|
|
|
|
|
|
|
you can call the class method checkVirtualUser(). |
|
115
|
|
|
|
|
|
|
It returns true (1) if the username is valid, and |
|
116
|
|
|
|
|
|
|
zero if not. |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Once your are done you can use the connect method (or |
|
119
|
|
|
|
|
|
|
the connect_cache method) that comes with DBIx-Password |
|
120
|
|
|
|
|
|
|
and just specify one of the virtual users you defined |
|
121
|
|
|
|
|
|
|
while making the module. |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
BTW I learned the bless hack that is used from Apache::DBI |
|
124
|
|
|
|
|
|
|
so some credit should go to the authors of that module. |
|
125
|
|
|
|
|
|
|
This is a rewrite of the module Tangent::DB that I did |
|
126
|
|
|
|
|
|
|
for slashcode. |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Hope you enjoy it. |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=head1 INSTALL |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Basically: |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
perl Makefile.PL |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
make |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
make test |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
make install |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Be sure to answer the questions as you make the module |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=head1 HOME |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
To find out more information look at: http://www.tangent.org/DBIx-Password/ |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 AUTHOR |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
Brian Aker, brian@tangent.org |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
perl(1). DBI(3). |
|
155
|
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=cut |
|
157
|
|
|
|
|
|
|
|