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