Index: /trunk/Bookmark.pm =================================================================== --- /trunk/Bookmark.pm (revision 2) +++ /trunk/Bookmark.pm (revision 2) @@ -0,0 +1,11 @@ +package Bookmark; + +use Class::Accessor qw{antlers}; + +has id => ( is => 'ro' ); +has uri => ( is => 'ro' ); +has ctime => ( is => 'ro' ); +has mtime => ( is => 'ro' ); + +# module return +1; Index: /trunk/Bookmarks.pm =================================================================== --- /trunk/Bookmarks.pm (revision 2) +++ /trunk/Bookmarks.pm (revision 2) @@ -0,0 +1,161 @@ +package Bookmarks; + +use Class::Accessor 'antlers'; +use Bookmark; + +has dbh => ( is => 'ro'); + +sub get_bookmark { + my $self = shift; + my $params = shift; + my $sth; + if ($params->{id}) { + $sth = $self->dbh->prepare('select id,resources.uri,title,ctime,mtime from bookmarks join resources on bookmarks.uri=resources.uri where id=?'); + $sth->execute($params->{id}); + } elsif ($params->{uri}) { + $sth = $self->dbh->prepare('select id,resources.uri,title,ctime,mtime from bookmarks join resources on bookmarks.uri=resources.uri where resources.uri=?'); + $sth->execute($params->{uri}); + } else { + die "Must specify either id or uri"; + } + my $bookmark = $sth->fetchrow_hashref; + if ($bookmark) { + my $sth_tag = $self->dbh->prepare('select tag from tags where uri = ? order by tag'); + $sth_tag->execute($bookmark->{uri}); + $bookmark->{tags} = [ map { $$_[0] } @{ $sth_tag->fetchall_arrayref } ]; + } + return $bookmark; +} + +sub get_resources { + my $self = shift; + my $params = shift; + my $tag = $params->{tag}; + my $sth_resource; + if ($tag) { + $sth_resource = $self->dbh->prepare('select * from resources join tags on resources.uri = tags.uri join bookmarks on resources.uri = bookmarks.uri where tags.tag = ? order by ctime desc'); + $sth_resource->execute($tag); + } else { + $sth_resource = $self->dbh->prepare('select * from resources join bookmarks on resources.uri = bookmarks.uri order by ctime desc'); + $sth_resource->execute; + } + + my $sth_tag = $self->dbh->prepare('select tag from tags where uri = ? order by tag'); + my @resources; + while (my $resource = $sth_resource->fetchrow_hashref) { + $sth_tag->execute($resource->{uri}); + $resource->{tags} = [ map { $$_[0] } @{ $sth_tag->fetchall_arrayref } ]; + push @resources, $resource; + } + return @resources; +} + +sub get_tags { + my $self = shift; + my $params = shift; + my $tag = $params->{selected}; + my $sth_all_tags = $self->dbh->prepare('select tag, count(tag) as count, tag = ? as selected from tags group by tag order by tag'); + $sth_all_tags->execute($tag); + my $all_tags = $sth_all_tags->fetchall_arrayref({}); + return @{ $all_tags }; +} + +sub get_cotags { + my $self = shift; + my $params = shift; + my $tag = $params->{tag}; + my $sth = $self->dbh->prepare('select tag, count(tag) as count from tags where tag != ? and uri in (select uri from tags where tag = ?) group by tag order by tag'); + $sth->execute($tag, $tag); + return @{ $sth->fetchall_arrayref({}) }; +} + +sub add { + my $self = shift; + my $bookmark = shift; + + my $uri = $bookmark->{uri}; + my $title = $bookmark->{title}; + #TODO: accept a ctime or mtime + my $mtime = my $ctime = $bookmark->{ctime} || time; + + # create an entry for the resource + my $sth_resource = $self->dbh->prepare('insert into resources (uri, title) values (?, ?)'); + eval { + $sth_resource->execute($uri, $title); + }; + if ($@) { + if ($@ =~ /column uri is not unique/) { + # this is not truly an error condition; the resource is already listed + # update the title instead + my $sth_update = $self->dbh->prepare('update resources set title = ? where uri = ?'); + $sth_update->execute($title, $uri); + } else { + die $@; + } + } + + # create the bookmark + my $sth_bookmark = $self->dbh->prepare('insert into bookmarks (uri, ctime, mtime) values (?, ?, ?)'); + eval { + $sth_bookmark->execute($uri, $ctime, $mtime); + }; + if ($@) { + if ($@ =~ /column uri is not unique/) { + # this is not truly an error condition; the bookmark was already there + # update the mtime instead + # TODO: only update mtime if the tag list is changed? + my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?'); + $sth_update->execute($mtime, $uri); + } else { + die $@; + } + } + + my %new_tags = map { $_ => 1 } @{ $bookmark->{tags} }; + my $sth_delete_tag = $self->dbh->prepare('delete from tags where uri = ? and tag = ?'); + my $sth_insert_tag = $self->dbh->prepare('insert into tags (uri, tag) values (?, ?)'); + my $sth_current_tags = $self->dbh->prepare('select tag from tags where uri = ?'); + $sth_current_tags->execute($uri); + while (my ($tag) = $sth_current_tags->fetchrow_array) { + if (!$new_tags{$tag}) { + # if a current tag is not in the new tags, remove it from the database + $sth_delete_tag->execute($uri, $tag); + } else { + # if a new tag is already in the database, remove it from the list of tags to add + delete $new_tags{$tag}; + } + } + for my $tag (keys %new_tags) { + $sth_insert_tag->execute($uri, $tag); + } + +=begin + + # clear all tags + my $sth_delete_tag = $self->dbh->prepare('delete from tags where uri = ?'); + $sth_delete_tag->execute($uri); + my $sth_tag = $self->dbh->prepare('insert into tags (uri, tag) values (?, ?)'); + for my $tag (@{ $bookmark->{tags} }) { + #print $tag, "\n"; + # prevent duplicate (uri,tag) pairs in the database + # TODO: should POST with a set of tags ever remove tags? + eval { + $sth_tag->execute($uri, $tag); + }; + if ($@) { + if ($@ =~ /columns uri, tag are not unique/) { + # this is not truly an error condition; the tag was already there + } else { + die $@; + } + } + } + +=cut + + # return the newly created or updated bookmark + return $self->get_bookmark({ uri => $uri }); +} + +# module returns true +1; Index: /trunk/bkmk =================================================================== --- /trunk/bkmk (revision 2) +++ /trunk/bkmk (revision 2) @@ -0,0 +1,38 @@ +#!/usr/bin/perl -w +use strict; + +use DBI; +use YAML; +use Bookmarks; + +my $dbname = 'new.db'; + +my $dbh = DBI->connect("dbi:SQLite:dbname=$dbname", "", "", { RaiseError => 1, PrintError => 0 }); + +my $bookmarks = Bookmarks->new({ + dbh => $dbh, +}); + +my $command = shift; + +my %action_for = ( + get => sub { + my $identifier = shift; + my $query = $identifier =~ /^\d+$/ ? { id => $identifier } : { uri => $identifier }; + my $bookmark = $bookmarks->get_bookmark($query); + + print $bookmark ? Dump($bookmark) : "Not Found\n"; + }, + add => sub { + my ($uri, $title, @tags) = @_; + my $bookmark = $bookmarks->add({ uri => $uri, title => $title, tags => \@tags }); + print Dump($bookmark); + }, +); + +$action_for{$command}->(@ARGV); + +=begin + +use YAML; + Index: /trunk/bookmark.tt =================================================================== --- /trunk/bookmark.tt (revision 2) +++ /trunk/bookmark.tt (revision 2) @@ -0,0 +1,75 @@ + + + Bookmark: [% title or uri %] + + + +
+ [% UNLESS exists %] + New bookmark: + [% END %] + [% title or uri %] + [% IF exists %] +

