P::P::Filter::BreakLinksToEntries
元々P::P::Filter::SeparateLinksという名前で作っていましたが、最近P::P::Filter::BreakEntriesToFeedsが出来たらしく、意味的に近いので名前を合わせました。1エントリ内に含まれる定型リンクでエントリを作り直します。
package Plagger::Plugin::Filter::BreakLinksToEntries; use strict; use warnings; use base qw( Plagger::Plugin ); use DirHandle; use Encode; use File::Spec; sub register { my($self, $context) = @_; $context->register_hook( $self, 'plugin.init' => \&initialize, 'update.entry.fixup' => \&extract_links, 'update.feed.fixup' => \&reconstruct_entries, ); } sub initialize { my($self, $context, $args) = @_; $self->{separated_links} = { links => undef, }; $self->load_entry_builder; } sub load_entry_builder { my $self = shift; my $context = Plagger->context; my $dir = $self->assets_dir; my $dh = DirHandle->new($dir) or $context->error("$dir: $!"); for my $file (grep -f $_->[0] && $_->[0] =~ /\.yaml$/, map [ File::Spec->catfile($dir, $_), $_ ], sort $dh->read) { my @data = YAML::LoadFile( $file->[0] ); push @{ $self->{entry_builders} }, Plagger::Plugin::Filter::BreakLinksToEntries::EntryBuilder->new(@data); } } sub extract_links { my($self, $context, $args) = @_; for my $entry_builder ( @{$self->{entry_builders}} ) { if ( $entry_builder->handle($args) ) { my $entry_data = $entry_builder->extract($args); for my $edata ( @{$entry_data} ) { push @{ $self->{separated_links}->{links} }, { title => $edata->{title} || $args->{entry}->title, link => $edata->{link}, date => $args->{entry}->date, }; } } } } sub reconstruct_entries { my($self, $context, $args) = @_; $args->{feed}->clear_entries; for my $link_entry ( @{ $self->{separated_links}->{links} } ) { my $entry = Plagger::Entry->new; $entry->title( $link_entry->{title} ); $entry->link( $link_entry->{link} ); $entry->date( $link_entry->{date} ); $args->{feed}->add_entry( $entry ); } } package Plagger::Plugin::Filter::BreakLinksToEntries::EntryBuilder; use Encode; sub new { my($class, $data) = @_; for my $key ( qw( handle ) ) { $data->{$key} = "^$data->{$key}" if $data->{$key} =~ m!^http?://!; } for my $key ( qw( extract ) ) { if (ref $data->{$key} && ref $data->{$key} eq 'ARRAY') { $data->{$key} = [ map decode("UTF-8", $_), @{$data->{$key}} ]; } else { $data->{$key} = decode("UTF-8", $data->{$key}); } } bless{ %$data }, $class; } sub handle { my($self, $args) = @_; $self->{handle} ? $args->{entry}->link =~ /$self->{handle}/ : 0; } sub extract { my($self, $args) = @_; if ( my @match = $args->{content} =~ /$self->{extract}/gs ) { my @capture = split /\s+/, $self->{extract_capture}; my $data; while (@match) { my @m = splice(@match, 0, $#capture+1); my $d; @{$d}{@capture} = @m; push @{$data}, $d; } return $data; } } 1;