#!/usr/bin/perl # $Id$ use strict; #use lib 'extlib'; package MapUp; use CGI::Fast; use LWP::UserAgent; use Net::Trackback::Server; use DBI qw(:sql_types); use XML::Atom::Feed; use XML::Atom::Entry; use XML::Atom::Person; use Template; our $SCREEN_XSL = 'screen.xsl'; my $geo_ns = XML::Atom::Namespace->new(geo => 'http://www.w3.org/2003/01/geo/wgs84_pos#'); *XML::Atom::Entry::geo = sub { { lat => $_[0]->get($geo_ns, 'lat'), long => $_[0]->get($geo_ns, 'long') }; }; sub new { my $class = shift; my $dbname = shift or die "No SQLite DBName provided."; my $key = shift or die "No Google Maps API key provided."; my $param = { dbh => DBI->connect('dbi:SQLite:dbname=' . $dbname, '', '', { RaiseError => 0, PrintError => 0 }), key => $key, }; bless $param, $class; } sub request { my $this = shift; $this->{cgi} = CGI::Fast->new; } # get coords feed sub get_coords { my($this, $args) = @_; my($lat, $lng) = ($args =~ m/(-?[\d.]+),(-?[\d.]+)/); my $q = $this->{cgi}; unless (defined $lat && abs($lat) <= 90 && defined $lng && abs($lng) <= 180) { print $q->header('text/html', '403 Forbidden'), "403 Forbidden\n"; return; } my $feed = $this->get_coords_feed($lat, $lng); if ($q->param('view') eq 'html') { print $q->header('text/html'); my $tmpl = get_tmpl(); my $tt = Template->new; $tt->process(\$tmpl, { lat => $lat, lng => $lng, q => $q, feed => $feed, key => $this->{key} }) or print $tt->error; } else { print $q->header('text/xml'), $feed->as_xml; } } sub get_coords_feed { my($this, $lat, $lng) = @_; my $q = $this->{cgi}; my $dbh = $this->{dbh}; my $feed = XML::Atom::Feed->new(Version => 1); # $feed->{doc}->insertProcessingInstruction('xml-stylesheet', # qq{type="text/xsl" media="screen" href="$SCREEN_XSL"}); $feed->title("MapUp coordinates ($lat,$lng)"); $feed->id('tag:' . $q->server_name . ',2006:' . $q->url(-absolute => 1, -path_info => 1)); $feed->add_link({ rel => 'self', type => 'application/atom+xml', href => $q->url(-path_info => 1) }); $feed->add_link({ rel => 'alternate', type => 'text/html', href => $q->url(-path_info => 1) . '?view=html' }); my @ts = gmtime(time); $feed->updated(sprintf('%04d-%02d-%02dT%02d:%02d:%02dZ', $ts[5]+1900, $ts[4]+1, @ts[3,2,1,0])); my $sql = "select *,(lat-$lat)*(lat-$lat)+(lng-$lng)*(lng-$lng) as dist from tbping order by dist asc, modified_on desc limit 20\n"; my $sth = $dbh->prepare($sql); my($id, $lat, $lng, $title, $excerpt, $url, $blog_name, $created_on, $modified_on, $dist); $sth->bind_columns(undef, \($id, $lat, $lng, $title, $excerpt, $url, $blog_name, $created_on, $modified_on, $dist)); $sth->execute or die "Select failed on SQL error " . $dbh->errstr; while ($sth->fetch) { my $entry = XML::Atom::Entry->new(Version => 1); $entry->title($title); $entry->summary($excerpt); $entry->id('tag:' . $q->server_name . ',2006:' . $q->script_name . '/item/' . $id); my $entry_url = $q->url . '/item/' . $id; $entry->add_link({ rel => 'alternate', type => 'text/html', href => $entry_url . '?view=html' }); $entry->add_link({ rel => 'alternate', type => 'application/atom+xml', href => $entry_url }); $entry->content(qq{$excerpt (Read more)}); $entry->content->type('xhtml'); $entry->content->elem->removeAttribute('mode'); # obsolete $created_on =~ s/ /T/; $entry->published($created_on . 'Z'); $modified_on =~ s/ /T/; $entry->updated($created_on . 'Z'); my $author = XML::Atom::Person->new(Version => 1); $author->set('name', 'nobody'); $entry->author($author); $entry->set($geo_ns, 'lat', $lat); $entry->set($geo_ns, 'long', $lng); $feed->add_entry($entry); } $sth->finish; return $feed; } # trackback sub post_coords { my($this, $args) = @_; my($lat, $lng) = ($args =~ m/(-?[\d.]+),(-?[\d.]+)/); unless (defined $lat && abs($lat) <= 90 && defined $lng && abs($lng) <= 180) { Net::Trackback::Server->send_error('error'); return; } my $q = $this->{cgi}; my $dbh = $this->{dbh}; # my $enc = $q->param('charset') # if $q->param('charset') && $q->param('charset') !~ m/utf-?8/i; my $ping = Net::Trackback::Server->receive_ping($q); # check source_url validity my $url = valid_url($ping->url); unless ($url) { Net::Trackback::Server->send_error('error'); return; } my $sql = "insert into tbping values (NULL, ?, ?, ?, ?, ?, ?, ?, ?)\n"; my $sth = $dbh->prepare($sql); $sth->bind_param(1, $lat, SQL_FLOAT); $sth->bind_param(2, $lng, SQL_FLOAT); $sth->bind_param(3, remove_html($ping->title), SQL_VARCHAR); $sth->bind_param(4, remove_html($ping->excerpt), SQL_VARCHAR); $sth->bind_param(5, $url, SQL_VARCHAR); $sth->bind_param(6, remove_html($ping->blog_name), SQL_VARCHAR); my @ts = gmtime(time); my $created_on = sprintf('%04d-%02d-%02d %02d:%02d:%02d', $ts[5]+1900, $ts[4]+1, @ts[3,2,1,0]); $sth->bind_param(7, $created_on, SQL_VARCHAR); $sth->bind_param(8, $created_on, SQL_VARCHAR); $sth->execute or die "Insert failed on SQL error " . $dbh->errstr; $sth->finish; Net::Trackback::Server->send_success($ping->id); } # get item feed sub get_item { my($this, $args) = @_; my $q = $this->{cgi}; my($id) = ($args =~ m/(\d+)/); unless ($id) { print $q->header('text/html', '403 Forbidden'), "403 Forbidden\n"; return; } my $feed = $this->get_item_feed($id); if ($q->param('view') eq 'html') { print $q->header('text/html'); my $tmpl = get_tmpl(); my $tt = Template->new; my($lat,$lng) = (35.658586,139.745450); if (scalar $feed->entries) { $lat = ($feed->entries)[0]->get($geo_ns, 'lat') || 35.658586; $lng = ($feed->entries)[0]->get($geo_ns, 'long') || 139.745450; } $tt->process(\$tmpl, { lat => $lat, lng => $lng, ,q => $q, feed => $feed, key => $this->{key} }) or print $tt->error; } else { print $q->header('text/xml'), $feed->as_xml; } } sub get_item_feed { my($this, $item_id) = @_; my $q = $this->{cgi}; my $dbh = $this->{dbh}; my $feed = XML::Atom::Feed->new(Version => 1); # $feed->{doc}->insertProcessingInstruction('xml-stylesheet', # qq{type="text/xsl" media="screen" href="$SCREEN_XSL"}); $feed->title("MapUp item ($item_id)"); $feed->id('tag:' . $q->server_name . ',2006:' . $q->url(-absolute => 1, -path_info => 1)); $feed->add_link({ rel => 'self', type => 'application/atom+xml', href => $q->url(-path_info => 1) }); $feed->add_link({ rel => 'alternate', type => 'text/html', href => $q->url(-path_info => 1) . '?view=html' }); my @ts = gmtime(time); $feed->updated(sprintf('%04d-%02d-%02dT%02d:%02d:%02dZ', $ts[5]+1900, $ts[4]+1, @ts[3,2,1,0])); my $sql = "select * from tbping where id = ?\n"; my $sth = $dbh->prepare($sql); my($id, $lat, $lng, $title, $excerpt, $url, $blog_name, $created_on, $modified_on); $sth->bind_columns(undef, \($id, $lat, $lng, $title, $excerpt, $url, $blog_name, $created_on, $modified_on)); $sth->execute($item_id) or die "Select failed on SQL error " . $dbh->errstr; while ($sth->fetch) { my $entry = XML::Atom::Entry->new(Version => 1); $entry->title($title); $entry->summary($excerpt); $entry->id('tag:' . $q->server_name . ',2006:' . $q->script_name . '/item/' . $id); my $entry_url = $q->url . '/item/' . $id; $entry->add_link({ rel => 'alternate', type => 'text/html', href => $entry_url . '?view=html' }); $entry->add_link({ rel => 'alternate', type => 'application/atom+xml', href => $entry_url }); $entry->content(qq{$excerpt (Read more)}); $entry->content->type('xhtml'); $entry->content->elem->removeAttribute('mode'); # obsolete $created_on =~ s/ /T/; $entry->published($created_on . 'Z'); $modified_on =~ s/ /T/; $entry->updated($created_on . 'Z'); my $author = XML::Atom::Person->new(Version => 1); $author->set('name', 'nobody'); $entry->author($author); $entry->set($geo_ns, 'lat', $lat); $entry->set($geo_ns, 'long', $lng); $feed->add_entry($entry); } $sth->finish; return $feed; } # delete item sub delete_item { my($this, $arg) = @_; print $this->{cgi}->header('text/html'); print shift; } sub get_tmpl { return << 'TMPL'; [% USE JavaScript -%] MapUp: Trackback/Atom-enabled Google Map