[% created %]

+ [% IF tags.size %] +

Tagged as: + [% FOREACH tag IN tags %] + [% tag %] + [% END %] +

+ [% END %] + [% END %] +
+ + + + + + + + + + + + + + + + + +
URI: + +
Title: + +
Tags: + +
+ +
+
+
+ + + + + Index: /trunk/bookmarks.sql =================================================================== --- /trunk/bookmarks.sql (revision 2) +++ /trunk/bookmarks.sql (revision 2) @@ -0,0 +1,55 @@ +drop table if exists tags; +drop table if exists resources; +drop table if exists bookmarks; + +-- bookmarks of resources +-- each resource can only have one bookmark +-- bookmarks have creation and modification times +create table bookmarks ( + id integer primary key, + uri varchar, + ctime integer, -- creation time of the bookmark + mtime integer, -- modification time of the bookmark + constraint unique_uri unique (uri) +); + +-- resources by URI +-- this is where we would store information about the resource, +-- such as its title, last known status, etc. +create table resources ( + uri varchar primary key, + title varchar -- URI title (e.g., page title) +); + +/* old resources table +create table resources ( + uri varchar primary key, + title varchar, -- URI title (e.g., page title) + ctime integer, -- creation time of the bookmark + mtime integer -- modification time of the bookmark +); +*/ + +-- tags that describe the resource +-- TODO: machine-tag style tags? e.g. format:video or creator:NASA; implicit tag prefix is "subject:" +create table tags ( + uri varchar, + tag varchar, + constraint unique_tag primary key (uri, tag) +); + +/* +create a new resource: +insert into resources (uri, title) values ('http://echodin.net/', 'More Space'); + +create a bookmark of that resource: +insert into bookmarks (uri, ctime, mtime) values ('http://echodin.net/', 1323407821, 1323407821); + +tag that resource: +insert into tags (uri, tag) values ('http://echodin.net/', 'homepage'); + +The resource's primary key is the URI. The bookmark id identifies the bookmark only, NOT the bookmarked resource + +get the bookmark and its resource values +select id,resources.uri,title,ctime,mtime from bookmarks join resources on bookmarks.uri=resources.uri where id=1; +*/ Index: /trunk/import =================================================================== --- /trunk/import (revision 2) +++ /trunk/import (revision 2) @@ -0,0 +1,41 @@ +#!/usr/bin/perl -w +use strict; + +use XML::XPath; +use DBI; +use YAML; +use Time::Local; + +my $xpath = XML::XPath->new(filename => 'delicious.xml'); + +my $nodeset = $xpath->find('/posts/post'); + +binmode(STDOUT, ":utf8"); + +use Bookmarks; +my $bookmarks = Bookmarks->new({ + dbh => DBI->connect("dbi:SQLite:dbname=bookmarks.db", "", "", { RaiseError => 1 }) +}); + +foreach my $node ($nodeset->get_nodelist) { + my $timestamp = $node->getAttribute('time'); + my ($year, $month, $day, $hour, $minute, $second) = ($timestamp =~ /^(\d\d\d\d)-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)Z$/); + my $ctime = timegm($second, $minute, $hour, $day, $month - 1, $year); + my %bookmark = ( + uri => $node->getAttribute('href'), + title => sanitize($node->getAttribute('description')), + tags => [ split ' ', $node->getAttribute('tag') ], + ctime => $ctime, + ); + print Dump(\%bookmark); + #TODO: UTF-8 issues + $bookmarks->add(\%bookmark); +} + + +# strip out Unicode control characters that are showing up in YouTube link titles +sub sanitize { + my $string = shift; + $string =~ s/[\x{202a}\x{202c}\x{200f}]//g; + return $string; +} Index: /trunk/index.cgi =================================================================== --- /trunk/index.cgi (revision 2) +++ /trunk/index.cgi (revision 2) @@ -0,0 +1,158 @@ +#!/usr/bin/perl -w +use strict; + +use Encode; +use URI; +use CGI; +use YAML; +use DBI; +use Template; +use JSON; +use Bookmarks; + +my $q = CGI->new; +my $template = Template->new; + +my $method = $ENV{REQUEST_METHOD}; + +# bookmarklet to add a bookmark via the browser +# javascript:(function(){window.open("http://grim.ath.cx/~peter/bookmarks?uri="+document.location+"&title="+document.title,"edit_bookmark","width=800,height=250")})() + +my $dbname = 'new.db'; +my $dbh = DBI->connect("dbi:SQLite:dbname=$dbname", "", "", { RaiseError => 1 }); + +my $bookmarks = Bookmarks->new({ + dbh => $dbh, +}); + +=begin new style? + +if ($ENV{PATH_INFO} =~ m{^/(\d+)(?:/(uri|title|tags))?\b}) { + require Resource::Bookmark; + my $resource = Resource::Bookmark->new({ + q => $q, + id => $1, + field => $2, + bookmarks => $bookmarks, + }); + $resource->$method(); +} +exit; + +=cut + +my %resource = ( + GET => sub { + my ($q, $dbh) = @_; + if ($ENV{PATH_INFO} =~ m{^/(\d+)(?:/(uri|title|tags))?\b}) { + my $id = $1; + my $field = $2; + my $bookmark = $bookmarks->get_bookmark({ id => $id }); + if ($bookmark) { + if ($field) { + print $q->header( + -type => 'text/plain', + -charset => 'UTF-8', + ); + my $value = $bookmark->{$field}; + print ref $value eq 'ARRAY' ? join(',', @{ $value }) : $value; + } else { + $bookmark->{exists} = 1; + $bookmark->{created} = "Created " . localtime($bookmark->{ctime}); + $bookmark->{created} .= '; Updated ' . localtime($bookmark->{mtime}) unless $bookmark->{ctime} == $bookmark->{mtime}; + print $q->header( + -type => 'text/html', + -charset => 'UTF-8', + ); + $template->process( + 'bookmark.tt', + $bookmark + ); + } + } else { + print $q->header( + -type => 'text/html', + -charset => 'UTF-8', + -status => 404, + ); + print "Not Found"; + } + } elsif (defined(my $uri = $q->param('uri'))) { + my $bookmark = $bookmarks->get_bookmark({ uri => $uri }); + if ($bookmark) { + #TODO: is there a better base URL to use? + print $q->redirect($q->url . '/' . $bookmark->{id}); + } else { + # bookmark was not found; show the form to create a new bookmark + $bookmark->{uri} = $uri; + $bookmark->{title} = $q->param('title'); + print $q->header( + -type => 'text/html', + -charset => 'UTF-8', + -status => 404, + ); + $template->process( + 'bookmark.tt', + $bookmark + ); + } + } else { + #print $q->header('text/html'); + #print "TODO: list bookmarks"; + #return; + # list all the resources + my $format = $q->param('format'); + my $tag = $q->param('tag'); + my @resources = $bookmarks->get_resources({ tag => $tag }); + my @all_tags = $bookmarks->get_tags({ selected => $tag }); + my @cotags = $bookmarks->get_cotags({ tag => $tag }); + + if ($format eq 'json') { + print $q->header( + -type => 'application/json', + -charset => 'UTF-8', + ); + print decode_utf8( + encode_json({ + resources => \@resources, + }) + ); + } else { + print $q->header( + -type => 'text/html', + -charset => 'UTF-8', + ); + $template->process( + 'list.tt', + { + selected_tag => $tag, + tags => \@all_tags, + cotags => \@cotags, + resources => \@resources, + }, + ); + } + } + }, + POST => sub { + #TODO: deal with changing URIs + my ($q, $dbh) = @_; + my $uri = $q->param('uri'); + my $title = $q->param('title'); + my @tags = split ' ', $q->param('tags'); + $bookmarks->add({ + uri => $uri, + title => $title, + tags => \@tags, + }); + + my $location = URI->new($q->url); + $location->query_form(uri => $uri) if defined $q->url_param('uri'); + $location->fragment('updated'); + print $q->redirect($ENV{REQUEST_URI}); #$location); + }, +); + +$resource{$method}->($q, $dbh); + + Index: /trunk/list.tt =================================================================== --- /trunk/list.tt (revision 2) +++ /trunk/list.tt (revision 2) @@ -0,0 +1,88 @@ + + + Bookmarks + + + +
+ + +
+ [% IF selected_tag %] +

+ [% selected_tag %] links +

+ [% END %] + + +

+ New Bookmark +

+
+ [% IF selected_tag %] + + [% END %] +
+ +
+
+ + + +