File Coverage

blib/lib/Protocol/OTR.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch			n/a
condition			n/a
subroutine	13	13	100.0
pod	4	4	100.0
total	56	56	100.0

# ABSTRACT: Off-the-Record secure messaging protocol
package Protocol::OTR;
BEGIN {
  $Protocol::OTR::AUTHORITY = 'cpan:AJGB';
}
$Protocol::OTR::VERSION = '0.05';
use strict;
use warnings;

use Alien::OTR;
use Alien::GCrypt;
use Alien::GPG::Error;
use Carp qw( croak );
use Protocol::OTR::Account ();
use Params::Validate qw(validate validate_pos SCALAR);

require Exporter;

require XSLoader;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = (
    'policies' => [ qw(
        POLICY_OPPORTUNISTIC
        POLICY_ALWAYS
    ) ],
    'error_codes' => [ qw(
        ERRCODE_NONE
        ERRCODE_ENCRYPTION_ERROR
        ERRCODE_MSG_NOT_IN_PRIVATE
        ERRCODE_MSG_UNREADABLE
        ERRCODE_MSG_MALFORMED
    ) ],
    'event_codes' => [ qw(
        MSGEVENT_NONE
        MSGEVENT_ENCRYPTION_REQUIRED
        MSGEVENT_ENCRYPTION_ERROR
        MSGEVENT_CONNECTION_ENDED
        MSGEVENT_SETUP_ERROR
        MSGEVENT_MSG_REFLECTED
        MSGEVENT_MSG_RESENT
        MSGEVENT_RCVDMSG_NOT_IN_PRIVATE
        MSGEVENT_RCVDMSG_UNREADABLE
        MSGEVENT_RCVDMSG_MALFORMED
        MSGEVENT_LOG_HEARTBEAT_RCVD
        MSGEVENT_LOG_HEARTBEAT_SENT
        MSGEVENT_RCVDMSG_GENERAL_ERR
        MSGEVENT_RCVDMSG_UNENCRYPTED
        MSGEVENT_RCVDMSG_UNRECOGNIZED
        MSGEVENT_RCVDMSG_FOR_OTHER_INSTANCE
    ) ],
    'smp_event_codes' => [ qw(
        SMPEVENT_NONE
        SMPEVENT_CHEATED
        SMPEVENT_IN_PROGRESS
        SMPEVENT_SUCCESS
        SMPEVENT_FAILURE
        SMPEVENT_ABORT
        SMPEVENT_ERROR
    ) ],
    'instags' => [ qw(
        INSTAG_BEST
        INSTAG_RECENT
        INSTAG_RECENT_RECEIVED
        INSTAG_RECENT_SENT
    ) ],
);
$EXPORT_TAGS{'constants'} = [
    map { @$_ } @EXPORT_TAGS{qw(policies error_codes event_codes smp_event_codes instags)}
];

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'constants'} } );

our @EXPORT = qw();

XSLoader::load('Protocol::OTR', $Protocol::OTR::{VERSION} ?
        ${ $Protocol::OTR::{VERSION} } : ()
    );

sub new {
    my $class = shift;

    my %args = validate(
        @_,
        {
            privkeys_file => {
                type => SCALAR,
                optional => 1,
                default => 'otr.privkey',
            },
            contacts_file => {
                type => SCALAR,
                optional => 1,
                default => 'otr.fingerprints',
            },
            instance_tags_file => {
                type => SCALAR,
                optional => 1,
                default => 'otr.instance_tags',
            },
        }
    );

    my $self = Protocol::OTR::_new(
        @args{qw(privkeys_file contacts_file instance_tags_file)}
    );

    return $self;
}

sub account {
    my $self = shift;

    my ($name, $protocol) = validate_pos(
        @_,
        {
            type => SCALAR,
        },
        {
            type => SCALAR,
        }
    );

    return Protocol::OTR::Account->_new(
        $self,
        {
            name => $name,
            protocol => $protocol,
        }
    );
}

sub accounts {
    my ($self) = @_;

    return map {
        Protocol::OTR::Account->_new($self, $_)
    } @{ $self->_accounts() }
}

sub find_account {
    my $self = shift;

    my ($name, $protocol) = validate_pos(
        @_,
        {
            type => SCALAR,
        },
        {
            type => SCALAR,
        }
    );

    return Protocol::OTR::Account->_new(
        $self,
        {
            name => $name,
            protocol => $protocol,
        },
        1, # find only
    );
}

1;

__END__