tokuhirom's blog.

'; DROP DATABASE database();

http://dancom.jp/ を Plagger で読む

dancom がすきで、いつも見てるんですが、はてなアンテナからたどるのがめんどくなっ
てきたので、PlaggerGmail に飛ばすことにしました。

EFT でできるかと思ったんですが、Permalink がないので、CustomFeed でやることに。
(うまくやればできるのかもしれないんですが、調べるのがめんどかったので。)

package Plagger::Plugin::CustomFeed::Dancom;
use strict;
use base qw( Plagger::Plugin );

use Encode;
use Plagger::UserAgent;
use HTML::TreeBuilder::XPath;
use Plagger::Util qw( decode_content extract_title );

my $url = 'http://dancom.jp/';

sub register {
    my($self, $context) = @_;
    $context->register_hook(
        $self,
        'subscription.load' => \&load,
    );
}

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

    my $feed = Plagger::Feed->new;
       $feed->aggregator(sub { $self->aggregate(@_) });
    $context->subscription->add($feed);
}

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

    # fetch content
    my $agent = Plagger::UserAgent->new;
    my $res = $agent->fetch($url, $self);

    if ($res->http_response->is_error) {
        $context->log(error => "GET $url failed: " . $res->status);
        return;
    }

    # decode
    my $content = decode_content($res);

    # construct xpath engine
    my $tree = HTML::TreeBuilder::XPath->new;
    $tree->parse($content);
    $tree->eof;

    # construct feed
    my $feed = Plagger::Feed->new;
    $feed->title('DANCOM');
    $feed->link($url);

    # create entries from html
    for my $child ( $tree->findnodes('//div[@class="contentBody"]') ) {
        my $title = $child->findnodes('./h2/text()')->pop->getValue;
        if ( $title =~ m{^\s*(\d{4}/\d\d/\d\d)\s*(.+)} ) {
            my ($ymd, $title) = ($1, $2);

            my $body = $child->findnodes('./div')->pop->as_HTML;

            my $entry = Plagger::Entry->new;
            $entry->title($title);
            $entry->body( $body );
            $entry->link($url);
            $entry->date( Plagger::Date->strptime('%Y/%m/%d', $ymd) );
            $feed->add_entry($entry);
        }
    }

    $context->update->add($feed);
}

1;

Plagger::Plugin::Publish::Caspeee 2

前回の奴はコードがアレなので CaspeeeAPI を実装した。

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

use Encode;
use Time::HiRes qw(sleep);
use URI;
use Plagger::UserAgent;
use HTTP::Request::Common ();

sub register {
   my ( $self, $context ) = @_;
   $context->register_hook( $self, 'publish.entry' => \&add_entry, );
}

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

   # validate
   unless ( $self->conf->{login_id} && $self->conf->{password} ) {
       $self->log( error => 'set your login_id and password before login.' );
   }

   # initialize
   my $host    = $self->conf->{host} || 'ul.caspeee.jp:80';    # for debug.
   my $api_url = "http://$host/api/file/upload";
   my $status  = $self->conf->{status} || 'wait';

   my $ua = Plagger::UserAgent->new;
   $ua->credentials(
       $host,
       'API AUTHENTICATION',
       $self->conf->{login_id},
       $self->conf->{password}
   );

   # execute
   for my $enclosure ( grep $_->local_path, $args->{entry}->enclosures ) {
       $context->log( debug => "upload file @{[ $enclosure->local_path ]}" );

       my $res = $ua->request(
           HTTP::Request::Common::POST(
               $api_url,
               Content_Type => 'multipart/form-data',
               Content      => [
                   moral => 'on',
                   title => encode( 'euc-jp', $args->{entry}->title_text ),
                   channel_title_en => $self->conf->{channel_title_en},
                   file             => [ $enclosure->local_path ],
                   description =>
                       encode( 'euc-jp', $args->{entry}->body || 'none' ),
                   tags => join( " ",
                       map { encode( 'euc-jp', $_ ) }
                           @{ $args->{entry}->tags },
                       'by.plagger' ),
                   status => $status,
               ]
           )
       );

       if ( $res->is_success ) {
           $self->log( debug => $res->content );
       }
       else {
           $self->log( error => $res->content );
       }
   }
}

