Applying patch to Publish::Maildir

先日から再考および試験を行っていた、Publish::Maildirへのパッチが落ち着きをみせたため、公開します。

plagger/lib/Plagger/Plugin/Publish/Maildir.pm:

package Plagger::Plugin::Publish::Maildir;
use strict;
use base qw( Plagger::Plugin );

use DateTime;
use DateTime::Format::Mail;
use Encode qw/ from_to encode/;
use Encode::MIME::Header;
use MIME::Lite;
use Digest::MD5 qw/ md5_hex /;;
use File::Find;
use IO::File;

sub register {
    my($self, $context) = @_;
    $self->{version} = '0.1';
    $context->register_hook(
      $self,
      'publish.init' => ?&initialize,
      'publish.entry.fixup' => ?&store_entry,
       'publish.finalize' => ?&finalize,
    );
}

sub initialize {
  my ($self, $context, $args) = @_;
  my $cfg = $self->conf;
  my $permission = $cfg->{permission} || 0700;
  if (-d $cfg->{maildir}) {
    my $path = "$cfg->{maildir}/.$cfg->{folder}";
       $path =~ s/?/?//?//g;
       $path =~ s/?/$//g;
    unless (-d $path) {
      mkdir($path,0700)
        or die $context->log(error => "Could not create $path");
      $context->log(info => "Create new folder ($path)");
    }
    unless (-d $path."/new") {
      mkdir($path."/new",0700)
        or die $context->log(error => "Could not Create $path/new");
      $context->log(info => "Create new folder($path/new)");
    }
    $self->{path} = $path;

    $self->precache($context);
  }else{
    die $context->log(error => "Could not access $cfg->{maildir}");
  }
}

sub precache {
  my ($self, $context) = @_;


  my $conf = $self->conf;


  my $paths = {
    cur => $self->{path} . '/cur',
  };

  foreach my $path (keys %$paths) {
    next unless (-d $paths->{$path});
    
    $self->{cache}->{$path}->{dirname} = $paths->{$path};
    
    $self->{cache}->{$path}->{entries}->{''} = undef;
    
    $context->log(debug => "Searching entries($path)...");
    
    find(
      sub {
        my ($d) = $_ =~ /^([0-9a-z]*)?.plagger/;
        
        return unless defined $d;
        
        $self->{cache}->{$path}->{entries}->{$d} = $_;
      },
      $self->{cache}->{$path}->{dirname});
  }

  
  return unless ($conf->{keep_deleted});


  $paths = {deleted => $conf->{maildir} . '/' .
                       ($conf->{trash} || '.Deleted Messages'),
  };

  foreach my $path (keys %$paths) {
    next unless (-d $paths->{$path});
 
    $self->{cache}->{$path}->{dirname} = $paths->{$path};
    
    $self->{cache}->{$path}->{entries}->{''} = undef;
    
    $context->log(debug => "Searching entries($path)...");
    
    find(
      sub {
        return unless (-f $_);
        return unless (/^?d{10}?./);
        
        if (my $fh = IO::File->new($_)) {
          while (my $line = <$fh>) {
            last if ($line =~ /^?n+/);
            
            my ($digest) = $line =~ /^Message-Id:?s+<([0-9a-f]+)/i;
            
            if (defined $digest) {
              $self->{cache}->{$path}->{entries}->{$digest} = $_;

              last;
            }
          }
          $fh->close;
        }
      },
      $paths->{$path});
  }
}

sub finalize {
  my ($self, $context, $args) = @_;
  if (my $msg_count = $self->{msg}) {
    if (my $update_count = $self->{update_msg}) {
      $context->log(info => "Store $msg_count message(s) ($update_count message(s) updated)");
    }else{
      $context->log(info => "Store $msg_count message(s)");
    }
  }
}

sub store_entry {
  my($self, $context, $args) = @_;
  my $cfg = $self->conf;
  my $msg;
  my $entry = $args->{entry}; 
  my $feed_title = $args->{feed}->title;
     $feed_title =~ tr/,//d;
  my $subject    = $entry->title || '(no-title)';
  my $body       = $self->templatize($context, $args);
  my $from       = $cfg->{mailfrom} || 'plagger@localhost';
  my $now = Plagger::Date->now(timezone => $context->conf->{timezone});

  my $digest = md5_hex($entry->id_safe);
  my $id     = $digest . '.plagger@localhost';

  $msg = MIME::Lite->new(
    Date    => $now->format('Mail'),
    From    => encode('MIME-Header', qq("$feed_title" <$from>)),
    To      => $cfg->{mailto},
    Subject => encode('MIME-Header', $subject),
    Type    => 'multipart/related',
  );
  $body = encode("utf-8", $body);
  $msg->attach(
    Type => 'text/html; charset=utf-8',
    Data => $body,
    Encoding => 'quoted-printable',
  );
  $msg->add('Message-Id', "<$id>");
  $msg->add('X-Tags', encode('MIME-Header',join(' ',@{$entry->tags})));
  my $xmailer = "MIME::Lite (Publish::Maildir Ver.$self->{version} in plagger)";
  $msg->replace('X-Mailer',$xmailer);

  store_maildir($self, $context, $msg->as_string(), $digest);

  $self->{msg} += 1;
}

