File Coverage

lib/File/UnixAuth/Storage.pm
Criterion Covered Total %
statement 17 17 100.0
branch 4 4 100.0
condition n/a
subroutine 5 5 100.0
pod 2 2 100.0
total 28 28 100.0


line stmt bran cond sub pod time code
1             package File::UnixAuth::Storage;
2              
3 1     1   11301 use namespace::autoclean;
  1         2  
  1         13  
4              
5 1     1   76 use File::DataClass::Constants qw( FALSE NUL SPC TRUE );
  1         1  
  1         69  
6 1     1   5 use Moo;
  1         2  
  1         8  
7              
8             extends q(File::DataClass::Storage);
9              
10             # Private functions
11             my $_original_order = sub {
12             my ($hash, $lhs, $rhs) = @_;
13              
14             # New elements will be added at the end
15             exists $hash->{ $lhs }->{_order_by} or return 1;
16             exists $hash->{ $rhs }->{_order_by} or return -1;
17             return $hash->{ $lhs }->{_order_by} <=> $hash->{ $rhs }->{_order_by};
18             };
19              
20             my $_parse_name = sub {
21             my $full_name = shift; $full_name or return {};
22              
23             my ($first_name, $last_name) = split SPC, $full_name, 2;
24              
25             return { first_name => $first_name, last_name => $last_name };
26             };
27              
28             # Private methods
29             my $_deflate = sub {
30             my ($self, $hash, $id) = @_; my $attr = $hash->{ $id }; my $gecos = NUL;
31              
32             exists $attr->{members }
33             and $attr->{members } = join ',', @{ $attr->{members } || [] };
34             exists $attr->{first_name} and $gecos .= $attr->{first_name} // NUL;
35             exists $attr->{last_name } and $gecos .= $attr->{last_name }
36             ? SPC.$attr->{last_name } : NUL;
37              
38             if ($attr->{location} or $attr->{work_phone} or $attr->{home_phone}) {
39             $gecos .= ','.($attr->{location } // NUL);
40             $gecos .= ','.($attr->{work_phone} // NUL);
41             $gecos .= ','.($attr->{home_phone} // NUL);
42             }
43              
44             $gecos and $attr->{gecos} = $gecos;
45             return;
46             };
47              
48             my $_inflate = sub {
49             my ($self, $hash, $id) = @_; my $attr = $hash->{ $id };
50              
51             exists $attr->{members}
52             and $attr->{members} = [ split m{ , }mx, $attr->{members} // NUL ];
53              
54             if (exists $attr->{gecos}) {
55             my @fields = qw( full_name location work_phone home_phone );
56              
57             @{ $attr }{ @fields } = split m{ , }mx, $attr->{gecos} // NUL;
58              
59             my $names = $_parse_name->( $attr->{full_name} );
60              
61             $attr->{first_name} = $names->{first_name} // NUL;
62             $attr->{last_name } = $names->{last_name } // NUL;
63             delete $attr->{full_name}; delete $attr->{gecos};
64             }
65              
66             return;
67             };
68              
69             my $_read_filter = sub {
70             my ($self, $buf) = @_; my $hash = {}; my $order = 0;
71              
72             my $source_name = $self->schema->source_name;
73             my $fields = $self->schema->source->attributes;
74              
75             for my $line (@{ $buf || [] }) {
76             my ($id, @rest) = split m{ : }mx, $line; my %attr = ();
77              
78             @attr{ @{ $fields } } = @rest;
79             $attr{ _order_by } = $order++;
80             $hash->{ $id } = \%attr;
81             $self->$_inflate( $hash, $id );
82             }
83              
84             return { $source_name => $hash };
85             };
86              
87             my $_write_filter = sub {
88             my ($self, $data) = @_; my $buf = [];
89              
90             my $source_name = $self->schema->source_name;
91             my $fields = $self->schema->source->attributes;
92             my $hash = $data->{ $source_name };
93              
94             $source_name eq 'passwd' and $fields = [ @{ $fields }[ 0 .. 5 ] ];
95              
96             for my $id (sort { $_original_order->( $hash, $a, $b ) } keys %{ $hash }) {
97             $self->$_deflate( $hash, $id );
98              
99             my $attr = $hash->{ $id }; delete $attr->{_order_by};
100             my $line = join ':', map { $attr->{ $_ } // NUL } @{ $fields };
101              
102             push @{ $buf }, "${id}:${line}";
103             }
104              
105             return $buf;
106             };
107              
108             # Public methods
109             sub read_from_file {
110 5     5 1 168494 my ($self, $rdr) = @_;
111              
112 5 100       38 $self->encoding and $rdr->encoding( $self->encoding );
113              
114 5         61 return $self->$_read_filter( [ $rdr->chomp->getlines ] );
115             }
116              
117             sub write_to_file {
118 6     6 1 28437 my ($self, $wtr, $data) = @_;
119              
120 6 100       36 $self->encoding and $wtr->encoding( $self->encoding );
121 6         80 $wtr->println( @{ $self->$_write_filter( $data ) } );
  6         19  
122              
123 6         9736 return $data;
124             };
125              
126             1;
127              
128             __END__