File Coverage

blib/lib/Venus/Role/Digestable.pm

Criterion	Covered	Total	%
statement	28	29	96.5
branch	1	2	50.0
condition	2	2	100.0
subroutine	11	11	100.0
pod	5	7	71.4
total	47	51	92.1

package Venus::Role::Digestable;

use 5.014;

use strict;
use warnings;

use Venus::Role 'fault';

# AUDITS

sub AUDIT {
  my ($self, $from) = @_;

  if (!$from->does('Venus::Role::Dumpable')) {
    fault "${self} requires ${from} to consume Venus::Role::Dumpable";
  }

  return $self;
}

# METHODS

sub digester {
  my ($self, $algorithm, $method, @args) = @_;

  my $result = $self->dump($method, @args);

  require Digest;

  my $digest = Digest->new(uc($algorithm || 'sha-1'));

  return $digest->add($result);
}

sub digest {
  my ($self, $algorithm, $method, @args) = @_;

  return $self->hexdigest($algorithm, $method, @args);
}

sub b64digest {
  my ($self, $algorithm, $method, @args) = @_;

  return $self->digester($algorithm, $method, @args)->b64digest;
}

sub bindigest {
  my ($self, $algorithm, $method, @args) = @_;

  return $self->digester($algorithm, $method, @args)->digest;
}

sub hexdigest {
  my ($self, $algorithm, $method, @args) = @_;

  return $self->digester($algorithm, $method, @args)->hexdigest;
}

# EXPORTS

sub EXPORT {
  ['digester', 'digest', 'b64digest', 'bindigest', 'hexdigest']
}

1;



=head1 NAME

Venus::Role::Digestable - Digestable Role

=cut

=head1 ABSTRACT

Digestable Role for Perl 5

=cut

=head1 SYNOPSIS

  package Example;

  use Venus::Class;

  attr 'data';

  with 'Venus::Role::Dumpable';
  with 'Venus::Role::Digestable';

  sub execute {
    my ($self, @args) = @_;

    return [$self->data, @args];
  }

  package main;

  my $example = Example->new(data => 123);

  # $example->digest;

  # "a6c3d9ae59f31690eddbdd15271e856a6b6f15d5"

=cut

=head1 DESCRIPTION

This package modifies the consuming package and provides methods for producing
message digests from a dump of the object or the return value of a dispatched
method call. All algorithms supported by L are supported, e.g.
C, C, C, C, C, C,
C, etc.

=cut

=head1 METHODS

This package provides the following methods:

=cut

=head2 b64digest

  b64digest(string $algo, string $method, any @args) (string)

The b64digest method returns a base64 formatted digest of the object or return
value of a dispatched method call. The algorithm defaults to C. This
method supports dispatching, i.e. providing a method name and arguments whose
return value will be acted on by this method.

I>

=over 4

=item b64digest example 1

  package main;

  my $example = Example->new(data => 123);

  my $b64digest = $example->b64digest;

  # "/PFIeIRxSIuCLPcrbWypwXVUpMY"

=back

=over 4

=item b64digest example 2

  package main;

  my $example = Example->new(data => 123);

  my $b64digest = $example->b64digest('sha-1', 'execute');

  # "T+raai5I0suKC3VpiZ8bqt0WXE0"

=back

=over 4

=item b64digest example 3

  package main;

  my $example = Example->new(data => 123);

  my $b64digest = $example->b64digest('sha-1', 'execute', '456');

  # "5Vf077AO11mZZfaQknfOtzfhzPc"

=back

=cut

=head2 bindigest

  bindigest(string $algo, string $method, any @args) (string)

The bindigest method returns a binary formatted digest of the object or return
value of a dispatched method call. The algorithm defaults to C. This
method supports dispatching, i.e. providing a method name and arguments whose
return value will be acted on by this method.

I>

=over 4

=item bindigest example 1

  package main;

  my $example = Example->new(data => 123);

  my $bindigest = $example->bindigest;

  # pack("H*","fcf148788471488b822cf72b6d6ca9c17554a4c6")

=back

=over 4

=item bindigest example 2

  package main;

  my $example = Example->new(data => 123);

  my $bindigest = $example->bindigest('sha-1', 'execute');

  # pack("H*","4feada6a2e48d2cb8a0b7569899f1baadd165c4d")

=back

=over 4

=item bindigest example 3

  package main;

  my $example = Example->new(data => 123);

  my $bindigest = $example->bindigest('sha-1', 'execute', '456');

  # pack("H*","e557f4efb00ed7599965f6909277ceb737e1ccf7")

=back

=cut

=head2 digest

  digest(string $algo, string $method, any @args) (string)

The digest method returns a hexadecimal formatted digest of a dump of the
object or return value of a dispatched method call. The algorithm defaults to
C. This method supports dispatching, i.e. providing a method name and
arguments whose return value will be acted on by this method.

I>

=over 4

=item digest example 1

  package main;

  my $example = Example->new(data => 123);

  my $digest = $example->digest;

  # "fcf148788471488b822cf72b6d6ca9c17554a4c6"

=back

=over 4

=item digest example 2

  package main;

  my $example = Example->new(data => 123);

  my $digest = $example->digest('sha-1', 'execute');

  # "4feada6a2e48d2cb8a0b7569899f1baadd165c4d"

=back

=over 4

=item digest example 3

  package main;

  my $example = Example->new(data => 123);

  my $digest = $example->digest('sha-1', 'execute', '456');

  # "e557f4efb00ed7599965f6909277ceb737e1ccf7"

=back

=cut

=head2 digester

  digester(string $algo, string $method, any @args) (string)

The digester method returns a L object with a dump of the object or
return value of a dispatched method call as the message. The algorithm defaults
to C. This method supports dispatching, i.e. providing a method name and
arguments whose return value will be acted on by this method.

I>

=over 4

=item digester example 1

  package main;

  my $example = Example->new(data => 123);

  my $digester = $example->digester;

  # bless(..., "Digest::SHA")

=back

=over 4

=item digester example 2

  package main;

  my $example = Example->new(data => 123);

  my $digester = $example->digester('md5');

  # bless(..., "Digest::MD5")

=back

=cut

=head2 hexdigest

  hexdigest(string $algo, string $method, any @args) (string)

The hexdigest method returns a ... formatted digest of the object or return
value of a dispatched method call. The algorithm defaults to C. This
method supports dispatching, i.e. providing a method name and arguments whose
return value will be acted on by this method.

I>

=over 4

=item hexdigest example 1

  package main;

  my $example = Example->new(data => 123);

  my $hexdigest = $example->hexdigest;

  # "fcf148788471488b822cf72b6d6ca9c17554a4c6"

=back

=over 4

=item hexdigest example 2

  package main;

  my $example = Example->new(data => 123);

  my $hexdigest = $example->hexdigest('sha-1', 'execute');

  # "4feada6a2e48d2cb8a0b7569899f1baadd165c4d"

=back

=over 4

=item hexdigest example 3

  package main;

  my $example = Example->new(data => 123);

  my $hexdigest = $example->hexdigest('sha-1', 'execute', '456');

  # "e557f4efb00ed7599965f6909277ceb737e1ccf7"

=back

=cut

=head1 AUTHORS

Awncorp, C

=cut

=head1 LICENSE

Copyright (C) 2000, Awncorp, C.

This program is free software, you can redistribute it and/or modify it under
the terms of the Apache license version 2.0.

=cut