Ticket #171: iCal.pm.txt

package Plagger::Plugin::Publish::iCal;
use strict;
use base qw(Plagger::Plugin);
use File::Spec;
use Date::ICal;
use Data::ICal;
use Data::ICal::Entry::Event;

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

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

    my $dir = $self->conf->{dir};
    unless (-e $dir && -d _) {
        mkdir $dir, 0755 or $context->error("Failed to mkdir $dir: $!");
    }
}

sub publish_feed {
    my($self, $context, $args) = @_;
    my $feed = $args->{feed};
    my $ical = Data::ICal->new;
    $ical->add_properties(
        'X-WR-CALNAME'  => $feed->title,
    );

    for my $entry ($feed->entries) {
        my $date = $entry->date;
        my $event = Data::ICal::Entry::Event->new;
        $event->add_properties(
            summary     => $entry->title,
            description => $entry->summary || $entry->body,
            dtstart     => join('', split('-', $date->ymd)),
            dtend       => join('', split('-', Plagger::Date->from_epoch(epoch => $date->epoch + 60*60*24)->ymd)),
        );
        $ical->add_entry($event);
    }

    my $filepath = File::Spec->catfile($self->conf->{dir}, $self->gen_filename($feed));
    my $data = $ical->as_string;
    utf8::decode($data) unless utf8::is_utf8($data);

    open my $output, ">:utf8", $filepath or $context->error("$filepath: $!");
    print $output $data;
    close $output;

    $context->log(info => "Wrote iCalendar file to $filepath");
}

my %formats = (
    'u' => sub { my $s = $_[0]->url;  $s =~ s!^https?://!!; $s },
    'l' => sub { my $s = $_[0]->link; $s =~ s!^https?://!!; $s },
    't' => sub { $_[0]->title },
    'i' => sub { $_[0]->id },
);

my $format_re = qr/%(u|l|t|i)/;

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

    my $file = $self->conf->{filename} || '%i.ics';
    $file =~ s{$format_re}{
        $self->safe_filename($formats{$1}->($feed))
    }egx;
    $file;
}

sub safe_filename {
    my($self, $path) = @_;
    $path =~ s![^\w\s]+!_!g;
    $path =~ s!\s+!_!g;
    $path;
}

1;