| 1 |
package Plagger::Plugin::Publish::CHTML; |
|---|
| 2 |
use strict; |
|---|
| 3 |
use base qw( Plagger::Plugin ); |
|---|
| 4 |
|
|---|
| 5 |
use Encode; |
|---|
| 6 |
use Digest::MD5 qw(md5_hex); |
|---|
| 7 |
use File::Path; |
|---|
| 8 |
use File::Copy; |
|---|
| 9 |
|
|---|
| 10 |
sub register { |
|---|
| 11 |
my($self, $context) = @_; |
|---|
| 12 |
$context->register_hook( |
|---|
| 13 |
$self, |
|---|
| 14 |
'publish.feed' => \&feed, |
|---|
| 15 |
'publish.finalize' => \&finalize, |
|---|
| 16 |
); |
|---|
| 17 |
$self->chtml_init($context); |
|---|
| 18 |
} |
|---|
| 19 |
|
|---|
| 20 |
sub chtml_init { |
|---|
| 21 |
my ($self, $context) = @_; |
|---|
| 22 |
$self->{context} = $context; |
|---|
| 23 |
$self->conf->{encoding} ||= 'cp932'; |
|---|
| 24 |
$self->{id} = time; |
|---|
| 25 |
@{$self->{feeds}} = (); |
|---|
| 26 |
unless ($self->conf->{work}) { |
|---|
| 27 |
$context->error("Can't parse value in work"); |
|---|
| 28 |
} |
|---|
| 29 |
$self->conf->{title} ||= __PACKAGE__; |
|---|
| 30 |
} |
|---|
| 31 |
|
|---|
| 32 |
sub id { shift->{id} } |
|---|
| 33 |
sub context { shift->{context} } |
|---|
| 34 |
sub work { shift->conf->{work} } |
|---|
| 35 |
|
|---|
| 36 |
sub add { |
|---|
| 37 |
my($self, $feed) = @_; |
|---|
| 38 |
push @{ $self->{feeds} }, $feed; |
|---|
| 39 |
} |
|---|
| 40 |
|
|---|
| 41 |
sub feeds { |
|---|
| 42 |
my $self = shift; |
|---|
| 43 |
wantarray ? @{ $self->{feeds} } : $self->{feeds}; |
|---|
| 44 |
} |
|---|
| 45 |
|
|---|
| 46 |
sub feed { |
|---|
| 47 |
my($self, $context, $args) = @_; |
|---|
| 48 |
|
|---|
| 49 |
my $feed = $args->{feed} or return; |
|---|
| 50 |
my $feed_path = $self->work . '/feeds/' . $feed->id_safe; |
|---|
| 51 |
my $publish_path = "$feed_path/" . $self->id; |
|---|
| 52 |
|
|---|
| 53 |
mkpath($publish_path); |
|---|
| 54 |
foreach my $entry ($feed->entries) { |
|---|
| 55 |
my $entry_id = md5_hex($entry->permalink); |
|---|
| 56 |
$self->write("$publish_path/$entry_id.html", |
|---|
| 57 |
$self->templatize('chtml_entry.tt', { |
|---|
| 58 |
conf => $self->conf, |
|---|
| 59 |
feed => $feed, |
|---|
| 60 |
entry => $entry, |
|---|
| 61 |
strip_html => sub { |
|---|
| 62 |
my $html = shift; |
|---|
| 63 |
$html =~ s|\s{2,}||og; |
|---|
| 64 |
$html =~ s|<[bh]r.*?>|\n|ogi; |
|---|
| 65 |
$html =~ s|<.*?>||og; |
|---|
| 66 |
$html; |
|---|
| 67 |
}, |
|---|
| 68 |
})); |
|---|
| 69 |
|
|---|
| 70 |
$entry->{feed2entry_link} = $self->id . "/$entry_id.html"; |
|---|
| 71 |
} |
|---|
| 72 |
|
|---|
| 73 |
$self->write("$publish_path.html", |
|---|
| 74 |
$self->templatize('chtml_feed.tt', { |
|---|
| 75 |
conf => $self->conf, |
|---|
| 76 |
feed => $feed, |
|---|
| 77 |
earlier => $self->earlier($feed_path), |
|---|
| 78 |
modified => (Plagger::Date->now), |
|---|
| 79 |
}), |
|---|
| 80 |
"$feed_path/index.html"); |
|---|
| 81 |
|
|---|
| 82 |
$self->add(+{ |
|---|
| 83 |
feed_link => './feeds/' . $feed->id_safe . '/' . $self->id . '.html', |
|---|
| 84 |
title => $feed->title || '(no-title)', |
|---|
| 85 |
lastdate => $feed->entries->[-1]->date, |
|---|
| 86 |
count => scalar(@{$feed->entries}), |
|---|
| 87 |
}); |
|---|
| 88 |
} |
|---|
| 89 |
|
|---|
| 90 |
sub finalize { |
|---|
| 91 |
my($self, $context) = @_; |
|---|
| 92 |
|
|---|
| 93 |
return unless @{$self->feeds}; |
|---|
| 94 |
$self->write($self->work . '/' . $self->id . '.html', |
|---|
| 95 |
$self->templatize('chtml_index.tt', { |
|---|
| 96 |
conf => $self->conf, |
|---|
| 97 |
feeds => [ $self->feeds ], |
|---|
| 98 |
earlier => $self->earlier($self->work), |
|---|
| 99 |
modified => (Plagger::Date->now), |
|---|
| 100 |
}), |
|---|
| 101 |
$self->work . '/index.html'); |
|---|
| 102 |
} |
|---|
| 103 |
|
|---|
| 104 |
sub write { |
|---|
| 105 |
my ($self, $file, $chtml, $symlink) = @_; |
|---|
| 106 |
open my $out, ">:encoding($self->{conf}->{encoding})", $file or $self->context->error("$file: $!"); |
|---|
| 107 |
local $PerlIO::encoding::fallback = Encode::FB_HTMLCREF; |
|---|
| 108 |
print $out $chtml; |
|---|
| 109 |
close $out; |
|---|
| 110 |
$self->symlink($file, $symlink) if $symlink; |
|---|
| 111 |
} |
|---|
| 112 |
|
|---|
| 113 |
sub symlink { |
|---|
| 114 |
my ($self, $old, $new) = @_; |
|---|
| 115 |
unlink $new if -e $new; |
|---|
| 116 |
eval { symlink $old, $new; }; |
|---|
| 117 |
if ($@) { |
|---|
| 118 |
copy $old, $new; |
|---|
| 119 |
} |
|---|
| 120 |
} |
|---|
| 121 |
|
|---|
| 122 |
sub earlier { |
|---|
| 123 |
my ($self, $path) = @_; |
|---|
| 124 |
my $earlier; |
|---|
| 125 |
my $file = "$path/earlier"; |
|---|
| 126 |
if (open my $in, '<', $file) { |
|---|
| 127 |
$earlier = <$in>; |
|---|
| 128 |
close $in; |
|---|
| 129 |
} |
|---|
| 130 |
open my $out, ">", $file or $self->context->error("$file: $!"); |
|---|
| 131 |
print $out $self->id; |
|---|
| 132 |
close $out; |
|---|
| 133 |
$earlier; |
|---|
| 134 |
} |
|---|
| 135 |
1; |
|---|