[dw-free] Create a page that can share off-site content on DW

[mark]

[commit: http://hg.dwscoalition.org/dw-free/rev/93d4ae733207]

http://bugs.dwscoalition.org/show_bug.cgi?id=1692

Add 'share this' type functionality to the update page so that other sites
can create 'share this on Dreamwidth' style buttons/links/etc.

Patch by janinedog.

Files modified:

• cgi-bin/DW/External/Page.pm
• htdocs/update.bml

--------------------------------------------------------------------------------
diff -r 8c0ea717000b -r 93d4ae733207 cgi-bin/DW/External/Page.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/External/Page.pm	Mon Oct 26 03:56:27 2009 +0000
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+#
+# DW::External::Page
+#
+# This class is for Page objects, which hold information from pages on other sites.
+#
+# Authors:
+#      Janine Smith <janine@netrophic.com>
+#
+# Copyright (c) 2009 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself.  For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::External::Page;
+
+use strict;
+use warnings;
+use HTML::TokeParser;
+
+sub new {
+    my ( $class, %opts ) = @_;
+
+    my $url = LJ::durl( $opts{url} );
+    return undef unless $url;
+
+    my $ua = LJ::get_useragent( role => 'share' );
+    $ua->agent( $LJ::SITENAME );
+    my $res = $ua->get( $url );
+    my $content = $res && $res->is_success ? $res->content : undef;
+    return undef unless $content;
+
+    my $p = HTML::TokeParser->new( \$content );
+
+    my $title;
+    if ( $p->get_tag( 'title' ) ) {
+        $title = $p->get_trimmed_text;
+    }
+
+    my $description;
+    while ( my $token = $p->get_tag( 'meta' ) ) {
+        next unless $token->[1]{name} && $token->[1]{name} eq 'description';
+        $description = LJ::trim( $token->[1]{content} )
+            if $token->[1]{content};
+    }
+
+    return bless {
+        url => $url,
+        title => $title || '',
+        description => $description || '',
+    }, $class;
+}
+
+sub url { $_[0]->{url} }
+sub title { $_[0]->{title} }
+sub description { $_[0]->{description} }
+
+1;
diff -r 8c0ea717000b -r 93d4ae733207 htdocs/update.bml
--- a/htdocs/update.bml	Mon Oct 26 03:46:30 2009 +0000
+++ b/htdocs/update.bml	Mon Oct 26 03:56:27 2009 +0000
@@ -2,6 +2,7 @@
 {
     use strict;
     use vars qw(%GET %POST %ML);
+    use DW::External::Page;
     BML::decl_params(_default => qr/./);
 
     # $_[1] is a pre-request scratch area
@@ -93,6 +94,12 @@
     my $subject = $POST{'subject'} || $GET{'subject'};
     my $event   = $POST{'event'}   || $GET{'event'};
     my $tags    = $POST{'prop_taglist'} || $GET{'prop_taglist'};
+
+    # if a share url was passed in, fill in the fields with the appropriate text
+    if ( $GET{share} && ( my $page = DW::External::Page->new( url => $GET{share} ) ) ) {
+        $subject = LJ::ehtml( $page->title );
+        $event = '<a href="' . $page->url . '">' . ( LJ::ehtml( $page->description ) || $subject || $page->url ) . "</a>\n\n";
+    }
 
     # if a QotD id was passed in, fill in the fields with that QotD
     my $qid = $GET{qotd}+0;
--------------------------------------------------------------------------------