sub templatize {
  my ($self, $context, $args) = @_;
  my $tt = $context->template();
#  $tt->process( 'gmail_notify.tt', {
  $tt->process( 'mail.tt', {
    entry => $args->{entry},
    feed  => $args->{feed},
  }, ?my $out ) or $context->error($tt->error);
  $out;
}

sub store_maildir {
  my($self, $context, $msg, $digest) = @_;

  my $filename = "$digest.plagger";

  if (exists $self->{cache}->{deleted}->{entries}->{$digest}) {
    $context->log(debug => "skip: deleted: $digest");
    return;
  }
  
  if (exists $self->{cache}->{cur}->{entries}->{$digest}) {
    $context->log(debug => "found: cur: $digest");
    
    return if ($self->conf->{keep_read});

    unlink ($self->{cache}->{cur}->{dirname} . '/' .
            $self->{cache}->{cur}->{entries}->{$digest});

    $self->{update_msg} ++;
  }

  $context->log(debug => "writing: new/$filename");
    
  if (my $fh = IO::File->new('>' . $self->{path} . '/new/' . $filename)) {
    print $fh $msg;

    $fh->close;
  }
}

1;

=head1 NAME

Plagger::Plugin::Publish::Maildir - Store Maildir

=head1 SYNOPSIS

  - module: Publish::Maildir 
    config:
      maildir: /home/foo/Maildir
      folder: plagger

=head1 DESCRIPTION

This plugin changes an entry into e-mail, and saves it to Maildir.

=head1 AUTHOR

Nobuhito Sato

=head1 SEE ALSO

L<Plagger>

=cut

diff -uを用いた差分は、以下になります。

--- Maildir.pm.orig	2006-06-02 00:39:59.000000000 -0700
+++ Maildir.pm	2006-06-02 00:42:15.000000000 -0700
@@ -9,6 +9,7 @@
 use MIME::Lite;
 use Digest::MD5 qw/ md5_hex /;;
 use File::Find;
+use IO::File;
 
 sub register {
     my($self, $context) = @_;
@@ -40,11 +41,85 @@
       $context->log(info => "Create new folder($path/new)");
     }
     $self->{path} = $path;
+
+    $self->precache($context);
   }else{
     die $context->log(error => "Could not access $cfg->{maildir}");
   }
 }
 
