qrss-tools/qrss-export

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

use Getopt::Std;
use IO::File;
use Date::Parse;
use DBIx::Simple;
use SQL::Abstract;
use Term::Prompt;
use YAML;

my $opts = { f => undef, F => undef };
getopts('f:F:', $opts)
  or die "Usage: $0 [-f <qrss.db>] [-F <filter-by-url>]\n";

die "Usage: $0 [-f <qrss.db>]\n"
  unless $opts->{f} and -f $opts->{f};

my $dbopts = { sqlite_unicode => 1, AutoCommit => 1, RaiseError => 1 };
my $dsn = sprintf 'dbi:SQLite:dbname=%s', $opts->{f};
my $db = DBIx::Simple->new($dsn, undef, undef, $dbopts);

sub list_feeds {
  my $filter = $opts->{F}
    ? { xmlUrl => {-like => "%$opts->{F}%"} }
    : { xmlUrl => {'!=' => ''} };
  my @feeds = $db->select('feeds', [qw(id title text xmlUrl)], $filter, 'title')->hashes;
  print " ID  | Feed name (URL)\n";
  print "-----+-----------------------------------------------------------\n";
  foreach my $f (@feeds) {
    printf " %3d | %s (%s)\n", $f->{id}, $f->{title} || $f->{text}, $f->{xmlurl};
  }
  print "\n";
}

sub export_feed {
  my $fid = shift;
  my $feed = $db->select('feeds', '*', {id => $fid})->hash
    or return warn "no such feed: $fid\n";
  my $fname = sprintf "%d - %s", $fid, substr($feed->{title} || $feed->{text}, 0, 128);
  $fname =~ tr[/][]d;
  $fname .= '.yml';
  my $file = IO::File->new($fname, 'w');
  my $yml = YAML::Dump({
    type => 'feed',
    url  => $feed->{xmlurl} || $feed->{htmlurl},
    name => $feed->{title}  || $feed->{text},
    note => $feed->{description},
  });
  if (utf8::is_utf8($yml)) { utf8::encode($yml); }
  $file->print($yml);
  my @news = $db->select('news', '*', {feedId => $fid})->hashes;
  my $exported = 0;
  print "exporting: ";
  while (my $n = shift @news) {
    $n->{flags}  = '';
    $n->{flags} .= ($n->{read})    ? 'u' : 'U';
    $n->{flags} .= ($n->{starred}) ? 'S' : 's';
    $n->{ctime} = str2time($n->{published} || $n->{modified});
    if ($n->{description} and not $n->{content}) {
      $n->{content} = $n->{description};
      undef $n->{description};
    }
    foreach my $attr (qw(guid link_href)) {
      next unless $n->{$attr} and index($n->{$attr}, '://') >= 0;
      $n->{url} = $n->{$attr};
      last;
    }
    $yml = YAML::Dump({
      type     => 'entry',
      url      => $n->{url},
      ctime    => $n->{ctime},
      flags    => $n->{flags},
      author   => $n->{author_name},
      category => $n->{category},
      title    => $n->{title},
      summary  => $n->{description},
      content  => $n->{content},
    });
    if (utf8::is_utf8($yml)) { utf8::encode($yml); }
    $file->print($yml);
    $exported++;
    if ($exported % 100 == 0) { print '.'; }
  } # foreach @news
  $file->close;
  print "\n";
  printf "exported: %s (%d entries)\n", $fname, $exported;
}

sub show_help {
  print <<"HELP";
  l\tList feeds
  f\tSet list filter
  e\tExport
  h\tHelp
  q\tQuit
HELP
}

binmode STDOUT => ':utf8';
$| = 1;

while (1) {
  my $a = prompt('c', 'command', 'h for help', '', qw(l f e h q));
  if ($a eq 'l') {
    list_feeds();
  } elsif ($a eq 'f') {
    $opts->{F} = prompt('x', 'Filter by URL', '', 'example.com', '');
  } elsif ($a eq 'e') {
    my $fid = prompt('n', 'feed id:', '', '');
    export_feed($fid);
  } elsif ($a eq 'q') {
    print "exiting...\n";
    exit 0;
  } else {
    show_help();
  }
}

exit 0;