package Bookmarks; use Moose; use SQL::Interp qw{:all}; use URI; use Bookmark; use Bookmarks::Search; has dbh => ( is => 'rw' ); has base_uri => ( is => 'ro', isa => 'URI' ); has _sth_tags_from_uri => ( is => 'ro', init_arg => undef, lazy => 1, default => sub { $_[0]->dbh->prepare('select tag from tags where uri = ? order by tag'); }, ); sub BUILD { my $self = shift; my $args = shift; if (!$self->dbh) { if ($args->{dbname}) { require DBI; $self->dbh(DBI->connect("dbi:SQLite:dbname=$$args{dbname}", "", "", { RaiseError => 1, PrintError => 0 })); # enable foreign key support (requires DBD::SQLite 1.26_05 or above (sqlite 3.6.19 or above)) $self->dbh->do('pragma foreign_keys = on;'); } else { #TODO: figure out how to make croak play nice with Moose to get the user-visible caller line die "No dbh or dbname specified in the constructor"; } } } sub create_tables { my $self = shift; require File::Slurp; require File::Basename; my $table_definitions = File::Slurp::read_file(File::Basename::dirname($INC{'Bookmarks.pm'}) . "/../bookmarks.sql"); $self->dbh->{sqlite_allow_multiple_statements} = 1; $self->dbh->do($table_definitions); $self->dbh->{sqlite_allow_multiple_statements} = 0; return $self; } sub get_bookmark { my $self = shift; my $params = shift; # look for bookmark by id or uri 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; return unless $bookmark; return Bookmark->new({ %$bookmark, exists => 1, tags => [ $self->get_tags({ uri => $bookmark->{uri} }) ], base_uri => $self->base_uri, collection => $self, }); } sub _sql_where_clause { my $self = shift; my $search = shift; # build the where clause my @sql; if (@{ $search->tags }) { push @sql, 'where resources.uri in'; # subquery to find tagged URIs push @sql, '('; my $intersect = 0; for my $tag (@{ $search->tags }) { push @sql, 'intersect' if $intersect; push @sql, 'select uri from tags where tag =', \$tag; $intersect++; } push @sql, ')'; } if ($search->query) { my $fuzzy_match = '%' . $search->query . '%'; push @sql, (@{ $search->tags } ? 'and' : 'where'), 'title like', \$fuzzy_match; } return @sql; } sub search { my $self = shift; my $params = shift || {}; my $search = Bookmarks::Search->new($params); # build the query my @sql; push @sql, 'select * from resources join bookmarks on resources.uri = bookmarks.uri'; push @sql, $self->_sql_where_clause($search); push @sql, 'order by ctime desc'; push @sql, ('limit', \$search->limit) if $search->limit; # an offset is only allowed if we have a limit clause push @sql, ('offset', \$search->offset) if $search->limit && $search->offset; my ($sql, @bind) = sql_interp(@sql); my $sth_resource = $self->dbh->prepare($sql); $sth_resource->execute(@bind); my @resources; while (my $resource = $sth_resource->fetchrow_hashref) { push @resources, Bookmark->new({ %$resource, exists => 1, tags => [ $self->get_tags({ uri => $resource->{uri} }) ], base_uri => $self->base_uri, collection => $self, }); } $search->results(\@resources); return $search; } sub get_tags { my $self = shift; my $params = shift; if (my $uri = $params->{uri}) { # get the tags for a particular URI $self->_sth_tags_from_uri->execute($uri); return map { $$_[0] } @{ $self->_sth_tags_from_uri->fetchall_arrayref }; } else { # return all tags 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 $search = $params->{search}; my @sql; push @sql, 'select tag, count(tag) as count from tags'; push @sql, 'join resources on tags.uri = resources.uri' if $search->query; # build the where clause if (@{ $search->tags }) { push @sql, 'where tags.uri in ('; my $intersect = 0; for my $tag (@{ $search->tags }) { push @sql, 'intersect' if $intersect; push @sql, 'select uri from tags where tag = ', \$tag; $intersect++; } push @sql, ') and tag not in ', $search->tags, ''; } if ($search->query) { my $fuzzy_match = '%' . $search->query . '%'; push @sql, (@{ $search->tags } ? 'and' : 'where'), 'title like', \$fuzzy_match; } push @sql, 'group by tag order by tag'; my ($sql, @bind) = sql_interp(@sql); my $sth = $self->dbh->prepare($sql); $sth->execute(@bind); return @{ $sth->fetchall_arrayref({}) }; } sub get_last_modified_time { my $self = shift; my $sth = $self->dbh->prepare('select mtime from bookmarks order by mtime desc limit 1'); $sth->execute; my ($mtime) = $sth->fetchrow_array; return $mtime; } sub add { my $self = shift; my $bookmark = shift; #TODO: accept a pre-made Bookmark object in addition to a hash my $uri = $bookmark->{uri}; my $title = $bookmark->{title}; my $ctime = $bookmark->{ctime} || time; my $mtime = $bookmark->{mtime} || $ctime; my $id = $bookmark->{id}; # 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 $bookmark_exists = 0; my ($sql_bookmark, @bind_bookmark) = sql_interp( 'insert into bookmarks', { ($id ? (id => $id) : ()), uri => $uri, ctime => $ctime, mtime => $mtime } ); my $sth_bookmark = $self->dbh->prepare($sql_bookmark); eval { $sth_bookmark->execute(@bind_bookmark); }; if ($@) { if ($@ =~ /column uri is not unique/) { # this is not truly an error condition; the bookmark was already there # set this flag so that later we can update the mtime if tags change $bookmark_exists = 1; } else { die $@; } } my $changed_tags = $self->_update_tags($uri, $bookmark->{tags}); if ($bookmark_exists && $changed_tags) { # update the mtime if the bookmark already existed but the tags were changed my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?'); $sth_update->execute($mtime, $uri); } # return the newly created or updated bookmark return $self->get_bookmark({ uri => $uri }); } sub update { my $self = shift; my $bookmark = shift; my $mtime = time; # update the URI, if it has changed my $changed_uri = 0; my $sth_current = $self->dbh->prepare('select uri from bookmarks where id = ?'); $sth_current->execute($bookmark->id); my ($stored_uri) = $sth_current->fetchrow_array; if ($stored_uri ne $bookmark->uri) { # the URI has changed my $sth_update_uri = $self->dbh->prepare('update resources set uri = ? where uri = ?'); $sth_update_uri->execute($bookmark->uri, $stored_uri); $changed_uri++; } # update the title, if it has changed my $changed_title = 0; my $sth_current_title = $self->dbh->prepare('select title from resources where uri = ?'); $sth_current_title->execute($bookmark->uri); my ($stored_title) = $sth_current_title->fetchrow_array; if ($stored_title ne $bookmark->title) { my $sth_update = $self->dbh->prepare('update resources set title = ? where uri = ?'); $sth_update->execute($bookmark->title, $bookmark->uri); $changed_title++; } # update the tags, if they have changed my $changed_tags = $self->_update_tags($bookmark->uri, $bookmark->tags); # update the mtime, if the bookmark has actually been changed if ($changed_uri or $changed_title or $changed_tags) { # update the mtime if the bookmark already existed but the tags were changed my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?'); $sth_update->execute($mtime, $bookmark->uri); } # return the bookmark return $bookmark; } sub _update_tags { my $self = shift; my ($uri, $tags) = @_; my $changed_tags = 0; my %new_tags = map { $_ => 1 } @{ $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); $changed_tags++; } 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); $changed_tags++; } # how many tags have changed? return $changed_tags; } # module returns true 1;