File Coverage

blib/lib/Crypt/DSA/Key.pm

Criterion	Covered	Total	%
statement	87	95	91.5
branch	21	34	61.7
condition	9	11	81.8
subroutine	18	19	94.7
pod	3	4	75.0
total	138	163	84.6

package Crypt::DSA::Key;

use strict;
use warnings;
use Math::BigInt 1.78 try => 'GMP, Pari';
use Carp qw( croak );
use Crypt::DSA::Util qw( bitsize );

our $VERSION = '1.21'; #VERSION

use vars qw{$VERSION};

sub new {
    my $class = shift;
    my %param = @_;
    my $key = bless { }, $class;

    if ($param{Filename} || $param{Content}) {
        if ($param{Filename} && $param{Content}) {
            croak "Filename and Content are mutually exclusive.";
        }
        return $key->read(%param);
    }
    $key;
}

sub size { bitsize($_[0]->p) }

BEGIN {
    no strict 'refs';
    for my $meth (qw( p q g pub_key priv_key r kinv )) {
        *$meth = sub {
            my($key, $value) = @_;
            if (ref $value eq 'Math::Pari') {
                $key->{$meth} = Math::Pari::pari2pv($value);
            }
            elsif (ref $value) {
                $key->{$meth} = "$value";
            }
            elsif ($value) {
                if ($value =~ /^0x/) {
                    $key->{$meth} = Math::BigInt->new($value)->bstr;
                }
                else {
                    $key->{$meth} = $value;
                }
            } elsif (@_ > 1 && !defined $value) {
                delete $key->{$meth};
            }
            my $ret = $key->{$meth} || "";
            $ret = Math::BigInt->new("$ret") if $ret =~ /^\d+$/;
            $ret;
        };
    }
}

sub read {
    my $key = shift;
    my %param = @_;
    my $type = $param{Type} or croak "read: Need a key file 'Type'";
    my $class = join '::', __PACKAGE__, $type;
    eval "use $class;";
    croak "Invalid key file type '$type': $@" if $@;
    bless $key, $class;
    local *FH;
    if (my $fname = delete $param{Filename}) {
        open FH, '<', $fname or return;
        my $blob = do { local $/;  };
        close FH;
        $param{Content} = $blob;
    }
    $key->deserialize(%param);
}

sub write {
    my $key = shift;
    my %param = @_;
    my $type;
    unless ($type = $param{Type}) {
        my $pkg = __PACKAGE__;
        ($type) = ref($key) =~ /^${pkg}::(\w+)$/;
    }
    croak "write: Need a key file 'Type'" unless $type;
    my $class = join '::', __PACKAGE__, $type;
    eval "use $class;";
    croak "Invalid key file type '$type': $@" if $@;
    bless $key, $class;
    my $blob = $key->serialize(%param);
    if (my $fname = delete $param{Filename}) {
        local *FH;
        open FH, '>', $fname or croak "Can't open $fname: $!";
        print FH $blob;
        close FH;
    }
    $blob;
}

1;
__END__