File Coverage

blib/lib/Text/Authinfo.pm

Criterion	Covered	Total	%
statement	50	81	61.7
branch	4	24	16.6
condition	7	32	21.8
subroutine	11	13	84.6
pod	5	5	100.0
total	77	155	49.6

package Text::Authinfo;

use strict;
use warnings;
use File::Copy qw(move);
use Text::CSV;
use Carp qw(croak carp);
use vars qw($VERSION @EXPORT);
use Exporter;
use base qw(Exporter);


@EXPORT = qw(readauthinfo writeauthinfo as_string);

our $VERSION = '0.03';
our $wildcard = 'ANY';
our $authinfofile = $ENV{'HOME'} . '/.authinfo';


sub new {
    my $self = {};
    my $class = shift;

    $self->{FILE} = shift || $authinfofile;
    $self->{AUTHINFO} = {};

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


sub readauthinfo {
    my $self = shift;

    my $ai = {};
    my $csv = Text::CSV->new({sep_char=> ' '}) || croak 'new Text::CSV';

    open(my $fh,'<',$self->{FILE}) || croak "open $self->{FILE}:$!";

    LINE:while (my $line = <$fh>) {
        chomp $line;
        $csv->parse($line);
        my %l = $csv->fields();
        # this package requires at least these fields to be on a valid
        # line:
        if (defined($l{'machine'}) &&
            defined($l{'login'})   &&
            defined($l{'password'})) {
            # allow port to be defined or ANY
            my $port = $wildcard;
            $port = $l{'port'} if (defined($l{'port'}));
            $ai->{$l{'machine'}}->{$port}->{$l{'login'}} = $l{'password'};
        } else {
            carp "$line missing some fields? skipping";
            next LINE;
        }
    }

    $self->{AUTHINFO} = $ai;

    close($fh) || croak "close $authinfofile:$!";

    return 1; # caller can now query authinfo data as a perl assoc array
}


sub getauth() {

    my $self    = shift;
    my $machine = shift || croak 'use: getauth(machine,login,[port])';
    my $login   = shift || croak 'use: getauth(machine,login,[port])';
    my $port    = shift || $wildcard;

    # retval may be undef
    return $self->{AUTHINFO}->{$machine}->{$port}->{$login};
}


sub as_string {
    my $self = shift;

    my $c = '';
    for my $machine (keys %{$self->{AUTHINFO}}) {
        for my $port (keys %{$self->{AUTHINFO}->{$machine}}) {
            for my $login (keys %{$self->{AUTHINFO}->{$machine}->{$port}}) {
                my $pass = $self->{AUTHINFO}->{$machine}->{$port}->{$login};
                $c .= 'machine ' . $machine . ' login ' . $login .
                    ' password ' . $pass;
                $c .= ' port ' . $port if ($port ne $wildcard);
                $c .= "\n";
            }
        }
    }
    return $c;
}


sub writeauthinfo {
    my $self = shift;

    my $ops = shift || undef;
    if (defined($ops) && (ref($ops) ne 'HASH')) {
        carp "args are passed to writeauthinfo via a hash ref";
    }

    if (-w $self->{FILE}) {
        # there is already a .authinfo file, mv it to .authinfo.bak
        if (defined($ops->{nobackup})) {
            unlink $self->{FILE} || croak "rm old $self->{FILE}:$!"
        } else { # by default, make a backup old old authinfo file
            my $bak = $self->{FILE} . '.bak';
            move($self->{FILE},$bak) || croak "mv $self->{FILE} $bak:$!";
        }
    }

    my $c = $self->as_string();
    if ($c) {
        open(my $fh,'>',$self->{FILE}) || croak "open $self->{FILE}:$!";
        print $fh $c;
        close($fh) || croak "close $self->{FILE}:$!";
        chmod 0600, $self->{FILE} || croak "chmod fail on $self->{FILE}:$!";
    }

    return 1;
}

__END__;