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=machine_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->{location}, 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;