MapUp: Trackback/Atom-enabled Google Map

MapUp allows you to send a trackback ping to anywhere you want, and to retrieve Atom feeds for trackback pings recently sent to.

Trackback URL:

2006, Hirotaka Ogawa.
TMPL } sub remove_html { my $text = shift; return $text if !defined $text; $text =~ s!<[^>]+>!!gs; $text =~ s! { 'GET' => 'get_coords', 'POST' => 'post_coords', }, 'item' => { 'GET' => 'get_item', 'DELETE' => 'delete_item', }, ); my $mapup = MapUp->new('db/mapup.db', 'ABQIAAAA2SGB7kYAwJ7vNIiGUvsYgBQBbqWMXPd7ku0BIuG8sIWAUrc4NRSFo9YNTIVrCt2PqV-iwm2ShFyasQ'); while (my $q = $mapup->request()) { $q->charset('utf-8'); if ($q->path_info =~ m!^/?$!) { print $q->redirect(-uri => $q->url . '/coords/35.658586,139.745450?view=html'); next; } my (undef, $class, $args) = split('/', $q->path_info); my $method = $q->request_method; if (!exists $actions{$class}{$method}) { print $q->header('text/html', '403 Forbidden'), "403 Forbidden\n"; next; } my $meth = $actions{$class}{$method}; $mapup->$meth($args); } 1;