File Coverage

blib/lib/Passwd/Keyring/Memory.pm
Criterion Covered Total %
statement 35 35 100.0
branch 6 6 100.0
condition 4 4 100.0
subroutine 9 9 100.0
pod 5 5 100.0
total 59 59 100.0


line stmt bran cond sub pod time code
1             package Passwd::Keyring::Memory;
2              
3 9     9   106512 use 5.006;
  9         36  
  9         291  
4 9     9   39 use strict;
  9         15  
  9         256  
5 9     9   38 use warnings;
  9         20  
  9         2993  
6              
7             =head1 NAME
8              
9             Passwd::Keyring::Memory - fallback keyring for environments
10             where no better keyring is available.
11              
12             =head1 VERSION
13              
14             Version 0.2405
15              
16             =cut
17              
18             our $VERSION = '0.2405';
19              
20             =head1 SYNOPSIS
21              
22             use Passwd::Keyring::Memory;
23              
24             my $keyring = Passwd::Keyring::Memory->new();
25              
26             $keyring->set_password("John", "verysecret", "my-realm");
27              
28             my $password = $keyring->get_password("John", "my-realm");
29              
30             $keyring->clear_password("John", "my-realm");
31              
32             Note: see L for detailed comments on
33             keyring method semantics (this document is installed with
34             Passwd::Keyring::Auto package).
35              
36              
37             =head1 SUBROUTINES/METHODS
38              
39             =head2 new
40              
41             Initializes the processing.
42              
43             =cut
44              
45             # Global map of folders to simulate case of a few ring objects working on the same data.
46             # (could be state variable in new, but let's not limit perl versions)
47             my $_passwords = {};
48              
49             sub new {
50 12     12 1 934 my ($cls, %args) = @_;
51 12   100     85 my $self = {
      100        
52             app => $args{app} || "Passwd::Keyring::Memory",
53             group => $args{group} || "Passwd::Keyring::Memory default passwords",
54             };
55 12         23 my $group = $self->{group};
56 12 100       48 unless(exists $_passwords->{$group}) {
57 9         29 $_passwords->{$group} = {};
58             }
59              
60 12         33 $self->{_passwords} = $_passwords->{$group}; # key → password
61              
62 12         25 bless $self, $cls;
63 12         41 return $self;
64             }
65              
66             sub _password_key {
67 59     59   63 my ($self, $realm, $user_name) = @_;
68 59         129 return join("||", $realm, $user_name);
69             }
70              
71             =head2 set_password(username, password, realm)
72              
73             Sets (stores) password identified by given realm for given user
74              
75             =cut
76              
77             sub set_password {
78 13     13 1 1991 my ($self, $user_name, $user_password, $realm) = @_;
79 13         39 my $key = $self->_password_key($realm, $user_name);
80 13         58 $self->{_passwords}->{ $key } = $user_password;
81              
82             #use Data::Dumper; print STDERR Dumper($_passwords);
83             }
84              
85             =head2 get_password($user_name, $realm)
86              
87             Reads previously stored password for given user in given app.
88             If such password can not be found, returns undef.
89              
90             =cut
91              
92             sub get_password {
93 33     33 1 2584 my ($self, $user_name, $realm) = @_;
94 33         61 my $key = $self->_password_key($realm, $user_name);
95              
96 33 100       93 if( exists $self->{_passwords}->{$key} ) {
97 23         99 return $self->{_passwords}->{$key};
98             } else {
99 10         44 return undef;
100             }
101             }
102              
103             =head2 clear_password($user_name, $realm)
104              
105             Removes given password (if present)
106              
107             =cut
108              
109             sub clear_password {
110 13     13 1 477 my ($self, $user_name, $realm) = @_;
111              
112 13         32 my $key = $self->_password_key($realm, $user_name);
113              
114             #use Data::Dumper; print STDERR Dumper($_passwords);
115              
116 13 100       50 if( exists $self->{_passwords}->{$key} ) {
117 10         30 delete $self->{_passwords}->{$key};
118 10         66 return 1;
119             } else {
120 3         13 return 0;
121             }
122             }
123              
124             =head2 is_persistent
125              
126             Returns info, whether this keyring actually saves passwords persistently.
127              
128             (false in this case)
129              
130             =cut
131              
132             sub is_persistent {
133 1     1 1 364 my ($self) = @_;
134 1         10 return 0;
135             }
136              
137              
138             =head1 AUTHOR
139              
140             Marcin Kasperski
141              
142             =head1 BUGS
143              
144             Please report any bugs or feature requests to
145             issue tracker at L.
146              
147             =head1 SUPPORT
148              
149             You can find documentation for this module with the perldoc command.
150              
151             perldoc Passwd::Keyring::Memory
152              
153             You can also look for information at:
154              
155             L
156              
157             Source code is tracked at:
158              
159             L
160              
161             =head1 LICENSE AND COPYRIGHT
162              
163             Copyright 2012 Marcin Kasperski.
164              
165             This program is free software; you can redistribute it and/or modify it
166             under the terms of either: the GNU General Public License as published
167             by the Free Software Foundation; or the Artistic License.
168              
169             See http://dev.perl.org/licenses/ for more information.
170              
171             =cut
172              
173              
174             1; # End of Passwd::Keyring::Memory