File Coverage

blib/lib/Crypt/DSA/Signature.pm

Criterion	Covered	Total	%
statement	51	55	92.7
branch	12	20	60.0
condition	1	2	50.0
subroutine	11	11	100.0
pod	2	4	50.0
total	77	92	83.7

package Crypt::DSA::Signature;

use strict;
use warnings;
use Carp qw( croak );

our $VERSION = '1.20'; #VERSION
#
use vars qw{$VERSION};

sub new {
    my $class = shift;
    my %param = @_;
    my $sig = bless { }, $class;
    if ($param{Content}) {
        return $sig->deserialize(%param);
    }
    $sig;
}

BEGIN {
    no strict 'refs';
    for my $meth (qw( r s )) {
        *$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;
                }
            }
            my $ret = $key->{$meth} || "";
            $ret = Math::BigInt->new("$ret") if $ret =~ /^\d+$/;
            $ret;
        };
    }
}

sub asn {
    require Convert::ASN1;
    my $asn = Convert::ASN1->new;
    $asn->prepare('SEQUENCE { r INTEGER, s INTEGER }') or croak $asn->{error};
    $asn;
}

sub deserialize {
    my $sig = shift;
    my %param = @_;
    my $asn = __PACKAGE__->asn;
    my $ref;
    require MIME::Base64;
    ## Turn off warnings, because we're attempting to base64-decode content
    ## that may not be base64-encoded.
    local $^W = 0;
    for ($param{Content}, MIME::Base64::decode_base64($param{Content})) {
        my $out = $asn->decode($_);
        $ref = $out, last if $out;
    }
    croak "Invalid Content" unless $ref;
    $sig->s($ref->{s});
    $sig->r($ref->{r});
    $sig;
}

sub serialize {
    my $sig = shift;
    my %param = @_;
    my $asn = __PACKAGE__->asn;
    my $buf = $asn->encode({ s => $sig->s, r => $sig->r })
        or croak $asn->{error};
    $buf;
}

1;
__END__