package Hare;

use strict;

use Config::Simple;
use IO::Handle;

use constant ALLOW => 1;
use constant DENY  => 2;

use constant TEMPLATE_PATH => '/opt/hare/share/templates';

use base qw( Exporter );
our @EXPORT = qw( ALLOW DENY );

sub new
{
   my $class = shift;

   # TODO - look up config, open DB? etc...

   return bless {}, $class;
}

sub get_config
{
   my $self = shift;
   my ( $key, $missingok ) = @_;

   my $configfile = "$ENV{HOME}/.harerc";

   my $cfg = $self->{cfg} ||= Config::Simple->new( $configfile ) or
      die "Cannot open config file $configfile\n";

   my $value = $cfg->param( $key );
   die "Missing config key $key\n" if !defined $value and !$missingok;

   return $value;
}

sub get_config_filename
{
   my $self = shift;
   my ( $key, $missingok ) = @_;

   my $path = $self->get_config( $key, $missingok );
   return undef unless defined $path;

   return $path =~ m{^/} ? $path : "$ENV{HOME}/$path";
}

sub get_datadir_filename
{
   my $self = shift;
   my ( $configkey, $dirname ) = @_;

   $dirname = $configkey unless defined $dirname;

   return $self->get_config_filename( $configkey, 1 ) ||
                    ( $self->get_config_filename( "datadir" ) . "/$dirname" );
}

sub is_matching_to
{
   my $self = shift;
   my ( $to ) = @_;
   my $myaddrs = $self->{myaddrs} ||= do {
      my $addrlist = $self->get_datadir_filename( "myaddrs" );
      open( my $addrlistfh, "<", $addrlist ) or die "Cannot read $addrlist - $!";

      my @myaddrs;
      while( <$addrlistfh> ) {
         chomp;
         push @myaddrs, qr/^$_$/;
      }

      \@myaddrs;
   };

   return 1 if grep { $to =~ $_ } @$myaddrs;
   return 0;
}

sub get_policy
{
   my $self = shift;
   my ( $to, $from ) = @_;

   my $policy = $self->{policy} ||= do {
      my $policyfile = $self->get_datadir_filename( "policy" );
      open( my $policyfh, "<", $policyfile ) or die "Cannot read $policyfile - $!";

      my @policy;
      while( <$policyfh> ) {
         m/^\s*#/ and next; # skip comment lines
         m/^\s*$/ and next; # skip blank lines
         m/^\s*(\S+)\s+(\S+)\s+(allow|deny)\s*/ and push @policy, [ qr/^$1$/, qr/^$2$/, $3 eq "allow" ] and next;
         die "Unrecognised policy line $_\n";
      }

      \@policy;
   };

   foreach my $p ( @$policy ) {
      $from =~ $p->[0] and $to =~ $p->[1] and return $p->[2];
   }

   return undef;
}

sub gen_new_archiveid
{
   my $self = shift;

   # TODO: Some kind of locking....

   my $archivedir = $self->get_datadir_filename( "archivedir", "archive" );
   my $idfile = "$archivedir/.nextid";

   open( my $fh, "+<", $idfile ) or die "Cannot read $idfile - $!";
   my $id = <$fh>; chomp $id;

   seek $fh, 0, 0;
   print $fh ( $id + 1 ) . "\n";

   close( $fh );

   return $id;
}

sub archive_message
{
   my $self = shift;
   my ( $mailtext ) = @_;

   my $mailid = $self->gen_new_archiveid;

   my $archivedir = $self->get_datadir_filename( "archivedir", "archive" );

   my $archivename = "$archivedir/$mailid";

   open my $fh, ">", $archivename or die "Cannot write $archivename - $!";
   $fh->write( $mailtext );

   close( $fh );

   return $mailid;
}

sub push_poke_queue
{
   my $self = shift;
   my ( $mailid, $text ) = @_;

   # Squash out any linefeeds or '%'
   $text =~ s{([%\n])}{sprintf( "%%%02x", ord $1 )}eg;

   my $pokequeue = $self->get_datadir_filename( "pokequeue", "pokequeue" );
   open my $fh, ">>", $pokequeue or die "Cannot write $pokequeue - $!";

   # TODO: Locking
   # TODO: fseek() to end

   print $fh "$mailid\t$text\n";

   close( $fh );
}

sub get_poke_queue
{
   my $self = shift;

   my $pokequeue = $self->get_datadir_filename( "pokequeue", "pokequeue" );
   open my $fh, "<", $pokequeue or die "Cannot read $pokequeue - $!";

   # TODO: Locking
   my @entries;

   foreach my $entry ( <$fh> ) {
      my ( $mailid, $text ) = $entry =~ m/^(.*?)\t(.*)$/;
      $text =~ s{(%[0-9a-f]{2})}{chr hex $1}eg;

      push @entries, { mailid => $mailid, text => $text };
   }

   close( $fh );

   return wantarray ? @entries : \@entries;
}

sub run_template
{
   my $self = shift;
   my ( $template, $vars ) = @_;

   my $tmpl = $self->{tmpl} ||= do {
      require Template;
      Template->new(
         INCLUDE_PATH => TEMPLATE_PATH,
         INTERPOLATE => 1,
      );
   };

   my %vars = (
      %$vars,
      h => $self,
   );

   my $output = "";
   $tmpl->process( $template, \%vars, \$output ) or die "Cannot process template - " . $tmpl->error() . "\n";

   return $output;
}

# Keep perl happy; keep Britain tidy
1;