Convert a Plerd webmentions database into a Whim one

plerd_wms_to_whim.pl

# This script converts a Plerd webmentions database into a Whim database.
#
# It won't affect your Plerd database, but it will write to your Whim one,
# so back up your Whim database first if it contains anything important to you.
#
# It runs using the same config file & options as plerdall & plerdwatcher.
#
# It writes to an SQLite database in the current directory. The script will
# fail if it can't find one. So, you may want to run this while in
# ~/.whim/data/, after running Whim at least once in order to create that DB.
#
# Run with the --delete option to empty out the DB first.
#
# Any questions? Please email jmac@jmac.org.
# (Honestly if you have been using a Plerd blog to receive and display
# webmentions before now I'd honestly love to hear about it anyway.)

use warnings;
use strict;
use v5.10;
use Plerd;
use Plerd::Util;
use utf8::all;
use JSON;
use DBI;
use FindBin;
use Mojo::UserAgent;
use Digest::SHA qw(sha256_hex);
use Getopt::Long;

my $config_file;
my $delete_first;
GetOptions(
    'config=s'            => \$config_file,
    'delete'              => \$delete_first,
);

my $config_ref = Plerd::Util::read_config_file( $config_file );
foreach (qw( base_uri image ) ) {
    unless ( ref $config_ref->{ $_ } ) {
        $config_ref->{ $_ } = URI->new ( $config_ref->{ $_ } );
    }
}

my $plerd = Plerd->new( $config_ref );

say "Reading Plerd posts for conversion...";

my $ua = Mojo::UserAgent->new;

my $dbh = DBI->connect("dbi:SQLite:dbname=$FindBin::Bin/wm.db","","");
my $foo = '?,' x 15;
chop $foo;
my $query = "insert into wm values($foo)";

$dbh->do('delete from wm') if $delete_first;

my $sth = $dbh->prepare($query);

for my $post ($plerd->posts->@*) {
    my @wms = $post->ordered_webmentions;
    next unless @wms;
    say $post->title . "...";
    for my $wm (@wms) {
        say "..." . $wm->original_source;
        $sth->execute(
            $wm->source,
            $wm->original_source,
            $wm->target,
            $wm->time_received,
            $wm->is_verified,
            $wm->is_tested,
            $wm->source_html,
            $wm->time_verified,
            $wm->type,
            $wm->author? $wm->author->name : undef,
            $wm->author? $wm->author->url : undef,
            $wm->author? $wm->author->photo: undef,
            author_photo_hash( $wm ) // undef,
            $wm->content,
            $wm->title,
        );
    }
}


sub author_photo_hash {
    my ($wm) = @_;
    return unless $wm->author && $wm->author->photo;

    my $result = $ua->get( $wm->author->photo->as_string )->result;
    if ($result->is_success) {
        my $hash = sha256_hex( $result->content->asset->slurp );
        $result->content->asset->move_to("$FindBin::Bin/images/$hash");
        return $hash;
    }
    else {
        return undef;
    }
}

BEGIN {
package Plerd::Post;
Readonly my $WEBMENTIONS_STORE_FILENAME => 'webmentions.json';


has 'webmentions_by_source' => (
    is => 'ro',
    isa => 'HashRef',
    lazy_build => 1,
);

has 'likes' => (
    is => 'ro',
    isa => 'ArrayRef[Web::Mention]',
    lazy_build => 1,
    traits => ['Array'],
    handles => {
        like_count => 'count',
    },
);

has 'reposts' => (
    is => 'ro',
    isa => 'ArrayRef[Web::Mention]',
    lazy_build => 1,
    traits => ['Array'],
    handles => {
        repost_count => 'count',
    },
);

has 'replies' => (
    is => 'ro',
    isa => 'ArrayRef[Web::Mention]',
    traits => ['Array'],
    lazy_build => 1,
    handles => {
        reply_count => 'count',
    },
);

has 'quotations' => (
    is => 'ro',
    isa => 'ArrayRef[Web::Mention]',
    traits => ['Array'],
    lazy_build => 1,
    handles => {
        quotation_count => 'count',
    },
);

has 'mentions' => (
    is => 'ro',
    isa => 'ArrayRef[Web::Mention]',
    traits => ['Array'],
    lazy_build => 1,
    handles => {
        mention_count => 'count',
    },);

has 'json' => (
    is => 'ro',
    isa => 'JSON',
    default => sub { JSON->new->convert_blessed },
);

sub add_webmention {
    my $self = shift;
    my ( $webmention ) = @_;

    $self->webmentions_by_source->{ $webmention->source } = $webmention;
    $self->serialize_webmentions;
}

sub update_webmention {
    return add_webmention( @_ );
}

sub delete_webmention {
    my $self = shift;
    my ( $webmention ) = @_;

    delete $self->webmentions_by_source->{ $webmention->source };
    $self->serialize_webmentions;
}

sub serialize_webmentions {
    my $self = shift;

    $self->_store( $WEBMENTIONS_STORE_FILENAME, $self->webmentions_by_source );
}

sub ordered_webmentions {
    my $self = shift;

    return sort
        {$a->time_published <=> $b->time_published }
        values( %{ $self->webmentions_by_source } )
    ;
}

sub webmention_count {
    my $self = shift;

    return scalar keys %{ $self->webmentions_by_source };
}

sub _build_webmentions_by_source {
    my $self = shift;

    my $webmentions_ref =
        $self->_retrieve(
            $WEBMENTIONS_STORE_FILENAME,
        )
        || {}
    ;

    for my $source_url ( keys( %{ $webmentions_ref } ) ) {
        my $webmention = Web::Mention->FROM_JSON(
            $webmentions_ref->{ $source_url }
        );
        $webmentions_ref->{ $source_url } = $webmention;
    }

    return $webmentions_ref;
}

sub _store {
    my $self = shift;
    my ($filename, $data_ref) = @_;

    my $post_dir =  Path::Class::Dir->new(
        $self->plerd->database_directory,
        $self->guid,
    );

    unless ( -e $post_dir ) {
        $post_dir->mkpath;
    }

    my $file = Path::Class::File->new(
        $post_dir,
        $filename,
    );
    $file->spew( $self->json->utf8->encode( $data_ref ) );
}

sub _retrieve {
    my $self = shift;
    my ($filename) = @_;

    my $file = Path::Class::File->new(
        $self->plerd->database_directory,
        $self->guid,
        $filename,
    );

    if ( -e $file ) {
        return $self->json->utf8->decode( $file->slurp );
    }
    else {
        return undef;
    }
}

sub _build_likes {
    my $self = shift;

    return $self->_grep_webmentions( 'like' );
}

sub _build_mentions {
    my $self = shift;

    return $self->_grep_webmentions( 'mention' );
}

sub _build_replies {
    my $self = shift;

    return $self->_grep_webmentions( 'reply' );
}

sub _build_quotations {
    my $self = shift;

    return $self->_grep_webmentions( 'quotation' );
}

sub _build_reposts {
    my $self = shift;

    return $self->_grep_webmentions( 'repost' );
}

sub _grep_webmentions {
    my ( $self, $webmention_type ) = @_;
    return [
        grep { $_->type eq $webmention_type } $self->ordered_webmentions
    ];
}

}