Browse files

import Web::oEmbed

  • Loading branch information...
0 parents commit 46ecec3deac348c224344bb305608577e5bbc85c @miyagawa committed Aug 13, 2008
Showing with 582 additions and 0 deletions.
  1. +1 −0 .shipit
  2. +4 −0 Changes
  3. +29 −0 MANIFEST
  4. +14 −0 MANIFEST.SKIP
  5. +14 −0 Makefile.PL
  6. +27 −0 README
  7. +248 −0 lib/Web/oEmbed.pm
  8. +106 −0 lib/Web/oEmbed/Response.pm
  9. +4 −0 t/00_compile.t
  10. +34 −0 t/01_providers.t
  11. +45 −0 t/02_request.t
  12. +8 −0 t/97_podspell.t
  13. +5 −0 t/98_perlcritic.t
  14. +4 −0 t/99_pod.t
  15. +15 −0 t/oEmbed.pm
  16. +1 −0 t/providers.json
  17. +23 −0 tools/fetch-providers.pl
1 .shipit
@@ -0,0 +1 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
4 Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension Web::oEmbed
+
+0.01 Wed Aug 13 11:47:22 2008
+ - original version
29 MANIFEST
@@ -0,0 +1,29 @@
+Changes
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/TestBase.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+inc/Spiffy.pm
+inc/Test/Base.pm
+inc/Test/Base/Filter.pm
+inc/Test/Builder.pm
+inc/Test/Builder/Module.pm
+inc/Test/More.pm
+lib/Web/oEmbed.pm
+lib/Web/oEmbed/Response.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00_compile.t
+t/01_providers.t
+t/02_request.t
+t/oEmbed.pm
+t/providers.json
+tools/fetch-providers.pl
14 MANIFEST.SKIP
@@ -0,0 +1,14 @@
+\bRCS\b
+\bCVS\b
+\.svn/
+^MANIFEST\.
+^Makefile$
+~$
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+\.shipit
+^t/9\d_.*\.t
14 Makefile.PL
@@ -0,0 +1,14 @@
+use inc::Module::Install;
+name 'Web-oEmbed';
+all_from 'lib/Web/oEmbed.pm';
+
+requires 'Moose';
+requires 'LWP';
+requires 'XML::LibXML::Simple';
+requires 'JSON::XS';
+requires 'HTML::Element';
+
+build_requires 'Test::More';
+use_test_base;
+auto_include;
+WriteAll;
27 README
@@ -0,0 +1,27 @@
+This is Perl module Web::oEmbed.
+
+INSTALLATION
+
+Web::oEmbed installation is straightforward. If your CPAN shell is set up,
+you should just be able to do
+
+ % cpan Web::oEmbed
+
+Download it, unpack it, then build it as per the usual:
+
+ % perl Makefile.PL
+ % make && make test
+
+Then install it:
+
+ % make install
+
+DOCUMENTATION
+
+Web::oEmbed documentation is available as in POD. So you can do:
+
+ % perldoc Web::oEmbed
+
+to read the documentation online with your favorite pager.
+
+Tatsuhiko Miyagawa
248 lib/Web/oEmbed.pm
@@ -0,0 +1,248 @@
+package Web::oEmbed;
+
+use strict;
+use 5.8.1;
+our $VERSION = '0.01';
+
+use Moose;
+has 'format' => (is => 'rw', default => 'json');
+has 'discovery' => (is => 'rw');
+has 'providers' => (is => 'rw', isa => 'ArrayRef', default => sub { [] });
+has 'agent' => (is => 'rw', isa => 'LWP::UserAgent', default => sub {
+ require LWP::UserAgent;
+ LWP::UserAgent->new( agent => __PACKAGE__ . "/" . $VERSION );
+ });
+
+use URI;
+use Web::oEmbed::Response;
+
+sub register_provider {
+ my($self, $provider) = @_;
+ $provider->{regexp} = $self->_compile_url($provider->{url});
+ push @{$self->providers}, $provider;
+}
+
+sub _compile_url {
+ my($self, $url) = @_;
+ my $res;
+ my $uri = URI->new($url);
+ $res = $uri->scheme . "://";
+ $res .= _run_regexp($uri->host, '[0-9a-zA-Z\-]+');
+ $res .= _run_regexp($uri->path, "[$URI::uric]+" );
+ $res;
+}
+
+sub _run_regexp {
+ my($str, $replacement) = @_;
+ $str =~ s/(?:(\*)|([^\*]+))/$1 ? $replacement : quotemeta($2)/eg;
+ $str;
+}
+
+sub provider_for {
+ my($self, $uri) = @_;
+ for my $provider (@{$self->providers}) {
+ if ($uri =~ m!^$provider->{regexp}!) {
+ return $provider;
+ }
+ }
+ return;
+}
+
+sub request_url {
+ my($self, $uri, $opt) = @_;
+
+ my $params = {
+ url => $uri,
+ format => $opt->{format} || $self->format,
+ };
+
+ $params->{maxwidth} = $opt->{maxwidth} if exists $opt->{maxwidth};
+ $params->{maxheight} = $opt->{maxheight} if exists $opt->{maxheight};
+
+ my $provider = $self->provider_for($uri) or return;
+ my $req_uri = URI->new( $provider->{api} );
+ if ($req_uri->path =~ /%7Bformat%7D/) { # yuck
+ my $path = $req_uri->path;
+ $path =~ s/%7Bformat%7D/$params->{format}/;
+ $req_uri->path($path);
+ delete $params->{format};
+ }
+
+ $req_uri->query_form($params);
+ $req_uri;
+}
+
+sub embed {
+ my($self, $uri, $opt) = @_;
+
+ my $url = $self->request_url($uri, $opt);
+ my $res = $self->agent->get($url);
+
+ Web::oEmbed::Response->new_from_response($res);
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=for stopwords oEmbed
+
+=head1 NAME
+
+Web::oEmbed - oEmbed consumer
+
+=head1 SYNOPSIS
+
+ use Web::oEmbed;
+
+ my $consumer = Web::oEmbed->new({ format => 'json' });
+ $consumer->register_provider({
+ url => 'http://*.flickr.com/*',
+ api => 'http://www.flickr.com/services/oembed/,
+ });
+
+ my $response = eval { $consumer->embed("http://www.flickr.com/photos/bulknews/2752124387/") };
+ if ($response) {
+ $response->matched_uri; # 'http://www.flickr.com/photos/bulknews/2752124387/'
+ $response->type; # 'photo'
+ $response->title; # title of the photo
+ $response->url; # JPEG URL
+ $response->width; # JPEG width
+ $response->height; # JPEG height
+
+ print $response->render; # handy shortcut to generate <img/> tag
+ }
+
+=head1 DESCRIPTION
+
+Web::oEmbed is a module that implements oEmbed consumer.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+ $consumer = Web::oEmbed->new;
+ $consumer = Web::oEmbed->new({ format => 'json' });
+
+Creates a new Web::oEmbed instance. You can specify the default format
+that will be used when it's not specified in the C<embed> method.
+
+=item register_provider
+
+ $consumer->register_provider({
+ name => 'Flickr',
+ url => 'http://*.flickr.com/*',
+ api => 'http://www.flickr.com/services/oembed/,
+ });
+
+Registers a new provider site. C<name> is optional while C<url> and
+C<api> are required. If you specify the mangled C<url> parameter like
+'*://www.flickr.com/' it will die with an error. You can call this
+method multiple times to add multiple oEmbed providers.
+
+=item embed
+
+ $response = $consumer->embed("http://www.example.com/");
+ $response = $consumer->embed( URI->new("http://photos.example.com/"), { format => 'xml' } );
+
+Given an URL it will try to find the correspondent provider based on
+their registered URL scheme, and then send the oEmbed request to the
+oEmbed provider endpoint and parse the response. The method returns an
+instance of Web::oEmbed::Response.
+
+Returns undef if there's no provider found for the URL. Throws an
+error if there's an error in JSON/XML parsing etc.
+
+C<format> optional parameter specifies which C<format> is sent to the
+provider as a prefered format parameter. When omitted, the default
+format parameter set in C<new> is used. If it's not speciied in C<new>
+either, the default will be C<json>.
+
+B<NOT IMPLEMENTED YET>: When optional parameter C<discovery> is set,
+the consumer will issue the HTTP request to the original URL to
+discover the oEmbed discovery tag described in the oEmbed spec chapter
+4. If the oEmbed discovery tag is found in the HTML, it will then
+issue the oEmbed request against the provider.
+
+=back
+
+=head1 METHODS in Web::oEmbed::Response
+
+=over 4
+
+=item http_response
+
+ $res = $response->http_response;
+
+Returns an underlying HTTP::Response object.
+
+=item matched_uri
+
+ $uri = $response->matched_uri;
+
+Returns the matched URL given to the original C<embed> method.
+
+=item type
+
+=item version
+
+=item title
+
+=item author_name
+
+=item author_url
+
+=item provider_name
+
+=item provider_url
+
+=item cache_age
+
+=item thumbnail_url
+
+=item thumbnail_width
+
+=item thumbnail_height
+
+Returns the value of response parameters.
+
+=item url, width, height
+
+Returns the value of response parameters if response type is I<photo>.
+
+=item html, width, height
+
+Returns the value of response parameters if response type is I<video> or I<rich>.
+
+=item render
+
+ $html = $response->render;
+
+Returns the HTML that you can use to display the embedded object. This
+method is an alias to C<html> accessor if there is one in the response
+(i.e. I<video> or I<rich>), or creates an A tag to represent C<photo>
+or C<rich> response.
+
+=back
+
+=head1 COPYRIGHT
+
+Six Apart, Ltd. E<lt>cpan@sixapart.comE<gt>
+
+=head1 AUTHOR
+
+Tatsuhiko Miyagawa E<lt>miyagawa@cpan.orgE<gt>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<http://www.oembed.com/>, L<JSON::XS>, L<XML::LibXML::Simple>
+
+=cut
106 lib/Web/oEmbed/Response.pm
@@ -0,0 +1,106 @@
+package Web::oEmbed::Response;
+use Carp;
+use Moose;
+
+has 'http_response', is => 'ro', isa => 'HTTP::Response';
+
+has 'type', is => 'rw';
+has 'version', is => 'rw';
+has 'title', is => 'rw';
+has 'author_name', is => 'rw';
+has 'author_url', is => 'rw';
+has 'prwvider_name', is => 'rw';
+has 'prwvider_url', is => 'rw';
+has 'cache_age', is => 'rw';
+has 'thumbnail_url', is => 'rw';
+has 'thumbnail_width', is => 'rw';
+has 'thumbnail_height', is => 'rw';
+
+has 'url', is => 'rw';
+has 'width', is => 'rw';
+has 'height', is => 'rw';
+
+has 'html', is => 'rw';
+
+use HTML::Element;
+
+sub new_from_response {
+ my($class, $http_res) = @_;
+
+ return if $http_res->is_error;
+
+ my $res = $class->new( http_response => $http_res );
+
+ my $data;
+ if ($http_res->content_type =~ /json/) {
+ $data = $res->parse_json($http_res->content);
+ } elsif ($http_res->content_type =~ /xml/) {
+ $data = $res->parse_xml($http_res->content);
+ } else {
+ croak "Content-Type is not either JSON or XML: " . $http_res->content_type;
+ }
+
+ for my $key (keys %$data) {
+ if ($res->can($key)) {
+ $res->$key( $data->{$key} );
+ } else {
+ $res->{$key} = $data->{$key};
+ }
+ }
+
+ $res;
+}
+
+sub parse_json {
+ my($self, $json) = @_;
+ require JSON::XS;
+ JSON::XS->new->decode($json);
+}
+
+sub parse_xml {
+ my($self, $xml) = @_;
+ require XML::LibXML::Simple;
+ XML::LibXML::Simple->new->XMLin($xml);
+}
+
+sub render {
+ my $self = shift;
+
+ if ($self->type eq 'photo') {
+ if ($self->thumbnail_url) {
+ my $element = HTML::Element->new('a', href => $self->url);
+ $element->attr(title => $self->title) if defined $self->title;
+ my $img = HTML::Element->new(
+ 'img',
+ src => $self->thumbnail_url,
+ width => $self->thumbnail_width,
+ height => $self->thumbnail_height,
+ );
+ $img->attr(alt => $self->title) if defined $self->title;
+
+ $element->push_content($img);
+ return $element->as_HTML;
+ } else {
+ my $img = HTML::Element->new(
+ 'img',
+ src => $self->url,
+ width => $self->width,
+ height => $self->height,
+ );
+ $img->attr(alt => $self->title) if defined $self->title;
+ return $img->as_HTML;
+ }
+ }
+
+ if ($self->type eq 'link') {
+ my $element = HTML::Element->new('a', href => $self->url);
+ $element->push_content(defined $self->title ? $self->title : $self->url);
+ return $element->as_HTML;
+ }
+
+ if ($self->html) {
+ return $self->html;
+ }
+}
+
+1;
4 t/00_compile.t
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'Web::oEmbed' }
34 t/01_providers.t
@@ -0,0 +1,34 @@
+use t::oEmbed;
+plan tests => 1 * blocks;
+
+use Web::oEmbed;
+
+my $consumer = Web::oEmbed->new;
+
+my $providers = read_json("t/providers.json");
+for my $provider (@$providers) {
+ $consumer->register_provider($provider);
+}
+
+run {
+ my $block = shift;
+
+ my $api_url = $consumer->request_url($block->input);
+ is( canon($api_url), canon($block->output) );
+};
+
+sub canon {
+ my $uri = URI->new(shift);
+ my %params = $uri->query_form;
+ $uri->query_form(map { $_ => $params{$_} } sort keys %params);
+ $uri;
+}
+
+__END__
+===
+--- input: http://www.flickr.com/photos/bees/2362225867/
+--- output: http://www.flickr.com/services/oembed/?url=http%3A%2F%2Fwww.flickr.com%2Fphotos%2Fbees%2F2362225867%2F&format=json
+
+===
+--- input: http://www.hulu.com/watch/20807/late-night-with-conan-obrien-wed-may-21-2008
+--- output: http://www.hulu.com/api/oembed.json?url=http%3A//www.hulu.com/watch/20807/late-night-with-conan-obrien-wed-may-21-2008
45 t/02_request.t
@@ -0,0 +1,45 @@
+use t::oEmbed;
+
+plan skip_all => "inc/.author is not there" unless -e "inc/.author";
+plan tests => 2 * blocks;
+
+use Web::oEmbed;
+
+my $consumer = Web::oEmbed->new;
+
+my $providers = read_json("t/providers.json");
+for my $provider (@$providers) {
+ $consumer->register_provider($provider);
+}
+
+run {
+ my $block = shift;
+
+ my $res1 = $consumer->embed($block->input, { format => 'json' });
+ my $res2 = $consumer->embed($block->input, { format => 'xml' });
+
+ is $res1->url, $res2->url;
+ is canon($res1->render), canon($block->html);
+};
+
+sub canon {
+ use HTML::TreeBuilder;
+ my $t = HTML::TreeBuilder->new;
+ $t->parse(shift);
+ return $t->as_HTML;
+}
+
+__END__
+===
+--- input: http://www.flickr.com/photos/bees/2362225867/
+--- html: <img src="http://farm4.static.flickr.com/3040/2362225867_4a87ab8baf.jpg" width="500" height="375" alt="Bacon Lollys" />
+
+===
+--- input: http://www.vimeo.com/757219
+--- html
+<object type="application/x-shockwave-flash" width="504" height="380" data="http://www.vimeo.com/moogaloop.swf?clip_id=757219&amp;server=www.vimeo.com&amp;fullscreen=1&amp;show_title=1&amp;show_byline=1&amp;show_portrait=1&amp;color=00ADEF">
+ <param name="quality" value="best" />
+ <param name="allowfullscreen" value="true" />
+ <param name="scale" value="showAll" />
+ <param name="movie" value="http://www.vimeo.com/moogaloop.swf?clip_id=757219&amp;server=www.vimeo.com&amp;fullscreen=1&amp;show_title=1&amp;show_byline=1&amp;show_portrait=1&amp;color=00ADEF" />
+</object>
8 t/97_podspell.t
@@ -0,0 +1,8 @@
+use Test::More;
+eval q{ use Test::Spelling };
+plan skip_all => "Test::Spelling is not installed." if $@;
+add_stopwords(<DATA>);
+all_pod_files_spelling_ok('lib');
+__DATA__
+Tatsuhiko
+Miyagawa
5 t/98_perlcritic.t
@@ -0,0 +1,5 @@
+use strict;
+use Test::More;
+eval q{ use Test::Perl::Critic };
+plan skip_all => "Test::Perl::Critic is not installed." if $@;
+all_critic_ok("lib");
4 t/99_pod.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
15 t/oEmbed.pm
@@ -0,0 +1,15 @@
+package t::oEmbed;
+use Test::Base -Base;
+
+use JSON::XS;
+
+our @EXPORT = qw( read_json );
+
+sub read_json() {
+ open my $fh, shift or die $!;
+ my $json = join '', <$fh>;
+ decode_json($json);
+}
+
+
+1;
1 t/providers.json
@@ -0,0 +1 @@
+[{"url":"http://*.flickr.com/*","api":"http://www.flickr.com/services/oembed/"},{"url":"http://*.viddler.com/*","api":"http://lab.viddler.com/services/oembed/"},{"url":"http://qik.com/video/*","api":"http://qik.com/api/oembed.{format}"},{"url":"http://*.pownce.com/*","api":"http://api.pownce.com/2.1/oembed.{format}"},{"url":"http://*.revision3.com/*","api":"http://revision3.com/api/oembed/"},{"url":"http://www.hulu.com/watch/*","api":"http://www.hulu.com/api/oembed.{format}"},{"url":"http://www.vimeo.com/*","api":"http://www.vimeo.com/api/oembed.{format}"}]
23 tools/fetch-providers.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+use strict;
+use JSON::XS;
+use Web::Scraper;
+use URI;
+
+sub extract_url { (m!(http://\S*)!)[0] }
+
+my $uri = URI->new( shift || "http://www.oembed.com/" );
+
+my $scraper = scraper {
+ process "//h3[contains(text(), 'Providers')]/following-sibling::ul", 'providers[]' => scraper {
+ process "//li[contains(text(), 'URL scheme')]", url => [ 'TEXT', \&extract_url ];
+ process "//li[contains(text(), 'endpoint') or contains(text(), 'Endpoint')]", api => [ 'TEXT', \&extract_url ];
+ };
+ result 'providers';
+};
+
+my @providers = grep { defined $_->{url} } @{ $scraper->scrape($uri) };
+print encode_json(\@providers);
+
+
+

0 comments on commit 46ecec3

Please sign in to comment.