Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

I've just got myself set up on Diaspora. One feature that I like, which hasn't been implemented in Diaspora yet is the ability to feed in RSS feeds of the other stuff you've been doing on the interwebs. So, this is a first crack at letting you post your RSS feed to your Diaspora pod,

I've put together a .tar.gz with all the config and such over at the page on my site. But here is the Perl bit of it in case anyone finds it useful.

#!/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 : 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: $ 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 executable wiith $ chmod 750 Finally you can start updating your feed with $ ./ 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: =cut

In reply to Post your RSS feeds to Diaspora with Perl by ciderpunx

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    Domain Nodelet?
    and the web crawler heard nothing...

    How do I use this?Last hourOther CB clients
    Other Users?
    Others sharing their wisdom with the Monastery: (3)
    As of 2024-07-25 04:30 GMT
    Find Nodes?
      Voting Booth?

      No recent polls found

      erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.