はてブのWeb Hookで指定したタグが含まれていたらメールする

のを軽く作ってみた。

#!/usr/bin/env perl

package Email;
use Moose;
use Moose::Util::TypeConstraints;
use utf8;
use Encode;
use Email::MIME;
use Email::MIME::Creator;
use Email::Send;
use Email::Valid::Loose;

subtype 'MailAddr'
  => as 'Str'
  => where { Email::Valid::Loose->address($_) };

has 'from' => (is => 'rw', isa => 'MailAddr', default => 'webhook@hoge.com');
has 'to' => (is => 'rw', isa => 'MailAddr', default => 'to@hoge.com');
has 'subject' => (is => 'rw', isa => 'Str', required => 1);
has 'body' => (is => 'rw', isa => 'Str', required => 1);

sub run {
  my $self = shift;
  my $mail = Email::MIME->create(
      header => [
	  From => $self->from,
	  To => $self->to,
	  Subject => Encode::encode('MIME-Header-ISO_2022_JP', $self->subject),
      ],
      parts => [
	  encode('iso-2022-jp', $self->body),
      ],
  );
  my $sender = Email::Send->new( { mailer => 'Sendmail' } );
  $sender->send($mail);
}

__PACKAGE__->meta->make_immutable;

package main;

use strict;
use warnings;
use utf8;
use CGI;
use Encode;

my $target_tag = 'tag';
my $q = CGI->new;
print $q->header(-type=>'text/plain', -charset=>'utf-8');

if ( $q->param('key') ne 'APIKEY' ) {
  die "Authentication failed";
} elsif ( $q->param('status') ne 'add') {
  die "This program operates only when additional bookmark.";
}

my $url = $q->param('url');
my $title = $q->param('title');
my $comment = $q->param('comment');
my @tags;
while ($comment =~ m!\[([^\:\[\]]+)\]!g) {
  push @tags, $1;
}

#指定したタグを含んでいない場合はメールを送信しない。
die "finished." unless grep /$target_tag/, @tags;

my $body = <<'__MESSAGE__';
$title

$url
$comment
__MESSAGE__

my $subject = "タグ[$target_tag]を含む新規ブックマーク";
my $sender = Email->new(
    to => 'fuba@fuba.com',
    from => 'fuba_recorder@fuba.com',
    subject => $subject,
    body => $body,
);

$sender->run;
print 'OK';

PHP.js

てのがあった。
PHPの文法がそのままJavascriptで使えるってやつだけど意味あるのかな。

<script type="text/javascript" src="js/php.default.min.js"></script>
<script>
print_r(date('F j, Y, g:i a', 1062462400));
$hoge = [];
for ($i = 0; $i < 10; $i++) {
    array_push($hoge, $i);
}
print_r($hoge);
</script>

September 2, 2003, 9:26 am

Array
(
[0] => 0
[1] => 1
[2] => 2
[3] => 3
[4] => 4
[5] => 5
[6] => 6
[7] => 7
[8] => 8
[9] => 9
)

新しく買ったiMacにCPANモジュールを色々インストールしようとして軽くはまった

Mac Perl

最近iMacを買ってついにWindowsとお別れしました。
で、今日Module::Setupをインストールしようとしたら

AppleEvents/t/event.t (Wstat: 65280 Tests: 145 Failed: 0)
Non-zero exit status: 255
Parse errors: Bad plan. You planned 305 tests but ran 145.
Files=18, Tests=2800, 35 wallclock secs ( 0.32 usr 0.06 sys + 1.84 cusr 0.66 csys = 2.88 CPU)
Result: FAIL
Failed 1/18 test programs. 0/2800 subtests failed.
make: *** [test_dynamic] Error 255
CNANDOR/Mac-Carbon-0.77.tar.gz
/usr/bin/make test -- NOT OK

とこける。
Macとか良く分からんし何だこれとか色々調べてたらid:sendがPortsで入れれば良いんじゃねって言うので

sudo port install p5-mac-appleevents-simple

して再度Module::Setup入れたらちゃんと出来た。
かずあき++

これで安心してMac::Growlを入れようとしたらまたこけた。

t/Mac-Growl.t .. Please run gluedialect and gluescriptadds programs at /opt/local/lib/perl5/site_perl/5.8.9/Mac/Glue.pm line 1358, line 1.

Mac::Glueの該当する所を調べてその辺から色々追ったけどいまいち分からない。
しばらく悩んでCPANからMac::Glueの最新版のtarを落としてmake installしたら今度はちゃんとインストール出来た。
READMEを良く見たら

You will need to have glues for your dialect and scripting additions
created; the installation process (perl Makefile.PL; make; make install)
should handle this automatically. It will also create glues for two
commonly used applications, Finder and System Events.

とか書かれてる。
何でcpanでこの辺がちゃんと出来ないんだろ。

そんな感じです。

続粉瘤



本日粉瘤手術の診察結果を聞きに病院に行った。
悪性の物が無く、破れた痕跡も無い。また大きさは10cm x 6.6cm x 6cmとも。
手術後も順調に回復し、かなり傷が奇麗になった。
場所が場所だけに写真は載せられないが。
上の写真は手術前の点滴と、とある日の食事。