#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use autodie;
use 5.10.0;
use Data::Dumper;
use JSON;
use XML::Feed;
use WWW::Mechanize;
use HTML::Strip;
use Readonly;


Readonly my $CONFIGPATH => 'feed2diasp.json';
Readonly my $FEEDSSEEN  => 'feed2diasp-seen';

my $config = get_config();
my $mech   = do_diaspora_login($config);
# status_update($mech, "I is diasporizing an ting. What a gwan?"); # D
+EBUG

open my $in, '<:utf8', $FEEDSSEEN;
my @seen = <$in>;
close $in;

my %seen = map { chomp; $_ => 1 } @seen;

my $max_items = $config->{max_items};
my $new_items = 0;
for my $feed (@{$config->{feeds}}){
    my @feed_items = fetch_feed($feed);
    open my $out, ">>:utf8", $FEEDSSEEN;
    for(@feed_items) {
        next if ($seen{$feed . $_->id});
        my $msg = '';
        $msg .= format_msg($_->summary->body) if ($_->summary && $_->s
+ummary->body);
        $msg .= format_msg($_->content->body) if ($_->content && $_->c
+ontent->body);
        # say "Status update: " . $_->link . "\n" . $msg; # DEBUG
        $mech = status_update($config, $mech, $msg);
        $new_items++;
        print $out $feed . $_->id . "\n"; 
        last unless $new_items < $max_items;
    }
    close $out;
}

sub get_config {
    open my $in, '<:utf8', $CONFIGPATH;
    my @lines = <$in>;
    close $in;
    my $config = decode_json "@lines";
    #die Dumper $config; #DEBUG
    return $config;
}

sub do_diaspora_login {
    my $config = shift;
    my $login_url = "https://" . $config->{pod} . "/users/sign_in";
    my $mech = WWW::Mechanize->new();
  $mech->get($login_url);
    my $form = $mech->form_id('user_new');
    my $auth_token = $form->value('authenticity_token'); # not quite s
+ure how this works. 
  my $res = $mech->submit_form(
        form_id            => 'user_new',
        fields => {
            'user[password]'     => $config->{password},
            'user[username]'     => $config->{username},
            'authenticity_token' => $auth_token,
            'utf8'               => '&#10003;',
            'user[remember_me]'  => 0,
            'commit'             => 'Sign in',
        },
  );
    die "Fsck it, can't login. Maybe you need to change the login deta
+ils in $CONFIGPATH?" unless $res->is_success;
    
    return $mech;
}

sub status_update {
    my ($config,$mech,$msg) = (shift,shift,shift);
    my $form = $mech->form_id('new_status_message');
    my $auth_token = $form->value('authenticity_token');
    my $res = $mech->submit_form(
        form_id    => 'new_status_message',
        fields    => {
            'status_message[fake_text]' => $msg,
            'status_message[text]'            => $msg,
      'utf8'                                            => '&#10003;',
            'commit'                                        => 'Share'
+,
            'aspect_ids[]'                            => 'all_aspects'
+,
        }
    );
    warn "Fsck it, can't post $msg" unless $res->is_success;
    $mech-&gt;get("https://" . $config->{pod} . "/stream");
    return $mech;
}

sub fetch_feed {
    my $uri = shift;
    my $feed = XML::Feed->parse(URI->new($uri));
    return $feed->entries;
}

sub format_msg {
    my $msg = shift;
    my $hs = HTML::Strip->new();
    return $hs->parse( $msg );
}

__END__

=head1 NAME

feed2diasp.pl : Get a feed and squish it into diaspora.

=head2 VERSION

0.1

=head1 SYNOPSIS

Edit feed2diasp.json to set up your account details then just:

$ feed2diasp.pl 

You probably want to run this as a cronjob

=head1 DESCRIPTION

Install by untarring with 

$ tar xvzf feed2diasp.tar.gz

Then

$ cd feed2diasp

You'll need to make sure you have Perl 5.10.0 and the CPAN dependencie
+s. 

$ sudo cpan XML::Feed Readonly HTML::Strip Data::Dumper WWW::Mechanize

Then edit the config file supplied to something more to your taste.

You should make feed2diasp.pl executable wiith

$ chmod 750 feed2diasp.pl

Finally you can start updating your feed with

$ ./feed2diasp.pl

You may want to put that in a cron job.

=head2 OPTIONS

All options are set in feed2yaml.json . I used JSON rather than YAML t
+o reduce dependencies

=head1 REQUIREMENTS

Perl 5.10.0 
Data::Dumper
JSON
XML::Feed
WWW::Mechanize
HTML::Strip
Readonly

=head1 COPYRIGHT AND LICENCE

           Copyright (C)2011 Charlie Harvey

 This program is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public License
 as published by the Free Software Foundation; either version 
 2 of the License, or (at your option) any later version.

 This program is distributed in the hope that it will be 
 useful, but WITHOUT ANY WARRANTY; without even the implied 
 warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
 PURPOSE.  See the GNU General Public License for more 
 details.

 You should have received a copy of the GNU General Public 
 License along with this program; if not, write to the Free
 Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA  02111-1307, USA.
 Also available on line: http://www.gnu.org/copyleft/gpl.html

=cut
[download]