[2] | 1 | package Bookmarks; |
---|
| 2 | |
---|
[15] | 3 | use Moose; |
---|
[71] | 4 | |
---|
[9] | 5 | use SQL::Interp qw{:all}; |
---|
[24] | 6 | use URI; |
---|
[71] | 7 | |
---|
[2] | 8 | use Bookmark; |
---|
[71] | 9 | use Bookmarks::Search; |
---|
[2] | 10 | |
---|
[15] | 11 | has dbh => ( is => 'rw' ); |
---|
[24] | 12 | has base_uri => ( is => 'ro', isa => 'URI' ); |
---|
[2] | 13 | |
---|
[25] | 14 | has _sth_tags_from_uri => ( |
---|
| 15 | is => 'ro', |
---|
| 16 | init_arg => undef, |
---|
| 17 | lazy => 1, |
---|
| 18 | default => sub { $_[0]->dbh->prepare('select tag from tags where uri = ? order by tag'); }, |
---|
| 19 | ); |
---|
| 20 | |
---|
[15] | 21 | sub BUILD { |
---|
| 22 | my $self = shift; |
---|
| 23 | my $args = shift; |
---|
| 24 | |
---|
| 25 | if (!$self->dbh) { |
---|
| 26 | if ($args->{dbname}) { |
---|
| 27 | require DBI; |
---|
| 28 | $self->dbh(DBI->connect("dbi:SQLite:dbname=$$args{dbname}", "", "", { RaiseError => 1, PrintError => 0 })); |
---|
| 29 | # enable foreign key support (requires DBD::SQLite 1.26_05 or above (sqlite 3.6.19 or above)) |
---|
| 30 | $self->dbh->do('pragma foreign_keys = on;'); |
---|
| 31 | } else { |
---|
| 32 | #TODO: figure out how to make croak play nice with Moose to get the user-visible caller line |
---|
| 33 | die "No dbh or dbname specified in the constructor"; |
---|
| 34 | } |
---|
| 35 | } |
---|
| 36 | } |
---|
| 37 | |
---|
[47] | 38 | sub create_tables { |
---|
| 39 | my $self = shift; |
---|
| 40 | require File::Slurp; |
---|
[92] | 41 | require File::Basename; |
---|
| 42 | my $table_definitions = File::Slurp::read_file(File::Basename::dirname($INC{'Bookmarks.pm'}) . "/../bookmarks.sql"); |
---|
[47] | 43 | $self->dbh->{sqlite_allow_multiple_statements} = 1; |
---|
| 44 | $self->dbh->do($table_definitions); |
---|
| 45 | $self->dbh->{sqlite_allow_multiple_statements} = 0; |
---|
| 46 | return $self; |
---|
| 47 | } |
---|
| 48 | |
---|
[2] | 49 | sub get_bookmark { |
---|
| 50 | my $self = shift; |
---|
| 51 | my $params = shift; |
---|
[25] | 52 | |
---|
| 53 | # look for bookmark by id or uri |
---|
[2] | 54 | my $sth; |
---|
| 55 | if ($params->{id}) { |
---|
| 56 | $sth = $self->dbh->prepare('select id,resources.uri,title,ctime,mtime from bookmarks join resources on bookmarks.uri=resources.uri where id=?'); |
---|
| 57 | $sth->execute($params->{id}); |
---|
| 58 | } elsif ($params->{uri}) { |
---|
| 59 | $sth = $self->dbh->prepare('select id,resources.uri,title,ctime,mtime from bookmarks join resources on bookmarks.uri=resources.uri where resources.uri=?'); |
---|
| 60 | $sth->execute($params->{uri}); |
---|
| 61 | } else { |
---|
| 62 | die "Must specify either id or uri"; |
---|
| 63 | } |
---|
| 64 | my $bookmark = $sth->fetchrow_hashref; |
---|
[25] | 65 | return unless $bookmark; |
---|
| 66 | |
---|
| 67 | return Bookmark->new({ |
---|
| 68 | %$bookmark, |
---|
[75] | 69 | exists => 1, |
---|
| 70 | tags => [ $self->get_tags({ uri => $bookmark->{uri} }) ], |
---|
| 71 | base_uri => $self->base_uri, |
---|
| 72 | collection => $self, |
---|
[25] | 73 | }); |
---|
[2] | 74 | } |
---|
| 75 | |
---|
[78] | 76 | sub _sql_where_clause { |
---|
[2] | 77 | my $self = shift; |
---|
[78] | 78 | my $search = shift; |
---|
[2] | 79 | |
---|
[78] | 80 | # build the where clause |
---|
[20] | 81 | my @sql; |
---|
[71] | 82 | if (@{ $search->tags }) { |
---|
[78] | 83 | push @sql, 'where resources.uri in'; |
---|
| 84 | # subquery to find tagged URIs |
---|
| 85 | push @sql, '('; |
---|
[20] | 86 | my $intersect = 0; |
---|
[71] | 87 | for my $tag (@{ $search->tags }) { |
---|
[20] | 88 | push @sql, 'intersect' if $intersect; |
---|
[78] | 89 | push @sql, 'select uri from tags where tag =', \$tag; |
---|
[20] | 90 | $intersect++; |
---|
| 91 | } |
---|
[78] | 92 | push @sql, ')'; |
---|
[20] | 93 | } |
---|
[71] | 94 | if ($search->query) { |
---|
| 95 | my $fuzzy_match = '%' . $search->query . '%'; |
---|
| 96 | push @sql, (@{ $search->tags } ? 'and' : 'where'), 'title like', \$fuzzy_match; |
---|
[52] | 97 | } |
---|
[78] | 98 | return @sql; |
---|
| 99 | } |
---|
| 100 | |
---|
[88] | 101 | sub search { |
---|
[78] | 102 | my $self = shift; |
---|
| 103 | my $params = shift || {}; |
---|
| 104 | my $search = Bookmarks::Search->new($params); |
---|
| 105 | |
---|
| 106 | # build the query |
---|
| 107 | my @sql; |
---|
| 108 | |
---|
| 109 | push @sql, 'select * from resources join bookmarks on resources.uri = bookmarks.uri'; |
---|
| 110 | push @sql, $self->_sql_where_clause($search); |
---|
[20] | 111 | push @sql, 'order by ctime desc'; |
---|
[71] | 112 | push @sql, ('limit', \$search->limit) if $search->limit; |
---|
[20] | 113 | # an offset is only allowed if we have a limit clause |
---|
[71] | 114 | push @sql, ('offset', \$search->offset) if $search->limit && $search->offset; |
---|
[20] | 115 | |
---|
| 116 | my ($sql, @bind) = sql_interp(@sql); |
---|
| 117 | |
---|
[9] | 118 | my $sth_resource = $self->dbh->prepare($sql); |
---|
| 119 | $sth_resource->execute(@bind); |
---|
| 120 | |
---|
[2] | 121 | my @resources; |
---|
| 122 | while (my $resource = $sth_resource->fetchrow_hashref) { |
---|
[25] | 123 | push @resources, Bookmark->new({ |
---|
| 124 | %$resource, |
---|
[75] | 125 | exists => 1, |
---|
| 126 | tags => [ $self->get_tags({ uri => $resource->{uri} }) ], |
---|
| 127 | base_uri => $self->base_uri, |
---|
| 128 | collection => $self, |
---|
[25] | 129 | }); |
---|
[2] | 130 | } |
---|
[88] | 131 | $search->results(\@resources); |
---|
| 132 | |
---|
| 133 | return $search; |
---|
[2] | 134 | } |
---|
| 135 | |
---|
| 136 | sub get_tags { |
---|
| 137 | my $self = shift; |
---|
| 138 | my $params = shift; |
---|
[25] | 139 | if (my $uri = $params->{uri}) { |
---|
| 140 | # get the tags for a particular URI |
---|
| 141 | $self->_sth_tags_from_uri->execute($uri); |
---|
| 142 | return map { $$_[0] } @{ $self->_sth_tags_from_uri->fetchall_arrayref }; |
---|
| 143 | } else { |
---|
| 144 | # return all tags |
---|
| 145 | my $tag = $params->{selected}; |
---|
| 146 | my $sth_all_tags = $self->dbh->prepare('select tag, count(tag) as count, tag = ? as selected from tags group by tag order by tag'); |
---|
| 147 | $sth_all_tags->execute($tag); |
---|
| 148 | my $all_tags = $sth_all_tags->fetchall_arrayref({}); |
---|
| 149 | return @{ $all_tags }; |
---|
| 150 | } |
---|
[2] | 151 | } |
---|
| 152 | |
---|
| 153 | sub get_cotags { |
---|
| 154 | my $self = shift; |
---|
| 155 | my $params = shift; |
---|
[71] | 156 | my $search = $params->{search}; |
---|
| 157 | |
---|
[20] | 158 | my @sql; |
---|
| 159 | |
---|
| 160 | push @sql, 'select tag, count(tag) as count from tags'; |
---|
[71] | 161 | push @sql, 'join resources on tags.uri = resources.uri' if $search->query; |
---|
[52] | 162 | |
---|
| 163 | # build the where clause |
---|
[71] | 164 | if (@{ $search->tags }) { |
---|
[52] | 165 | push @sql, 'where tags.uri in ('; |
---|
[20] | 166 | my $intersect = 0; |
---|
[71] | 167 | for my $tag (@{ $search->tags }) { |
---|
[20] | 168 | push @sql, 'intersect' if $intersect; |
---|
| 169 | push @sql, 'select uri from tags where tag = ', \$tag; |
---|
| 170 | $intersect++; |
---|
| 171 | } |
---|
[71] | 172 | push @sql, ') and tag not in ', $search->tags, ''; |
---|
[20] | 173 | } |
---|
[71] | 174 | if ($search->query) { |
---|
| 175 | my $fuzzy_match = '%' . $search->query . '%'; |
---|
| 176 | push @sql, (@{ $search->tags } ? 'and' : 'where'), 'title like', \$fuzzy_match; |
---|
[52] | 177 | } |
---|
| 178 | |
---|
[20] | 179 | push @sql, 'group by tag order by tag'; |
---|
| 180 | |
---|
| 181 | my ($sql, @bind) = sql_interp(@sql); |
---|
| 182 | my $sth = $self->dbh->prepare($sql); |
---|
| 183 | $sth->execute(@bind); |
---|
[2] | 184 | return @{ $sth->fetchall_arrayref({}) }; |
---|
| 185 | } |
---|
| 186 | |
---|
[57] | 187 | sub get_last_modified_time { |
---|
| 188 | my $self = shift; |
---|
| 189 | my $sth = $self->dbh->prepare('select mtime from bookmarks order by mtime desc limit 1'); |
---|
| 190 | $sth->execute; |
---|
| 191 | my ($mtime) = $sth->fetchrow_array; |
---|
| 192 | return $mtime; |
---|
| 193 | } |
---|
| 194 | |
---|
[2] | 195 | sub add { |
---|
| 196 | my $self = shift; |
---|
| 197 | my $bookmark = shift; |
---|
| 198 | |
---|
[75] | 199 | #TODO: accept a pre-made Bookmark object in addition to a hash |
---|
[2] | 200 | my $uri = $bookmark->{uri}; |
---|
| 201 | my $title = $bookmark->{title}; |
---|
[15] | 202 | my $ctime = $bookmark->{ctime} || time; |
---|
| 203 | my $mtime = $bookmark->{mtime} || $ctime; |
---|
| 204 | my $id = $bookmark->{id}; |
---|
[2] | 205 | |
---|
| 206 | # create an entry for the resource |
---|
| 207 | my $sth_resource = $self->dbh->prepare('insert into resources (uri, title) values (?, ?)'); |
---|
| 208 | eval { |
---|
| 209 | $sth_resource->execute($uri, $title); |
---|
| 210 | }; |
---|
| 211 | if ($@) { |
---|
| 212 | if ($@ =~ /column uri is not unique/) { |
---|
| 213 | # this is not truly an error condition; the resource is already listed |
---|
| 214 | # update the title instead |
---|
| 215 | my $sth_update = $self->dbh->prepare('update resources set title = ? where uri = ?'); |
---|
| 216 | $sth_update->execute($title, $uri); |
---|
| 217 | } else { |
---|
| 218 | die $@; |
---|
| 219 | } |
---|
| 220 | } |
---|
| 221 | |
---|
| 222 | # create the bookmark |
---|
[28] | 223 | my $bookmark_exists = 0; |
---|
[15] | 224 | my ($sql_bookmark, @bind_bookmark) = sql_interp( |
---|
| 225 | 'insert into bookmarks', { ($id ? (id => $id) : ()), uri => $uri, ctime => $ctime, mtime => $mtime } |
---|
| 226 | ); |
---|
| 227 | my $sth_bookmark = $self->dbh->prepare($sql_bookmark); |
---|
[2] | 228 | eval { |
---|
[15] | 229 | $sth_bookmark->execute(@bind_bookmark); |
---|
[2] | 230 | }; |
---|
| 231 | if ($@) { |
---|
| 232 | if ($@ =~ /column uri is not unique/) { |
---|
| 233 | # this is not truly an error condition; the bookmark was already there |
---|
[28] | 234 | # set this flag so that later we can update the mtime if tags change |
---|
| 235 | $bookmark_exists = 1; |
---|
[2] | 236 | } else { |
---|
| 237 | die $@; |
---|
| 238 | } |
---|
| 239 | } |
---|
| 240 | |
---|
[46] | 241 | my $changed_tags = $self->_update_tags($uri, $bookmark->{tags}); |
---|
| 242 | |
---|
| 243 | if ($bookmark_exists && $changed_tags) { |
---|
| 244 | # update the mtime if the bookmark already existed but the tags were changed |
---|
| 245 | my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?'); |
---|
| 246 | $sth_update->execute($mtime, $uri); |
---|
| 247 | } |
---|
| 248 | |
---|
| 249 | # return the newly created or updated bookmark |
---|
| 250 | return $self->get_bookmark({ uri => $uri }); |
---|
| 251 | } |
---|
| 252 | |
---|
| 253 | sub update { |
---|
| 254 | my $self = shift; |
---|
| 255 | my $bookmark = shift; |
---|
| 256 | |
---|
| 257 | my $mtime = time; |
---|
| 258 | |
---|
[76] | 259 | # update the URI, if it has changed |
---|
[46] | 260 | my $changed_uri = 0; |
---|
| 261 | my $sth_current = $self->dbh->prepare('select uri from bookmarks where id = ?'); |
---|
| 262 | $sth_current->execute($bookmark->id); |
---|
| 263 | my ($stored_uri) = $sth_current->fetchrow_array; |
---|
| 264 | |
---|
| 265 | if ($stored_uri ne $bookmark->uri) { |
---|
| 266 | # the URI has changed |
---|
| 267 | my $sth_update_uri = $self->dbh->prepare('update resources set uri = ? where uri = ?'); |
---|
| 268 | $sth_update_uri->execute($bookmark->uri, $stored_uri); |
---|
| 269 | $changed_uri++; |
---|
| 270 | } |
---|
| 271 | |
---|
[76] | 272 | # update the title, if it has changed |
---|
| 273 | my $changed_title = 0; |
---|
| 274 | my $sth_current_title = $self->dbh->prepare('select title from resources where uri = ?'); |
---|
| 275 | $sth_current_title->execute($bookmark->uri); |
---|
| 276 | my ($stored_title) = $sth_current_title->fetchrow_array; |
---|
[46] | 277 | |
---|
[76] | 278 | if ($stored_title ne $bookmark->title) { |
---|
| 279 | my $sth_update = $self->dbh->prepare('update resources set title = ? where uri = ?'); |
---|
| 280 | $sth_update->execute($bookmark->title, $bookmark->uri); |
---|
| 281 | $changed_title++; |
---|
| 282 | } |
---|
| 283 | |
---|
| 284 | # update the tags, if they have changed |
---|
[46] | 285 | my $changed_tags = $self->_update_tags($bookmark->uri, $bookmark->tags); |
---|
| 286 | |
---|
[76] | 287 | # update the mtime, if the bookmark has actually been changed |
---|
| 288 | if ($changed_uri or $changed_title or $changed_tags) { |
---|
[46] | 289 | # update the mtime if the bookmark already existed but the tags were changed |
---|
| 290 | my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?'); |
---|
| 291 | $sth_update->execute($mtime, $bookmark->uri); |
---|
| 292 | } |
---|
| 293 | |
---|
| 294 | # return the bookmark |
---|
| 295 | return $bookmark; |
---|
| 296 | } |
---|
| 297 | |
---|
| 298 | sub _update_tags { |
---|
| 299 | my $self = shift; |
---|
| 300 | my ($uri, $tags) = @_; |
---|
| 301 | |
---|
[28] | 302 | my $changed_tags = 0; |
---|
[46] | 303 | my %new_tags = map { $_ => 1 } @{ $tags }; |
---|
[2] | 304 | my $sth_delete_tag = $self->dbh->prepare('delete from tags where uri = ? and tag = ?'); |
---|
| 305 | my $sth_insert_tag = $self->dbh->prepare('insert into tags (uri, tag) values (?, ?)'); |
---|
| 306 | my $sth_current_tags = $self->dbh->prepare('select tag from tags where uri = ?'); |
---|
| 307 | $sth_current_tags->execute($uri); |
---|
| 308 | while (my ($tag) = $sth_current_tags->fetchrow_array) { |
---|
| 309 | if (!$new_tags{$tag}) { |
---|
| 310 | # if a current tag is not in the new tags, remove it from the database |
---|
| 311 | $sth_delete_tag->execute($uri, $tag); |
---|
[28] | 312 | $changed_tags++; |
---|
[2] | 313 | } else { |
---|
| 314 | # if a new tag is already in the database, remove it from the list of tags to add |
---|
| 315 | delete $new_tags{$tag}; |
---|
| 316 | } |
---|
| 317 | } |
---|
| 318 | for my $tag (keys %new_tags) { |
---|
| 319 | $sth_insert_tag->execute($uri, $tag); |
---|
[28] | 320 | $changed_tags++; |
---|
[2] | 321 | } |
---|
| 322 | |
---|
[46] | 323 | # how many tags have changed? |
---|
| 324 | return $changed_tags; |
---|
[2] | 325 | } |
---|
| 326 | |
---|
[46] | 327 | |
---|
[2] | 328 | # module returns true |
---|
| 329 | 1; |
---|