2D/3D Location API & Geo/GeoRSS Namespace Support

via http://plagger.org/trac/browser/branches/feature-geo

lib/Plagger/Entry.pm

@@ -10,6 +10,7 @@ use Digest::MD5;
 use DateTime::Format::Mail;
 use Storable;
 use Plagger::Util;
+use Plagger::Location;
 
 sub new {
     my $class = shift;
@@ -104,5 +105,26 @@ sub digest {
     Digest::MD5::md5_hex($data);
 }
 
+sub location {
+    my $self = shift;
+
+    if (@_ == 2) {
+        my $location = Plagger::Location->new;
+        $location->latitude($_[0]);
+        $location->longitude($_[1]);
+        $self->{location} = $location;
+    } elsif (@_ == 3) {
+        my $location = Plagger::Location->new;
+        $location->latitude($_[0]);
+        $location->longitude($_[1]);
+        $location->altitude($_[2]);
+        $self->{location} = $location;
+    } elsif (@_) {
+        $self->{location} = shift;
+    }
+
+    $self->{location};
+}
+
 1;
 

lib/Plagger/Location.pm

@@ -0,0 +1,36 @@
+package Plagger::Location;
+use strict;
+use warnings;
+
+use base qw( Class::Accessor::Fast );
+__PACKAGE__->mk_accessors( qw( address ));
+
+# XXX add datum here?
+# For now latitude/longitude should be in WGS84
+
+sub latitude {
+    my $self = shift;
+    if (@_) {
+        $self->{latitude} = shift() + 0; # numify
+    }
+    $self->{latitude};
+}
+
+sub longitude {
+    my $self = shift;
+    if (@_) {
+        $self->{longitude} = shift() + 0; # numify
+    }
+    $self->{longitude};
+}
+
+sub altitude {
+    my $self = shift;
+    if (@_) {
+        $self->{altitude} = shift() + 0; # numify
+    }
+    $self->{altitude};
+}
+
+1;
+

lib/Plagger/Plugin/Namespace/Geo.pm

@@ -0,0 +1,67 @@
+package Plagger::Plugin::Namespace::Geo;
+use strict;
+use base qw( Plagger::Plugin );
+
+sub register {
+    my($self, $context) = @_;
+    $context->register_hook(
+        $self,
+        'aggregator.entry.fixup' => \&handle,
+    );
+}
+
+sub handle {
+    my($self, $context, $args) = @_;
+    my $geo_ns = "http://www.w3.org/2003/01/geo/wgs84_pos#";
+
+    my $entry = $args->{orig_entry}->{entry};
+
+    if (ref($entry) eq 'XML::Atom::Entry') {
+        my($lat, $long, $alt) = map $entry->get($geo_ns, $_), qw( lat long alt );
+        if (defined $lat && defined $long) {
+            if (defined $alt) {
+                $args->{entry}->location($lat, $long, $alt);
+            } else {
+                $args->{entry}->location($lat, $long);
+            }
+        }
+    }
+    elsif (ref($entry) eq 'HASH') {
+        my $geo = $entry->{$geo_ns} || {};
+        $geo = $geo->{Point}->{geo} if $geo->{Point};
+        if (defined($geo->{lat}) && defined($geo->{long})) {
+            if (defined($geo->{alt})) {
+                $args->{entry}->location($geo->{lat}, $geo->{long}, $geo->{alt});
+            } else {
+                $args->{entry}->location($geo->{lat}, $geo->{long});
+            }
+        }
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Plagger::Plugin::Namespace::Geo - Extract location using Geo RDF
+
+=head1 SYNOPSIS
+
+  - module: Namespace::Geo
+
+=head1 DESCRIPTION
+
+This plugin parses the Geo tagged feed extension and store the
+longitude and latitude coordinates in the entry's location object.
+
+=head1 AUTHOR
+
+Jean-Yves Stervinou
+Tatsuhiko Miyagawa
+
+=head1 SEE ALSO
+
+L<Plagger>
+
+=cut

lib/Plagger/Plugin/Namespace/GeoRSS.pm

@@ -0,0 +1,96 @@
+package Plagger::Plugin::Namespace::GeoRSS;
+use strict;
+use base qw( Plagger::Plugin );
+
+sub register {
+    my($self, $context) = @_;
+    $context->register_hook(
+        $self,
+        'aggregator.entry.fixup' => \&handle,
+    );
+}
+
+sub handle {
+    my($self, $context, $args) = @_;
+
+    my $georss = "http://www.georss.org/georss";
+    my $gml    = "http://www.opengis.net/gml";
+
+    my $entry = $args->{orig_entry}->{entry};
+
+    if (ref($entry) eq 'XML::Atom::Entry') {
+        if (my $point = $entry->get($georss, "point")) {
+            if (my $elev = $entry->get($georss, "elev")) {
+                $self->extract_point($args->{entry}, $point, $elev);
+            } else {
+                $self->extract_point($args->{entry}, $point);
+            }
+        }
+        # XXX HACK: get LibXML node using XML::Atom internal API
+        elsif (my @where = XML::Atom::Util::nodelist($entry->elem, $georss, "where")) {
+            my($p) = $where[0]->getElementsByTagName('gml:Point');
+            if ($p) {
+                $self->extract_point($args->{entry}, $p->textContent);
+            }
+        }
+    } elsif (ref($entry) eq 'HASH') {
+        if ($entry->{$georss}) {
+            if (my $point = $entry->{$georss}->{point}) {
+                if (my $elev = $entry->{$georss}->{elev}) {
+                    $self->extract_point($args->{entry}, $point, $elev);
+                } else {
+                    $self->extract_point($args->{entry}, $point);
+                }
+            }
+            elsif (my $where = $entry->{$georss}->{where}) {
+                if (my $pos = $where->{$gml}->{Point}->{$gml}->{pos}) {
+                    $self->extract_point($args->{entry}, $pos);
+                }
+            }
+        }
+    }
+}
+
+sub extract_point {
+    my($self, $entry, $point, $elev) = @_;
+    $point =~ s/^\s+|\s+$//g;
+    $elev =~ s/^\s+|\s+$//g;
+    my($lat, $lon, $alt) = split /\s+/, $point, 3;
+    if (length $lat && length $lon) {
+        if (length $elev) {
+            $entry->location($lat, $lon, $elev);
+        } elsif (length $alt) {
+            $entry->location($lat, $lon, $alt);
+        } else {
+            $entry->location($lat, $lon);
+        }
+    }
+}
+
+1;
+__END__
+
+=for stopwords GeoRSS GML
+
+=head1 NAME
+
+Plagger::Plugin::Namespace::GeoRSS - GeoRSS module extension
+
+=head1 SYNOPSIS
+
+  - module: Namespace::GeoRSS
+
+=head1 DESCRIPTION
+
+This plugin extracts Geo location information using GeoRSS
+extension. It supports both Simple and GML notation of location point.
+
+=head1 AUTHOR
+
+Tatsuhiko Miyagawa
+
+=head1 SEE ALSO
+
+L<Plagger>, L<http://www.georss.org/>
+
+=cut