This module pissed me off with its totally shite interface so I have added the necessary stuff and will submit it to the author so he can add it. No documentation but should be pretty self explanatory if you follow the synopsis example.
Please note that I would not use the DBIx::Password module in a pink fit as it is a very insecure way of saving passwords - this code demonstrates just how easy it is to extract the data-structure. In this case it is for (perhaps) a worthwhile purpose although adding functionality to the module seems like a bad idea in retrospect.
use strict;
use warnings;
use Data::Dumper;
my $d = new DBIx::Password::Modify;
# have a look at the object we created
print Dumper $d;
# use the methods
$d->add_user( 'new user',
{ 'database' => 'databasename',
'port' => 'port',
'host' => 'host_name',
'password' => 'password',
'driver' => 'mysql',
'username' => 'username',
'attributes'=> { 'extra_attrib' => 'attrib_value' },
'connect' => 'DBI:mysql:database=databasename;host=m
+achine_name;port=port'
}
);
$d->delete_user('new user');
$d->set_attribute( 'user', 'password', 'new_pass' );
my $password = $d->get_attribute( 'user', 'password' );
$d->write_data();
###
### DBIx::Password::Modify
### A quick hack to fix the issues with DBIx::Password
###
package DBIx::Password::Modify;
sub new {
my $class = shift;
my $location = find_dbix_password();
die "Can't find DBIx::Password.pm" unless $location;
my %parse = _parse_password_pm($location);
return bless { location => $location, %parse }, $class;
}
sub find_dbix_password {
for my $dir ( @INC ) {
return "$dir/DBIx/Password.pm" if -e "$dir/DBIx/Password.pm";
}
return 0;
}
sub _parse_password_pm {
my $location = shift;
open FILE, $location or die "Can't open $location, perl says $!\n"
+;
undef $/;
my $file = <FILE>;
close FILE;
$file =~ s/my\s*\$virtual1\s*=(.*?)(my %driver_cache)/<VIRTUAL1>\n
+\n$2/s;
my $virtual1 = $1;
return 'file' => $file, 'config' => eval $virtual1;
}
sub write_data {
my $self = shift;
#Now, lets build up our data structure
require Data::Dumper;
my $data = Data::Dumper->new( [$self->{config}] );
$data->Purity(1);
$data->Indent(3);
$data->Varname('virtual');
my $dump = $data->Dump();
my $text = $self->{file};
$text =~ s/<VIRTUAL1>/my $dump/;
open FILE, ">$self->{location}" or die "Can't write $self->{locati
+on}, perl says $!\n";
print FILE $text;
close FILE;
}
sub add_user {
my ( $self, $user, $hash_ref ) = @_;
$self->{config}->{$user} = $hash_ref;
}
sub delete_user {
my ( $self, $user ) = @_;
if ( exists $self->{config}->{$user} ) {
delete $self->{config}->{$user};
return 1;
}
else {
$self->error("$user does not exist\n");
return 0;
}
}
sub get_attribute {
my ( $self, $user, $attribute ) = @_;
if ( exists $self->{config}->{$user}->{$attribute} ) {
return $self->{config}->{$user}->{$attribute}
}
else {
$self->error("$attribute does not exist for $user\n");
return 0;
}
}
sub set_attribute {
my ( $self, $user, $attribute, $value ) = @_;
$self->{config}->{$user}->{$attribute} = $value;
}
sub error {
my ( $self, $error ) = @_;
$self->{error} .= $error if $error;
return $self->{error};
}
1;
cheers
tachyon
s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print
|