File Coverage

blib/lib/GnuPG/PrimaryKey.pm
Criterion Covered Total %
statement 29 30 96.6
branch 6 10 60.0
path n/a
condition 2 3 66.6
subroutine 7 7 100.0
pod 1 1 100.0
total 45 51 88.2


line stmt bran path cond sub pod time code
1               # PrimaryKey.pm
2               # - objectified GnuPG primary keys (can have subkeys)
3               #
4               # Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
5               #
6               # This module is free software; you can redistribute it and/or modify it
7               # under the same terms as Perl itself.
8               #
9               # This program is distributed in the hope that it will be useful,
10               # but WITHOUT ANY WARRANTY; without even the implied warranty of
11               # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12               #
13               # $Id: PrimaryKey.pm,v 1.4 2001/09/14 12:34:36 ftobin Exp $
14               #
15                
16               package GnuPG::PrimaryKey;
17 7       7   19119 use Moo;
  7           20  
  7           125  
18 7       7   3900 use MooX::late;
  7           16  
  7           190  
19 7       7   4909 use MooX::HandlesVia;
  7           20  
  7           338  
20                
21 7       7   1107 BEGIN { extends qw( GnuPG::Key ) }
22                
23               for my $list (qw(user_ids subkeys user_attributes)) {
24               my $ref = $list . "_ref";
25               has $ref => (
26               handles_via => 'Array',
27               is => 'rw',
28               default => sub { [] },
29               handles => {
30               "push_$list" => 'push',
31               },
32               );
33                
34 7       7   1902 no strict 'refs';
  7           33  
  7           2984  
35               *{$list} = sub {
36 38       38   613 my $self = shift;
37 38 50         216 return wantarray ? @{$self->$ref(@_)} : $self->$ref(@_);
  0           0  
38               };
39               }
40                
41               has $_ => (
42               isa => 'Any',
43               is => 'rw',
44               clearer => 'clear_' . $_,
45               ) for qw( local_id owner_trust );
46                
47                
48               sub compare {
49 4       4 1 783 my ($self, $other, $deep) = @_;
50                
51 4           21 my @comparison_fields = qw (
52               owner_trust
53               );
54                
55 4           30 foreach my $field (@comparison_fields) {
56 4 50         107 return 0 unless $self->$field eq $other->$field;
57               }
58                
59 4 100   66     104 if (defined $deep && $deep) {
60 2           27 my @lists = qw(
61               user_ids
62               subkeys
63               user_attributes
64               );
65                
66 2           11 foreach my $list (@lists) {
67 6 50         13 return 0 unless @{$self->$list} == @{$other->$list};
  6           36  
  6           45  
68 6           16 for ( my $i = 0; $i < scalar(@{$self->$list}); $i++ ) {
  12           32  
69 6 50         14 return 0
70               unless $self->$list->[$i]->compare($other->$list->[$i], 1);
71               }
72               }
73               }
74                
75 4           35 return $self->SUPER::compare($other, $deep);
76               }
77                
78               1;
79                
80               __END__
81                
82               =head1 NAME
83                
84               GnuPG::PrimaryKey - GnuPG Primary Key Objects
85                
86               =head1 SYNOPSIS
87                
88               # assumes a GnuPG::Interface object in $gnupg
89               my @keys = $gnupg->get_public_keys( 'ftobin' );
90                
91               # or
92                
93               my @keys = $gnupg->get_secret_keys( 'ftobin' );
94                
95               # now GnuPG::PrimaryKey objects are in @keys
96                
97               =head1 DESCRIPTION
98                
99               GnuPG::PrimaryKey objects are generally instantiated
100               as GnuPG::PublicKey or GnuPG::SecretKey objects
101               through various methods of GnuPG::Interface.
102               They embody various aspects of a GnuPG primary key.
103                
104               This package inherits data members and object methods
105               from GnuPG::Key, which is not described here, but rather
106               in L<GnuPG::Key>.
107                
108               =head1 OBJECT DATA MEMBERS
109                
110               =over 4
111                
112               =item user_ids
113                
114               A list of GnuPG::UserId objects associated with this key.
115                
116               =item user_attributes
117                
118               A list of GnuPG::UserAttribute objects associated with this key.
119                
120               =item subkeys
121                
122               A list of GnuPG::SubKey objects associated with this key.
123                
124               =item local_id
125                
126               WARNING: DO NOT USE. This used to mean GnuPG's local id for the key,
127               but modern versions of GnuPG do not produce it. Expect this to be the
128               empty string or undef.
129                
130               =item owner_trust
131                
132               The scalar value GnuPG reports as the ownertrust for this key.
133               See GnuPG's DETAILS file for details.
134                
135               =back
136                
137               =head1 SEE ALSO
138                
139               L<GnuPG::Key>,
140               L<GnuPG::UserId>,
141               L<GnuPG::SubKey>,
142                
143               =cut