#!/usr/bin/perl -w
###########################################
# xaday - Mail out a tip every day
# Mike Schilli, 2007 (m@perlmeister.com)
###########################################
use strict;
use Rose::DB::Object::Loader;
use Getopt::Std;
use File::Temp qw(tempfile);
use Sysadm::Install qw(:all);
use Mail::Mailer;

my $RECSEP    = qr/^=head1/;
my $HEAD      = "=head1";
my $MAIL_FROM = 'me@_foo.com';

getopts("d:lepm:f:", \my %opts);

die "usage: $0 -d dbfile ..." 
                           unless $opts{d};

my $loader = Rose::DB::Object::Loader->new(
  db_dsn => "dbi:SQLite:dbname=$opts{d}",
  db_options   => {
    AutoCommit => 1, RaiseError => 1 },
);

$loader->make_classes();

if($opts{e} or $opts{l}) {
  my($fh, $tmpf) = tempfile(UNLINK => 1);
  my $tips = 
         Tip::Manager->get_tips_iterator();
  my $data_before = "";

  while(my $tip = $tips->next()) {
    $data_before .= 
      "$HEAD " .
      $tip->head() . " {" .
      $tip->id() . "}" . "\n\n" .
      $tip->text() .  "\n\n";
    }
    if($opts{l}) {
        print $data_before;
        exit 0;
    }
    blurt($data_before, $tmpf);
    system("$ENV{EDITOR} $tmpf");
    my $data_after = slurp($tmpf);
    die "No change" if 
              $data_before eq $data_after;

    db_update(\$data_after);
}

if($opts{f}) {
    db_update($opts{f});
}

if($opts{m}) {
  my $tips = Tip::Manager->get_tips(
    query => [ "published" => undef],
    sort_by => 'id',
    limit   => 1,
  );
  if(@$tips) {
    $tips->[0]->published(
                        DateTime->today());
    $tips->[0]->update();
    mail($opts{m}, $tips->[0]->head(), 
         $tips->[0]->text());
  } else {
      die "Nothing left to publish";
  }
}

###########################################
sub text2db {
###########################################
  my($text) = @_;
  $text = "" unless defined $text;

  my @fields = ();

  while($text =~ 
          /^($RECSEP.*?)
            (?=$RECSEP|\s*\Z)/smgx) {
    my($head, $info, $tip) = rec_parse($1);
    $tip =~ s/\s+\Z//;
    $tip =~ s/\A\s+//;
    push @fields, [$head, $info, $tip];
  }
  return \@fields;
}

###########################################
sub rec_parse {
###########################################
    my($text) = @_;

    if($text =~ /$RECSEP\s+(.*?)
                 (?:\s+\{(.*?)\})?
                 $
                 (.*)
                /smgx) {
        return($1, $2, $3);
    }

    return undef;
}

###########################################
sub db_update {
###########################################
  my($in) = @_;

  my $data;

  if( ref($in) ){
    $data = $$in;
  } else {
    $data = slurp($in);
  }

  my $fields = text2db($data);

  my @keep_ids = map { $_->[1] } @$fields;
  my $gone;
  if(@keep_ids) {
    $gone = Tip::Manager->delete_tips(
          where => ["!id" => \@keep_ids] );
  } else {
    $gone = Tip::Manager->delete_tips(
                                all => 1 );
  }
  print "$gone rows deleted\n" if $gone;

  for(@$fields) {
    my($head, $info, $tip) = @$_;

    my $rec;

    if(defined $info) {
      $rec = Tip->new(id => $info);
      $rec->load();
      $rec->head($head);
      $rec->text($tip);
      $rec->update();
    } else {
      $rec = Tip->new(
        text => $tip,
        head => $head,
      );
      $rec->save();
    }
  }
}

###########################################
sub mail {
###########################################
  my($to, $head, $body) = @_;

  my $mailer = Mail::Mailer->new();

  $mailer->open({
   'From' => $MAIL_FROM,
   'To'   => $to,
   'Subject' => $head,
  });
  print $mailer $body;
  close $mailer;
}