1;

__END__

=head1 NAME

Plagger::Plugin::Publish::Caspeee - Post to caspeee automatically

=head1 SYNOPSIS

 - module: Publish::Caspeee
   config:
     login_id: your-username
     password: your-password
     channel_title_en: boofy
     status: wait

=head1 DESCRIPTION

This plugin automatically posts podcasting to caspeee
L<http://caspeee.jp/>. It supports automatic tagging as well.

=head1 AUTHOR

Tokuhiro Matsuno

=head1 SEE ALSO

L<Plagger>

=cut

Plagger::Plugin::Publish::Caspeee

カッとなってやった。後悔はしていない。

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

use Encode;
use Time::HiRes qw(sleep);
use URI;
use Plagger::Mechanize;

my $LOGIN_URL = 'http://caspeee.jp/account/login';
my $UPLOAD_URL = 'http://ul.caspeee.jp/my/files/upload';

sub register {
    my($self, $context) = @_;
    $context->register_hook(
        $self,
        'publish.entry' => \&add_entry,
        'publish.init'  => \&initialize,
    );
}

sub initialize {
    my $self = shift;
    unless ($self->{mech}) {
        my $mech = Plagger::Mechanize->new;
        $mech->quiet(1);
        $self->{mech} = $mech;
    }
    $self->login_caspeee;
}


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

    for my $enclosure (grep $_->local_path, $args->{entry}->enclosures) {
        $context->log( debug => "upload file @{[ $enclosure->local_path ]}");

        $self->{mech}->request(
            HTTP::Request::Common::POST(
                $UPLOAD_URL,
                Content_Type => 'multipart/form-data',
                Content      => [
                    moral       => 'on',
                    channel_rid => $self->conf->{channel_rid},
                    file        => [$enclosure->local_path],
                ]
            )
        );
        $self->{mech}->url;
    }
}

sub login_caspeee {
    my $self = shift;

    unless ($self->conf->{login_id} && $self->conf->{password}) {
        Plagger->context->log(error => 'set your login_id and password before login.');
    }

    my $res = $self->{mech}->get($LOGIN_URL);
    $self->{mech}->submit_form(
        form_name => 'Login',
        fields    => { login_id => $self->conf->{login_id}, login_pw => $self->conf->{password} }
    );
    unless ($self->{mech}->uri =~ m{/my/}) {
        Plagger->context->log(error => "failed to login to caspeee.");
    } else {
        Plagger->context->log(debug => "success to login to caspeee.");
    }
}

1;

fetch baka-ga-yuku by plagger.

global:
  timezone: Asia/Tokyo
  log:
    level: info
    #level: debug

plugins:
  - module: Subscription::Config
    config:
      feed:
        - url: http://www.jitu.org/~tko/cgi-bin/bakagaiku.rb
          meta:
            follow_xpath: //a[contains(@href, 'bakagaiku.rb')]

  - module: CustomFeed::Simple

  # Upgrade entry body to fulltext. Even if upgrade fails, store the whole HTML
  - module: Filter::EntryFullText
    config:
      store_html_on_failure: 1

  # Deduplicate entries using URL + datetime as a key
  - module: Filter::Rule
    rule:
      module: Deduped

  - module: Publish::Gmail
    config:
      mailto:   tokuhirom@ma.la
      mailfrom: tokuhirom@ma.la

Filter::DegradeYouTube

久々のPlaggerネタ。

ブログにはっつけられてる YouTube の object タグが Gmail などのメイラーだと再生されないので、サムネイル画像+リンクに差し替えるフィルターです。

