use
version;
our
$VERSION
= qv(
sprintf
'0.3.%d'
,
q$Rev: 238 $
=~ /\d+/gmx );
augment
'_read_file'
=>
sub
{
my
(
$self
,
$rdr
) =
@_
;
return
$self
->_read_filter( [
$rdr
->
chomp
->getlines ] );
};
augment
'_write_file'
=>
sub
{
my
(
$self
,
$wtr
,
$data
) =
@_
;
$wtr
->println( @{
$self
->_write_filter(
$data
) } );
return
$data
;
};
sub
_read_filter {
my
(
$self
,
$buf
) =
@_
;
$buf
||= [];
my
$res
= {};
my
$ord
= 0;
my
$recipients
;
my
(
$alias
,
$comment
,
$created
,
$owner
) = (NUL, NUL, NUL, NUL);
for
my
$line
(@{
$buf
}) {
if
(
$line
and
$line
=~ m{ \A \
$line
=~ s{ \A \
if
(
$line
=~ m{ \A Created \s+ by \s+ ([^ ]+) \s+ (.*) }mx) {
$owner
= $1;
$created
= $2;
}
elsif
(not
$comment
) {
$comment
= [
$line
] }
else
{
push
@{
$comment
},
$line
}
}
elsif
(
$line
and
$line
!~ m{ \A \
and
$line
=~ m{ \A (([^:]+) : \s+) (.*) }mx) {
$alias
= $2;
$recipients
= $3;
$recipients
=~ s{ \s+ }{}gmx;
$recipients
=~ s{ , \z }{}mx;
$res
->{
$alias
} = {
comment
=>
$comment
,
created
=>
$created
,
owner
=>
$owner
,
recipients
=> [
split
m{ , }mx,
$recipients
],
_order_by
=>
$ord
++,
};
}
elsif
(
$line
and
$line
!~ m{ \A \
$line
=~ s{ \s+ }{}gmx;
$line
=~ s{ , \z }{}mx;
push
@{
$res
->{
$alias
}->{recipients} },
split
m{ , }mx,
$line
;
}
else
{ (
$alias
,
$comment
,
$created
,
$owner
) = (NUL, NUL, NUL, NUL) }
}
return
{
aliases
=>
$res
};
}
sub
_write_filter {
my
(
$self
,
$data
) =
@_
;
my
$aliases
=
$data
->{aliases};
my
$buf
= [];
local
$Text::Wrap::columns
= 80;
local
$Text::Wrap::unexpand
= 0;
for
my
$name
(
sort
{ __original_order(
$aliases
,
$a
,
$b
) }
keys
%{
$aliases
}) {
my
$alias
=
$aliases
->{
$name
};
my
(
$comment
,
$owner
);
if
(
$owner
=
$alias
->{owner}) {
my
$created
=
$alias
->{created} || __stamp();
push
@{
$buf
},
"# Created by $owner $created"
;
}
if
(
$comment
=
$alias
->{comment}) {
for
my
$line
(@{
$comment
}) {
push
@{
$buf
}, wrap(
'# '
,
'# '
,
$line
);
}
}
my
$pad
= SPC x (2 +
length
$name
);
my
$line
=
$name
.
q(: )
.(
join
q(, )
, @{
$alias
->{recipients} || [] });
push
@{
$buf
}, wrap( NUL,
$pad
,
$line
), NUL;
}
return
$buf
;
}
sub
__original_order {
my
(
$aliases
,
$lhs
,
$rhs
) =
@_
;
return
1
unless
(
exists
$aliases
->{
$lhs
}->{_order_by});
return
-1
unless
(
exists
$aliases
->{
$rhs
}->{_order_by});
return
$aliases
->{
$lhs
}->{_order_by} <=>
$aliases
->{
$rhs
}->{_order_by};
}
sub
__stamp {
return
Date::Format::Generic->time2str(
'%Y-%m-%d %H:%M:%S'
,
time
);
}
__PACKAGE__->meta->make_immutable;
no
Moose;
1;