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

Last change on this file since 101 was 92, checked in by peter, 9 years ago

issue #10: added basic test of the web app and the Bookmark class

To make the application testable, BookmarksApp now does not require a
config_file to be set, and can just be configured via a config hash in the
constructor. In addition, authentication and reverse proxy rewriting are now
conditionally enabled based on whether there is an auth and proxy_ip key in
the config, respecitvely.

Added Plack 1.0036 to the cpanfile dependencies, since that is the version that
contains Plack::Test.

Also fixed the Bookmarks::create_tables() method to load the
bookmarks.sql file from the correct location.

File size: 10.4 KB
RevLine 
[2]1package Bookmarks;
2
[15]3use Moose;
[71]4
[9]5use SQL::Interp qw{:all};
[24]6use URI;
[71]7
[2]8use Bookmark;
[71]9use Bookmarks::Search;
[2]10
[15]11has dbh      => ( is => 'rw' );
[24]12has base_uri => ( is => 'ro', isa => 'URI' );
[2]13
[25]14has _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]21sub 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]38sub 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]49sub 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]76sub _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]101sub 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
136sub 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
153sub 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]187sub 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]195sub 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
253sub 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
298sub _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
3291;
Note: See TracBrowser for help on using the repository browser.