[Bast-commits] r7310 - in ironman: IronMan-Web/lib/IronMan IronMan-Web/script plagger/lib/IronMan/Schema plagger/lib/IronMan/Schema/ResultSet

castaway at dev.catalyst.perl.org castaway at dev.catalyst.perl.org
Wed Aug 12 13:21:44 GMT 2009


Author: castaway
Date: 2009-08-12 13:21:43 +0000 (Wed, 12 Aug 2009)
New Revision: 7310

Added:
   ironman/IronMan-Web/lib/IronMan/Feeds.pm
   ironman/IronMan-Web/script/add_feed.pl
   ironman/plagger/lib/IronMan/Schema/ResultSet/
   ironman/plagger/lib/IronMan/Schema/ResultSet/Feed.pm
Log:
New script to add new feeds manually (mst req'd)


Added: ironman/IronMan-Web/lib/IronMan/Feeds.pm
===================================================================
--- ironman/IronMan-Web/lib/IronMan/Feeds.pm	                        (rev 0)
+++ ironman/IronMan-Web/lib/IronMan/Feeds.pm	2009-08-12 13:21:43 UTC (rev 7310)
@@ -0,0 +1,37 @@
+package IronMan::Feeds;
+
+use strict;
+use warnings;
+
+use IronMan::Schema;
+use Data::UUID;
+use LWP::Simple;
+
+sub verify_feed_data {
+    my ($title, $url, $email, $email_conf, $errors) = @_;
+
+    if(!$url and !$email and !$title) {
+        return 0;
+    }
+    
+    ## Submitted form
+    $errors = [];
+    if($email ne $email_conf || !$email) {
+        push @$errors, 'Email does not match';
+    }
+#    $c->log->debug("Getting feed");
+    my $feed_xml = get($url);
+#    $c->log->debug("Got feed");
+    if(!$url || !defined $feed_xml) {
+        push @$errors, "Cannot fetch feed: $url";
+    }
+    if(!$title) {
+        push @$errors, 'Missing title';
+    }
+
+    return 0 if(@$errors);
+
+    return 1;
+}
+
+1;

Added: ironman/IronMan-Web/script/add_feed.pl
===================================================================
--- ironman/IronMan-Web/script/add_feed.pl	                        (rev 0)
+++ ironman/IronMan-Web/script/add_feed.pl	2009-08-12 13:21:43 UTC (rev 7310)
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IronMan::Schema;
+use IronMan::Feeds;
+use Term::Prompt;
+use Data::Dumper;
+
+# my $dsn = [ 'dbi:SQLite:/home/castaway/plagger/subscriptions.db' ];
+my $dsn = [ 'dbi:SQLite:/var/www/ironman.enlightenedperl.org/plagger/subscriptions.db' ];
+my ($title, $url, $email, $email_2);
+my $why = [];
+do {
+    print $_ for(@$why);
+    ## Ask for name, feed url, email (2x)
+    ($title, $url, $email, $email_2) = collect_data($title, $url, $email, $email_2);
+} until($url && (IronMan::Feeds::verify_feed_data($title, $url, $email, $email_2, $why)));
+
+
+## Add blog
+my ($res, $fdb) = add_new_blog($title, $url, $email, $dsn) ;
+if(!$res) {
+    print "That blog already exists: ", Dumper({ $fdb->get_columns });
+} else {
+    print "Added new blog: ", Dumper({ $fdb->get_columns });
+}
+## prompt to send email yes/no
+
+## send email to user with guid
+
+sub add_new_blog {
+    my ($title, $url, $email, $dsn) = @_;
+
+    my $schema = IronMan::Schema->connect(@$dsn);
+
+    return $schema->resultset('Feed')->add_new_blog($title, $url, $email);
+}
+
+sub collect_data {
+    my ($title_def, $url_def, $email_def) = @_;
+    my $title = prompt('x', 'Display name: First Last (nick):', '', $title_def ||'');
+    my $url = prompt('x', 'URL of the ATOM/RSS feed:', '', $url_def || '');
+    my $email = prompt('x', "Blogger's email:", '', $email_def || '');
+    my $email_2 = prompt('x', "Blogger's email (confirmation):", '', '');
+
+    return ($title, $url, $email, $email_2);
+}
+
+
+
+

Added: ironman/plagger/lib/IronMan/Schema/ResultSet/Feed.pm
===================================================================
--- ironman/plagger/lib/IronMan/Schema/ResultSet/Feed.pm	                        (rev 0)
+++ ironman/plagger/lib/IronMan/Schema/ResultSet/Feed.pm	2009-08-12 13:21:43 UTC (rev 7310)
@@ -0,0 +1,33 @@
+package IronMan::Schema::ResultSet::Feed;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Data::UUID;
+
+## Need to check if url is duplicated by normalising it as well as just uniquing what is passed in!
+sub add_new_blog {
+    my ($self, $title, $email, $url) = @_;
+
+    my $uuids = Data::UUID->new;
+    my $fdb = $self->find_or_new
+      ({
+        id => $uuids->create_str,
+        url => $url,
+        title => $title,
+        owner => $email,
+       },
+       { key => 'url' }
+      );
+
+    if($fdb->in_storage) {
+        return (0, $fdb);
+    }
+    $fdb->insert;
+
+    return (1, $fdb);
+}
+
+1;




More information about the Bast-commits mailing list