source: bookmarks/trunk/lib/Bookmarks.pm @ 86

Last change on this file since 86 was 84, checked in by peter, 9 years ago

issue #9: use FindBin to get the actual path to the bookmarks.sql

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