==================================================================
--- deps/Filter-DegradeYouTube.yaml  (revision 3805)
+++ deps/Filter-DegradeYouTube.yaml  (local)
@@ -0,0 +1,4 @@
+name: Filter-DegradeYouTube
+author: Tokuhiro Matsuno
+depends:
+  WebService::YouTube: 0
=== lib/Plagger/Plugin/Filter/DegradeYouTube.pm
==================================================================
--- lib/Plagger/Plugin/Filter/DegradeYouTube.pm  (revision 3805)
+++ lib/Plagger/Plugin/Filter/DegradeYouTube.pm  (local)
@@ -0,0 +1,78 @@
+package Plagger::Plugin::Filter::DegradeYouTube;
+use strict;
+use base qw( Plagger::Plugin );
+
+my $regex = <<'...';
+<object width="\d+" height="\d+"><param name="movie" value="(http://www.youtube.com/[^"]+)"></param><param name="wmode" value="transparent"></param><embed src="http://www.youtube.com/[^"]+"  type="application/x-shockwave-flash" wmode="transparent"  width="\d+" height="\d+"></embed></object>
+...
+chomp $regex;
+
+sub register {
+    my($self, $context) = @_;
+
+    $context->register_hook(
+        $self,
+        'update.entry.fixup' => \&update,
+    );
+}
+
+sub update {
+    my($self, $context, $args) = @_;
+
+    my $body  = $args->{entry}->body;
+    $body =~ s{$regex}{
+        my $url = $1;
+        my $body;
+        if (my $dev_id = $self->conf->{dev_id}) {
+            my $thumb_url = $self->_thumbnail_url($dev_id, $self->_video_id($url));
+            qq{<a href="$url"><img src="$thumb_url" /></a>}
+        } else {
+            qq{<a href='$url'>YouTube Movie</a>}
+        }
+    }ge;
+    $args->{entry}->body($body);
+}
+
+sub _thumbnail_url {
+    my ($self, $dev_id, $video_id) = @_;
+
+    my $api = WebService::YouTube->new({dev_id => $dev_id});
+    my $video = $api->videos->get_details($video_id);
+    return $video->thumbnail_url;
+}
+
+sub _video_id {
+    my ($self, $url) = @_;
+
+    $url =~ m[/v/([^/]+)$];
+    return $1;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Plagger::Plugin::Filter::DegradeYouTube -
+
+=head1 SYNOPSIS
+
+  - module: Filter::DegradeYouTube
+
+=head1 DESCRIPTION
+
+XXX Write the description for Filter::DegradeYouTube
+
+=head1 CONFIG
+
+XXX Document configuration variables if any.
+
+=head1 AUTHOR
+
+Tokuhiro Matsuno
+
+=head1 SEE ALSO
+
+L<Plagger>
+
+=cut
=== t/plugins/Filter-DegradeYouTube/base.t
==================================================================
--- t/plugins/Filter-DegradeYouTube/base.t  (revision 3805)
+++ t/plugins/Filter-DegradeYouTube/base.t  (local)
@@ -0,0 +1,47 @@
+use strict;
+use t::TestPlagger;
+
+test_plugin_deps;
+plan 'no_plan';
+run_eval_expected;
+
+__END__
+
+=== Loading Filter::DegradeYouTube
+--- input config
+plugins:
+  - module: Filter::DegradeYouTube
+--- expected
+ok 1, $block->name;
+
+=== no dev_id
+--- input config
+plugins:
+  - module: Filter::DegradeYouTube
+
+  - module: CustomFeed::Debug
+    config:
+      title: feed title
+      entry:
+        - title: frepa
+          link: http://www.frepa.livedoor.com/blog/show?id=4&diary=60231
+          body: <object width="340" height="280"><param name="movie" value="http://www.youtube.com/v/nf8LyHLN2x4"></param><param name="wmode" value="transparent"></param><embed src="http://www.youtube.com/v/nf8LyHLN2x4"  type="application/x-shockwave-flash" wmode="transparent"  width="340" height="280"></embed></object>
+--- expected
+like $context->update->feeds->[0]->entries->[0]->body, qr{<a href='http://www.youtube.com/v/nf8LyHLN2x4'>YouTube Movie</a>}, "degrade with no dev_id";
+
+=== with dev_id
+--- input config
+plugins:
+  - module: Filter::DegradeYouTube
+    config:
+      dev_id: DkL0TIF7LpQ
+
+  - module: CustomFeed::Debug
+    config:
+      title: feed title
+      entry:
+        - title: frepa
+          link: http://www.frepa.livedoor.com/blog/show?id=4&diary=60231
+          body: <object width="340" height="280"><param name="movie" value="http://www.youtube.com/v/nf8LyHLN2x4"></param><param name="wmode" value="transparent"></param><embed src="http://www.youtube.com/v/nf8LyHLN2x4"  type="application/x-shockwave-flash" wmode="transparent"  width="340" height="280"></embed></object>
+--- expected
+like $context->update->feeds->[0]->entries->[0]->body, qr{<a href="http://www.youtube.com/v/nf8LyHLN2x4"><img src="http://sjl-static16.sjl.youtube.com/vi/nf8LyHLN2x4/2.jpg" /></a>}, "degrade with thumbnail";

Plagger::Plugin::CustomFeed::CybozuOffice6

サイボウズオフィスの自分の一週間分の予定を得られる Plagger の Plugin を作ってみました。
以前は、単一のスクリプトとして書いてみたんですが、「それPla」といわれそうなので、Plagger を使うようにしました。

iCal サポートまで待ってようかとも思ったんですが近々に自分で欲しかったので。

package Plagger::Plugin::CustomFeed::CybozuOffice6;
use strict;
use warnings;
use base qw( Plagger::Plugin );

sub register {
   my ( $self, $context ) = @_;
   $context->register_hook( $self, 'subscription.load' => \&load, );
}

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

   my $feed = Plagger::Feed->new;
   $feed->aggregator( sub { $self->aggregate(@_) } );
   $context->subscription->add($feed);
}

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

   my $mech = join( '::', __PACKAGE__, "Mechanize" )->new($self);
   $mech->login or $context->error('login failed');

   my $feed = Plagger::Feed->new;
   $feed->title('Cybouz Office 6');
   $feed->link( $self->conf->{url} );

   for my $entry_info ( @{ $mech->entries } ) {
       my $entry = Plagger::Entry->new;
       $entry->title( $entry_info->{title} );
       $entry->body( $entry_info->{body} );
       $feed->add_entry($entry);
   }

   $context->update->add($feed);
}

