CatalystX::Usul::MailAliases - Manipulate the mail aliases file

   use CatalystX::Usul::MailAliases;

   $alias_obj = CatalystX::Usul::MailAliases->new( $app, $config );

   $alias_obj->create( $fields );

   $alias_obj->delete( $name );

   $response_obj = $alias_obj->retrieve( $name );

   $alias_obj->update( $fields );

   $alias_obj->update_file( $alias, $recipients, $owner, $comment );

# @(#)$Id: MailAliases.pm 584 2009-06-12 15:25:11Z pjf $

package CatalystX::Usul::MailAliases;

use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.3.%d', q$Rev: 584 $ =~ /\d+/gmx );
use parent qw(CatalystX::Usul CatalystX::Usul::Utils);

use Class::C3;
use English qw(-no_match_vars);
use File::Copy;
use Text::Wrap;

my $NUL = q();

__PACKAGE__->config( aliases_file => q(/etc/mail/aliases),
                     new_aliases  => q(newaliases),
                     commit       => 0, );

__PACKAGE__->mk_accessors( qw(aliases aliases_file file new_aliases
                              comment commit created found owner prog
                              recipients) );

sub new {
   my ($self, $app, @rest) = @_;

   my $app_conf = $app->config || {};
   my $new      = $self->next::method( $app, @rest );
   my $aliases  = $self->catfile(    $app_conf->{ctrldir}, q(aliases) );
   my $prog     = $self->catfile(    $app_conf->{binsdir},
                                  lc $app_conf->{prefix }.q(_cli) );

   $new->file( $aliases ) unless ($new->file);
   $new->prog( $prog    ) unless ($new->prog);

   return $new;
}

sub create {
   my ($self, $flds) = @_; my ($cmd, $name, $res);

   unless ($name = $flds->{alias_name}) {
      $self->throw( 'No alias name specified' );
   }

   if ($res = $self->retrieve( $name ) and $res->found) {
      $self->throw( error => 'Alias [_1] already exists', args => [ $name ] );
   }

   $cmd  = $self->suid.' -n -c aliases_update -- '.$name;
   $cmd .= ' "'.(join q(,), @{ $flds->{recipients} }).'" ';
   $cmd .= $flds->{owner}.' "'.$flds->{comment}.'" ';

   return $self->run_cmd( $cmd, { err => q(out) } )->out;
}

sub delete {
   my ($self, $name) = @_; my $res;

   unless ($res = $self->retrieve( $name ) and $res->found) {
      $self->throw( error => 'Alias [_1] unknown', args => [ $name ] );
   }

   my $cmd = $self->suid.' -n -c aliases_update -- '.$name;

   return $self->run_cmd( $cmd, { err => q(out) } )->out;
}