+sub precache {
+  my ($self, $context) = @_;
+
+
+  my $conf = $self->conf;
+
+
+  my $paths = {
+    cur => $self->{path} . '/cur',
+  };
+
+  foreach my $path (keys %$paths) {
+    next unless (-d $paths->{$path});
+    
+    $self->{cache}->{$path}->{dirname} = $paths->{$path};
+    
+    $self->{cache}->{$path}->{entries}->{''} = undef;
+    
+    $context->log(debug => "Searching entries($path)...");
+    
+    find(
+      sub {
+        my ($d) = $_ =~ /^([0-9a-z]*)?.plagger/;
+        
+        return unless defined $d;
+        
+        $self->{cache}->{$path}->{entries}->{$d} = $_;
+      },
+      $self->{cache}->{$path}->{dirname});
+  }
+
+  
+  return unless ($conf->{keep_deleted});
+
+
+  $paths = {deleted => $conf->{maildir} . '/' .
+                       ($conf->{trash} || '.Deleted Messages'),
+  };
+
+  foreach my $path (keys %$paths) {
+    next unless (-d $paths->{$path});
+ 
+    $self->{cache}->{$path}->{dirname} = $paths->{$path};
+    
+    $self->{cache}->{$path}->{entries}->{''} = undef;
+    
+    $context->log(debug => "Searching entries($path)...");
+    
+    find(
+      sub {
+        return unless (-f $_);
+        return unless (/^?d{10}?./);
+        
+        if (my $fh = IO::File->new($_)) {
+          while (my $line = <$fh>) {
+            last if ($line =~ /^?n+/);
+            
+            my ($digest) = $line =~ /^Message-Id:?s+<([0-9a-f]+)/i;
+            
+            if (defined $digest) {
+              $self->{cache}->{$path}->{entries}->{$digest} = $_;
+
+              last;
+            }
+          }
+          $fh->close;
+        }
+      },
+      $paths->{$path});
+  }
+}
+
 sub finalize {
   my ($self, $context, $args) = @_;
   if (my $msg_count = $self->{msg}) {
@@ -65,8 +140,12 @@
      $feed_title =~ tr/,//d;
   my $subject    = $entry->title || '(no-title)';
   my $body       = $self->templatize($context, $args);
-  my $from       = 'plagger@localhost';
+  my $from       = $cfg->{mailfrom} || 'plagger@localhost';
   my $now = Plagger::Date->now(timezone => $context->conf->{timezone});
+
+  my $digest = md5_hex($entry->id_safe);
+  my $id     = $digest . '.plagger@localhost';
+
   $msg = MIME::Lite->new(
     Date    => $now->format('Mail'),
     From    => encode('MIME-Header', qq("$feed_title" <$from>)),
@@ -80,11 +159,13 @@
     Data => $body,
     Encoding => 'quoted-printable',
   );
+  $msg->add('Message-Id', "<$id>");
   $msg->add('X-Tags', encode('MIME-Header',join(' ',@{$entry->tags})));
   my $xmailer = "MIME::Lite (Publish::Maildir Ver.$self->{version} in plagger)";
   $msg->replace('X-Mailer',$xmailer);
-  my $filename = md5_hex($entry->id_safe);
-  store_maildir($self, $context,$msg->as_string(),$filename);
+
+  store_maildir($self, $context, $msg->as_string(), $digest);
+
   $self->{msg} += 1;
 }
 
@@ -100,21 +181,33 @@
 }
 
 sub store_maildir {
-  my($self,$context,$msg,$file) = @_;
-  my $filename = $file.".plagger";
-  find(
-    sub {
-      if ($_ =~ m!$file.*!) {
-        unlink $_;
-        $self->{update_msg} += 1;
-      }
-    },
-    $self->{path}."/cur"
-  );
-  my $filename = $self->{path}."/new/".$filename;
-  open(FILE,">$filename");
-  print(FILE $msg);
-  close(FILE);
+  my($self, $context, $msg, $digest) = @_;
+
+  my $filename = "$digest.plagger";
+
+  if (exists $self->{cache}->{deleted}->{entries}->{$digest}) {
+    $context->log(debug => "skip: deleted: $digest");
+    return;
+  }
+  
+  if (exists $self->{cache}->{cur}->{entries}->{$digest}) {
+    $context->log(debug => "found: cur: $digest");
+    
+    return if ($self->conf->{keep_read});
+
+    unlink ($self->{cache}->{cur}->{dirname} . '/' .
+            $self->{cache}->{cur}->{entries}->{$digest});
+
+    $self->{update_msg} ++;
+  }
+
+  $context->log(debug => "writing: new/$filename");
+    
+  if (my $fh = IO::File->new('>' . $self->{path} . '/new/' . $filename)) {
+    print $fh $msg;
+
+    $fh->close;
+  }
 }
 
 1;

PlaggerCommitterGuidelineのMake Your Plugin Simpleの章に反するようで後ろめたい気もしますが、config:の項目を4つ増やしています*1。

mailfrom	MIME::Liteに渡される、From:タグの内容を指定する(デフォルトは、plagger@localhost)
keep_read	既読のエントリを再配信/未読化しない(デフォルトは、オフ(再配信/未読化をする))
keep_deleted	削除されているエントリを再配信/未読化しない(デフォルトは、オフ(再配信/未読化をする))
trash	Maildir内のゴミ箱ディレクトリを指定する。maildirからの相対パスで記述する(デフォルトは、.Deleted Messages)

設定は目的によってもまちまちなのですが、Publish::Maildirの部分は、以下のように設定しています。

config.yaml:

                   :
  - module: Publish::Maildir
    config:
      maildir: /Users/username/Maildir
      folder: plagger
      mailto: me@example.com
      mailfrom: me@example.com
      keep_read: 1
      keep_deleted: 1

次回からは、このパッチを作成する際に試行した考えや、テストコーディングについて記載していきたいと思っています。

いつもながら、自分のコーディングの稚拙さと、筆の遅さには歯痒さを感じます。

*1:6/3/2006修正