package Plagger::Plugin::CustomFeed::CybozuOffice6::Mechanize;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);
use Encode;
use Plagger::Mechanize;
use Plagger::Date;

__PACKAGE__->mk_accessors(qw(mech conf));

my $REGEXP = q{
   (
       <td.class="eventcell">
           .+?
       </td>
   )
};

sub new {
   my ( $class, $plugin ) = @_;

   bless {
       conf => $plugin->conf,
       mech => Plagger::Mechanize->new,
   }, $class;
}

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

   if ( my $basicauth = $self->conf->{basicauth} ) {
       $self->mech->add_header( Authorization => "Basic $basicauth" );
   }

   $self->mech->get( $self->conf->{url} );

   $self->mech->submit_form(
       form_number => 1,
       fields      => {
           _Account => $self->conf->{account},
           Password => $self->conf->{password},
       }
   );
}

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

   my @entries;
   my $date = Plagger::Date->today;
   my $content = decode( 'sjis', $self->mech->content );
   while ( $content =~ m[$REGEXP]igsx ) {
       my $body = $1;

       push @entries,
         +{
           body  => $body,
           title => $date->ymd,
           date  => $date,
         };

       $date->add(days => 1);
   }

   unless (@entries) {
       Plagger->context->error( "match failed: " . $content );
   }

   return \@entries;
}

1;
__END__

=head1 NAME

Plagger::Plugin::CustomFeed::CybozuOffice6 -

=head1 SYNOPSIS

 - module: CustomFeed::CybozuOffice6
     config:
       url:       http://example.com/cybozu/ag.exe
       account:   your account
       password:  your password
       basicauth: abacdjkFh==

=head1 DESCRIPTION

XXX Write the description for CustomFeed::CybozuOffice6

=head1 CONFIG

XXX Document configuration variables if any.

=head1 AUTHOR

Tokuhiro Matsuno <tokuhiro __at__ mobilefactory.jp>

=head1 SEE ALSO

L<Plagger>

=cut