File Coverage

blib/lib/Protocol/OTR.pm
Criterion Covered Total %
statement 20 22 90.9
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 28 30 93.3


line stmt bran cond sub pod time code
1             # ABSTRACT: Off-the-Record secure messaging protocol
2             package Protocol::OTR;
3             BEGIN {
4 4     4   83967 $Protocol::OTR::AUTHORITY = 'cpan:AJGB';
5             }
6             $Protocol::OTR::VERSION = '0.04';
7 4     4   32 use strict;
  4         6  
  4         145  
8 4     4   18 use warnings;
  4         4  
  4         135  
9              
10 4     4   2110 use Alien::OTR;
  4         938601  
  4         39  
11 4     4   16715 use Alien::GCrypt;
  4         9  
  4         24  
12 4     4   6640 use Alien::GPG::Error;
  4         7  
  4         23  
13 4     4   15044 use Carp qw( croak );
  4         9  
  4         258  
14 4     4   1819 use Protocol::OTR::Account ();
  0            
  0            
15             use Params::Validate qw(validate validate_pos SCALAR);
16              
17             require Exporter;
18              
19             require XSLoader;
20              
21             our @ISA = qw(Exporter);
22              
23             our %EXPORT_TAGS = (
24             'policies' => [ qw(
25             POLICY_OPPORTUNISTIC
26             POLICY_ALWAYS
27             ) ],
28             'error_codes' => [ qw(
29             ERRCODE_NONE
30             ERRCODE_ENCRYPTION_ERROR
31             ERRCODE_MSG_NOT_IN_PRIVATE
32             ERRCODE_MSG_UNREADABLE
33             ERRCODE_MSG_MALFORMED
34             ) ],
35             'event_codes' => [ qw(
36             MSGEVENT_NONE
37             MSGEVENT_ENCRYPTION_REQUIRED
38             MSGEVENT_ENCRYPTION_ERROR
39             MSGEVENT_CONNECTION_ENDED
40             MSGEVENT_SETUP_ERROR
41             MSGEVENT_MSG_REFLECTED
42             MSGEVENT_MSG_RESENT
43             MSGEVENT_RCVDMSG_NOT_IN_PRIVATE
44             MSGEVENT_RCVDMSG_UNREADABLE
45             MSGEVENT_RCVDMSG_MALFORMED
46             MSGEVENT_LOG_HEARTBEAT_RCVD
47             MSGEVENT_LOG_HEARTBEAT_SENT
48             MSGEVENT_RCVDMSG_GENERAL_ERR
49             MSGEVENT_RCVDMSG_UNENCRYPTED
50             MSGEVENT_RCVDMSG_UNRECOGNIZED
51             MSGEVENT_RCVDMSG_FOR_OTHER_INSTANCE
52             ) ],
53             'smp_event_codes' => [ qw(
54             SMPEVENT_NONE
55             SMPEVENT_CHEATED
56             SMPEVENT_IN_PROGRESS
57             SMPEVENT_SUCCESS
58             SMPEVENT_FAILURE
59             SMPEVENT_ABORT
60             SMPEVENT_ERROR
61             ) ],
62             'instags' => [ qw(
63             INSTAG_BEST
64             INSTAG_RECENT
65             INSTAG_RECENT_RECEIVED
66             INSTAG_RECENT_SENT
67             ) ],
68             );
69             $EXPORT_TAGS{'constants'} = [
70             map { @$_ } @EXPORT_TAGS{qw(policies error_codes event_codes smp_event_codes instags)}
71             ];
72              
73             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'constants'} } );
74              
75             our @EXPORT = qw();
76              
77             XSLoader::load('Protocol::OTR', $Protocol::OTR::{VERSION} ?
78             ${ $Protocol::OTR::{VERSION} } : ()
79             );
80              
81             sub new {
82             my $class = shift;
83              
84             my %args = validate(
85             @_,
86             {
87             privkeys_file => {
88             type => SCALAR,
89             optional => 1,
90             default => 'otr.privkey',
91             },
92             contacts_file => {
93             type => SCALAR,
94             optional => 1,
95             default => 'otr.fingerprints',
96             },
97             instance_tags_file => {
98             type => SCALAR,
99             optional => 1,
100             default => 'otr.instance_tags',
101             },
102             }
103             );
104              
105             my $self = Protocol::OTR::_new(
106             @args{qw(privkeys_file contacts_file instance_tags_file)}
107             );
108              
109             return $self;
110             }
111              
112             sub account {
113             my $self = shift;
114              
115             my ($name, $protocol) = validate_pos(
116             @_,
117             {
118             type => SCALAR,
119             },
120             {
121             type => SCALAR,
122             }
123             );
124              
125             return Protocol::OTR::Account->_new(
126             $self,
127             {
128             name => $name,
129             protocol => $protocol,
130             }
131             );
132             }
133              
134             sub accounts {
135             my ($self) = @_;
136              
137             return map {
138             Protocol::OTR::Account->_new($self, $_)
139             } @{ $self->_accounts() }
140             }
141              
142             sub find_account {
143             my $self = shift;
144              
145             my ($name, $protocol) = validate_pos(
146             @_,
147             {
148             type => SCALAR,
149             },
150             {
151             type => SCALAR,
152             }
153             );
154              
155             return Protocol::OTR::Account->_new(
156             $self,
157             {
158             name => $name,
159             protocol => $protocol,
160             },
161             1, # find only
162             );
163             }
164              
165             1;
166              
167             __END__