sub retrieve {
   my ($self, $name) = @_; my ($alias, $recipients);

   my $new = $self->_init();
   my $buf = $self->_read_file;

   $self->lock->reset( k => $self->file );

   my ($comment, $created, $owner) = ($NUL, $NUL, $NUL);

   for my $line (@{ $buf }) {
      if ($line && $line !~ m{ \A \# }mx
          && $line =~ m{ \A (([^:]+) : \s+) (.*) }mx) {
         $alias = $2; $recipients = $3;
         push @{ $new->aliases }, $alias;

         if ($name && $name eq $alias) {
            $new->found(   1 );
            $new->owner(   $owner );
            $new->created( $created );
            $new->comment( $comment );
            $recipients =~ s{ \s+ }{}gmx;
            $recipients =~ s{ , \z }{}mx;
            $new->recipients( [ split m{ , }mx, $recipients ] );
         }
      }
      elsif ($line && $line !~ m{ \A \# }mx
             && $alias && $name && $name eq $alias) {
         $line =~ s{ \s+ }{ }gmx;
         $line =~ s{ , \z }{}mx;
         push @{ $new->recipients }, split m{ , }mx, $line;
      }
      else { $alias = $NUL; $comment = $NUL }

      if ($line && $line =~ m{ \A \# }mx) {
         $line =~ s{ \A \# \s* }{}mx;

         if ($line =~ m{ \A Created \s+ by \s+ ([^ ]+) \s+ (.*) }mx) {
            $owner = $1; $created = $2;
         }
         else { $comment = $line }
      }
   }

   @{ $new->aliases } = sort { lc $a cmp lc $b } @{ $new->aliases };
   return $new;
}

sub update {
   my ($self, $flds) = @_; my ($cmd, $name, $res);

   unless ($name = $flds->{alias_name}) {
      $self->throw( 'No alias name specified' );
   }

   unless ($res = $self->retrieve( $name ) and $res->found) {
      $self->throw( error => 'Alias [_1] unknown', args => [ $name ] );
   }

   $cmd  = $self->suid.' -n -c aliases_update -- '.$name;
   $cmd .= ' "'.(join q(,), @{ $flds->{recipients} }).'" "" "';
   $cmd .= $flds->{comment}.'" ';

   return $self->run_cmd( $cmd, { err => q(out) } )->out;
}

sub update_file {
   my ($self, $alias, $recipients, $owner, $comment) = @_;
   my (@buf, $cmd, $created, $found, $func, $in_region);
   my ($key, $line, @lines, $pad, $res, $tempfile);

   $self->throw( 'No alias name specified' ) unless ($alias);

   $tempfile = $self->tempfile;
   ($key = $alias) =~ tr{ }{.};
   ($created, $found, $in_region) = ( $NUL, 0, 0 );

   for $line (@{ $self->_read_file }) {
      push @buf, $line;

      if ($line =~ m{ \A $key : }mx) {
         $line = $buf[0] && $buf[0] =~ m{ Created \s+ by }mx
               ? shift @buf : $NUL;

         if ($line && $line =~ m{ Created \s+ by \s+ ([^ ]+) \s+ (.*) }mx) {
            $owner = $1; $created = $2;
         }

         $comment  ||= $buf[0] ? shift @buf : $NUL;
         $in_region  = 1; $found = 1;
      }
      elsif (!$line) {
         $tempfile->println( @buf ) unless ($in_region);

         $in_region = 0; @buf = ();
      }
   }

   $tempfile->println( @buf ) if ($buf[0] && !$in_region);

   $func = $recipients ? q(update) : q(delete);

   if ($func eq q(update)) {
## no critic
      local $Text::Wrap::columns  = 80;
      local $Text::Wrap::unexpand = 0;
## critic

      if ($created) { $line = 'Created by '.$owner.q( ).$created }
      else { $line = 'Created by '.$owner.q( ).$self->stamp }

      $tempfile->println( wrap( '# ', '# ', $line ) );
      $tempfile->println( wrap( '# ', '# ', ($comment || q(-)) ) );
      $line = $recipients;
      $line =~ s{ \015 }{,}gmsx;
      $line =~ tr{ \n}{}d;
      $line =~ tr{,}{}s;
      $line =~ s{ , }{, }gmsx;
      $line = $key.q(: ).$line;
      $pad  = q( ) x ((length $key) + 2);
      $tempfile->println( wrap( $NUL, $pad, $line ), $NUL );
      $found = 1;
   }

   unless ($found) {
      $self->lock->reset( k => $self->file );
      $self->throw( error => 'Alias [_1] unknown', args => [ $alias ] );
   }

   $tempfile->io_handle->flush;

   unless (copy( $tempfile->pathname, $self->file )) {
      $self->lock->reset( k => $self->file );
      $self->throw( $ERRNO );
   }

   $self->lock->reset( k => $self->file ); $tempfile->close;

   if ($self->new_aliases && -x $self->new_aliases) {
      unless (copy( $self->file, $self->aliases_file )) {
         $self->throw( $ERRNO );
      }

      $self->run_cmd( $self->new_aliases, { err => q(out) } );
   }

   if ($self->commit) {
      $cmd = $self->prog.' -n -c release -- commit '.$self->file;
      $self->run_cmd( $cmd, { err => q(out) } );
   }

   $func = $func eq q(delete)
         ? q(deleted) : $created
         ? q(updated) : q(created);
   return 'Mail alias '.$alias.q( ).$func;
}

# Private methods

sub _init {
   my $self = shift;

   return bless { aliases    => [],
                  comment    => $NUL,
                  created    => $NUL,
                  found      => 0,
                  owner      => $NUL,
                  recipients => [] }, ref $self;
}

sub _read_file {
   my $self = shift; my ($e, $buf, $line);

   unless (-s $self->file) {
      $self->throw( error => 'File [_1] not found or zero bytes',
                    args  => [ $self->file ] );
   }

   $self->lock->set( k => $self->file );

   $buf = eval { [ $self->io( $self->file )->chomp->getlines ] };

   if ($e = $self->catch) {
      $self->lock->reset( k => $self->file ); $self->throw( $e );
   }

   return $buf;
}

1;

__END__

# Local Variables:
# mode: perl
# tab-width: 3
# End: