File Coverage

blib/lib/DBIx/MyPassword.pm

Criterion	Covered	Total	%
statement	44	54	81.4
branch	6	14	42.8
condition	9	27	33.3
subroutine	14	16	87.5
pod	7	7	100.0
total	80	118	67.8

package DBIx::MyPassword;

use warnings;
use strict;
use Carp;
use DBI();
use IO::File;
use Text::CSV;
use File::Spec;

@DBIx::MyPassword::ISA     = qw ( DBI::db );
$DBIx::MyPassword::VERSION = '1.02';

#--> Name of the password file that we are looking for
my $PASSFILE = '.mypassword';

#--> Name of environment variable that can point to override file
my $ENV_VAR = 'MYPASSWORD' ;

#--> Order of data within password file
my @FIELDS = qw(alias user password datasource options) ;

my %virtual_users;
my $EMPTY = q{};

#-------------------------------------------------------------------------------
#--  import([password file])
#-------------------------------------------------------------------------------
#--  Try to find a file in which to grab password information.  After a file is
#--  found, parse out the DBI connection information and store it in a hash.
#-------------------------------------------------------------------------------
#--> Pick a file to use to get passwords from.  The order that we are going to
#--> look for a password file is:
#-->                   1) import argument
#-->                   2) an environment variable
#-->                   3) the current directory
#-->                   4) the users home directory
sub import {
    my $file = $EMPTY;
    for (
        ( $_[-1] || $EMPTY ),    #--> 'use' override
        $ENV{$ENV_VAR},          #--> environmental override
        $PASSFILE,               #--> current directory
        File::Spec->catpath(
            File::Spec->rootdir(), ( $ENV{HOME} || $EMPTY ), $PASSFILE
        ),                       #--> home directory
      )
    {
        if ( $_ && -e $_ ) {
            $file = $_;
            last;
        }
    }
    croak("Unable to find $PASSFILE file") unless ($file);

    #--> If we are here, we have found a password file.  Assume that it is a CSV
    #--> file and start to parse
    my $csv = Text::CSV->new();
    my $fh  = IO::File->new();
    croak("Unable to open file ($file): $!") unless ( $fh->open("<$file") );
    while (<$fh>) {
        chomp;
        unless ( $csv->parse($_) ) {  #--> Parse the line, just warn if problems
            carp 'Unable to parse: ' . $csv->error_input();
            next;
        }
        next unless ( my @fields = $csv->fields() );

        #--> Add all password elements indexed by the first CSV field
        if ( $fields[0] ) {
            $virtual_users{ $fields[0] }{ $FIELDS[$_] } = $fields[$_] || $EMPTY
              for ( 0 .. $#FIELDS );
        }
    }
    $fh->close();
    return;
}

#-------------------------------------------------------------------------------
#--  connect(virtual user)
#-------------------------------------------------------------------------------
#--  An override of the of the DBI::connect subroutine.  Lookup the virtual user
#-- specified and return a standard DBI connection
#-------------------------------------------------------------------------------
sub connect {    ##no critic
    my ( $class, $user ) = @_;
    return unless ( $virtual_users{$user} );

    my $self = DBI->connect(
        $virtual_users{$user}{datasource}, $virtual_users{$user}{user}
        , $virtual_users{$user}{password}

          #, eval("{$virtual_users{$user}{options}}")
          #, eval {{$virtual_users{$user}{options}}}
        , { $virtual_users{$user}{options} }
    );

    bless $self, $class;
    return $self;
}

#-------------------------------------------------------------------------------
#--  getVirtualUsers()
#-------------------------------------------------------------------------------
#--  Return a list of virtual users.  Presort them to be nice.
#-------------------------------------------------------------------------------
sub getVirtualUsers {
    return sort keys %virtual_users;
}

#-------------------------------------------------------------------------------
#--  checkVirtualUser(virtual user)
#-------------------------------------------------------------------------------
#--  Returns true if the specified virtual user exists, false if not.
#-------------------------------------------------------------------------------
sub checkVirtualUser {
    return defined $virtual_users{ $_[-1] || $EMPTY };
}

#-------------------------------------------------------------------------------
#--  getDataSource(virtual user)
#-------------------------------------------------------------------------------
#--  Return data source information for the specified virtual user.
#-------------------------------------------------------------------------------
sub getDataSource {
    return $virtual_users{ $_[-1] || $EMPTY }{datasource};
}

#-------------------------------------------------------------------------------
#--  getUser(virtual user)
#-------------------------------------------------------------------------------
#--  Return database user for the specified virtual user.
#-------------------------------------------------------------------------------
sub getUser {
    return $virtual_users{ $_[-1] || $EMPTY }{user};
}

#-------------------------------------------------------------------------------
#--  getPassword(virtual user)
#-------------------------------------------------------------------------------
#--  Return password for the specified virtual user.
#-------------------------------------------------------------------------------
sub getPassword {
    return $virtual_users{ $_[-1] || $EMPTY }{password};
}

#-------------------------------------------------------------------------------
#--  getOptions(virtual_user)
#-------------------------------------------------------------------------------
#--  Return options for the specified virtual user.
#-------------------------------------------------------------------------------
sub getOptions {
    return $virtual_users{ $_[-1] || $EMPTY }{options};
}

#-------------------------------------------------------------------------------
#--  DESTROY
#-------------------------------------------------------------------------------
#--  Clean up.
#-------------------------------------------------------------------------------
sub DESTROY {    ##no critic
    my ($self) = @_;
    $self->SUPER::DESTROY;
    return;
}

1;

__END__